|
you da man > -----Original Message----- > From: Chuck Lewis [SMTP:clewis@iquest.net] > Sent: Monday, January 31, 2000 10:09 AM > To: MI400@midrange.com > Subject: Re: Please compile this program > > Thanks Leif ! > > I'll give it a whirl ! > > Chuck > > Leif Svalgaard wrote: > > > 1) compile the program using your MI-compiler. (if you don't have any, > > attached is an RPG program that creates the MI-compiler front-end, > > or you can find better ones in the archives of the this list). > > 2) save the *PGM object to a save file (no compression) > > 3) e-mail the save file to me > > Thanks. > > > > <<crtmicmp.txt>> > > /*================================================================ > > * This program creates MI compiler CRTMI in *CURLIB. = > > * Source statements for the MI compiler are found in array MI. = > > *================================================================ > > E MI 1 210 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 16800 #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 ", "*SUBSTR ", > > "*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, *; > > BRK "1"; > > 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; > > > > > -----Original Message----- > > > From: Chuck Lewis [SMTP:clewis@iquest.net] > > > Sent: Monday, January 31, 2000 7:14 AM > > > To: MI400@midrange.com > > > Subject: Re: Please compile this program > > > > > > Leif, > > > > > > Duh question of the day - what do I use to do this ? > > > > > > I'm at V4R1 and will be glad to help ! > > > > > > Chuck > > > > > > Leif Svalgaard wrote: > > > > > > > I need to know what the encapsulated program looks like > > > > for the little MI-program below, on V3R7, V4R1, and V4R2. > > > > I already have V4R3 and V4R4. > > > > > > > > Anybody with these versions wanna help? > > > > Please send me a savefile with the result. > > > > Thanks. > > > > > > > > DCL DD X BIN(4); > > > > ENTRY * EXT; > > > > CPYNV X, H'00000000'; > > > > CPYNV X, H'00000000'; > > > > CPYNV X, H'00000000'; > > > > CPYNV X, H'00000000'; > > > > PEND; > > > > +--- > > > > | This is the MI Programmers Mailing List! > > > > | To submit a new message, send your mail to MI400@midrange.com. > > > > | To subscribe to this list send email to MI400-SUB@midrange.com. > > > > | To unsubscribe from this list send email to > MI400-UNSUB@midrange.com. > > > > | Questions should be directed to the list owner/operator: > > > dr2@cssas400.com > > > > +--- > > > > > > +--- > > > | This is the MI Programmers Mailing List! > > > | To submit a new message, send your mail to MI400@midrange.com. > > > | To subscribe to this list send email to MI400-SUB@midrange.com. > > > | To unsubscribe from this list send email to > MI400-UNSUB@midrange.com. > > > | Questions should be directed to the list owner/operator: > > > dr2@cssas400.com > > > +--- > > > > /*================================================================ > > * This program creates MI compiler CRTMI in *CURLIB. = > > * Source statements for the MI compiler are found in array MI. = > > *================================================================ > > E MI 1 210 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 16800 #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 ", "*SUBSTR ", > > "*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, *; > > BRK "1"; > > 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; > > > > +--- > > | This is the MI Programmers Mailing List! > > | To submit a new message, send your mail to MI400@midrange.com. > > | To subscribe to this list send email to MI400-SUB@midrange.com. > > | To unsubscribe from this list send email to MI400-UNSUB@midrange.com. > > | Questions should be directed to the list owner/operator: > dr2@cssas400.com > > +--- > > +--- > | This is the MI Programmers Mailing List! > | To submit a new message, send your mail to MI400@midrange.com. > | To subscribe to this list send email to MI400-SUB@midrange.com. > | To unsubscribe from this list send email to MI400-UNSUB@midrange.com. > | Questions should be directed to the list owner/operator: > dr2@cssas400.com > +--- +--- | This is the MI Programmers Mailing List! | To submit a new message, send your mail to MI400@midrange.com. | To subscribe to this list send email to MI400-SUB@midrange.com. | To unsubscribe from this list send email to MI400-UNSUB@midrange.com. | Questions should be directed to the list owner/operator: dr2@cssas400.com +---
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.