/*================================================================ * This program creates MI compiler CRTMIPGM in *CURLIB. = * Source statements for the MI compiler are found in array MI. = *================================================================ E MI 1 208 80 I DS I B 1 40#SRCLN I I 'CRTMIPGM *CURLIB' 5 24 #PGMLB I 25 74 #TEXT I I '*NONE' 75 94 #SRCFL I 95 104 #MBR I 105 117 #CHGDT I 105 105 #CENT I 106 107 #YY I 108 111 #MMDD I 112 117 #HMS I 118 137 #PRTFL I B 138 1410#STRPG I 142 151 #AUT I 152 327 #OP I B 328 3310#NOOPT C CALL 'QPRCRTPG' C PARM MI C PARM 16640 #SRCLN C PARM #PGMLB C PARM 'MI Comp' #TEXT C PARM #SRCFL C PARM #MBR C PARM #CHGDT C PARM ' ' #PRTFL C PARM 0 #STRPG C PARM '*USE' #AUT C PARM '*REPLACE'#OP C PARM 1 #NOOPT C MOVE *ON *INLR ** */ DCL SPCPTR .MBR PARM; DCL SPCPTR .FIL PARM; DCL SPCPTR .DET PARM; DCL OL *ENTRY (.MBR, .FIL, .DET) PARM EXT MIN(1); DCL DD MBR CHAR(10) BAS(.MBR); DCL DD FIL CHAR(10) BAS(.FIL); DCL DD DET CHAR(10) BAS(.DET); DCL SPC PCO BASPCO; DCL SPCPTR .PCO DIR; DCL SPC SEPT BAS(.PCO); DCL SPCPTR .SEPT(2000) DIR; DCL SPCPTR .UFCB INIT(UFCB); DCL DD UFCB CHAR(214) BDRY(16); DCL SPCPTR .ODP DEF(UFCB) POS( 1); DCL SPCPTR .INBUF DEF(UFCB) POS( 17); DCL SPCPTR .OUTBUF DEF(UFCB) POS( 33); DCL SPCPTR .OPEN-FEEDBACK DEF(UFCB) POS( 49); DCL SPCPTR .IO-FEEDBACK DEF(UFCB) POS( 65); DCL SPCPTR .NEXT-UFCB DEF(UFCB) POS( 81); DCL DD * CHAR(32) DEF(UFCB) POS( 97); DCL DD FILE CHAR(10) DEF(UFCB) POS(129) INIT("QMISRC"); DCL DD LIB-ID BIN ( 2) DEF(UFCB) POS(139) INIT(-75); DCL DD LIBRARY CHAR(10) DEF(UFCB) POS(141) INIT("*LIBL"); DCL DD MBR-ID BIN ( 2) DEF(UFCB) POS(151) INIT( 73); DCL DD MEMBER CHAR(10) DEF(UFCB) POS(153); DCL DD ODP-DEVICE-NAME CHAR(10) DEF(UFCB) POS(163); DCL DD ODP-DEVICE-INDEX BIN ( 2) DEF(UFCB) POS(173); DCL DD FLAGS-PERM-80 CHAR( 1) DEF(UFCB) POS(175) INIT(X'80'); DCL DD FLAGS-GET-20 CHAR( 1) DEF(UFCB) POS(176) INIT(X'20'); DCL DD REL-VERSION CHAR( 4) DEF(UFCB) POS(177) INIT("0100"); DCL DD INVOC-MARK-COUNT BIN ( 4) DEF(UFCB) POS(181); DCL DD MORE-FLAGS CHAR( 1) DEF(UFCB) POS(185) INIT(X'00'); DCL DD * CHAR(23) DEF(UFCB) POS(186); DCL DD RECORD-PARAM BIN ( 2) DEF(UFCB) POS(209) INIT(1); DCL DD RECORD-LENGTH BIN ( 2) DEF(UFCB) POS(211) INIT(92); DCL DD NO-MORE-PARAMS BIN ( 2) DEF(UFCB) POS(213) INIT(32767); DCL SPC ODP BAS(.ODP); DCL DD * CHAR(16) DIR; DCL DD DEV-OFFSET BIN ( 4) DIR; DCL SPCPTR .DMDEV; DCL SPC DMDEV BAS(.DMDEV); DCL DD MAX-DEVICE BIN ( 2) DIR; DCL DD NBR-DEVICES BIN ( 2) DIR; DCL DD DEVICE-NAME CHAR(10) DIR; DCL DD WORKAREA-OFFSET BIN ( 4) DIR; DCL DD WORKAREA-LENGTH BIN ( 4) DIR; DCL DD LUD-PTR-INDEX BIN ( 2) DIR; DCL DD DM-GET BIN ( 2) DIR; DCL SPCPTR .GETOPT INIT(GETOPT); DCL DD GETOPT CHAR(4); DCL DD GET-OPTION-BYTE CHAR(1) DEF(GETOPT) POS(1) INIT(X'03'); DCL DD GET-SHARE-BYTE CHAR(1) DEF(GETOPT) POS(2) INIT(X'00'); DCL DD GET-DATA-BYTE CHAR(1) DEF(GETOPT) POS(3) INIT(X'00'); DCL DD GET-DEVICE-BYTE CHAR(1) DEF(GETOPT) POS(4) INIT(X'01'); DCL SPCPTR .NULL; DCL OL GET (.UFCB, .GETOPT, .NULL); DCL OL OPEN (.UFCB); DCL OL CLOSE(.UFCB); DCL SPC INBUF BAS(.INBUF); DCL DD INBUF-DATE CHAR(12) DEF(INBUF) POS( 1); DCL DD INBUF-LINE CHAR(80) DEF(INBUF) POS(13); DCL DD INBUF-KEYWORD CHAR( 9) DEF(INBUF-LINE) POS( 1); DCL DD INBUF-NEWMBR CHAR(10) DEF(INBUF-LINE) POS(10); DCL SPCPTR .SOURCE; DCL DD LINE(10000) CHAR(80) AUTO; DCL DD LINE-NBR BIN(4); DCL DD READ-NBR BIN(4); DCL DD SAVE-NBR BIN(4); DCL DD SKIP-NBR BIN(4); DCL DD INCL-NBR BIN(2); DCL SPCPTR .SIZE INIT(SIZE); DCL DD SIZE BIN(4); DCL SPCPTR .PGM INIT(PGM); DCL DD PGM CHAR(20); DCL DD PGM-NAME CHAR(10) DEF(PGM) POS( 1); DCL DD PGM-LIB CHAR(10) DEF(PGM) POS(11) INIT("*CURLIB"); DCL SPCPTR .PGM-TEXT INIT(PGM-TEXT); DCL DD PGM-TEXT CHAR(50) INIT(" "); DCL SPCPTR .PGM-SRCF INIT(PGM-SRCF); DCL DD PGM-SRCF CHAR(20) INIT("*NONE"); DCL SPCPTR .PGM-SRCM INIT(PGM-SRCM); DCL DD PGM-SRCM CHAR(10) INIT(" "); DCL SPCPTR .PGM-SRCD INIT(PGM-SRCD); DCL DD PGM-SRCD CHAR(13) INIT(" "); DCL SPCPTR .PRTF-NAME INIT(PRTF-NAME); DCL DD PRTF-NAME CHAR(20); DCL DD PRTF-FILE CHAR(10) DEF(PRTF-NAME) POS( 1) INIT("QSYSPRT "); DCL DD PRTF-LIB CHAR(10) DEF(PRTF-NAME) POS(11) INIT("*LIBL "); DCL SPCPTR .PRT-STRPAG INIT(PRT-STRPAG); DCL DD PRT-STRPAG BIN(4) INIT(1); DCL SPCPTR .PGM-PUBAUT INIT(PGM-PUBAUT); DCL DD PGM-PUBAUT CHAR(10) INIT("*ALL"); DCL SPCPTR .PGM-OPTS INIT(PGM-OPTS); DCL DD PGM-OPTS(16) CHAR(11) INIT("*REPLACE ", "*NOADPAUT ", "*NOCLRPSSA ", "*NOCLRPASA ", "*SUBSCR ", "*LIST ", "*ATR ", "*XREF "); DCL SPCPTR .NBR-OPTS INIT(NBR-OPTS); DCL DD NBR-OPTS BIN(4); DCL OL QPRCRTPG (.SOURCE, .SIZE, .PGM, .PGM-TEXT, .PGM-SRCF, .PGM-SRCM, .PGM-SRCD, .PRTF-NAME, .PRT-STRPAG, .PGM-PUBAUT, .PGM-OPTS, .NBR-OPTS) ARG; DCL SYSPTR .QPRCRTPG INIT("QPRCRTPG", CTX("QSYS"), TYPE(PGM)); DCL DD NBR-PARMS BIN(2); DCL EXCM * EXCID(H'5001') BP(EOF) IMD; DCL DD START CHAR(80); DCL DD * CHAR(12) DEF(START) POS( 1) INIT("/* INCLUDE: "); DCL DD NEWMBR CHAR(10) DEF(START) POS(13); DCL DD * CHAR(58) DEF(START) POS(23) INIT(" */"); DCL DD STOP CHAR(80); DCL DD * CHAR(80) DEF(STOP) POS(1) INIT("/* END INCLUDE */"); /****************************************************************/ ENTRY * (*ENTRY) EXT; CPYNV LINE-NBR, 1; CPYNV INCL-NBR, 0; CPYNV SKIP-NBR, 0; CPYBWP .NULL, *; CPYNV NBR-OPTS, 6; /* YES: *LIST; NO: *ATR, *XREF */ STPLLEN NBR-PARMS; CMPNV(B) NBR-PARMS, 3/NEQ(PREPARE-FILE); CMPBLA(B) DET, <10|*DETAIL >/EQ(YES-DETAIL); CMPBLA(B) DET, <10|*NOLIST >/EQ(NO-LIST); B PREPARE-FILE; YES-DETAIL: CPYNV(B) NBR-OPTS, 8/NNAN(PREPARE-FILE); NO-LIST: CPYNV(B) NBR-OPTS, 5/NNAN(PREPARE-FILE); PREPARE-FILE: CPYBLAP FILE, "QMISRC", " "; CMPNV(B) NBR-PARMS, 1 /EQ(SET-MEMBER); CPYBLA FILE, FIL; SET-MEMBER: CPYBLA MEMBER, MBR; CPYBLA PGM-NAME, MBR; OPEN-FILE: CPYNV READ-NBR, 0; CALLX .SEPT(12), OPEN, *; ADDSPP .DMDEV, .ODP, DEV-OFFSET; NEXT-SOURCE-RECORD: CALLX .SEPT(DM-GET), GET, *; ADDN(S) READ-NBR, 1; SUBN(SB) SKIP-NBR, 1/NNEG(NEXT-SOURCE-RECORD); CMPBLA(B) INBUF-KEYWORD, "%INCLUDE "/EQ(INCLUDE-MEMBER); CPYBLA LINE(LINE-NBR), INBUF-LINE; ADDN(S) LINE-NBR, 1; B NEXT-SOURCE-RECORD; EOF: CALLX .SEPT(11), CLOSE, *; CMPNV(B) INCL-NBR, 0/HI(END-INCLUDE); CPYBLAP LINE(LINE-NBR), <23|/*'/*'/*"/*"*/; PEND;;;>, " "; MULT SIZE, LINE-NBR, 80; SETSPP .SOURCE, LINE; CALLX .QPRCRTPG, QPRCRTPG, *; RTX *; ERROR: RTX *; INCLUDE-MEMBER: ADDN(S) INCL-NBR, 1; CPYBLA NEWMBR, INBUF-NEWMBR; CALLX .SEPT(11), CLOSE, *; CPYBLA MEMBER, NEWMBR; CPYBLA LINE(LINE-NBR), START; ADDN(S) LINE-NBR, 1; CPYNV(B) SAVE-NBR, READ-NBR/NNAN(OPEN-FILE); END-INCLUDE: CPYBLA LINE(LINE-NBR), STOP; ADDN(S) LINE-NBR, 1; SUBN(S) INCL-NBR, 1; CPYBLA MEMBER, MBR; CPYNV(B) SKIP-NBR, SAVE-NBR/NNAN(OPEN-FILE); PEND;