|
midrange.com
----- Original Message -----
From: <James_Turnbull@kaz.com.au>
To: <MIDRANGE-L@midrange.com>
Sent: Saturday, November 06, 1999 9:48 PM
Subject: Re: MI programmers list? Interested?
> I have always been interested in learning about the dark arts, MI that is.
> Count me in also. Do we have anyone on the list with MI experience? For
that
> matter is there an MI compiler and how do MI objects work?
Every AS/400 has an MI-compiler built in.
All you need is a program to pass your source text to it.
The following RPG program will generate (when run)
such a wrapper program:
/*================================================================
* This program creates MI compiler CRTMI in *CURLIB. =
* Source statements for the MI compiler are found in array MI. =
*================================================================
E MI 1 171 80
I DS
I B 1 40#SRCLN
I I 'CRTMI QGPL' 5 24 #PGMLB
I 25 74 #TEXT
I I 'QMISRC QGPL' 75 94 #SRCFL
I I 'CRTMI' 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 13680 #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 ' ' #OP
C PARM 0 #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 SPCPTR .SOURCE;
DCL DD LINE(10000) CHAR(80) AUTO;
DCL DD LINE-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(
*(1)(1)"*REPLACE ", *(2)(1)"*NOCLRPSSA ", *(3)(1)"*NOCLRPASA ",
*(4)(1)"*NOSUBSCR ", *(5)(1)"*NOSUBSTR ", *(6)(1)"*LIST ",
*(7)(1)"*ATR ", *(8)(1)"*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 EXCM * EXCID(H'6301') BP(ERROR) IMD; */
/****************************************************************/
ENTRY * (*ENTRY) EXT;
CPYNV LINE-NBR, 1;
CPYBWP .NULL, *;
STPLLEN NBR-PARMS;
CPYNV NBR-OPTS, 6; /* YES: *LIST; NO: *ATR, *XREF */
CMPNV(B) NBR-PARMS, 3/NEQ(OPEN-SOURCE);
CMPBLA(B) DET, <10|*DETAIL >/EQ(YES-DETAIL);
CMPBLA(B) DET, <10|*NOLIST >/EQ(NO-LIST);
B OPEN-SOURCE;
YES-DETAIL: CPYNV(B) NBR-OPTS, 8/NNAN(OPEN-SOURCE);
NO-LIST: CPYNV(B) NBR-OPTS, 5/NNAN(OPEN-SOURCE);
OPEN-SOURCE:
CPYBLAP FILE, "QMISRC", " ";
CMPNV(B) NBR-PARMS, 1 /EQ(SET-MEMBER);
CPYBLA FILE, FIL;
SET-MEMBER:
CPYBLA MEMBER, MBR;
CPYBLA PGM-NAME, MBR;
CALLX .SEPT(12), OPEN, *;
ADDSPP .DMDEV, .ODP, DEV-OFFSET;
NEXT-SOURCE-RECORD:
CALLX .SEPT(DM-GET), GET, *;
CPYBLA LINE(LINE-NBR), INBUF-LINE;
ADDN(S) LINE-NBR, 1;
B NEXT-SOURCE-RECORD;
EOF:
CALLX .SEPT(11), CLOSE, *;
CPYBLAP LINE(LINE-NBR), <23|/*'/*'/*"/*"*/; PEND;;;>, " ";
MULT SIZE, LINE-NBR, 80;
SETSPP .SOURCE, LINE;
BRK "1";
CALLX .QPRCRTPG, QPRCRTPG, *;
RTX *;
ERROR:
RTX *;
PEND;
+---
| This is the Midrange System Mailing List!
| To submit a new message, send your mail to MIDRANGE-L@midrange.com.
| To subscribe to this list send email to MIDRANGE-L-SUB@midrange.com.
| To unsubscribe from this list send email to MIDRANGE-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 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.
