PRINT NOGEN 00010000 *********************************************************************** 00020000 * Title : Print ACBLIB directory in a sensible form * 00030000 * * 00040000 * Submitter : Dougie Lawson * 00050000 * Consultant Systems Programmer * 00060000 * IBM UK * 00070000 * * 00080000 * Phone : 01256 341061 * 00090000 * * 00100000 * JCL:- * 00110000 * * 00120000 * // EXEC PGM=ACBLIST * 00130000 * //STEPLIB DD DSN=***************,DISP=SHR * 00140000 * //ACBLIB DD DSN=********.ACBLIB,DISP=SHR * 00150000 * //SYSPRINT DD SYSOUT=*,LRECL=133,BLKSIZE=1334,RECFM=VBA @DGL01 * 00160000 * //SYSUDUMP DD SYSOUT=* * 00170000 * * 00180000 * Amended : Neil Price TNT Express Worldwide 29/11/1996 ** NRP * 00190000 * - Initialise print-line to spaces * 00200000 * - Removed IMS 1.2, added 3.x (not documented in ACBDIR) * 00210000 * - Changed DMB size calulation from MH to SLL * 00220000 * - Adjusted PSB size multiplier to 16 to agree with ACBGEN * 00230000 * as per PDIRSHFT in macro DFSPDIR * 00240000 * - Added storage sizes to report * 00250000 * - Minor cosmetic changes incl. added comments * 00260000 * Amended : Neil Price TNT Express Worldwide 24/05/2001 ** NRP1* 00270000 * - Adjusted PSB size multiplier to 64 for V7 only * 00280000 * as per PDIRSHFT in macro DFSPDIR * 00290000 * - Removed IMS 1.3 and 2.2, added 6.1 and 7.1 * 00300000 * Amended : Dougie Lawson, IBM 03/02/2003 @DGL01 * 00310000 * - PHDAM, PHIDAM, PSINDEX support @DGL01 * 00320000 * - removed IMS 3.1, 4.1 @DGL01 * 00330000 * - added IMS 8.1 @DGL01 * 00340000 * - renumbered source code @DGL01 * 00350000 *********************************************************************** 00360000 REQUATE ** NRP 00370000 ACBLIST CSECT 00380000 ACBLIST AMODE 31 00390000 ACBLIST RMODE ANY 00400000 BAKR R14,0 00410000 USING ACBLIST,R12 00420000 LR R12,R15 00430000 STORAGE OBTAIN,LENGTH=4096,LOC=BELOW 00440000 USING DSA,R13 00450000 LR R13,R1 00460000 LA R2,AC2LISTB 00470000 L R3,=A(AC2LISTL) 00480000 LA R4,AC3LISTB 00490000 L R5,=A(AC3LISTL) 00500000 MVCL R4,R2 00510000 MVI PRTLINE,C' ' ** NRP 00520000 MVC PRTLINE+1(LPRTLINE-1),PRTLINE ** NRP 00530000 LA R2,DIRJFCBA 00540000 ST R2,DIREXLST 00550000 MVI DIREXLST,X'07' 00560000 LA R2,DIREXLST 00570000 STCM R2,B'0111',DIRBLK+37 00580000 OI OPENLIST+4,X'80' 00590000 OPEN (DIRBLK,,SYSPRINT,OUTPUT),MF=(E,OPENLIST) 00600000 TM SYSPRINT+48,X'10' 00610000 BO SYSPOK 00620000 WTO MF=(E,MSG1) 00630000 OI CLSLIST,X'80' 00640000 CLOSE (DIRBLK),MF=(E,CLSLIST) 00650000 LA R15,16 00660000 PR 00670000 SYSPOK DS 0H 00680000 TIME DEC 00690000 STM R0,R1,TIMEDATE 00700000 UNPK UNPKTIME,TIMEDATE 00710000 TR HDRDATE,UNPKTIME 00720000 MVI HDRANSI,C'1' 00730000 OI OPENLIST,X'80' 00740000 RDJFCB (DIRBLK),MF=(E,OPENLIST) 00750000 MVC HDRDSN,DIRJFCBA 00760000 PUT SYSPRINT,HDRLINE 00770000 PUT SYSPRINT,TITLE 00780000 MVI PRTANSI,C'0' 00790000 XC LINECNT,LINECNT 00800000 MVC PRTLINE,=Y(LPRTLINE) 00810000 SLR R2,R2 00820000 EACHDIR DS 0H 00830000 GET DIRBLK,INARE READ A RECORD 00840000 LA R7,INARE+2 SKIP LENGTH NIBBL 00850000 LA R2,INARE 00860000 AH R2,INARE ADD THE LENGTH. 00870000 EACHMEM DS 0H 00880000 CLC LASTMEM,0(R7) HIGH VALUES? (END OF DIRECTORY) 00890000 BE ENDIT YES 00900000 MVC PRTNAME,0(R7) 00910000 BAL R9,EACHBLK 00920000 CR R2,R7 IS NEXT BLOCK IN BUFFER 00930000 BNH EACHDIR NO GET NEXT DIRECTORY BLOCK 00940000 B EACHMEM YES PROCESS NEXT MEMBER 00950000 ENDIT DS 0H 00960000 OI CLSLIST+4,X'80' 00970000 CLOSE (DIRBLK,,SYSPRINT),MF=(E,CLSLIST) 00980000 PR 00990000 EACHBLK DS 0H 01000000 USING ACBNTRY,R7 01010000 UNPK UNPADATE,ACBDATE 01020000 MVC PRTDATE,PATADATE 01030000 TR PRTDATE,UNPADATE 01040000 MVO WKATIME,ACBTIME 01050000 OI WKATIME+4,X'0F' 01060000 UNPK UNPATIME,WKATIME 01070000 MVC PRTTIME,PATATIME 01080000 TR PRTTIME,UNPATIME 01090000 CLI ACBRLVL,ACBREL81 , @DGL01 01100000 BE IMS81 , @DGL01 01110000 CLI ACBRLVL,ACBREL71 ** NRP1 01120000 BE IMS71 ** NRP1 01130000 CLI ACBRLVL,ACBREL61 ** NRP1 01140000 BE IMS61 ** NRP1 01150000 CLI ACBRLVL,ACBREL51 01160000 BE IMS51 01170000 * CLI ACBRLVL,ACBREL41 , @DGL01 01180000 * BE IMS41 , @DGL01 01190000 * CLI ACBRLVL,ACBREX41 , @DGL01 01200000 * BE IMS41 , @DGL01 01210000 * CLI ACBRLVL,ACBREL31 , @DGL01 01220000 * BE IMS31 , @DGL01 01230000 * CLI ACBRLVL,ACBREX31 , @DGL01 01240000 * BE IMS31 , @DGL01 01250000 * CLI ACBRLVL,ACBREL30 , @DGL01 01260000 * BE IMS31 , @DGL01 01270000 MVC PRTRELL,=C'UNK' 01280000 B RELDONE 01290000 IMS81 DS 0H , @DGL01 01300000 MVC PRTRELL,=C'8.1' , @DGL01 01310000 MVI PSBMULT+1,64 Change multiplier to 64 , @DGL01 01320000 B RELDONE , @DGL01 01330000 IMS71 DS 0H ** NRP1 01340000 MVC PRTRELL,=C'7.1' ** NRP1 01350000 MVI PSBMULT+1,64 Change multiplier to 64** NRP1 01360000 B RELDONE ** NRP1 01370000 IMS61 DS 0H ** NRP1 01380000 MVC PRTRELL,=C'6.1' ** NRP1 01390000 B RELDONE ** NRP1 01400000 IMS51 DS 0H 01410000 MVC PRTRELL,=C'5.1' 01420000 B RELDONE 01430000 *MS41 DS 0H , @DGL01 01440000 * MVC PRTRELL,=C'4.1' , @DGL01 01450000 * B RELDONE , @DGL01 01460000 *MS31 DS 0H , @DGL01 01470000 * MVC PRTRELL,=C'3.1' , @DGL01 01480000 RELDONE DS 0H 01490000 TM ACBFLAG,ACBDMB 01500000 BZ PSB 01510000 MVC PRTTYPE,=C'DMB ' 01520000 TM ACBFLAG,ACBMSDB 01530000 BO MSDB 01540000 TM ACBFLAG,ACBDEDB 01550000 BO DEDB 01560000 * Flag settings copied from V7 acbdir macro , @DGL01 01570000 *ACBL2FLG DS XL1 . , @DGL01 01580000 *ACB2PDB EQU X'80' Not sure on this flag meaning , @DGL01 01590000 *ACBHDPD EQU X'40' PARTITIONED HDAM DB , @DGL01 01600000 *ACBHIPD EQU X'20' PARTITIONED HIDAM DB , @DGL01 01610000 * use ACBFLAG+1 because V5 and V6 maclib doesn't have flags , @DGL01 01620000 TM ACBFLAG+1,X'40' , @DGL01 01630000 BO PHDAM , @DGL01 01640000 TM ACBFLAG+1,X'20' , @DGL01 01650000 BO PHIDAM , @DGL01 01660000 TM ACBFLAG+1,X'80' , @DGL01 01670000 BO PDB , @DGL01 01680000 MVC PRTDMBT,=C'DL/1' 01690000 B TYPEDONE 01700000 PDB DS 0H , @DGL01 01710000 MVC PRTDMBT,=C'PDB ' , @DGL01 01720000 B TYPEDONE , @DGL01 01730000 PHDAM DS 0H , @DGL01 01740000 MVC PRTTYPE,=C'PHDAM' , @DGL01 01750000 B TYPEDONE , @DGL01 01760000 PHIDAM DS 0H , @DGL01 01770000 MVC PRTTYPE,=C'PHIDAM' , @DGL01 01780000 B TYPEDONE , @DGL01 01790000 MSDB DS 0H 01800000 MVC PRTDMBT,=C'MSDB' 01810000 B TYPEDONE 01820000 DEDB DS 0H 01830000 MVC PRTDMBT,=C'DEDB' 01840000 B TYPEDONE 01850000 PSB DS 0H 01860000 MVC PRTTYPE,=C'PSB ' 01870000 TYPEDONE DS 0H 01880000 * FORMAT TTR ** NRP 01890000 XC WORKA1,WORKA1 01900000 MVC WORKA1+1,ACBTTR 01910000 MVO WORKA2,WORKA1 01920000 UNPK WORKA3,WORKA2 01930000 NC WORKA3,PATTERN 01940000 TR WORKA3,TRANTAB 01950000 MVC PRTTTR,WORKA3+3 01960000 LH R4,ACBSIZE 01970000 TM ACBFLAG,ACBDMB Is it a DMB? ** NRP1 01980000 BZ PSBSTOR No - it's a PSB ** NRP1 01990000 * Process DMB ** NRP1 02000000 SLL R4,3 Multiply by 8 ** NRP1 02010000 CVD R4,PACKSIZE 02020000 UNPK PRTSIZE,PACKSIZE+4 02030000 OI PRTSIZE+7,X'F0' 02040000 MVC PRTCSA,=CL8' ' ** NRP 02050000 MVC PRTSAS,=CL8' ' ** NRP 02060000 MVC PRTPSBW,=CL8' ' ** NRP 02070000 B PRTDONE ** NRP 02080000 * Process PSB ** NRP1 02090000 PSBSTOR DS 0H ** NRP 02100000 MH R4,PSBMULT Multiply by 16 or 64 ** NRP1 02110000 CVD R4,PACKSIZE ** NRP1 02120000 UNPK PRTSIZE,PACKSIZE+4 ** NRP1 02130000 OI PRTSIZE+7,X'F0' ** NRP1 02140000 * CSA SIZE ** NRP 02150000 LH R5,ACBPCBS ** NRP 02160000 MH R5,PSBMULT Multiply by 16 or 64 ** NRP1 02170000 CVD R5,PACKSIZE ** NRP 02180000 UNPK PRTCSA,PACKSIZE+4 ** NRP 02190000 OI PRTCSA+7,X'F0' ** NRP 02200000 * SAS SIZE ** NRP 02210000 SR R4,R5 ** NRP 02220000 CVD R4,PACKSIZE ** NRP 02230000 UNPK PRTSAS,PACKSIZE+4 ** NRP 02240000 OI PRTSAS+7,X'F0' ** NRP 02250000 * PSBW SIZE ** NRP 02260000 LH R4,ACBXWA ** NRP 02270000 MH R4,PSBMULT Multiply by 16 or 64 ** NRP1 02280000 CVD R4,PACKSIZE ** NRP 02290000 UNPK PRTPSBW,PACKSIZE+4 ** NRP 02300000 OI PRTPSBW+7,X'F0' ** NRP 02310000 SPACE , @DGL01 02320000 PRTDONE DS 0H ** NRP 02330000 BAL R10,PRINT 02340000 AH R7,=Y(ACBDSLN) 02350000 BR R9 02360000 DROP R7 02370000 * PRINT Subroutine ** NRP 02380000 PRINT DS 0H 02390000 PUT SYSPRINT,PRTLINE 02400000 MVI PRTANSI,C' ' 02410000 LH R3,LINECNT 02420000 AH R3,=H'1' 02430000 STH R3,LINECNT 02440000 CH R3,=H'50' 02450000 BNL PRINTHDR 02460000 BR R10 02470000 PRINTHDR DS 0H 02480000 PUT SYSPRINT,HDRLINE 02490000 PUT SYSPRINT,TITLE 02500000 MVI PRTANSI,C'0' 02510000 XC LINECNT,LINECNT 02520000 BR R10 02530000 SPACE , @DGL01 02540000 PATADATE DC X'000105020304' 02550000 PATATIME DC X'0001080203080405090607' 02560000 PATTERN DC 9X'0F' 02570000 TRANTAB DC C'0123456789ABCDEF' 02580000 LASTMEM DC X'FFFFFFFFFFFFFFFF' 02590000 MSG1 WTO '*** SYSPRINT DD OPEN FAILURE, RUN ABANDONED ***', *02600000 ROUTCDE=11,MF=L 02610000 TITLE DC Y(LTITLE),H'0' 02620000 DC C'-' 02630000 DC CL8'ACB NAME' 02640000 DC CL4' ' 02650000 DC CL6' TTR ' 02660000 DC CL2' ' 02670000 DC CL8'ACB-TYPE' 02680000 DC CL2' ' 02690000 DC CL19' DATE TIME' 02700000 DC CL2' ' 02710000 DC CL8' SIZE ' 02720000 DC CL2' ' 02730000 DC CL3'REL' 02740000 DC CL2' ' 02750000 DC CL8' PSBW ' 02760000 DC CL2' ' 02770000 DC CL8' CSA ' 02780000 DC CL2' ' 02790000 DC CL8' SAS ' 02800000 LTITLE EQU *-TITLE 02810000 DS 0D 02820000 AC2LISTB EQU * 02830000 DCB DDNAME=SYSPRINT,DSORG=PS,MACRF=PM,RECFM=VBA 02840000 DCB DDNAME=ACBLIB,DSORG=PS,RECFM=U,LRECL=256,MACRF=(GM), C02850000 EODAD=ENDIT 02860000 DC H'16' ** NRP1 02870000 #DRLINE DC Y(L#DRLINE),H'0' 02880000 DS C' ' 02890000 DC C' ' 02900000 DC X'00011002031004050F0F0A0B110C0D0E' 02910000 DC C' - ACB DIRECTORY LIST FOR LIBRARY - ' 02920000 DC CL44' ' 02930000 L#DRLINE EQU *-#DRLINE 02940000 DC CL15' ',C' :.' 02950000 DC CL5' ',C'.' 02960000 DC CL8' ',C':.' 02970000 AC2LISTL EQU *-AC2LISTB 02980000 LTORG 02990000 DSA DSECT 03000000 DS 18F 03010000 AC3LIST EQU * 03020000 TIMEDATE DS PL8 03030000 PACKSIZE DS 2F 03040000 WKATIME DC CL5' ' 03050000 WORKA1 DS F 03060000 WORKA2 DS XL5 03070000 WORKA3 DS XL9 03080000 LINECNT DS H 03090000 OPENLIST OPEN (DIRBLK,,SYSPRINT,OUTPUT),MF=L 03100000 CLSLIST CLOSE (DIRBLK,,SYSPRINT),MF=L 03110000 DIREXLST DS F 03120000 DIRJFCBA DS 0F,176C 03130000 DS 0D 03140000 AC3LISTB EQU * 03150000 SYSPRINT DCB DDNAME=SYSPRINT,DSORG=PS,MACRF=PM,RECFM=VBA 03160000 DIRBLK DCB DDNAME=ACBLIB,DSORG=PS,RECFM=U,LRECL=256,MACRF=(GM), C03170000 EODAD=ENDIT 03180000 PSBMULT DC H'16' ** NRP1 03190000 HDRLINE DC H'0',H'0' 03200000 HDRANSI DS C 03210000 DC C' ' 03220000 HDRDATE DC X'00011002031004050F0F0A0B110C0D0E' 03230000 DC C' - ACB DIRECTORY LIST FOR LIBRARY - ' 03240000 HDRDSN DC CL44' ' 03250000 UNPKTIME DC CL15' ',C' :.' 03260000 UNPADATE DC CL5' ',C'.' 03270000 UNPATIME DC CL8' ',C':.' 03280000 AC3LISTL EQU *-AC3LISTB 03290000 PRTLINE DC H'0',H'0' 03300000 PRTANSI DS C 03310000 PRTNAME DS CL8 03320000 DS CL4 03330000 PRTTTR DS CL6 03340000 DS CL2 03350000 PRTTYPE DS 0CL8 ** NRP 03360000 DS CL4 ** NRP 03370000 PRTDMBT DS CL4 03380000 DS CL2 03390000 PRTDATE DS CL6 03400000 DS CL2 03410000 PRTTIME DS CL11 03420000 DS CL2 03430000 PRTSIZE DS CL8 03440000 DS CL2 03450000 PRTRELL DS CL3 03460000 DS CL2 ** NRP 03470000 PRTPSBW DS CL8 ** NRP 03480000 DS CL2 ** NRP 03490000 PRTCSA DS CL8 ** NRP 03500000 DS CL2 ** NRP 03510000 PRTSAS DS CL8 ** NRP 03520000 LPRTLINE EQU *-PRTLINE 03530000 DS 0F , @DGL01 03540000 INARE DC 256C' ' 03550000 *C3LISTS EQU *-AC3LIST 03560000 ACBDIR DSECT=YES,PREFIX=ACB 03570000 *CBREL30 EQU X'30' , @DGL01 03580000 *CBREL31 EQU X'31' , @DGL01 03590000 *CBREX31 EQU X'3A' , @DGL01 03600000 *CBREL41 EQU X'32' , @DGL01 03610000 *CBREX41 EQU X'3B' , @DGL01 03620000 ACBREL51 EQU X'50' 03630000 ACBREL61 EQU X'61' ** NRP1 03640000 ACBREL71 EQU X'71' ** NRP1 03650000 ACBREL81 EQU X'81' , @DGL01 03660000 END 03670000