• Subject: RE: ILE/C Fornt-end to the MI Compiler
  • From: Leif Svalgaard <l.svalgaard@xxxxxxxxxxxxx>
  • Date: Mon, 8 Nov 1999 13:10:56 -0600

Phil, I've been trying to post the MI-front-end but it was bounced
everytime.
I'm coat-tailing it to this reply. Not to compete with you, but to point out
that the wrapper should support things like %INCLUDE, etc. Anyway
here it is:

Every AS/400 comes with an MI-compiler built in. It is the QPRCRTPG API.
It does not take input from a source file member, but rather wants the
source
as one big in-memory parameter. The following RPG program, when run, will
create the CRTMIPGM program, that will read a source file member (by
default in file QMISRC) and produce a program in *CURLIB. 

You run the compiler interface like this:
   CALL CRTMIPGM MYPROG

You can also (should) make a command to call CRTMIPGM.

Since the program sits between your source and what is passed to the API,
one can be fancy and implement things that the API does not support, such 
as INCLUDE files, macros, DEFINEs, etc.

In fact the program posted already supports INCLUDE.
Place a line anywhere in the source like this:
%INCLUDE YOURSTUFF
to include the member YOURSTUFF (from the QMISRC file).
You can have as many INCLUDES as you want (can't be nested yet).

With time we can work together and improve the program.
The example given in IBM's API manuals is much too complicated
and won't run as given (the initial program is larger than the 2000
character limit set by CL). It is instructive though.


     /*================================================================
      * 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: Phil Hall [SMTP:hallp@ssax.com]
> Sent: Monday, November 08, 1999 11:20 AM
> To:   mi-list
> Subject:      ILE/C Fornt-end to the MI Compiler
> 
> Hi all,
> 
> I have coded a ILE/C front-end to the MI Compiler over the weekend. It's
> up
> for grabs to anyone who wants a copy... includes ILE/C source and a CMD
> source...
> 
> Even if you don't have a C compiler, you might want it to glean the CMD
> source (to save typing in all those options) & see how to call the
> QPRCRTPG
> API (the MI Compiler API)
> 
> I can;
> 
> 1. Post it to the list
> 2. Post it to the list as a file attachment
> 3. Post directly to interested individuals
> 
> Don: what's the best way ?
> 
> --phil
> 
> 
> +---
> | 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 thread ...

Follow-Ups:

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

This mailing list archive is Copyright 1997-2019 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].