|
midrange.com
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
+---
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.
