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