MI code example: MICRTPG2 complete program
In its consolidated state, this is the new MICRTPG2 program:
/********************************************************************/
/********************************************************************/
/* */
/* program Name: MICRTPG2 */
/* */
/* programming Language: MI */
/* */
/* Description: Initial version of MI program MICRTPG2, */
/* which calls QPRCRTPG API. */
/* */
/* */
/* Header Files Included: None */
/* */
/* */
/********************************************************************/
/* Entry point and associated parameters */
ENTRY * (*ENTRY) EXT;
DCL SPCPTR FIL@ PARM;
DCL SPCPTR MBR@ PARM;
DCL OL *ENTRY (MBR@, FIL@) PARM EXT MIN(1);
DCL DD FIL CHAR(10) BAS(FIL@);
DCL DD MBR CHAR(10) BAS(MBR@);
DCL DD NUM_PARMS BIN( 4);
/* Control field for first time initialization */
DCL DD READY CHAR( 1) INIT("0");
/* Binary offset into the space */
DCL DD BINOFFSET BIN(4) AUTO INIT(0);
DCL SPCPTR BINOFFSET@ AUTO INIT(BINOFFSET);
/* Pointers for accessing the space */
DCL SPCPTR USRSPC;
DCL SYSPTR USRSPC@;
/* QCMDEXC and associated CL commands */
DCL SYSPTR QCMDEXC INIT("QCMDEXC", CTX("QSYS"), TYPE(PGM));
DCL DD CLOVRCMD CHAR(65);
DCL DD OVRSTR CHAR(39) DEF(CLOVRCMD) POS(1)
INIT("OVRDBF MISRC 1234567890 MBR(1234567890)");
DCL DD OVRSTR2 CHAR(26) DEF(CLOVRCMD) POS(40)
INIT(" POSITION(*RRN 1234567890)");
DCL DD FILNAM CHAR(10) DEF(CLOVRCMD) POS(14);
DCL DD MBRNAM CHAR(10) DEF(CLOVRCMD) POS(29);
DCL DD RECNUM ZND(10,0) DEF(CLOVRCMD) POS(55);
DCL SPCPTR CLOVRCMD@ INIT(CLOVRCMD);
DCL DD CLOVRLNG PKD(15,5) INIT(P'65');
DCL SPCPTR CLOVRLNG@ INIT(CLOVRLNG);
DCL OL QCMDOVROL (CLOVRCMD@, CLOVRLNG@) ARG;
DCL DD CLDLTCMD CHAR(12) INIT("DLTOVR MISRC");
DCL SPCPTR CLDLTCMD@ INIT(CLDLTCMD);
DCL DD CLDLTLNG PKD(15,5) INIT(P'12');
DCL SPCPTR CLDLTLNG@ INIT(CLDLTLNG);
DCL OL QCMDDLTOL (CLDLTCMD@, CLDLTLNG@) ARG;
/* CL06 and associated parameters */
DCL SYSPTR CL06 INIT("CL06", TYPE(PGM));
DCL DD OFFSET PKD(15,5);
DCL SPCPTR OFFSET@ INIT(OFFSET);
DCL OL CL06OL (USRSPC, OFFSET@) ARG;
/* Access QTEMP address */
DCL SYSPTR QTEMP@ BASPCO POS(65);
/* Template for CRTS MI instruction */
DCL DD CRTSTMPLT CHAR(160) BDRY(16);
DCL DD TMPLTSPEC CHAR(8) DEF(CRTSTMPLT) POS(1);
DCL DD TMPLTSIZE BIN(4) DEF(TMPLTSPEC) POS(1) INIT(160);
DCL DD TMPLTBA BIN(4) DEF(TMPLTSPEC) POS(5) INIT(0);
DCL DD OBJID CHAR(32) DEF(CRTSTMPLT) POS(9);
DCL DD SPCTYPE CHAR(1) DEF(OBJID) POS(1) INIT(X'19');
DCL DD SPCSUBTYPE CHAR(1) DEF(OBJID) POS(2) INIT(X'EF');
DCL DD SPCNAME CHAR(30) DEF(OBJID) POS(3) INIT("MICRTPG2");
DCL DD OBJCRTOPT CHAR(4) DEF(CRTSTMPLT) POS(41) INIT(X'60020000');
DCL DD OBJRCVOPTS CHAR(4) DEF(CRTSTMPLT) POS(45);
DCL DD * CHAR(2) DEF(OBJRCVOPTS) POS(1) INIT(X'0000');
DCL DD ASP CHAR(2) DEF(OBJRCVOPTS) POS(3) INIT(X'0000');
DCL DD SPCSIZ BIN(4) DEF(CRTSTMPLT) POS(49) INIT(1);
DCL DD INTSPCVAL CHAR(1) DEF(CRTSTMPLT) POS(53) INIT(X'00');
DCL DD PERFCLASS CHAR(4) DEF(CRTSTMPLT) POS(54) INIT(X'00000000');
DCL DD * CHAR(1) DEF(CRTSTMPLT) POS(58) INIT(X'00');
DCL DD PUBAUT CHAR(2) DEF(CRTSTMPLT) POS(59) INIT(X'0000');
DCL DD TMPLTEXTN BIN(4) DEF(CRTSTMPLT) POS(61) INIT(96);
DCL SYSPTR CONTEXT DEF(CRTSTMPLT) POS(65);
DCL SYSPTR ACCESSGRP DEF(CRTSTMPLT) POS(81);
DCL SYSPTR USRPRF DEF(CRTSTMPLT) POS(97);
DCL DD MAXSPCSIZ BIN(4) DEF(CRTSTMPLT) POS(113) INIT(0);
DCL DD DOMAIN CHAR(2) DEF(CRTSTMPLT) POS(117) INIT(X'0001');
DCL DD * CHAR(42) DEF(CRTSTMPLT) POS(119) INIT((42)X'00');
DCL SPCPTR CRTSTMPLT@ INIT(CRTSTMPLT);
/* QPRCRTPG and associated parameters */
DCL DD PGM CHAR(20);
DCL DD PGMNAM CHAR(10) DEF(PGM) POS(1);
DCL DD PGMLIBNAM CHAR(10) DEF(PGM) POS(11) INIT("*CURLIB ");
DCL SPCPTR PGM@ INIT(PGM);
DCL DD PGMTXT CHAR(50) INIT(" ");
DCL SPCPTR PGMTXT@ INIT(PGMTXT);
DCL DD PGMSRCF CHAR(20) INIT("*NONE");
DCL SPCPTR PGMSRCF@ INIT(PGMSRCF);
DCL DD PGMSRCM CHAR(10) INIT(" ");
DCL SPCPTR PGMSRCM@ INIT(PGMSRCM);
DCL DD PGMSRCCHG CHAR(13) INIT(" ");
DCL SPCPTR PGMSRCCHG@ INIT(PGMSRCCHG);
DCL DD PRTFNAM CHAR(20) INIT("QSYSPRT *LIBL ");
DCL SPCPTR PRTFNAM@ INIT(PRTFNAM);
DCL DD PRTSTRPAG BIN(4) INIT(1);
DCL SPCPTR PRTSTRPAG@ INIT(PRTSTRPAG);
DCL DD PGMPUBAUT CHAR(10) INIT("*ALL ");
DCL SPCPTR PGMPUBAUT@ INIT(PGMPUBAUT);
DCL DD PGMOPTS(16) CHAR(11) INIT((1)"*LIST", *(2)(1)"*REPLACE",
*(3)(1)"*XREF");
DCL SPCPTR PGMOPTS@ INIT(PGMOPTS);
DCL DD NUMOPTS BIN(4) INIT(3);
DCL SPCPTR NUMOPTS@ INIT(NUMOPTS);
DCL OL QPRCRTPGOL (USRSPC, BINOFFSET@, PGM@, PGMTXT@, PGMSRCF@,
PGMSRCM@, PGMSRCCHG@, PRTFNAM@, PRTSTRPAG@,
PGMPUBAUT@, PGMOPTS@, NUMOPTS@) ARG;
DCL SYSPTR QPRCRTPG INIT("QPRCRTPG", CTX("QSYS"), TYPE(PGM));
/* Start of instruction stream */
STPLLEN NUM_PARMS;
CMPNV(B) NUM_PARMS, 2 / EQ(PARM2);
CPYBLAP FILNAM, 'MISRC', ' ';
B PARM1;
PARM2: CPYBLA FILNAM, FIL;
PARM1: CPYBLA MBRNAM,MBR;
CMPBLA(B) READY, '1' / EQ(SKIP);
CPYBWP CONTEXT, QTEMP@;
CRTS USRSPC@, CRTSTMPLT@;
SETSPPFP USRSPC,USRSPC@;
CPYBLA READY, '1';
SKIP: CPYNV RECNUM, 1;
MORE: CALLX QCMDEXC, QCMDOVROL, *;
CPYNV OFFSET,1;
CALLX CL06, CL06OL, *;
SUBN(S) OFFSET, 1;
ADDN(S) BINOFFSET, OFFSET;
SETSPPO USRSPC, BINOFFSET;
ADDN(S) RECNUM, 20;
CALLX QCMDEXC, QCMDDLTOL, *;
CMPNV(B) OFFSET, 1600 /EQ(MORE);
CPYBLA PGMNAM, MBR;
SETSPPO USRSPC, 0;
CALLX QPRCRTPG, QPRCRTPGOL, *;
RTX *;
PEND;