TITLE "RETRIEVE SEPT"; /***********************************************************/ /* AUTHOR. LEIF SVALGAARD */ /* WRITTEN. 99/02/11 */ /* REVISED. 99/02/15 */ /* USE: RTVSEPT */ /***********************************************************/ DCL SPCPTR .PARM1 PARM; DCL DD PARM-LIB CHAR(10) BAS(.PARM1); DCL OL PARAMETERS(.PARM1) EXT PARM MIN(0); DCL DD NBR-OF-PARMS BIN(2); DCL SPCPTR .NULL; DCL CON CLOSE-ENTRY BIN(2) INIT(11); DCL CON OPEN-ENTRY BIN(2) INIT(12); DCL CON *LIBL BIN(2) INIT(-75); /* S/38: -72 */ DCL CON *FIRST BIN(2) INIT(-71); /* S/38: -73 */ DCL CON THE-LIB BIN(2) INIT(72); DCL CON THE-MBR BIN(2) INIT(73); DCL DD BINARY-CHARS CHAR(4); DCL DD BINARY-VALUE BIN(4) DEF(BINARY-CHARS) POS(1); DCL DD ENTRY-NBR BIN(2); DCL SPCPTR .ODP-ROOT; DCL SPC ODP-ROOT BAS(.ODP-ROOT); DCL DD ODP-STATUS CHAR(4) DIR; DCL DD ODP-DEV-LENGTH BIN(4) DIR; DCL DD ODP-OPEN-SIZE BIN(4) DIR; DCL DD ODP.OPEN-FEEDBCK BIN(4) DIR; DCL DD ODP.DEV-NAMELIST BIN(4) DIR; DCL DD ODP.IO-FEEDBACK BIN(4) DIR; DCL DD ODP.LOCK-LIST BIN(4) DIR; DCL DD ODP.SPOOL-OUTPUT BIN(4) DIR; DCL DD ODP.MBR-DESCR BIN(4) DIR; DCL DD ODP.CUR-IN-REC BIN(4) DIR; DCL DD ODP.CUR-OUT-REC BIN(4) DIR; DCL DD ODP.OPEN-DMCQ BIN(4) DIR; DCL DD ODP.OUTSTANDINGS BIN(4) DIR; DCL DD * CHAR(12) DIR; DCL SYSPTR .ODP-CURSOR DIR; DCL SPCPTR * DIR; DCL SPCPTR .ODP-CDM-ERROR DIR; DCL SPCPTR .ODP-INPUT-BUFFER DIR; DCL SPCPTR .ODP-OUTPUT-BUFFER DIR; DCL DD ODP.CDM-CLOSING BIN(2) DIR; DCL DD ODP-DEV-NAME-IDX BIN(2) DIR; DCL DD ODP-NBR-OF-DEVS BIN(2) DIR; DCL DD ODP-SEQUENCE-NBR BIN(4) DIR; DCL DD ODP-REC-LENGTH BIN(2) DIR; DCL DD ODP-REC-LENGTH2 BIN(2) DIR; DCL DD ODP-NBR-OF-*RDS BIN(2) DIR; DCL DD ODP-RELEASE-NBR BIN(2) DIR; DCL DD ODP-OPEN-POSN CHAR(1) DIR; DCL DD ODP-OVR-REC-LEN BIN(2) DIR; DCL DD ODP-COM-DEV-CNT BIN(2) DIR; DCL DD ODP.INPUT-BPCA BIN(4) DIR; DCL DD ODP.OUTPUT-BPCA BIN(4) DIR; DCL DD ODP............ CHAR(1) DIR; DCL SPCPTR .DEV-CONTROL-BLOCK; DCL SPC DEV-CONTROL-BLOCK BAS(.DEV-CONTROL-BLOCK); DCL DD DCB-MAX-NBR-OF-DEVICES BIN( 2) DIR; DCL DD DCB-DEVICES-IN-THE-ODP BIN( 2) DIR; DCL DD DCB-DEVICE-NAME CHAR(10) DIR; DCL DD DCB-OFFSET-TO-FM-WORK BIN( 4) DIR; DCL DD DCB-LENGTH-OF-FM-WORK BIN( 4) DIR; DCL DD DCB-INDEX-FOR-LUD-PTR BIN( 2) DIR; DCL DD DCB-GET BIN( 2) DIR; DCL DD DCB-GET-BY-RRN BIN( 2) DIR; DCL DD DCB-GET-BY-KEY BIN( 2) DIR; DCL DD * BIN( 2) DIR; DCL DD DCB-PUT BIN( 2) DIR; DCL DD DCB-PUT-GET BIN( 2) DIR; DCL DD DCB-UPDATE BIN( 2) DIR; DCL DD DCB-DELETE BIN( 2) DIR; DCL DD DCB-FORCE-EOD BIN( 2) DIR; DCL DD DCB-FORCE-EOV BIN( 2) DIR; DCL DD * BIN( 2) DIR; DCL DD * BIN( 2) DIR; DCL DD DCB-FREE-REC-LOCK BIN( 2) DIR; DCL DD * BIN( 2) DIR; DCL DD * BIN( 2) DIR; DCL DD * BIN( 2) DIR; DCL DD DCB-CLOSE BIN( 2) DIR; DCL DD DCB-OPEN BIN( 2) DIR; DCL DD DCB-SPTB BIN( 2) DIR; /* THE I/O IS DONE BY USING THE CALLX INSTRUCTION REFERENCING */ /* A SYSTEM POINTER THAT IS OBTAINED FROM THE ENTRY POINT */ /* TABLE. THE ENTRY POINT TABLE CONTAINS PRE-RESOLVED SYSTEM */ /* POINTERS (THOUSANDS...). THE SYSTEM ENTRY POINT TABLE */ /* IS ADDRESSED BY THE POINTER BASED ON THE PROCESS COMMUNI- */ /* CATION OBJECT (PCO): */ /* PCO POINTER --> POINTER TO SEPT --> PTR TO OS FUNCTION 1 */ /* PTR TO OS FUNCTION 2 */ /* ... */ /* THE SIZE OF THE SEPT (6440) IS VERSION DEPENDENT. IT KEEPS */ /* GOING UP... */ DCL SPC PROCESS-COMM-AREA BASPCO; DCL SPCPTR PCO-POINTER DIR; DCL SYSPTR .SEPT(6440) BAS(PCO-POINTER); /* THE USER FILE CONTROL BLOCK (UFCB) DEFINES THE FILE NAME, */ /* BUFFER SPACES AND ALL NECESSARY CONTROL INFORMATION NEEDED */ /* TO MANAGE THE FILE. IT ALSO PROVIDES THE FEEDBACKS NEEDED */ /* TO ACCESS VARIOUS STRUCTURES, SUCH AS THE ODP (THE OPEN */ /* DATA PATH). */ /* DUMP FILE PARAMETERS */ DCL SPCPTR .DFCB INIT(DFCB); DCL DD DFCB CHAR(214) BDRY(16); DCL SPCPTR .DFCB-ODP DEF(DFCB) POS( 1); DCL SPCPTR .DFCB-INBUF DEF(DFCB) POS( 17); DCL SPCPTR .DFCB-OUTBUF DEF(DFCB) POS( 33); DCL SPCPTR .DFCB-OPEN-FEEDBACK DEF(DFCB) POS( 49); DCL SPCPTR .DFCB-IO-FEEDBACK DEF(DFCB) POS( 65); DCL SPCPTR .DFCB-NEXT-UFCB DEF(DFCB) POS( 81); DCL DD * CHAR(32) DEF(DFCB) POS( 97); DCL DD DFCB-FILE CHAR(10) DEF(DFCB) POS(129); DCL DD DFCB-LIB-ID BIN(2) DEF(DFCB) POS(139); DCL DD DFCB-LIBRARY CHAR(10) DEF(DFCB) POS(141); DCL DD DFCB-MBR-ID BIN(2) DEF(DFCB) POS(151); DCL DD DFCB-MEMBER CHAR(10) DEF(DFCB) POS(153); DCL DD DFCB-DEVICE-NAME CHAR(10) DEF(DFCB) POS(163); DCL DD DFCB-DEVICE-INDEX BIN(2) DEF(DFCB) POS(173); DCL DD DFCB-FLAGS-1 CHAR(1) DEF(DFCB) POS(175) INIT(X'80'); DCL DD DFCB-FLAGS-2 CHAR(1) DEF(DFCB) POS(176) INIT(X'20'); DCL DD DFCB-REL-VERSION CHAR(4) DEF(DFCB) POS(177); DCL DD DFCB-INV-MK-COUNT BIN (4) DEF(DFCB) POS(181); DCL DD DFCB-MORE-FLAGS CHAR(1) DEF(DFCB) POS(185); DCL DD * CHAR(23) DEF(DFCB) POS(186); DCL DD DFCB-RECORD-ID BIN (2) DEF(DFCB) POS(209) INIT(1); DCL DD DFCB-RECORD-LENGTH BIN (2) DEF(DFCB) POS(211) INIT(132); DCL DD DFCB-NO-MORE-PARMS BIN (2) DEF(DFCB) POS(213) INIT(32767); DCL OL OPEN-D(.DFCB); DCL OL CLOSE-D(.DFCB); DCL SPCPTR .DBUF; DCL DD DBUF CHAR(132) BAS(.DBUF); DCL DD DBUF-MARKER CHAR(10) DEF(DBUF) POS( 1); DCL DD DBUF-ENTRY CHAR(132) DEF(DBUF) POS( 1); DCL DD DBUF-OFFSET CHAR( 6) DEF(DBUF-ENTRY) POS( 3); DCL DD DBUF-OBJ CHAR(10) DEF(DBUF-ENTRY) POS( 22); DCL DD DBUF-CTX CHAR(10) DEF(DBUF-ENTRY) POS( 60); DCL DD DBUF-TYPE CHAR( 3) DEF(DBUF-ENTRY) POS(104); DCL DD D-GET BIN(2); DCL SPCPTR .GET-OPT-D INIT(GET-OPT-D); DCL DD GET-OPT-D BIN(4) INIT(H'03000001'); DCL OL GET-D(.DFCB, .GET-OPT-D, .NULL); DCL SPCPTR .FORMAT-NAME INIT(FORMAT-NAME); DCL DD FORMAT-NAME CHAR(8) INIT("PGMI0100"); /* FORMAT FOR PGM INFORMATION 'PGMI0100' */ DCL SPCPTR .PGMI0100-LENGTH INIT(PGMI0100-LENGTH); DCL DD PGMI0100-LENGTH BIN(4) INIT(435); DCL SPCPTR .PGMI0100 INIT(PGMI0100); DCL DD PGMI0100 CHAR(435) BDRY(16); DCL DD FMT-BYTES-RETURNED BIN(4) DEF(PGMI0100) POS( 1); DCL DD FMT-BYTES-AVAILABLE BIN(4) DEF(PGMI0100) POS( 5); DCL DD FMT-PGM-NAME CHAR(10) DEF(PGMI0100) POS( 9); DCL DD FMT-PGM-LIB CHAR(10) DEF(PGMI0100) POS( 19); DCL DD FMT-OWNER CHAR(10) DEF(PGMI0100) POS( 29); DCL DD FMT-PGM-ATTR CHAR(10) DEF(PGMI0100) POS( 39); DCL DD FMT-PGM-DATE-TIME CHAR(13) DEF(PGMI0100) POS( 49); DCL DD FMT-SRC-FILE CHAR(10) DEF(PGMI0100) POS( 62); DCL DD FMT-SRC-LIB CHAR(10) DEF(PGMI0100) POS( 72); DCL DD FMT-SRC-MBR CHAR(10) DEF(PGMI0100) POS( 82); DCL DD FMT-SRC-DATE-TIME CHAR(13) DEF(PGMI0100) POS( 92); DCL DD FMT-OBS-INFO CHAR( 1) DEF(PGMI0100) POS(105); DCL DD FMT-USR-PROFILE CHAR( 1) DEF(PGMI0100) POS(106); DCL DD FMT-USE-ADOPTED-AUTH CHAR( 1) DEF(PGMI0100) POS(107); DCL DD FMT-LOG-COMMANDS CHAR( 1) DEF(PGMI0100) POS(108); DCL DD FMT-ALW-RTVCLSRC CHAR( 1) DEF(PGMI0100) POS(109); DCL DD FMT-FIC-DEC-DATA CHAR( 1) DEF(PGMI0100) POS(110); DCL DD FMT-TEXT-DESCR CHAR(50) DEF(PGMI0100) POS(111); DCL DD FMT-PGM-TYPE CHAR( 1) DEF(PGMI0100) POS(161); DCL DD FMT-RESERVED1 CHAR(59) DEF(PGMI0100) POS(162); DCL DD FMT-MIN-PARMS BIN(4) DEF(PGMI0100) POS(221); DCL DD FMT-MAX-PARMS BIN(4) DEF(PGMI0100) POS(225); DCL DD FMT-PGM-SIZE BIN(4) DEF(PGMI0100) POS(229); DCL DD FMT-ASC-SPACE-SIZE BIN(4) DEF(PGMI0100) POS(233); DCL DD FMT-STATIC-SIZE BIN(4) DEF(PGMI0100) POS(237); DCL DD FMT-AUTO-SIZE BIN(4) DEF(PGMI0100) POS(241); DCL DD FMT-NBR-MI-INST BIN(4) DEF(PGMI0100) POS(245); DCL DD FMT-NBR-ODT-ENTRIES BIN(4) DEF(PGMI0100) POS(249); DCL DD FMT-PGM-STATE CHAR( 1) DEF(PGMI0100) POS(253); DCL DD FMT-COMPILER-ID CHAR(14) DEF(PGMI0100) POS(254); DCL DD FMT-EARLIEST-REL CHAR( 6) DEF(PGMI0100) POS(268); DCL DD FMT-SORT-SEQ-TABLE-NAME CHAR(10) DEF(PGMI0100) POS(274); DCL DD FMT-SORT-SEQ-TABLE-LIB CHAR(10) DEF(PGMI0100) POS(284); DCL DD FMT-LANGUAGE-ID CHAR(10) DEF(PGMI0100) POS(294); DCL DD FMT-PGM-DOMAIN CHAR( 1) DEF(PGMI0100) POS(304); DCL DD FMT-RESERVED2 CHAR(21) DEF(PGMI0100) POS(305); DCL DD FMT-OPTIMIZATION CHAR( 1) DEF(PGMI0100) POS(326); DCL DD FMT-PAGING-POOL CHAR( 1) DEF(PGMI0100) POS(327); DCL DD FMT-UPDATE-PASA CHAR( 1) DEF(PGMI0100) POS(328); DCL DD FMT-CLEAR-PASA CHAR( 1) DEF(PGMI0100) POS(329); DCL DD FMT-PAGING-AMOUNT CHAR( 1) DEF(PGMI0100) POS(330); DCL DD FMT-RESERVED3 CHAR(18) DEF(PGMI0100) POS(331); DCL DD FMT-ILE-ENTRY-MODULE CHAR(10) DEF(PGMI0100) POS(349); DCL DD FMT-ILE-ENTRY-MOD-LIB CHAR(10) DEF(PGMI0100) POS(359); DCL DD FMT-ILE-ACT-GRP-ATTR CHAR(30) DEF(PGMI0100) POS(369); DCL DD FMT-ILE-OBS-COMPRESSED CHAR( 1) DEF(PGMI0100) POS(399); DCL DD FMT-ILE-RUN-COMPRESSED CHAR( 1) DEF(PGMI0100) POS(400); DCL DD FMT-ILE-RELEASE-ON CHAR( 6) DEF(PGMI0100) POS(401); DCL DD FMT-ILE-SHARED-ACT-GRP CHAR( 1) DEF(PGMI0100) POS(407); DCL DD FMT-ILE-ALLOW-UPD CHAR( 1) DEF(PGMI0100) POS(408); DCL DD FMT-ILE-PGM-CCSID BIN(4) DEF(PGMI0100) POS(409); DCL DD FMT-ILE-NBR-OF-MODULES BIN(4) DEF(PGMI0100) POS(413); DCL DD FMT-ILE-NBR-OF-SRV-PGMS BIN(4) DEF(PGMI0100) POS(417); DCL DD FMT-ILE-NBR-OF-COPYRIGHTS BIN(4) DEF(PGMI0100) POS(421); DCL DD FMT-ILE-NBR-OF-UNRESOLVED BIN(4) DEF(PGMI0100) POS(425); DCL DD FMT-ILE-RELEASE-FOR CHAR( 6) DEF(PGMI0100) POS(429); DCL DD FMT-ILE-ALW-STATIC-REINIT CHAR( 1) DEF(PGMI0100) POS(435); DCL SPCPTR .QUALIFIED-PGM-NAME INIT(QUALIFIED-PGM-NAME); DCL DD QUALIFIED-PGM-NAME CHAR(20); DCL DD PGM-OBJ CHAR(10) DEF(QUALIFIED-PGM-NAME) POS( 1); DCL DD PGM-CTX CHAR(10) DEF(QUALIFIED-PGM-NAME) POS(11); DCL SPCPTR .ERR-CODE INIT(ERR-CODE); DCL DD ERR-CODE CHAR(32); DCL DD ERR-CODE-BYTES-PRV BIN(4) POS( 1) INIT(0); /* 0 = IGN */ DCL DD ERR-CODE-BYTES-AVL BIN(4) POS( 5); DCL DD ERR-CODE-EXCP-ID CHAR( 7) POS( 9); DCL DD ERR-CODE-RESERVED CHAR( 1) POS(16); DCL DD ERR-CODE-EXCP-DATA CHAR(16) POS(17); DCL OL QCLRPGMI(.PGMI0100, .PGMI0100-LENGTH, .FORMAT-NAME, .QUALIFIED-PGM-NAME, .ERR-CODE); /* LIST FILE PARAMETERS */ DCL SPCPTR .LFCB INIT(LFCB); DCL DD LFCB CHAR(214) BDRY(16); DCL SPCPTR .LFCB-ODP DEF(LFCB) POS( 1); DCL SPCPTR .LFCB-INBUF DEF(LFCB) POS( 17); DCL SPCPTR .LFCB-OUTBUF DEF(LFCB) POS( 33); DCL SPCPTR .LFCB-OPEN-FEEDBACK DEF(LFCB) POS( 49); DCL SPCPTR .LFCB-IO-FEEDBACK DEF(LFCB) POS( 65); DCL SPCPTR .LFCB-NEXT-UFCB DEF(LFCB) POS( 81); DCL DD * CHAR(32) DEF(LFCB) POS( 97); DCL DD LFCB-FILE CHAR(10) DEF(LFCB) POS(129); DCL DD LFCB-LIB-ID BIN(2) DEF(LFCB) POS(139); DCL DD LFCB-LIBRARY CHAR(10) DEF(LFCB) POS(141); DCL DD LFCB-MBR-ID BIN(2) DEF(LFCB) POS(151); DCL DD LFCB-MEMBER CHAR(10) DEF(LFCB) POS(153); DCL DD LFCB-DEVICE-NAME CHAR(10) DEF(LFCB) POS(163); DCL DD LFCB-DEVICE-INDEX BIN(2) DEF(LFCB) POS(173); DCL DD LFCB-FLAGS-1 CHAR(1) DEF(LFCB) POS(175) INIT(X'80'); DCL DD LFCB-FLAGS-2 CHAR(1) DEF(LFCB) POS(176) INIT(X'10'); DCL DD LFCB-REL-VERSION CHAR(4) DEF(LFCB) POS(177); DCL DD LFCB-INV-MK-COUNT BIN (4) DEF(LFCB) POS(181); DCL DD LFCB-MORE-FLAGS CHAR(1) DEF(LFCB) POS(185); DCL DD * CHAR(23) DEF(LFCB) POS(186); DCL DD LFCB-RECORD-ID BIN (2) DEF(LFCB) POS(209) INIT(1); DCL DD LFCB-RECORD-LENGTH BIN (2) DEF(LFCB) POS(211) INIT(92); DCL DD LFCB-NO-MORE-PARMS BIN (2) DEF(LFCB) POS(213) INIT(32767); DCL OL OPEN-L(.LFCB); DCL OL CLOSE-L(.LFCB); DCL SPCPTR .LBUF; DCL DD LBUF CHAR(132) BAS(.LBUF); DCL DD LBUF-ENTRY-NBR ZND(4,0) DEF(LBUF) POS( 1); DCL DD * CHAR( 1) DEF(LBUF) POS( 5); DCL DD LBUF-PGM-NAME CHAR(10) DEF(LBUF) POS( 6); DCL DD * CHAR( 1) DEF(LBUF) POS( 16); DCL DD LBUF-PGM-LIB CHAR(10) DEF(LBUF) POS( 17); DCL DD * CHAR( 1) DEF(LBUF) POS( 27); DCL DD LBUF-PGM-DATE-TIME CHAR(19) DEF(LBUF) POS( 28); DCL DD * CHAR( 1) DEF(LBUF) POS( 47); DCL DD LBUF-PGM-TYPE CHAR( 3) DEF(LBUF) POS( 48); DCL DD * CHAR( 1) DEF(LBUF) POS( 51); DCL DD LBUF-USR-PROFILE CHAR( 5) DEF(LBUF) POS( 52); DCL DD * CHAR( 1) DEF(LBUF) POS( 57); DCL DD LBUF-ADOPT-AUTH CHAR( 4) DEF(LBUF) POS( 58); DCL DD * CHAR( 1) DEF(LBUF) POS( 62); DCL DD LBUF-PGM-SIZE CHAR( 8) DEF(LBUF) POS( 63); DCL DD LBUF-PGM-STATE CHAR( 7) DEF(LBUF) POS( 71); DCL DD * CHAR( 1) DEF(LBUF) POS( 78); DCL DD LBUF-PGM-DOMAIN CHAR( 7) DEF(LBUF) POS( 79); DCL DD * CHAR( 1) DEF(LBUF) POS( 86); DCL DD LBUF-OWNER CHAR(10) DEF(LBUF) POS( 87); DCL DD * CHAR( 1) DEF(LBUF) POS( 97); DCL DD LBUF-PGM-ATTR CHAR( 3) DEF(LBUF) POS( 98); DCL DD L-PUT BIN(2); DCL DD PUT-OPT-L BIN(4) INIT(H'10000005'); DCL SPCPTR .PUT-OPT-L INIT(PUT-OPT-L); DCL OL PUT-L(.LFCB, .PUT-OPT-L, .NULL); DCL DD AS-400-DATE-TIME CHAR(13); DCL DD AS-400-C CHAR( 1) DEF(AS-400-DATE-TIME) POS( 1); DCL DD AS-400-YY CHAR( 2) DEF(AS-400-DATE-TIME) POS( 2); DCL DD AS-400-MONTH CHAR( 2) DEF(AS-400-DATE-TIME) POS( 4); DCL DD AS-400-DAY CHAR( 2) DEF(AS-400-DATE-TIME) POS( 6); DCL DD AS-400-HOUR CHAR( 2) DEF(AS-400-DATE-TIME) POS( 8); DCL DD AS-400-MIN CHAR( 2) DEF(AS-400-DATE-TIME) POS(10); DCL DD AS-400-SEC CHAR( 2) DEF(AS-400-DATE-TIME) POS(12); DCL DD DSP-DATE-TIME CHAR(19); DCL DD DSP-CENTURY CHAR( 2) DEF(DSP-DATE-TIME) POS( 1); DCL DD DSP-YY CHAR( 2) DEF(DSP-DATE-TIME) POS( 3); DCL DD * CHAR( 1) DEF(DSP-DATE-TIME) POS( 5) INIT("/"); DCL DD DSP-MONTH CHAR( 2) DEF(DSP-DATE-TIME) POS( 6); DCL DD * CHAR( 1) DEF(DSP-DATE-TIME) POS( 8) INIT("/"); DCL DD DSP-DAY CHAR( 2) DEF(DSP-DATE-TIME) POS( 9); DCL DD * CHAR( 1) DEF(DSP-DATE-TIME) POS(11) INIT(" "); DCL DD DSP-HOUR CHAR( 2) DEF(DSP-DATE-TIME) POS(12); DCL DD * CHAR( 1) DEF(DSP-DATE-TIME) POS(14) INIT(":"); DCL DD DSP-MIN CHAR( 2) DEF(DSP-DATE-TIME) POS(15); DCL DD * CHAR( 1) DEF(DSP-DATE-TIME) POS(17) INIT(":"); DCL DD DSP-SEC CHAR( 2) DEF(DSP-DATE-TIME) POS(18); DCL DD DATA-ATTR CHAR(7); DCL DD TYPE CHAR(1) DEF(DATA-ATTR) POS(1) INIT(X'00'); DCL DD LENGTH BIN (2) DEF(DATA-ATTR) POS(2) INIT(4); DCL DD * BIN (4) DEF(DATA-ATTR) POS(4) INIT(0); DCL DD S CHAR(180); DCL DD S-CENTURY-0 CHAR(15) DEF(S) POS( 1) INIT("01 0 19 "); DCL DD S-CENTURY-1 CHAR(15) DEF(S) POS( 16) INIT("01 1 20 "); DCL DD S-USR-PFL-U CHAR(15) DEF(S) POS( 31) INIT("02 U *USER "); DCL DD S-USR-PFL-O CHAR(15) DEF(S) POS( 46) INIT("02 O *OWNER "); DCL DD S-ADOPT-AUT-Y CHAR(15) DEF(S) POS( 61) INIT("03 Y *YES "); DCL DD S-ADOPT-AUT-N CHAR(15) DEF(S) POS( 76) INIT("03 N *NO "); DCL DD S-PGM-STATE-S CHAR(15) DEF(S) POS( 91) INIT("04 S *SYSTEM "); DCL DD S-PGM-STATE-U CHAR(15) DEF(S) POS(106) INIT("04 U *USER "); DCL DD S-PGM-STATE-I CHAR(15) DEF(S) POS(121) INIT("04 I *INHERITS "); DCL DD S-PGM-DOMN-S CHAR(15) DEF(S) POS(136) INIT("05 S *SYSTEM "); DCL DD S-PGM-DOMN-U CHAR(15) DEF(S) POS(151) INIT("05 U *USER "); DCL DD S.END CHAR(15) DEF(S) POS(166) INIT(" "); DCL DD S.STOP CHAR( 4) DEF(S.END) POS(1); DCL DD S.ENTRY( 12) CHAR(15) DEF(S) POS(1); DCL DD @NBR BIN(2); DCL INSPTR .RETURN; DCL DD @FROM BIN(2); DCL DD @TO BIN(2); DCL DD @SIZE BIN(2); DCL DD EDITED-NBR CHAR(10); DCL DD NBR-TO-EDIT ZND(10,0) DEF(EDITED-NBR) POS(1); DCL DD EDIT-CHAR(10) CHAR(1) DEF(EDITED-NBR) POS(1); DCL DD S.VALUE CHAR(15) INIT(" "); DCL DD S.MATCH CHAR( 4) DEF(S.VALUE) POS(1); DCL DD S.TYPE CHAR( 2) DEF(S.MATCH) POS(1); DCL DD * CHAR( 1) DEF(S.MATCH) POS(3); DCL DD S.CHAR CHAR( 1) DEF(S.MATCH) POS(4); DCL DD * CHAR( 1) DEF(S.VALUE) POS(5); DCL DD S.WORD CHAR(10) DEF(S.VALUE) POS(6); DCL EXCM * EXCID(H'5001') /* EOF */ BP(EOF-DETECTED) CV("CPF") IMD; DCL DD GETSEPT-LIB CHAR(10); DCL SPCPTR .GETSEPT-LIB INIT(GETSEPT-LIB); DCL OL GETSEPT(.GETSEPT-LIB) ARG; DCL SYSPTR .GETSEPT INIT("GETSEPT", TYPE(PGM)); /**************************************************************/ ENTRY * (PARAMETERS) EXT; CPYBWP .NULL, *; CPYBLAP DFCB-LIBRARY,"LSV", " "; STPLLEN NBR-OF-PARMS; CMPNV(B) NBR-OF-PARMS,1 /NEQ(SET-FILES); CPYBLA DFCB-LIBRARY, PARM-LIB; SET-FILES: CPYBLAP DFCB-FILE, "SEPTDUMP", " "; CPYNV DFCB-LIB-ID, THE-LIB; CPYNV DFCB-MBR-ID, THE-MBR; CPYBLA DFCB-MEMBER, DFCB-FILE; CPYBLAP LFCB-FILE, "SEPTLIST", " "; CPYNV LFCB-LIB-ID, THE-LIB; CPYBLA LFCB-LIBRARY, DFCB-LIBRARY; CPYNV LFCB-MBR-ID, THE-MBR; CPYBLA LFCB-MEMBER, LFCB-FILE; GET-DUMPED-SEPT: CPYBLA GETSEPT-LIB, DFCB-LIBRARY; CALLX .GETSEPT, GETSEPT, *; OPEN-DUMP-FILE: CALLX .SEPT(OPEN-ENTRY), OPEN-D, *; CPYBWP .DBUF, .DFCB-INBUF; CPYBWP .ODP-ROOT, .DFCB-ODP; ADDSPP .DEV-CONTROL-BLOCK, .ODP-ROOT, ODP.DEV-NAMELIST; CPYNV D-GET, DCB-GET; OPEN-LIST-FILE: CALLX .SEPT(OPEN-ENTRY), OPEN-L, *; CPYBWP .LBUF, .LFCB-OUTBUF; CPYBWP .ODP-ROOT, .LFCB-ODP; ADDSPP .DEV-CONTROL-BLOCK, .ODP-ROOT, ODP.DEV-NAMELIST; CPYNV L-PUT, DCB-PUT; FIND-DUMP-MARKER: CALLX .SEPT(D-GET), GET-D, *; CMPBLA(B) DBUF-MARKER, ".POINTERS-"/NEQ(FIND-DUMP-MARKER); READ-DUMP-RECORD: CALLX .SEPT(D-GET), GET-D, *; CMPBLA(B) DBUF-TYPE, "*PGM"/NEQ(READ-DUMP-RECORD); GET-PGM-INFO: CVTCH BINARY-CHARS, DBUF-OFFSET; DIV ENTRY-NBR, BINARY-VALUE, H'1000'; ADDN(S) ENTRY-NBR, 1; CPYBLA PGM-OBJ, DBUF-OBJ; CPYBLA PGM-CTX, DBUF-CTX; CALLX .SEPT(5088), QCLRPGMI, *; /* GET PGM INFO */ CPYBREP LBUF, " "; /* CLEAR LISTING FIRST */ CPYNV LBUF-ENTRY-NBR , ENTRY-NBR ; CPYBLA LBUF-PGM-NAME , FMT-PGM-NAME ; CPYBLA LBUF-PGM-LIB , FMT-PGM-LIB ; CPYBLA LBUF-OWNER , FMT-OWNER ; CPYBLA LBUF-PGM-ATTR , FMT-PGM-ATTR ; CPYBLA AS-400-DATE-TIME , FMT-PGM-DATE-TIME ; CPYBLA S.TYPE, "01"; CPYBLA S.CHAR, AS-400-C; CALLI GET-DISPLAY-VALUE, *, .RETURN; CPYBLA DSP-CENTURY, S.WORD; /* FORMAT DATE */ CPYBLA DSP-YY , AS-400-YY; CPYBLA DSP-MONTH , AS-400-MONTH; CPYBLA DSP-DAY , AS-400-DAY; CPYBLA DSP-HOUR , AS-400-HOUR; /* FORMAT TIME */ CPYBLA DSP-MIN , AS-400-MIN; CPYBLA DSP-SEC , AS-400-SEC; CPYBLA LBUF-PGM-DATE-TIME, DSP-DATE-TIME; CPYBLA S.TYPE, "02"; CPYBLA S.CHAR, FMT-USR-PROFILE; CALLI GET-DISPLAY-VALUE, *, .RETURN; CPYBLA LBUF-USR-PROFILE, S.WORD; CPYBLA S.TYPE, "03"; CPYBLA S.CHAR, FMT-USE-ADOPTED-AUTH; CALLI GET-DISPLAY-VALUE, *, .RETURN; CPYBLA LBUF-ADOPT-AUTH, S.WORD; CPYBLA S.TYPE, "04"; CPYBLA S.CHAR, FMT-PGM-STATE; CALLI GET-DISPLAY-VALUE, *, .RETURN; CPYBLA LBUF-PGM-STATE, S.WORD; CPYBLA S.TYPE, "05"; CPYBLA S.CHAR, FMT-PGM-DOMAIN; CALLI GET-DISPLAY-VALUE, *, .RETURN; CPYBLA LBUF-PGM-DOMAIN, S.WORD; CPYNV NBR-TO-EDIT, FMT-PGM-SIZE; CALLI REMOVE-LEADING-ZEROES, *, .RETURN; CPYBLA LBUF-PGM-SIZE, EDITED-NBR; OUTPUT-EXTRACTED-INFO: CALLX .SEPT(L-PUT), PUT-L, *; B READ-DUMP-RECORD; EOF-DETECTED: CLOSE-ALL-FILES: CALLX .SEPT(CLOSE-ENTRY), CLOSE-D, *; CALLX .SEPT(CLOSE-ENTRY), CLOSE-L, *; RTX *; /* FIND A SUBSTITUTION VALUE IN A TABLE */ ENTRY GET-DISPLAY-VALUE INT; CPYNV @NBR, 0; CPYBLA S.STOP, S.MATCH; /* ENSURE ALWAYS MATCH */ NEXT-DISPLAY-ENTRY: ADDN(S) @NBR, 1; /* CMPBLA BELOW USES SIZE OF SHORTEST OP */ CMPBLA(B) S.ENTRY (@NBR), S.MATCH/NEQ(NEXT-DISPLAY-ENTRY); CPYBLA S.VALUE, S.ENTRY (@NBR); B .RETURN; /* REMOVE LEADING ZEROES FROM NUMERIC VALUE */ ENTRY REMOVE-LEADING-ZEROES INT; CPYNV @SIZE, 10; /* MUST BE AT LEAST 2 */ FROM-BEGINNING-OF-NBR: CPYNV @TO, 1; CMPBLA(B) EDIT-CHAR(@TO), "0"/NEQ(.RETURN); SHIFT-DIGITS-LEFT: ADDN @FROM, @TO, 1; CPYBLA EDIT-CHAR(@TO), EDIT-CHAR(@FROM); CPYNV @TO, @FROM; CMPNV(B) @TO, @SIZE/NEQ(SHIFT-DIGITS-LEFT); CPYBLA EDIT-CHAR(@SIZE), " "; SUBN(SB) @SIZE, 1/POS(FROM-BEGINNING-OF-NBR); /* ALWAYS */