Create the MICRTPG2 program

This topic shows how to create the MICRTPG2 program and how to handle exceptions in the MICRTPG2 program.

Note: Read the Code license and disclaimer information for important legal information.

To create the MICRTPG2 program, use:

DLTOVR MISRC
CALL CL03 (MISRC MICRTPG2)

After the successful creation of MICRTPG2, you can create any new MI programs by entering the following, where SourceFileName is an optional parameter:

CALL MICRTPG2 (MemberName SourceFileName)

Handle exceptions in the MICRTPG2 program

Some exceptions that are not being handled by the MICRTPG2 program might occur. For example, if you used MICRTPG2 to compile MICRTPG2 two times in succession, the exception MCH1401 occurs. This occurs because the most recent activation of the MICRTPG2 program has its own static storage and is not aware of the earlier instances of MICRTPG2 creating the space named MICRTPG2 in QTEMP.

To correct this problem do the following:

  1. Define an exception description that passes control to an internal exception handler: 
        DCL EXCM DUPERROR EXCID(H'0E01') INT(M1401) IMD;
  2. Define the internal entry point: 
        ENTRY  M1401 INT;
  3. Define related data elements for the M1401 exception: 
        /* Exception description template for RETEXCPD   */

    DCL DD EXCPDBUF CHAR(200) BDRY(16);
     DCL DD BYTPRV BIN(4) DEF(EXCPDBUF) POS(1) INIT(200);
     DCL DD BYTAVL BIN(4) DEF(EXCPDBUF) POS(5);
     DCL DD EXCPID CHAR(2) DEF(EXCPDBUF) POS(9);
     DCL DD CMPLEN BIN(2) DEF(EXCPDBUF) POS(11);
     DCL DD CMPDTA CHAR(32) DEF(EXCPDBUF) POS(13);
     DCL DD MSGKEY CHAR(4) DEF(EXCPDBUF) POS(45);
     DCL DD EXCDTA CHAR(50) DEF(EXCPDBUF) POS(49);
      DCL SYSPTR EXC_OBJ@ DEF(EXCDTA) POS(1);
      DCL DD EXC_OBJ CHAR(32) DEF(EXCDTA) POS(17);
     DCL PTR INV_PTR DEF(EXCPDBUF) POS(97);
     DCL DD * CHAR(87) DEF(EXCPDBUF) POS(113);
    DCL SPCPTR EXCPDBUF@ INIT(EXCPDBUF);

    /* Template for RTNEXCP                          */

    DCL DD RTNTMPLT CHAR(19) BDRY(16);
     DCL PTR INV_PTR2 DEF(RTNTMPLT) POS(1);
     DCL DD * CHAR(1) DEF(RTNTMPLT) POS(17) INIT(X'00');
     DCL DD ACTION CHAR(2) DEF(RTNTMPLT) POS(18);
    DCL SPCPTR RTNTMPLT@ INIT(RTNTMPLT);
  4. Retrieve the exception data associated with the MCH1401 exception: 
               RETEXCPD EXCPDBUF@, X'01';
  5. Compare the exception data object identifier to the space identifier you create. If they are the same, branch to label SAME: 
               CMPBLA(B) EXC_OBJ, OBJID / EQ(SAME);
    1. If the exception data object identifier and the space identifier are not the same, the program is truly in an unexpected error condition and the exception description needs to be disabled: 
                 MODEXCPD DUPERROR, X'2000', X'01';

      Retry the failing instruction. As the exception description is disabled, the exception is sent to the caller of the program:

                 CPYBLA ACTION, X'0000';
           B E1401;
    2. If the exception data object identifier and the space identifier are the same, the static storage must have been effectively reset. The program reassigns USRSPC@ by using the returned system pointer in the exception data and continues with the next instruction following the failed CRTS: 
          SAME:  CPYBWP USRSPC@, EXC_OBJ@;
           CPYBLA ACTION, X'0100';
    E1401: CPYBWP INV_PTR2, INV_PTR;
           RTNEXCP RTNTMPLT@;
           PEND;

MI code example: MICRTPG2 complete program (enhanced)

In its consolidated state, this is the new MICRTPG2 program:

/********************************************************************/
/********************************************************************/
/*                                                                  */
/*     program Name: MICRTPG2                                       */
/*                                                                  */
/*     programming Language: MI                                     */
/*                                                                  */
/*     Description: Enhanced version of MI program MICRTPG2,        */
/*                  which provides for exception handling.          */
/*                                                                  */
/*                                                                  */
/*     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));

/* Exception Description Monitor for MCH1401     */

DCL EXCM DUPERROR EXCID(H'0E01') INT(M1401) IMD;

/* 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 *;

/* Entry point for internal exception handler    */

ENTRY  M1401 INT;

/* Exception description template for RETEXCPD   */

DCL DD EXCPDBUF CHAR(200) BDRY(16);
 DCL DD BYTPRV BIN(4) DEF(EXCPDBUF) POS(1) INIT(200);
 DCL DD BYTAVL BIN(4) DEF(EXCPDBUF) POS(5);
 DCL DD EXCPID CHAR(2) DEF(EXCPDBUF) POS(9);
 DCL DD CMPLEN BIN(2) DEF(EXCPDBUF) POS(11);
 DCL DD CMPDTA CHAR(32) DEF(EXCPDBUF) POS(13);
 DCL DD MSGKEY CHAR(4) DEF(EXCPDBUF) POS(45);
 DCL DD EXCDTA CHAR(50) DEF(EXCPDBUF) POS(49);
  DCL SYSPTR EXC_OBJ@ DEF(EXCDTA) POS(1);
  DCL DD EXC_OBJ CHAR(32) DEF(EXCDTA) POS(17);
 DCL PTR INV_PTR DEF(EXCPDBUF) POS(97);
 DCL DD * CHAR(87) DCF(EXCPDBUF) POS(113);
DCL SPCPTR EXCPDBUF@ INIT(EXCPDBUF);

/* Template for RTNEXCP                          */

DCL DD RTNTMPLT CHAR(19) BDRY(16);
 DCL PTR INV_PTR2 DEF(RTNTMPLT) POS(1);
 DCL DD * CHAR(1) DEF(RTNTMPLT) POS(17) INIT(X'00');
 DCL DD ACTION CHAR(2) DEF(RTNTMPLT) POS(18);
DCL SPCPTR RTNTMPLT@ INIT(RTNTMPLT);

/* Start of internal handler                     */

       RETEXCPD EXCPDBUF@, X'01';
       CMPBLA(B) EXC_OBJ, OBJID / EQ(SAME);
       MODEXCPD DUPERROR, X'2000', X'01';
       CPYBLA ACTION, X'0000';
       B E1401;
SAME:  CPYBWP USRSPC@, EXC_OBJ@;
       CPYBLA ACTION, X'0100';
E1401: CPYBWP INV_PTR2, INV_PTR;
       RTNEXCP RTNTMPLT@;
       PEND;
Parent topic: Machine interface programming
Related reference
Compile an MI program