//JOBNAME JOB (ACCT),NAME,CLASS=A,MSGCLASS=A,MSGLEVEL=(1,1) //********************************************************************* //ASMCG PROC AOPT=,APARM=,LOPT=, // MAC1='SYS1.MACLIB', // MAC2='SYS1.MACLIB', // MAC3='SYS1.MODGEN' //ASM EXEC PGM=ASMA90, // PARM=('OBJ,NODECK,LC(32767),XREF(SHORT),TERM,RLD,ASA,&AOPT', // 'US(MAP,WARN(11)),SYSPARM(&APARM)') //SYSPRINT DD SYSOUT=* //SYSTERM DD SYSOUT=* //SYSLIB DD DISP=SHR,DSN=&MAC1 // DD DISP=SHR,DSN=&MAC2 // DD DISP=SHR,DSN=&MAC3 //SYSUT1 DD UNIT=SYSALLDA,SPACE=(TRK,(80,20)) //SYSLIN DD DISP=(,PASS),UNIT=SYSALLDA,SPACE=(TRK,(30,15),RLSE), // DCB=(RECFM=FB,BLKSIZE=0,LRECL=80) //GO EXEC PGM=LOADER,COND=(5,LT,ASM), // PARM=('LIST,LET,MAP,XREF,&LOPT') //SYSLOUT DD DUMMY //SYSLIN DD DSN=*.ASM.SYSLIN,DISP=(OLD,DELETE) //SYSPRINT DD SYSOUT=* //SYSLIST DD SYSOUT=* // PEND //********************************************************************* //STEP1 EXEC ASMCG //ASM.SYSIN DD * *=====================================================================* * MVS STANDARD HOUSE KEEPING PROCEDURE * *=====================================================================* * *----------------------------------* * * ENTRY PROCESSING * * *----------------------------------* MYASMPGM CSECT , DEFINE CONTROL SECTION MYASMPGM AMODE 31 DEFINE DEFAULT AMODE=31 MYASMPGM RMODE 24 DEFINE DEFAULT RMODE=24 USING *,12 DEFINE BASE REGISTER SAVE (14,12),,* SAVE CALLER REGISTERS LA 12,0(,15) GR12 --> OUR 1ST BASE ADDRESS LR 15,13 SAVE CALLER SAVEAREA CNOP 0,4 INSURE FULL WORD BOUNDARY BAS 13,*+4+72 AROUND OUR SAVEAREA DC 18F'-1' OUR GPR SAVEAREA ST 15,4(,13) SAVE CALLER SAVEAREA POINTER ST 13,8(,15) SET BACK CHAIN FOR LINK TRACE B MAINPROC DO MAINLINE PROCESSING * *----------------------------------* * * EXIT PROCESSING * * *----------------------------------* EXITPROC DS 0H L 13,4(,13) RESTORE CALLER SAVEAREA ST 15,16(,13) PASS RETURN CODE TO CALLER RETURN (14,12),T RESTORE CALLER REGISTERS + AND RETURN TO CALLER EJECT , *********************************************************************** * MAIN LINE PROCESSING. * * ===================================================== * * GR1 -- EXEC PARAMETER PLIST * * GR12 - BASE REGISTER * * GR13 - OUR REGISTER SAVEAREA * *---------------------------------------------------------------------* * SAMPLE CODE OF 'MVS ADVANCED SKILL Vol-2' CHAPTER 5.3 * * ===================================================== * * LIST CATALOG UTILITY BY DFSMS CSI(CATALOG SEARCH INTERFACE). * *---------------------------------------------------------------------* * GR3 --> REMAINING DATA LENGTH * * GR7 --> CURRENT CATALOG DATA ENTRY * * GR8 --> CURRENT CATALOG NAME ENTRY * * GR9 --> CSI RETURN WORKAREA * *********************************************************************** MAINPROC DS 0H OPEN (SYSPRINT,OUTPUT, OPEN LIST DATASET + SYSLIST,OUTPUT) SPACE , * *----------------------------------* * * SETUP CSI INTERFACE AREA * * * ============================== * * * - MAKE UP CSI SELECTION * * * CRITERIA FIELD * * * - LOAD CSI INTERFACE MODULE * * *----------------------------------* USING CSIFIELD,CSISCF ENABLE TO MAP CSI SELECTION + CRITERIA FIELDS L R2,CSIWORKL LOAD STORAGE SIZE GETMAIN RU,LV=(2),LOC=ANY OBTAIN CSI RETURN AREA ST R1,CSIPLIST+8 SAVE IT INTO CSI CALLING PLIST LR R9,R1 GR9 --> CSI RETURN WORKAREA USING CSIRWORK,R9 ADDRESS IT ST R2,CSIUSRLN SET STORAGE SIZE INTO CSIUSRLN SPACE , MVC CSIFILTK,=CL44'USR6.**' SET CSI SEARCH FILTER KEY MVC CSICATNM,BLANKS SET TARGET CATALOG NAME MVI CSICLDI,C'Y' RETURN DATA/INDEX WHEN CLUSTER + NAME WAS MATCHED MVI CSIS1CAT,C' ' SEARCH ALL CATALOG FOR FILTER + KEY IN SYSTEM+ Y = SEARCH TARGET CATALOG ONLY MVI CSIOPTNS,C'F' REQUIRE FULL WORD LENGTH FIELD MVC CSINUMEN,=H'1' SET NUM OF ITEM NAME LIST SPACE , LOAD EP=IGGCSI00 LOAD CSI SERVICE ROUTINE ST R0,ACSISERV SAVE ENTRY ADDRESS SPACE , * *----------------------------------* * * PRINT SYSPRINT TITLE LINE * * *----------------------------------* LA R2,LINEWORK BUILD SYSPRINT TITLE LINE MVC 0(32,R2),=CL32'CATALOG LISTING PROGRAM, FILTER=' LA R2,32(,R2) LOCATE TO END OF FIXED TITLE LA R0,L'CSIFILTK GET FILTER KEY LENGTH LA R1,CSIFILTK I SLR RF,RF I CLI 0(R1),C' ' I BNH *+4+4+4+4 I AHI RF,1 I LA R1,1(,R1) I BCT R0,*-4-4-4-4 V BCTR RF,0 SET FILTER KEY IN PRINT LINE EX RF,*+4+4 I B *+4+6 I MVC 0(0,R2),CSIFILTK V LA R2,1(RF,R2) LOCATE END OF FILTER KEY MVC 0(10,R2),=CL10', CATALOG=' SET CATALOG NAME LA R2,10(,R2) I MVC 0(44,R2),CSICATNM V PUT SYSPRINT,LINEWORK PRINT TITLE LINE-1 MVC LINEWORK,=130C'=' MVC LINEWORK+130(2),BLANKS PUT SYSPRINT,LINEWORK PRINT TITLE LINE-2 PUT SYSPRINT,BLANKS PRINT BLANK LINE SPACE , *---------------------------------------------------------------------* * M A I N L I N E P R O C E S S I N G * *---------------------------------------------------------------------* * *----------------------------------* * * CALL CSI ROUTINE * * *----------------------------------* CALLCSI DS 0H L RF,ACSISERV LOAD CSI ROUTINE ENTRY CALL (15),MF=(E,CSIPLIST) CALL IT LTR RF,RF SUCCESSFUL FUNCTION ? BZ DOLISTUP YES, DO LIST RETURNED DATASETS SPACE , C RF,HIGHCC HIGHEST RETURN CODE ? BNL *+4+4 NO, ST RF,HIGHCC YES, REPLACE IT SPACE , LR R2,RF SAVE CSI RETURN CODE LR R0,RF LOAD IT LA R1,DOUBLE LOAD EDIT FIELD IN PRINT AREA BAS RE,CNVRTX CONVERT IT TO HEX-DECIMAL CHARS MVC ERRMSG+4+25(2),DOUBLE+6 SET CSI RETURN CODE IN MSG L R0,CSIERROR LOAD CSI REASON CODE LA R1,DOUBLE LOAD EDIT FIELD IN PRINT AREA BAS RE,CNVRTX CONVERT IT TO HEX-DECIMAL CHARS MVC ERRMSG+4+28(4),DOUBLE+4 SET CSI REASON CODE IN MSG WTO MF=(E,ERRMSG) INFORM IT SPACE , CH R2,=H'4' RETCD FROM CTLG MANAGER ? BNE DOABEND NO, CLI CSIERROR+3,100 RETCD=100 ? BE DOLISTUP YES, CONTINUE... SPACE , DOABEND DS 0H ABEND (2),DUMP USER ABEND WITH CTLG ERROR CODE SPACE , * *----------------------------------* * * PRINT RETURNED CATALOG ENTRIES * * *----------------------------------* DOLISTUP DS 0H L R3,CSIUSDLN GR3 --> REMAINING DATA LENGTH SH R3,=Y(CSICWORK-CSIRWORK) ADJUST REMAINING LENGTH LA R7,CSICWORK LOCATE NEXT CATALOG NAME ENTRY CHNGCTLG DS 0H LR R8,R7 GR8 --> NEXT CATALOG NAME ENTRY USING CSICWORK,R8 ADDRESS IT LA R7,CSIEWORK LOCATE 1ST DATA ENTRY IN THIS + CATALOG USING CSIEWORK,R7 ADDRESS IT SH R3,=Y(CSIEWORK-CSICWORK) ADJUST REMAINING LENGTH BNP DONE IF NO ENTRY RETURNED SPACE , CLI CSIENAME,0 NULL DSNAME ? BNE *+4+6 NO, MVC CSIENAME,=44C'0' YES, SET SPECIAL NAME + FOR TARGET CATALOG SPACE , EDITDATA DS 0H CLI CSIETYPE,X'F0' CHANGED NEXT CATALOG ? BE CHNGCTLG YES, SPACE , MVC LINEWORK,BLANKS INIT LINE DATA MVC PRTETYP(1),CSIETYPE SET ENTRY TYPE CHARACTER MVI PRTETYP+1,C'-' MVC PRTETYP+2(4),BLANKS TRANSLATE IT TO HUMAN WORD LA RE,TYPTAB I CLI 4(RE),X'FF' I BE *+4+6+4+4+4+6 I CLC 4(1,RE),CSIETYPE I BE *+4+4+4 I LA RE,LYPTAB(,RE) I B *-4-4-6-4-4 I MVC PRTETYP+2(4),5(RE) V L RF,0(,RE) INCREMENT TYPE COUNTER LA RF,1(,RF) I ST RF,0(,RE) V SPACE , MVI PRTETYP+6,C',' MVC PRTENAM,CSIENAME SET ENTRY NAME(DSNAME) MVI PRTENAM+44,C',' MVC PRTVOL1,BLANKS INIT 1ST VOLUME NAME MVI PRTVOLM,C' ' MVI PRTVOLM+1,C',' MVC PRTVOL#,BLANKS INIT NUM OF VOLUMES MVI PRTVOL#+2,C',' MVC PRTCTLG,BLANKS INIT RELATED CATALOG NAME SPACE , TM CSIEFLAG,CSIENTER FIELD ERROR ? BO FIELDERR YES, SPACE , SLR R0,R0 CLEAR WORKREG ICM R1,B'1111',CSILENF1 RETURNED VOLUME DATA ? BZ ENDVOLNM NO, MVC PRTVOL1,CSIDATF1 YES, SET IT(1ST VOLSER) D R0,=F'6' GET NUM OF VOLUMES CVD R1,DOUBLE SET IT IN LIST LINE UNPK PRTVOL#,DOUBLE I OI PRTVOL#+1,C'0' V CH R1,=H'2' MULTIPLE VOLUME DATASET ? BL *+4+4 NO, MVI PRTVOLM,C'+' YES, INDICATE IT ENDVOLNM DS 0H SPACE , MVC PRTCTLG,CSICNAME SET RELATED CATALOG NAME SPACE , ICM RA,B'1111',CSITOTLN LOAD CURRENT ENTRY DATA LENGTH PRTENTRY DS 0H PUT SYSLIST,LINEWORK PUT DATA RECORD LINE... LA R7,CSIEDATA(RA) LOCATE TO NEXT ENTRY PART LA RA,CSIEDATA-CSIEWORK(,RA) GET CURRENT ENTRY PART LENGTH SR R3,RA ADJUST REMAINING LENGTH BP EDITDATA IF PLUS, EDIT NEXT ENTRY DATA SPACE , CLI CSIRESUM,C'Y' RECOMMEND RESUME BY CSI ? BE CALLCSI YES, CALL CSI AGAIN B DONE NO, PROCESSING DONE SPACE , FIELDERR DS 0H MVC PRTVOL1(18),=CL18'*ERROR(????????),,' ICM R0,B'1111',CSIERETN LOAD ERROR INFO CODE LA R1,PRTVOL1+7 LOAD EDIT FIELD IN PRINT AREA BAS RE,CNVRTX CONVERT IT TO HEX-DECIMAL CHARS LA RA,L'CSIERETN LOAD CURRENT ENTRY PART LENGTH B PRTENTRY SPACE , *---------------------------------------------------------------------* * E N D O F P R O C E S S I N G * *---------------------------------------------------------------------* DONE DS 0H * *----------------------------------* * * PRINT CATALOG SEARCH SUMMARY * * *----------------------------------* MVC LINEWORK,BLANKS MVC LINEWORK(36),=C'THE NUMBER OF ENTRIES PROCESSED WAS:' PUT SYSPRINT,LINEWORK PUT IT TO SUMLIST MVC LINEWORK,BLANKS SPACE , LA R2,TYPTAB MAKE ENTRY TYPE SUMMARY SH R2,=Y(LYPTAB) I ADJUST FOR LOOP SLR R3,R3 I CLEAR TOTAL COUNTER SUMMARY DS 0H I LA R2,LYPTAB(,R2) I LOCATE TO NEXT ENTRY L R0,0(,R2) I LOAD NUM OF ENTRIES AR R3,R0 I ADD FOR TOTAL COUNTER MVC LINEWORK(12),12(R2) I SET ENTRY TYPE NAME CVD R0,DOUBLE I CONVERT PACKED DECIMAL MVC LINEWORK+12(15),=XL15'6020206B2020206B2020206B202120' LA R1,LINEWORK+12+15-1 I PRELOAD LAST DIGIT ADDRESS EDMK LINEWORK+12(15),DOUBLE+2 I EDIT TO 'Z,ZZZ,ZZZ,ZZ9' BCTR R1,0 I CORRECT SIGN LOCATION MVI 0(R1),C' ' V SET SPACE AS SIGN PUT SYSPRINT,LINEWORK PUT NEXT ENTRY TYPE TO SUMLIST CLI 4(R2),X'FF' E.O.T ? BNE SUMMARY LOOP FOR NEXT TYPE ENTRY SPACE , MVC LINEWORK(27),=27C'=' PUT SYSPRINT,LINEWORK PUT IT TO SUMLIST SPACE , MVC LINEWORK(12),=CL12'TOTAL ------' CVD R3,DOUBLE CONVERT PACKED DECIMAL MVC LINEWORK+12(15),=XL15'6020206B2020206B2020206B202120' LA R1,LINEWORK+12+15-1 PRELOAD LAST DIGIT ADDRESS EDMK LINEWORK+12(15),DOUBLE+2 EDIT TO 'Z,ZZZ,ZZZ,ZZ9' BCTR R1,0 CORRECT SIGN LOCATION MVI 0(R1),C' ' SET SPACE AS SIGN PUT SYSPRINT,LINEWORK PUT TOTALS TO SUMLIST SPACE , * *----------------------------------* * * CLEAN-UP USED RESOURCES * * *----------------------------------* L R0,CSIWORKL LOAD STORAGE SIZE L R1,CSIPLIST+8 LOAD STORAGE ADDRESS FREEMAIN RU,LV=(0),A=(1) RELEASE IT CLOSE (SYSPRINT,,SYSLIST) CLOSE LIST DATASET L RF,HIGHCC LOAD HIGHEST RETURN CODE SPACE , * *----------------------------------* * * END OF PROCESSING * * *----------------------------------* SLR 15,15 LOAD RETURN CODE = 0 B EXITPROC DO EXIT PROCESSING EJECT , *********************************************************************** * I N T E R N A L S U B R O U T I N E S * *********************************************************************** *---------------------------------------------------------------------* * CNVRTX - CONVERT BINARY TO HEX-DECIMAL TEXT (REGISTER TYPE) * * CALL INTERFACE - * * GR0: FULL-WORD BINARY VALUE * * GR1: 8BYTES OUTPUT-AREA ADDRESS * * BAS 14,CNVRTX * *---------------------------------------------------------------------* CNVRTX DS 0H CONVERT GR0 TO HEX-DECIMAL LA 1,7(,1) LA 15,8 STC 0,0(,1) NI 0(1),X'0F' TR 0(1,1),CNVTRT2 SRL 0,4 BCTR 1,0 BCT 15,*-2-4-6-4-4 BR 14 CNVTRT2 DC CL16'0123456789ABCDEF' TRANS TABLE FOR HEX-CHARACTER EJECT , *********************************************************************** * DATA AREA * *********************************************************************** DS 0D *---------------------------------------------------------------------* * *----------------------------------* * * MISCELLANEOUS * * *----------------------------------* DOUBLE DC D'0' DOUBLE WORD WORKAREA HIGHCC DC F'0' HIGHEST COMPLETION CODE BLANKS DC CL132' ' BLANK CONSTANT LINEWORK DC CL132' ' LINE DATA EDIT WORKAREA ORG LINEWORK PRTETYP DC CL6' ' DC CL1',' PRTENAM DC CL44' ' DC CL1',' PRTVOL1 DC CL6' ' PRTVOLM DC CL1' ' DC CL1',' PRTVOL# DC CL2'99' DC CL1',' PRTCTLG DC CL44' ' ORG , SYSPRINT DCB DDNAME=SYSPRINT, DCB FOR SYSPRINT DATASET + DSORG=PS,MACRF=PM,RECFM=FB,BLKSIZE=0,LRECL=132 SYSLIST DCB DDNAME=SYSLIST, DCB FOR SYSLIST DATASET + DSORG=PS,MACRF=PM,RECFM=FB,BLKSIZE=0,LRECL=132 SPACE , TYPTAB DS 0H CATALOG ENTRY TYPE TABLE DC F'0',CL1'A',CL7'NVSM',CL12'NONVSAM ----' NONVSAM DATASET LYPTAB EQU *-TYPTAB (LENGTH OF ENTRY) DC F'0',CL1'B',CL7'GDG',CL12'GDG ---------' GENE DATA GROUP DC F'0',CL1'H',CL7'NVSM',CL12'GD(NONVSAM) ' NONVSAM DATASET DC F'0',CL1'C',CL7'CLST',CL12'CLUSTER ----' VSAM CLUSTER DC F'0',CL1'I',CL7'INDX',CL12'INDEX ------' VSAM INDEX DC F'0',CL1'D',CL7'DATA',CL12'DATA -------' VSAM DATA DC F'0',CL1'G',CL7'AIX',CL12'AIX ---------' VSAM ALT INDEX DC F'0',CL1'R',CL7'PATH',CL12'PATH -------' VSAM ALT PATH DC F'0',CL1'X',CL7'ALIS',CL12'ALIAS ------' ALIAS DC F'0',CL1'U',CL7'CTLG',CL12'USERCATALOG ' USER CATALOG DC F'0',XL1'FF',XL7'FFFFFFFFFFFFFF',CL12'OTHER ENTRY ' SPACE , ERRMSG WTO 'RECEIVED CSI ERROR, CODE=XX(XXXX)',MF=L SPACE , * *----------------------------------* * * CSI CALLING PARAMETERS * * * ============================== * * * CSI ADDRESS PLIST FORMAT * * * GR1 --> A(Reason Field) * * * A(Selection * * * Criteria Fields) * * * A(Return Area) * * *----------------------------------* ACSISERV DC A(0) ENTRY OF CSI SERVICE ROUTINE CSIPLIST CALL ,(CSIERROR, CSI SERVICE CALLING PLIST + CSISCF, + 0),MF=L SPACE , CSIERROR DC F'0' CSI ERROR CODE CSIERMID EQU CSIERROR+0,2 (MODULE ID) CSIERRSN EQU CSIERROR+2,1 (REASON CODE) CSIERRTN EQU CSIERROR+3,1 (RETURN CODE) SPACE , CSISCF DS 0F DC (CSIENTS-CSIFIELD)C' ' CSI SELECTION CRITERIA FIELDS + (MAPPED BY IGGCSINA MACRO) DC CL8'VOLSER' (REQUIRE RTN VOLUME NAME) SPACE , CSIWORKL DC F'64000' CSI RETURN WORKAREA STORAGE SIZE (64000 IS IBM RECOMMENDED SIZE) *---------------------------------------------------------------------* LTORG , LITERAL POOL AT HERE DROP , FORGET ALL BASE REGISTERS EJECT , *********************************************************************** * DATA AREA (OUTSIDE OUR BASE) * *********************************************************************** *---------------------------------------------------------------------* * LOCAL WORKAREA * *---------------------------------------------------------------------* *---------------------------------------------------------------------* * DSECTS * *---------------------------------------------------------------------* *********************************************************************** * CSI INPUT/OUTPUT PARAMETER AREA DSECT * *********************************************************************** * *----------------------------------* * * CSI SELECTION CRITERIA FIELD * * *----------------------------------* COPY IGGCSINA CSI SELECTION CRITERIA FIELD * *----------------------------------* * * CSI RETURN WORKAREA * * *----------------------------------* CSIRWORK DSECT , CSI Return Work Area CSIUSRLN DC F'0' (IN) Total length of work area. + (User provided) CSIREQLN DC F'0' (OT) Minimum required work area for + 1 catalog name entry and + 1 data entry entry. CSIUSDLN DC F'0' (OT) Total length of work area used + in returning entries. CSINUMFD DC H'0' (OT) Num of filed names +1. *---------------------------------------------------------------------* CSICWORK DS 0C CSICFLAG DC XL1'00' (OT) Catalog flag information CSINTICF EQU X'80' (Not supported) CSINOENT EQU X'40' No entry found for this catalo CSINTCMP EQU X'20' Data gotten for this catalog + is not complete. CSICERR EQU X'10' Whole catalog not processed + due to error. CSICERRP EQU X'08' Catalog partially processed + due to error. CSICTYPE DC XL1'F0' (OT) Catalog type. X'F0' CSICNAME DC CL44' ' (OT) Catalog name CSICRETN DS 0AL4 (OT) Return information for Catalog CSICRETM DC AL2(0) Catalog return module ID CSICRETR DC AL1(0) Catalog return reason code CSICRETC DC AL1(0) Catalog return code *---------------------------------------------------------------------* CSIEWORK DS 0C CSIEFLAG DC XL1'00' (OT) Entry flag information CSIPMENT EQU X'80' Primary entry. CSIENTER EQU X'40' Error indication is set for + this entry and error code + follows CSIENAME. CSIERDAT EQU X'20' Data is returned for this entr CSIETYPE DC CL1' ' (OT) Entry Type. + A - Non-VSAM data set + B - Generation data group + C - Cluster + D - Data component + G - Alternate index ******** H - Generation data set + I - Index component + R - Path + X - Alias + U - User catalog + W - ATL Volume entry + L - ATL Library entry CSIENAME DC CL44' ' (OT) Entry name CSIEDATA DS 0C (OT) Returned data for entry. + (Only exists if CSIENTER is 0) CSITOTLN DC FL4'0' Total length of returned + information including this + field and length fields. + The next entry begins at this + offset plus this length. DC XL4'00' (Reserved) CSILENFD DS 0C (OT) Return field length.(variable) CSILENF1 DC FL4'0' Length of fields-1. + There is one length field + returned for each field name + passed on input. CSIDATFD DC 0C (OT) Return Field data.(variable) + For each field name passed on + input, there will be a data + item corresponding to its length. CSIDATF1 EQU * (1st filed data at here) ORG CSIEDATA CSIERETN DS 0AL4 (ER) Return information for Entry. + (Only exists if CSIENTER is 1) CSIERETM DC AL2(0) Entry return module ID CSIERETR DC AL1(0) Entry return reason code CSIERETC DC AL1(0) Entry return code ORG , *---------------------------------------------------------------------* * S/370, ESA/390 REGISTER EQUATES * *---------------------------------------------------------------------* YREGS , OS: REGISTER EQUATES RA EQU 10 ADD EQUATION FOR GR10 RB EQU 11 ADD EQUATION FOR GR11 RC EQU 12 ADD EQUATION FOR GR12 RD EQU 13 ADD EQUATION FOR GR13 RE EQU 14 ADD EQUATION FOR GR14 RF EQU 15 ADD EQUATION FOR GR15 END // //