• Subject: Re: MI programmers list? Interested?
  • From: leif@xxxxxxxxxxxxx
  • Date: Sun, 7 Nov 1999 07:56:44 -0600


----- 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
+---

This thread ...

Replies:

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