× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.


  • Subject: RE: Please compile this program
  • From: Leif Svalgaard <l.svalgaard@xxxxxxxxxxxxx>
  • Date: Mon, 31 Jan 2000 15:37:32 -0600

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 thread ...


Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

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.