07
Tue, May
4 New Articles

Simon's Solutions: Exploring the QSCMATPG and QSCCRTPG APIs

APIs
Typography
  • Smaller Small Medium Big Bigger
  • Default Helvetica Segoe Georgia Times

Open the door to the OMI program template.

 

In a post in the MI400-L mailing list at midrange.com, Simon Coulter documented the Materialize Program (QSCMATPG) and Create Program (QSCCRTPG) APIs in detail, including the parameter lists and related usage notes. Simon also designed a couple of CL commands to make it easier and more secure to use these APIs. With this information, you can open the door to the Original MI (OMI) program template, which allows a System/38 program to survive all the hardware changes and run on the most current IBM i release without recompilation.

There's no doubt that Machine Interface (MI) is one of the cornerstones of System/38 and its descendants (AS/400, iSeries, System i, and IBM i). As a high-level, virtual instruction set, it isolates the application software and most of the operating system from hardware dependencies. Since the introduction of New MI (NMI), on which the Integrated Language Environment (ILE) program model is based, the previous MI instruction set is referred to as OMI. And an MI transformer was introduced to convert OMI instruction streams to NMI instruction streams. This way, either old or newly developed Original Program Model (OPM) programs can still run on current or future IBM i releases. Search for NMI in the mailing list archive of MI400-L, you'll find a lot of discussion about OMI and NMI.

The key that a program created on one IBM i release (even System/38) can run on future IBM i releases with no need of recompilation is the intermediate representation of the program that is stored in the program object, the program template (the OMI program template for an OPM program or the NMI program template for an ILE program).The ability to obtain the MI program template is obviously one of the prerequisites to the goal of understanding the MI architecture. A couple of undocumented APIs in existence since S/38, the QSCMATPG and QSCCRTPG APIs, can be used to retrieve the OMI program template of an OPM program to a physical file and create an OPM program from the OMI program template stored in a physical file, respectively.

Simon's Post That Documented the QSCMATPG and QSCCRTPG APIs

The following is Simon's original post:

Re: QSCMATPG and QSCCRTPG

   * Subject: Re: QSCMATPG and QSCCRTPG

   * From: "Simon Coulter" <shc@xxxxxxxxxxxxxxxxx>;

   * Date: Wed, 30 May 01 21:02:57 +1000

To All,

I found some old notes of mine regarding these programs so I thought I would incorporate them in the documentation I sent earlier. The updates incorporate the supported special values and Gene's comment regarding LVLCHK(*NO). At the end you will find CMD and CL source for using them which I wrote years ago, hence the code to cope with S/38 -- remember that :)

QSCMATPG

   ---------------------------------------------

   | 1 | Program name   | Input   | CHAR(10) |

   ---------------------------------------------

   | 2 | Library name   | Input   | CHAR(10) |

   ---------------------------------------------

   | 3 | File name       | Input   | CHAR(10) |

   ---------------------------------------------

   | 4 | File library   | Input   | CHAR(10) |

   ---------------------------------------------

   | 5 | Member name     | Input   | CHAR(10) |

   ---------------------------------------------

   | 6 | Member option   | Input   | CHAR(8)   |

   ---------------------------------------------

The Materialize Program (QSCMATPG) API retrieves the program template for an OPM program and places it in the specified file member.

Program name: The name of the program to materalize.

Library name: The name of the library containing the program. *LIBL is supported.

File name: The name of the output file. This is a physical file with a record length of 80 bytes and LVLCHK(*NO). The file must exist before the API is called.

File library: The name of the library containing the output file. *LIBL is supported.

Member name: The name of the member to receive the program template. *PGM causes the program template to be stored in a member with the same name as the program.

Member option: *ADD or *REPLACE

QSCCRTPG

   ---------------------------------------------

   | 1 | Program name   | Input   | CHAR(10) |

   ---------------------------------------------

   | 2 | Library name   | Input   | CHAR(10) |

   ---------------------------------------------

   | 3 | File name       | Input   | CHAR(10) |

   ---------------------------------------------

   | 4 | File library   | Input   | CHAR(10) |

   ---------------------------------------------

   | 5 | Member name     | Input   | CHAR(10) |

   ---------------------------------------------

The Create Program (QSCCRTPG) API creates a program from the program template retrieved by the Materialise Program (QSCMATPG) API.

Program name: The name of the program to create.

Library name: The name of the library to contain the program. Special values are not supported.

File name: The name of the file containing the program template. This is a physical file with a record length of 80 bytes. The file must exist before the API is called.

File library: The name of the library containing the file. *LIBL is supported.

Member name: The name of the member containing the program template. *PGM uses a member with the same name as the program.

Example code:

MATPG:     CMD       PROMPT('Materialise Program Template')

             PARM       KWD(PGM) TYPE(Q1) MIN(1) PROMPT('Program')

             PARM       KWD(FILE) TYPE(Q2) MIN(1) PROMPT('File')

             PARM       KWD(MBR) TYPE(*NAME) DFT(*PGM) SPCVAL((*PGM) +

                         (*FILE)) EXPR(*YES) PROMPT('Member')

             PARM       KWD(MBROPT) TYPE(*CHAR) LEN(8) RSTD(*YES) +

                         DFT(*REPLACE) VALUES(*REPLACE *ADD) +

                         PROMPT('Replace or add records')

Q1:         QUAL       TYPE(*NAME) MIN(1) EXPR(*YES)

             hUAL       TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL)) +

                         EXPR(*YES) PROMPT('Library')

Q2:         QUAL       TYPE(*NAME) MIN(1) EXPR(*YES)

             QUAL       TYPE(*NAME) DFT(*CURLIB) SPCVAL((*CURLIB +

                         *CURLIB) (*LIBL)) EXPR(*YES) +

                         PROMPT('Library')

MATPGC:     PGM       PARM(&QUALPGM &QUALFILE &MBR &MBROPT)

/*                                                                 */

/*----------------- Input Parameter Declarations ------------------*/

/*                                                                 */

             DCL       VAR(&QUALPGM) TYPE(*CHAR) LEN(20)

             /* NameLibrary */

             DCL       VAR(&QUALFILE) TYPE(*CHAR) LEN(20)

             /* NameLibrary */

            DCL       VAR(&MBR) TYPE(*CHAR) LEN(10)

             /* Work file member */

             DCL       VAR(&MBROPT) TYPE(*CHAR) LEN(8)

             /* *ADD or *REPLACE */

/*                                                                 */

/*-------------------- Program Declarations -----------------------*/

/*                                                                 */

             DCL       VAR(&PGM) TYPE(*CHAR) LEN(10)

             DCL       VAR(&PLIB) TYPE(*CHAR) LEN(10)

             DCL       VAR(&FILE) TYPE(*CHAR) LEN(10)

             /* Program template work file */

             DCL       VAR(&FLIB) TYPE(*CHAR) LEN(10)

             /* Work file library */

             DCL       VAR(&REALLIB) TYPE(*CHAR) LEN(10) /* Actual +

                          library containing program (for *LIBL +

                         search) */

             DCL       VAR(&MSGTYPE) TYPE(*CHAR) LEN(5)

             DCL       VAR(&IGC) TYPE(*CHAR) LEN(1)

/*                                                                */

/*----------------- Mnemonic Value Declarations -------------------*/

/*                                                                 */

             DCL       VAR(&BLANK) TYPE(*CHAR) LEN(1) VALUE(X'40')

                       /* Mnemonic for 'blank' */

             DCL       VAR(&TRUE) TYPE(*LGL) LEN(1) VALUE('1')

                       /* Mnemonic for 'true' */

             DCL       VAR(&FALSE) TYPE(*LGL) LEN(1) VALUE('0')

                       /* Mnemonic for 'false' */

            DCL       VAR(&ERROR) TYPE(*LGL) LEN(1)

                       /* Mnemonic for 'error' */

/*                                                                 */

/*-------------- Global Message Monitor Declarations --------------*/

/*                                                                */

             DCL       VAR(&MSGDTA) TYPE(*CHAR) LEN(40)

             DCL       VAR(&MSGID) TYPE(*CHAR) LEN(7)

             DCL       VAR(&MSGF) TYPE(*CHAR) LEN(10)

             DCL       VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)

/*                                                                 */

/*--------------- Global Message Monitor Intercept ----------------*/

/*                                                                 */

             MONMSG     MSGID(CPF0000 MCH0000) EXEC(GOTO CMDLBL(ERROR))

/* Substring out the program and library names */

             CHGVAR     VAR(&PGM) VALUE(%SST(&QUALPGM 1 10))

             CHGVAR     VAR(&PLIB) VALUE(%SST(&QUALPGM 11 10))

             CHGVAR     VAR(&REALLIB) VALUE(&PLIB)

             CHGVAR     VAR(&FILE) VALUE(%SST(&QUALFILE 1 10))

             CHGVAR     VAR(&FLIB) VALUE(%SST(&QUALFILE 11 10))

/* Handle special values from command definition */

             IF         COND(&MBR *EQ '*PGM') THEN(DO)

              CHGVAR     VAR(&MBR) VALUE(&PGM)

             ENDDO

             IF         COND(&MBR *EQ '*FILE') THEN(DO)

               CHGVAR     VAR(&MBR) VALUE(&FILE)

             ENDDO

/* ********************************************************** */

/* If '*LIBL' was passed in for library, get the name of the */

/* actual library containing the program.                     */

/*                                                           */

/* The trick to determining the library of an existing object */

/* is as follows:                                             */

/*                                                           */

/* 1. Rename the object to itself                           */

/* 2. CPF returns a message informing that the object was    */

/*     not renamed.                                         */

/*     On the AS/400, an escape message is sent.             */

/*     On the S/38, an informational message is sent         */

/*     This code section works on either machine.            */

/* 3. The library of the object is in positions 11 - 20     */

/*     of the message data associated with the message.     */

/* ********************************************************** */

             IF         COND(&REALLIB *EQ '*LIBL') THEN(DO)

               CHGVAR     VAR(&MSGTYPE) VALUE('*INFO')

               RNMOBJ     OBJ(&PGM) OBJTYPE(*PGM) NEWOBJ(&PGM)

               MONMSG     MSGID(CPF2132) EXEC(DO)

                 CHGVAR     VAR(&MSGTYPE) VALUE('*EXCP')

               ENDDO

               RCVMSG     MSGTYPE(&MSGTYPE) MSGDTA(&MSGDTA) MSGID(&MSGID)

               CHGVAR     VAR(&REALLIB) VALUE(%SST(&MSGDTA 11 10))

             ENDDO     /* RealLib */

/* Allocate the program */

             ALCOBJ     OBJ((&REALLIB/&PGM *PGM *EXCL))

/* Ensure work file and member exist */

             CHKOBJ     OBJ(&FLIB/&FILE) OBJTYPE(*FILE)

             MONMSG     MSGID(CPF9801) EXEC(DO)

               RCVMSG     MSGTYPE(*LAST)

               RTVSYSVAL SYSVAL(QIGC) RTNVAR(&IGC)

              IF         COND(&IGC *EQ '1') THEN(DO)

                 CRTPF     FILE(&FLIB/&FILE) RCDLEN(80) MBR(&MBR) +

                             TEXT('Work file for MATPG/CRTPG command.'h +

                             OPTION(*NOLIST *NOSOURCE) MAXMBRS(*NOMAX) +

                             SIZE(*NOMAX) LVLCHK(*NO) IGCDTA(*YES)

               ENDDO

               ELSE       CMD(DO)

                 CRTPF     FILE(&FLIB/&FILE) RCDLEN(80) MBR(&MBR) +

                             TEXT('Work file for MATPG/CRTPG command.') +

                             OPTION(*NOLIST *NOSOURCE) MAXMBRS(*NOMAX) +

                             SIZE(*NOMAX) LVLCHK(*NO)

               ENDDO

             ENDDO

             CLRPFM     FILE(&FLIB/&FILE) MBR(&MBR)

             MONMSG     MSGID(CPF3141) EXEC(DO)

               RCVMSG     MSGTYPE(*LAST)

               ADDPFM     FILE(&FLIB/&FILE) MBR(&MBR)

             ENDDO

/* ************************************************************ */

/* Call the CPF module to materialise the program.             */

/* This will convert the internal representation of the program */

/* into an external form we can modify.                         */

/* The materialised information is placed in the work file.     */

/* Note:- this interface is not supported after V2R1.1.         */

/* ************************************************************ */

             CALL       PGM(QSCMATPG) PARM(&PGM &REALLIB &FILE +

                         &FLIB &MBR &MBROPT)

/*                                                                */

/*--------------------- Send User a Message -----------------------*/

/*                                                                 */

             SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +

                         MSGDTA('Program' *BCAT &PGM *BCAT 'in' +

                         *BCAT &REALLIB *BCAT 'materialised in +

                         member' *BCAT &MBR *BCAT 'in file' *BCAT +

                         &FILE *BCAT 'in' *BCAT &FLIB) MSGTYPE(*COMP)

EXIT:       RETURN     /* Normal end of program */

/*                                                                 */

/*---------------------- Exception Routine ------------------------*/

/*                                                                 */

ERROR:      RCVMSG     MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) +

                         MSGF(&MSGF) MSGFLIB(&MSGFLIB)

             MONMSG     MSGID(CPF0000 MCH0000) EXEC(RETURN)

                       /* Just in case */

             IF         COND(&MSGID *NE &BLANK) THEN(DO)

             SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +

                         MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)

             MONMSG     MSGID(CPF0000 MCH0000) EXEC(RETURN)

                       /* Just in case */

            ENDDO

MATPGX:     ENDPGM

CRTPG:     CMD       PROMPT('Create Program from Template')

             PARM       KWD(PGM) TYPE(Q1) MIN(1) PROMPT('Program')

             PARM       KWD(FILE) TYPE(Q2) MIN(1) PROMPT('File')

             PARM       KWD(MBR) TYPE(*NAME) DFT(*PGM) SPCVAL((*PGM) +

                         (*FILE)) EXPR(*YES) PROMPT('Member')

Q1:         QUAL       TYPE(*NAME) MIN(1) EXPR(*YES)

             QUAL       TYPE(*NAME) DFT(*CURLIB) SPCVAL((*CURLIB +

                         *CURLIB)) EXPR(*YES) PROMPT('Library')

Q2:         QUAL       TYPE(*NAME) MIN(1) EXPR(*YES)

             QUAL       TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL) +

                         (*CURLIB *CURLIB)) EXPR(*YES) +

                         PROMPT('Library')

CRTPGC:     PGM       PARM(&QUALPGM &QUALFILE &MBR)

/*                                                                 */

/*----------------- Input Parameter Declarations ------------------*/

/*                                                                */

             DCL       VAR(&QUALPGM) TYPE(*CHAR) LEN(20)

             /* NameLibrary */

             DCL       VAR(&QUALFILE) TYPE(*CHAR) LEN(20)

             /* NameLibrary */

             DCL       VAR(&MBR) TYPE(*CHAR) LEN(10)

             /* Work file member */

/*                                                                 */

/*-------------------- Program Declarations -----------------------*/

/*                                                                 */

              DCL       VAR(&PGM) TYPE(*CHAR) LEN(10)

             DCL       VAR(&PLIB) TYPE(*CHAR) LEN(10)

             DCL       VAR(&FILE) TYPE(*CHAR) LEN(10)

             /* Program template work file */

             DCL       VAR(&FLIB) TYPE(*CHAR) LEN(10)

             /* Work file library */

             DCL       VAR(&REALLIB) TYPE(*CHAR) LEN(10) /* Actual +

                           library containing file (for *LIBL +

                           search) */

             DCL       VAR(&MSGTYPE) TYPE(*CHAR) LEN(5)

             DCLF       FILE(QADSPOBJ)

/*                                                                 */

/*----------------- Mnemonic Value Declarations -------------------*/

/*                                                                */

             DCL       VAR(&BLANK) TYPE(*CHAR) LEN(1) VALUE(X'40')

                       /* Mnemonic for 'blank' */

             DCL       VAR(&TRUE) TYPE(*LGL) LEN(1) VALUE('1')

                       /* Mnemonic for 'true' */

            DCL       VAR(&FALSE) TYPE(*LGL) LEN(1) VALUE('0')

                       /* Mnemonic for 'false' */

             DCL       VAR(&ERROR) TYPE(*LGL) LEN(1)

                       /* Mnemonic for 'error' */

/*                                                                */

/*-------------- Global Message Monithr Declarations --------------*/

/*                                                                 */

             DCL       VAR(&MSGDTA) TYPE(*CHAR) LEN(40)

             DCL       VAR(&MSGID) TYPE(*CHAR) LEN(7)

             DCL       VAR(&MSGF) TYPE(*CHAR) LEN(10)

             DCL       VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)

/*                                                                 */

/*--------------- Global Message Monitor Intercept ----------------*/

/*                                                                 */

             MONMSG     MSGID(CPF0000 MCH0000) EXEC(GOTO CMDLBL(ERROR))

/* Substring out the program and library names */

             CHGVAR     VAR(&PGM) VALUE(%SST(&QUALPGM 1 10))

             CHGVAR     VAR(&PLIB) VALUE(%SST(&QUALPGM 11 10))

             CHGVAR     VAR(&FILE) VALUE(%SST(&QUALFILE 1 10))

             CHGVAR     VAR(&FLIB) VALUE(%SST(&QUALFILE 11 10))

             CHGVAR     VAR(&REALLIB) VALUE(&FLIB)

/* Handle special values from command definition */

             IF         COND(&MBR *EQ '*PGM') THEN(DO)

               CHGVAR     VAR(&MBR) VALUE(&PGM)

             ENDDO

             IF         COND(&MBR *EQ '*FILE') THEN(DO)

                CHGVAR     VAR(&MBR) VALUE(&FILE)

             ENDDO

/* ********************************************************** */

/* If '*LIBL' was passed in for library, get the name of the */

/* actual library containing the file.                        */

/*                                                           */

/* The trick to determining the library of an existing object */

/* is as follows:                                             */

/*                                                            */

/* 1. Rename the object to itself                           */

/* 2. CPF returns a message informing that the object was   */

/*     not renamed.                                         */

/*     On the AS/400, an escape message is sent.              */

/*     On the S/38, an informational message is sent         */

/*     This code section works on either machine.             */

/* 3. The library of the object is in positions 11 - 20     */

/*     of the message data associated with the message.     */

/* ********************************************************** */

             IF         COND(&REALLIB *EQ '*LIBL') THEN(DO)

               CHGVAR     VAR(&MSGTYPE) VALUE('*INFO')

               RNMOBJ     OBJ(&FILE) OBJTYPE(*FILE) NEWOBJ(&FILE)

               MONMSG     MSGID(CPF2132) EXEC(DO)

                 CHGVAR     VAR(&MSGTYPE) VALUE('*EXCP')

               ENDDO

               RCVMSG     MSGTYPE(&MSGTYPE) MSGDTA(&MSGDTA) MSGID(&MSGID)

               CHGVAR     VAR(&REALLIB) VALUE(%SST(&MSGDTA 11 10))

             ENDDO     /* RealLib */

/* Allocate the program */

             ALCOBJ     OBJ((&PLIB/&PGM *PGM *EXCL))

             MONMSG     MSGID(CPF1085) EXEC(DO)

               RCVMSG     MSGTYPE(*EXCP)                 h

              GOTO       CMDLBL(CREATE) /* Not found */

             ENDDO

/* Ensure work file and member exist */

             CHKOBJ     OBJ(&REALLIB/&FILE) OBJTYPE(*FILE) MBR(&MBR)

/* Find out the current owner of the object */

             DSPOBJD   OBJ(&PLIB/&PGM) OBJTYPE(*PGM) +

                         DETAIL(*SERVICE) OUTPUT(*OUTFILE) +

                         OUTFILE(QTEMP/@RTVPGMOWN)

             OVRDBF     FILE(QADSPOBJ) TOFILE(QTEMP/@RTVPGMOWN)

             RCVF

/* Delete the existing program */

             DLTPGM     PGM(&PLIB/&PGM)

/* ************************************************************ */

/* Call the CPF module to recreate the program from the update */

/* program template.                                           */

/* Note:- this interface is not supported after V2R1.1.         */

/* ************************************************************ */

CREATE:     CALL       PGM(QSCCRTPG) PARM(&PGM &PLIB &FILE +

                         &REALLIB &MBR)

/* Ensure the original owner still owns the program */

/* Note:- Need to adopt GOD to ensure this works   */

             IF         COND(&ODOBOW *NE &BLANK) THEN(DO)

               CHGOBJOWN OBJ(&REALLIB/&PGM) OBJTYPE(*PGM) +

                           NEWOWN(&ODOBOW)

           ENDDO

/*                                                                 */

/*--------------------- Send User a Message -----------------------*/

/*                                                                 */

             SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +

                         MSGDTA('Program' *BCAT &PGM *BCAT 'in' +

                         *BCAT &REALLIB *BCAT 'created from +

                         member' *BCAT &MBR *BCAT 'in file' *BCAT +

                         &FILE *BCAT 'in' *BCAT &FLIB) MSGTYPE(*COMP)

EXIT:       RETURN     /* Normal end of program */

ERROR:     RCVMSG     MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) +

                         MSGF(&MSGF) MSGFLIB(&MSGFLIB)

             MONMSG     MSGID(CPF0000 MCH0000) EXEC(RETURN)

                       /* Just in case */

             IF         COND(&MSGID *NE &BLANK) THEN(DO)

             SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +

                         MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)

             MONMSG    MSGID(CPF0000 MCH0000) EXEC(RETURN)

                       /* Just in case */

             ENDDO

CRTPGX:     ENDPGM

Regards,

Simon Coulter.

The source of the MATPG and CRTPG CL commands and their Command Processing Programs are available as matpg.cl-cmd, crtpg.cl-cmd, matpgc.clp, and crtpgc.clp.

To retrieve the OMI program template of an OPM program, you can issue the following command:

MATPG PGM(MYOPMPGM) FILE(OMI)

This will place the materialized OPM program template of *LIBL/MYOPMPGM into physical file member *CURLIB/OMI(MYOPMPGM). To create an OPM program from an existing OPM program template stored in a physical file member, you can issue the following command:

CRTPG PGM(MYOPMPGM) FILE(OMI) MBR(MBR_NAME)

To display the materialized OMI program templates, you can use the Source Entry Utility (SEU) or the Display File (DSPF) command. However, it would be a little inconvenient to browse the hexadecimal content of the program template with either of these tools. There's a tiny tool program PRTHEX80 (whose source code is available as prthex80.c at i5/OS Programmer's Toolkit) that prints the content of a physical file member in a format similar to SST to an output spooled file. For example, to print the content of the above-mentioned OMI program template of MYOPMPGM stored in physical file member *CURLIB/OMI(MYOPMPGM), you can call PRTHEX80 like so:

   CALL PRTHEX '*CURLIB/OMI(MYOPMPGM)'

or

 CALL PRTHEX 'OMI(MYOPMPGM)'

The output spooled file of PRTHEX80 might look like the following:

omi(myopmpgm)

00000000     D7E3000011F00000   0000000000000000 000011E8000014A0   0201D4E8D6D7D4D7 *PT   0             Y   ~   MYOPMP*

00000020   C7D4404040404040   4040404040404040 4040404040404040 E000800000000000 *GM                     $       *

00000040     0000100000110000 0000000000000000 0000000000000000 01111305F1000400 *                           1   *

00000060     0000000000000000 0000000000000000 00A000FC00000000 000082D0002A0074 *                 ~       b}     *

00000080     0000010000000240 000004180000000A   0000009C0000114C 0000000000000947   *                       <       *

000000A0   00000804000011E8 0000002A00000000 0000000005400000 0000000000000540   *       Y                       *

000000C0   8000000000000000 0000000000000000   0000000000000000 0000000000000000 *                               *

000000E0     0000000000000000 0000000000000000 0000000000000000 0000000000000000   *                                *

00000100     0000000000000000 0000000000000000 0000014021320043 00440132003F4045 *                               *

00000120     213A0252003F0070 02834045213C0070   000003EF00380036 20013042004F2001   *         c                   | *

00000140     10B3002B00082040 3042004F200210B3   0028200020403042 004F200318461000   *           |             |     *

00000160     0025000E002E1CC2 C000002E20F10010 101100113042004F 200418C340000026 *       B{     1         |   C     *

00000180     20F12040002E18C3 4000002720F12040 002F1093002E002E 002F1CC2C000002E   * 1       C     1     l       B{     *

000001A0   20F1001410110021 3042004F200518C3 C000002600272040   002E1CC2C000002E *   1         |   C{           B{   *

000001C0   20F1001A3042004F 200610B3002B0017   2040301100213042 004F200718E6C000 * 1     |                 |   W{ *

000001E0     0029002A002E1CC2 C000002E20F10020 3042004F200810B3 002B001D204030B2 *       B{     1     |           \*

00000200     0048002310110074 3011403A004F3011 4039004F23EF0038 0037200102834045 *             |     |           c *

00000220     214E0072000003EF 0038003620011CC2 4000005120C9003D 1011003B23EF0038 * +             B     I         *

00000240     0037200102834045 2139007100000260 000001D414010000 1401000014010000   *    c           -   M           *

00000260     5B8000042801000F 0944001430000006 6804001D30000008 3000000830000008   *¥                               *

00000280     3000000A3000000A 680300223000000E   3000000E3000000E 3000000E30000014 *                              *

000002A0   3000001430000014 3000001768040027   300000193000001A 3000001A3000001A *                               *

000002C0   3000001D6804002C 3000001F3000001F 3000001F3000001F 3000001F68040031 *                               *

000002E0    0900004A0900005B 090400660904006E 090400761A01007E 1A0100850A04008C   *   £     ¥       >       =     e   *

00000300     0904009119010098 0144000101440001 110100000B04009B 990000A40B0400AB *   j     q               r u     *

00000320     094400B401440001 680400BA680400BF 788800C4480000D0 480000E330000021 *           [     h D     }   T   *

00000340     2000002130000022 2000002211020000 190100F6190100F9 190100FC11020000 *                   6   9         *

00000360     1D0100FF1A020104   014400300B04010D 0B04013001440048 1B01014F1B010156 *                           |   *

00000380     1B01015D0B040164 0B04016E0B00017E 0B0401890B040198 0B0401A201440060 *   )         >   =   i     q   s   -*

000003A0   0B0001B2094401BD 1B0102B01B0002B9 1B0102C01B0202C9 1B0202D01B0202D7   *   \       ^         {   I   }     P*

000003C0   1B0102DE0B0402E5 0B0002EF0B0002FA   0B0403050B040318 0B0403220B04032C   *       V                       *

000003E0     0B0403441B01035D 1B0003640B00036B 0B0003760B040383 1B01039C0B0403A3 *       )         ,      c       t*

00000400     1B0103BC1B0103C3 0A0403CA090003CF 5C8003D45C8003DB   5C8003E230000023 *       C       *   M*   * S     *

00000420     3000002800000000 000003E901000300 0000010002000311 0004000160000100   *           Z               -   *

00000440     00002A0000420002 C5D8420002078F42 0002D5C5420002D5 C5420016FFFFFFFF *       EQ       NE   NE       *

00000460     4040404040404040 4040010000000000 0000640004000000 0100000000000400   *                               *

00000480     0000004C00040000   0024000000004C00   0100000028F04C00 0100000029F04C00 *     <         <     0<     0< *

000004A0   0100000023401800 0100000001180002   0000000150000200 0348000200000021 *                   &           *

000004C0   0400065800010030 0000001044000400 0000005800010032   0000000441400000 *                               *

000004E0     800F420002A00042   0002200085007300 03C3D7C600019999 0100080009000C00 *     ~       e   CPF rr         *

00000500     0F00130019001800   1F001E0100080007   000B000D00120015 0016001B001C0400   *                               *

00000520     5504004604004908 000000013000001C   70000000435C001A 0046000000010000 *                     *         *

00000540     0000000000000000 0000000000008000 0000000000000000 5C00160046000000 *                      *       *

00000560     1B00000000000000 0000000000000000 0000000000000018 0049000000011800   *                               *

00000580     4900000011180049 000000215C000100   4900000031005C00 0700490000003200 *             *         *         *

000005A0   0000000000005C00   0200490000003900 005C000600490000   003BF0F0F0F0F0F0   *     *         *       000000*

000005C0   5C00010049000000   41005C0007004900   0000420000000000 00005C0002005300   **         *               *     *

000005E0     00000100004400F0   0040404040404040 4040404040404040 4040404040404040 *       0                       *

00000600     4040404040404040 4040404040404040 4040404040404040 4040404040404040   *                               *

00000620     4040404040404040 4040404040404040 4040404040404040 4040404040404040   *                               *

00000640     4040404040404040 4040404040404040 4040404040404040 4040404040404040   *                               *

00000660     4040404040404040 4040404040404040 4040404040404040 4040404040404040   *                               *

00000680     4040404040404040 4040404040404040 4040404040404040 4040404040404040   *                               *

000006A0   4040404040404040 4040404040404040   4040404040404040 4040404040404040 *                                *

000006C0   4040404040404040 4040404040404040   4040404040404040 1C00550000000100   *                               *

000006E0     4618005500000011 1C00550000002100   5318005500000031 1800550000004118 *                                *

00000700     0055000000511800 55000000615C0001   005500000071045C 0002005500000072 *             /*         *       *

00000720     00005C0002005500   00007400005C000A 0055000000760000 0000000000000000   * *         *                 *

00000740     5C00010055000000 80005C0001005500 000081F05C000F00 5500000082000000 **         *       a0*       b     *

00000760     0000000000000000 000000005C001000   5500000091000000 0000000000000000 *             *       j           *

00000780     0000000000180055 0000009118005500 0000A15C00020055   000000B100005C00   *           j     ?*         * *

000007A0   040055000000B300 0000005C00100055 000000C100000000 0000000000000000 *           *       A           *

000007C0   0000000018005500 0000C15C00100055 000000D100000000 0000000000000000 *         A*       J           *

000007E0     0000000018005500 0000D11800550000 00E1500400005C44 0002000001000100 *         J       &     *         *

00000800     0000400100010000 0040010001000000 4200000000000233 FFFFFFFFFFFFFFFF   *                              *

00000820     FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFF   *                               *

... ...

000010C0   FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFF   FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFF *                               *

000010E0     FFFFFFFFFFFFFFFF 00084006E3C3C8D6 D7E3FFFFFFFF000E 4004D3C1D3C1FFFF *             TCHOPT       LALA *

00001100     FFFF001F4006C5D5 C4C3D4D7FFFFFFFF 0025C00250C2FFFF   FFFF0026C00450C9 *     ENDCMP     { &B     { &I*

00001120     D5F1FFFFFFFF0027 C00450C9D5F2FFFF   FFFF0028C00450D6   D7E3FFFFFFFF0029 *N1     {   &IN2     { &OPT     *

00001140   C00350D7F1FFFFFF FF002AC00350D7F2   FFFFFFFF002BC003 50D9C5000006F1F4 *{ &P1     { &P2     { &RE   14*

00001160   F0F0404040404040 0008E3C3C8D6D7E3   404040400008F1F5 F0F0404040404040 *00       TCHOPT     1500     *

00001180     000AF1F6F0F04040   40404040000ED3C1 D3C1404040404040 000EF1F8F0F04040 *   1600       LALA       1800   *

000011A0   404040400014F2F1 F0F0404040404040 0017F2F3F0F04040   404040400019F2F4 *       2100       2300       24*

000011C0   F0F0404040404040 001AF2F5F0F04040 40404040001AF2F6 F0F0404040404040 *00       2500       2600     *

000011E0     001FC5D5C4C3D4D7 40404040001FF3F1 F0F0404040404040 FF0000000000FF00 * ENDCMP       3100             *

00001200   C1E2000010000000   0000FF0000000000 0000000000000000 0005000100000514 *AS                             *

00001220     0000003C00000000   0000000000000000 0000000000000000 0000000000000000 *                                *

00001240     0000000000000000 000000000001000F   708003A700000000   000000FC000002D6 *                     x           O*

00001260     00000000000000FC 0000000000000000 000000FC00000000 00000000000003D2   *                               K*

00001280     0000003D00000000   0000000000000000 000000000000040F   000000D600000000 *                             O   *

000012A0   000004F000000060   0000000000000000 0000000000000000 0000000000000000 *   0     -                       *

000012C0   0000000000000000 0000000000000000   0000000000000000 0000000000000000 *                               *

000012E0     0000000000000000 0000000000000000 0000000000000000 0000000000000000   *                               *

00001300     0000000000000000 000000000008000A   0000000001900000 0015D7C7D440D7C1 *                         PGM PA*

00001320     D9D44D50D7F14050 D7F24050D9C55D00 0001F400000017C4 C3D340E5C1D94D50 *RM(&P1 &P2 &RE)   4     DCL VAR(&*

00001340     D7F15D40E3E8D7C5 4D5CD7E3D95D0000 025800000017C4C3 D340E5C1D94D50D7 *P1) TYPE(*PTR)       DCL VAR(&P*

00001360   F25D40E3E8D7C54D 5CD7E3D95D000002 BC0000001FC4C3D3 40E5C1D94D50D9C5   *2) TYPE(*PTR)       DCL VAR(&RE*

00001380     5D40E3E8D7C54D5C C3C8C1D95D40D3C5 D54DF25D00000320 0000002BC4C3D340 *) TYPE(*CHAR) LEN(2)       DCL *

000013A0   E5C1D94D50C9D5F1 5D40E3E8D7C54D5C   C3C8C1D95D40D3C5   D54DF15D40E5C1D3   *VAR(&IN1) TYPE(*CHAR) LEN(1) VAL*

000013C0   E4C54D7DF07D5D00 0003E80000002BC4 C3D340E5C1D94D50 C9D5F25D40E3E8D7 *UE('0')   Y     DCL VAR(&IN2) TYP*

000013E0   C54D5CC3C8C1D95D   40D3C5D54DF15D40   E5C1D3E4C54D7DF0 7D5D0000044C0000 *E(*CHAR) LEN(1) VALUE('0')   <   *

00001400     0020C4C3D340E5C1 D94D50D6D7E35D40 E3E8D7C54D5CC3C8 C1D95D40D3C5D54D * DCL   VAR(&OPT) TYPE(*CHAR) LEN(*

00001420   F15D000004B00000   001DC4C3D340E5C1 D94D50C25D40E3E8 D7C54D5CC9D5E35D *1)     ^   DCL VAR(&B) TYPE(*INT)*

00001440     40D3C5D54DF45D00   0005780000001BC3 C8C7E5C1D940E5C1   D94D50D9C55D40E5 *   LEN(4)       CHGVAR VAR(&RE) V*

00001460   C1D3E4C54D7DC5D8 7D5D000005DC0000 0025E3C3C8D6D7E3   7A40C3C8C7E5C1D9 *ALUE('EQ')       TCHOPT: CHGVAR*

00001480     40E5C1D94D50D6D7   E35D40E5C1D3E4C5 4DE77DF0F07D5D00 0006400000002AC9 * VAR(&OPT)   VALUE(X'00')       I*

000014A0   C640C3D6D5C44D50 C2405CC7E340F7F8   5D40E3C8C5D54DC7 D6E3D640C3D4C4D3   *F COND(&B *GT 78) THEN(GOTO CMDL*

000014C0   C2D34DD3C1D3C15D 5D00000708000000 4BD3C1D3C17A40C9 C640C3D6D5C44D4D *BL(LALA))       .LALA: IF COND((*

000014E0     50C9D5F1405CC5D8 407DF17D5D405CC1 D5C4404D50C9D5F2   405CC5D8407DF17D *&IN1 *EQ '1') *AND (&IN2 *EQ '1'*

00001500     5D5D40E3C8C5D54D C7D6E3D640C3D4C4   D3C2D34DC5D5C4C3   D4D75D5D00000834 *)) THEN(GOTO CMDLBL(ENDCMP))   *

00001520     0000001FC9C640C3 D6D5C44D50C9D5F1   405CD5C54050C9D5 F25D40E3C8C5D54D   *   IF COND(&IN1 *NE &IN2)   THEN(*

00001540   C4D65D000008FC00   00001BC3C8C7E5C1 D940E5C1D94D50D9 C55D40E5C1D3E4C5   *DO)       CHGVAR VAR(&RE) VALUE*

00001560     4D7DD5C57D5D0000   096000000013C7D6   E3D640C3D4C4D3C2 D34DC5D5C4C3D4D7 *('NE')   -     GOTO CMDLBL(ENDCMP*

00001580     5D000009C4000000   05C5D5C4C4D60000   0A2800000036C9C6 40C3D6D5C44D50D7 *)   D     ENDDO       IF COND(&P*

000015A0   F1405CD5C54050D7 F25D40E3C8C5D54D C3C8C7E5C1D940E5 C1D94D50D9C55D40   *1 *NE &P2) THEN(CHGVAR VAR(&RE) *

000015C0   E5C1D3E4C54D7DD5 C57D5D5D00000C1C   0000000EC5D5C4C3 D4D77A40C5D5C4D7 *VALUE('NE'))       ENDCMP: ENDP*

000015E0   C7D4000000000000   0000000000000800 00013B0103000001 5E01030000018B01 *GM                     ;       *

00001600     05000001BD010500 0002100105000002 3703030000028201 0500000282020300   *                     b     b     *

00001620     010000000000015C D3C9C2D340404040 4000000000042700 0000000008D7C7D4 *       *LIBL                 PGM*

00001640     4040404040404000 0000000000000000 00010000C4C3D340   4040404040400000 *                  DCL         *

00001660     0000000000000000 010000C3C8C7E5C1 D940404040000000 0000000000000002   *           CHGVAR               *

00001680     0000C9C640404040 4040404000000000   0000000000000200 00C7D6E3D6404040   * IF                     GOTO   *

000016A0   4040400000000000 0000000000020000 C4D6404040404040   4040000000000000 *                 DO             *

000016C0   00000000020000C5 D5C4C4D640404040   4000000000000000 000000020000C5D5   *       ENDDO                 EN*

000016E0   C4D7C7D440404040 0000000000000000   0000020000000000 0000000000000000 *DPGM                           *

00001700     0000000000000000 0000000000000000 0000000000000000 0000000000000000   *                               *

... ...

000021E0     0000000000000000 0000000000000000 0000000000000000 0000000000000000   *                               *

00002200     0000000000000000 0000000000000000 E3E7000000320000 0000000000000000   *               TX               *

00002220     D4A840A385A7A340 8485A283998997A3 8996954040404040   4040404040404040 *My text description             *

00002240     4040404040404040 4040404040404040 4040E2C3000000A8   0000000000000000 *                 SC   y       *

00002260     0000404040404040 4040404040404040 40404040404040F1 4040404040404040   *                       1       *

00002280     4040404040404040 4040404040E5F5D9 F4D4F0F1F1F3F0F2 F0F1F1F4F5F0F5F0 *             V5R4M01130201145050*

000022A0   F1F1F3F0F1F2F9F1 F6F4F6F2F6C4C2C6 E2D9C3404040407B F0F0F0F0F0F0F0F0 *1130129164626DBFSRC   #00000000*

000022C0   F1D8E3C5D4D74040 4040404040404040   4040404040404040 4040000000000000 *1QTEMP                         *

000022E0     0000000000000000 0000000000000000 0000000000000000 0000404000000000   *                               *

00002300     0000000000000000 0000C1E400000000   3F10000000000000   0000404040404040 *         AU                     *

00002320     4040404040404040 4040404040404040 4040404040404040 4040404040404040   *                               *

Understand the Output of the QSCMATPG API

The output of the QSCMATPG API is composed of not only the OMI program template, but also several other components. Gene Gaunt gave the names and meaning of these components in a post in the same discussion thread as following:

Re: QSCMATPG and QSCCRTPG

   * Subject: Re: QSCMATPG and QSCCRTPG

   * From: gene_gaunt@xxxxxxxxxxxxxxx>

   * Date: Tue, 29 May 2001 09:22:50 -0400

Looks like QSCMATPG gets more than program creation template into a file:

PT section: program creation template

AS section: associated space

TX section: object description

SC section: service data

AU section: authority bits

A short investigation into the above-shown example output of QSCMATPG will prove Gene's assumption. Also, you can figure out the format of each section easily. Each QSCMATPG output section starts with a 16-byte header. The first two fields in this header are:

Since the QSCMATPG output sections are self-described, a parser program can walk through the entire output with ease.

With more investigation, you might find out more details of the QSCMATPG output sections:

An Example of Modifying an OPM Program via the Retrieved OMI Program Template

While our purpose of retrieving the OMI program template is to study and learn from the design of MI, it's also possible to change an existing OPM program via the retrieved OMI program template. I'll provide a real example.

In VRM540, IBM introduces pointer variables to CL and related supportsfor example, supports for based and defined CL variables. However before VRM710, when comparing two pointer values in an OPM CL program, if one of the pointers is a null pointer or both pointers are null pointers, the comparison will failed with a Pointer Does Not Exist exception (hex 2401, aka MCH3601). By compiling an OPM CL program that compares two pointer values with parameter GENOPT(*LIST), you will find out the reason from the MI source listing generated by the OPM CL compiler. Here's the compiler listing of an OPM CL program (at VRM540), a322.clp:

Compiler   . . . . . . . . . . . . . . . . . . :     IBM Control Language Compiler

                                         Control Language Source

SEQNBR   *...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7   ...+... 8 ...+... 9 ...+. DATE

     100-             /**                                                     */

     200-             /** @file a322.clp                                     */

     300-             /**                                                     */

     400-             PGM       PARM(&P1 &P2 &RE)

     500-             DCL       VAR(&P1) TYPE(*PTR)

     600-             DCL       VAR(&P2) TYPE(*PTR)

     700-             DCL       VAR(&RE) TYPE(*CHAR) LEN(2)

     800-             DCL       VAR(&IN1) TYPE(*CHAR) LEN(1)   VALUE('0')

     900-               /* '1'=&P1 is a null   pointer, '0'=&P1 is NOT null */

   1000-             DCL       VAR(&IN2) TYPE(*CHAR) LEN(1)   VALUE('0')

   1100-             DCL       VAR(&OPT) TYPE(*CHAR) LEN(1)

   1200-             DCL       VAR(&B) TYPE(*INT) LEN(4)

   1300-

   1400-             CHGVAR     VAR(&RE) VALUE('EQ')

   1500-   TCHOPT:     CHGVAR     VAR(&OPT) VALUE(X'00')

   1600-              IF         COND(&B *GT 78) THEN(GOTO   CMDLBL(LALA))

   1700-

   1800-   LALA:       IF         COND((&IN1 *EQ '1') *AND   (&IN2 *EQ '1')) +

   1900                           THEN(GOTO   CMDLBL(ENDCMP))

   2000-               /* Both pointers are null pointers.   So they are EQ */

   2100-             IF         COND(&IN1 *NE &IN2) THEN(DO)

   2200-               /* One of the two pointers is   null pointer */

   2300-               CHGVAR VAR(&RE)   VALUE('NE')

   2400-               GOTO ENDCMP

   2500-             ENDDO

   2600-             IF         COND(&P1 *NE &P2)   THEN(CHGVAR VAR(&RE) +

   2700                           VALUE('NE'))

   2800-               /* Since neither is null   pointer, compare +

   2900                           their   addressibilities. */

   3000-

   3100-   ENDCMP:     ENDPGM

                               * * * *   *   E N D   O F     S O U R C E   * * * * *

At statement 2600, pointer variables &P1 and &P2 are compared for equality. Corresponding OMI instructions generated by the OPM CL compiler (at VRM540) are the following:

00059                                               BRK '2600 '                                                           ; 2600

00060                                     ?RCLBL00007:                                                                  ; 2600

00061   001A 0000C6   3042 004F   2007               CPYNV ?WCLCSREI   ,00007                                                 ; 2600

00062   001B 0000CC 18E6 C000 0029 002A             CMPPSPAD(I)&P1,&P2/NEQ(?4TEMP0001)                                   ; 2600

                     002E                                                                                                     2600

00063   001C   0000D6 1CC2 C000 002E 20F1            CMPBLA(B) ?4TEMP0001   ,C'1'/NEQ(?FL00004)                             ; 2600

                     0020                                                                                                     2600

00064                                   ?RCLBL00008:                                                                     ; 2600

00065   001D 0000E0 3042 004F 2008               CPYNV ?WCLCSREI ,00008                                                 ; 2600

00066   001E 0000E6 10B3 002B 001D 2040            CPYBLAP &RE   ,<0002|NE>,' '                                             ; 2600

00067                                     ?ICLBL00008:                                                                     ; 2600

00068                                    ?ICLBL00007:                                                                     ; 2600

00069                                     ?FL00004:                                                                       ; 2600

00070                                            BRK 'ENDCMP               '                                             ; ENDCMP

00071                                   ENDCMP   :                                                                         ; ENDCMP

Note: All the OMI instructions shown in this example are generated by the OPM CL compiler at VRM540.

Now you know the reason for the MCH3601 exception. Before the Compare Pointer for Space Addressability (CMPPSPAD) instruction is used to compare the addressability of space pointers &P1 and &P2, no action is adopted to test whether &P1 or &P2 is null pointer. If one of CMPPSPAD's operands is a null pointer, CMPPSPAD will raise a Pointer Does Not Exist exception (MCH3601). One possible (although quite far from practical) workaround is retrieving the OMI program template of the OPM CL program to a physical file via the QSCMATPG API, inserting OMI instructions that check for null pointers into the OMI instruction stream in the OMI program template, and finally re-creating the OPM CL program from the modified program template via the QSCCRTPG API. (Of course, if you only want to solve the MCH3601 problem, the simplest method is changing the OPM program that compares pointers into ILE CL.)

For information about the OMI program template and OMI instruction stream, please refer to the following resources:

Imagine that the original version of the OPM CL program (a322.clp) is the following. It compares the two input pointer parameters for equality and returns the comparison result in the CHAR(2) output parameter &RE.

SEQNBR   *...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7   ...+... 8 ...+... 9 ...+. DATE

     100-             /**                                                     */

     200-             /** @file a322.clp                                     */

     300-              /**                                                     */

     400-             PGM       PARM(&P1 &P2 &RE)

     500-             DCL       VAR(&P1) TYPE(*PTR)

     600-             DCL       VAR(&P2) TYPE(*PTR)

     700-             DCL       VAR(&RE) TYPE(*CHAR) LEN(2)

     800-             CHGVAR     VAR(&RE) VALUE('EQ')

     900-             IF         COND(&P1 *NE &P2)   THEN(CHGVAR VAR(&RE) +

   1000                           VALUE('NE'))

   1100-   ENDCMP:     ENDPGM

To make sure neither pointer variable &P1 nor &P2 is a null pointer before statement 900 is executed, you may insert a couple of indicator form Compare Pointer Type (CMPPTRT) instructions to test for null pointer and store the test results in CL indicator variables. This allows you to check the test results in CL instead of inserting more MI instructions into the OMI instruction stream. The definitions of the CL indicator variables and CL statements checking them might look like the following:

             DCL       VAR(&IN1) TYPE(*CHAR) LEN(1)   VALUE('0')

               /* '1'=&P1 is a null   pointer, '0'=&P1 is NOT null */

             DCL       VAR(&IN2) TYPE(*CHAR) LEN(1)   VALUE('0')

             IF         COND((&IN1 *EQ '1') *AND   (&IN2 *EQ '1')) +

                         THEN(GOTO   CMDLBL(ENDCMP))

               /* Both pointers are null   pointers. So they are EQ */

             IF         COND(&IN1 *NE &IN2) THEN(DO)

              /* One of the two pointers is null   pointer */

               CHGVAR VAR(&RE)   VALUE('NE')

               GOTO ENDCMP

             ENDDO

Next, you need placeholder instructions in the OMI instruction stream of the CL program that occupies the same length as the CMPPTRT instructions so that you can simply replace the placeholder instructions with two CMPPTRT instructions. To test if a pointer is a null pointer, a branch form or indicator form CMPPTRT instruction can be issued against the target pointer setting operand 2 to hex 00. As you probably know, an indicator form CMPPTRT instruction contains five 2-byte fields (see "Analyzing the MI Instruction Stream of an OPM Program"); for example, the OMI instruction CMPPTRT(I) &P1, X'00' / EQ(&IN1) might look like the following in the compiled OMI instruction stream:

18E2 4000 0001 2000 0002   CMPPTRT(I) &P1, X'00' / EQ(&IN1)

The five 2-byte fields are:

  • 18E2Operation code of CMPPTRT (indicator form)
  • 4000Op-code extender. Indicates there is one group-3 resultant conditionin this case, <I>EQspecified for the instruction
  • 0001ODT reference of space pointer <I>&P1 (operand 1 of the CMPPTRT instruction)
  • 2000Immediate operand hex 00 (operand 2 of the CMPPTRT instruction)
  • 0002ODT reference of indicator operand <I>&IN1

Comparing a numeric variable in OPM CL will generate an indicator form comparison instruction and a branch form comparison instruction (each occupies five 2-byte fields in the OMI instruction stream, the same with an indicator form CMPPTRT instruction). For example, OMI instructions generated for an OPM CL statement IF COND(&B *GT 78) THEN(...) might look like this:

000A 000046 3042 004F 2003              CPYNV ?WCLCSREI ,00003                   ;

000B 00004C   1846 1000 0025 000E           CMPNV(I) &B,P'+78'/   HI(?4TEMP0001)       ;

             002E

000C 000056 1CC2 C000 002E 20F1             CMPBLA(B) ?4TEMP0001 ,C'1'/NEQ(?FL00001) ;

            0010

So a numeric comparison CL statement would be a perfect placeholder for inserting two indicator form CMPPTRT instructions. The following is the modified version of a322.clp. Two CHAR(1) variables&IN1 and &IN2are added to receive the comparison result of the CMPPTRT instructions. The BIN(4) field &B is added and is compared to numeric value 78 for equality in statement 1600, which creates the do-nothing GOTO to label LALA after the comparison.

Compiler   . . . . . . . . . . . . . . . . . . :     IBM Control Language Compiler

                                         Control Language Source

SEQNBR   *...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7   ...+... 8 ...+... 9 ...+. DATE

     100-             /**                                                  */

     200-             /** @file a322.clp                                     */

     300-             /**                                                     */

     400-             PGM       PARM(&P1 &P2 &RE)

     500-             DCL       VAR(&P1) TYPE(*PTR)

     600-             DCL       VAR(&P2) TYPE(*PTR)

     700-             DCL       VAR(&RE) TYPE(*CHAR) LEN(2)

     800-             DCL       VAR(&IN1) TYPE(*CHAR) LEN(1)   VALUE('0')

     900-               /* '1'=&P1 is a null   pointer, '0'=&P1 is NOT null */

   1000-             DCL       VAR(&IN2) TYPE(*CHAR) LEN(1)   VALUE('0')

   1100-             DCL       VAR(&OPT) TYPE(*CHAR) LEN(1)

   1200-             DCL       VAR(&B) TYPE(*INT) LEN(4)

   1300-

   1400-             CHGVAR     VAR(&RE) VALUE('EQ')

   1500-   TCHOPT:     CHGVAR     VAR(&OPT) VALUE(X'00')

   1600-             IF         COND(&B *GT 78) THEN(GOTO   CMDLBL(LALA))

   1700-

   1800-   LALA:       IF         COND((&IN1 *EQ '1') *AND   (&IN2 *EQ '1')) +

   1900                           THEN(GOTO   CMDLBL(ENDCMP))

   2000-               /* Both pointers are null   pointers. So they are EQ */

   2100-             IF         COND(&IN1 *NE &IN2) THEN(DO)

   2200-                /* One of the two   pointers is null pointer */

   2300-               CHGVAR VAR(&RE)   VALUE('NE')

   2400-               GOTO ENDCMP

   2500-             ENDDO

   2600-             IF         COND(&P1 *NE &P2)   THEN(CHGVAR VAR(&RE) +

 2700                           VALUE('NE'))

   2800-               /* Since neither is null   pointer, compare +

   2900                           their addressability.   */

   3000-

   3100-   ENDCMP:     ENDPGM

                               * * * *   *   E N D   O F     S O U R C E   * * * * *

The MI instructions generated for statement 1600 (IF COND(&B *GT 78)) are the following:

00024                                               BRK '1600 '                                                          ; 1600

00025                                     ?RCLBL00003:                                                                     ; 1600

00026   000A   000046 3042 004F 2003               CPYNV ?WCLCSREI ,00003                                              ;   1600

00027   000B 00004C 1846 1000 0025 000E           CMPNV(I) &B,P'+78'/   HI(?4TEMP0001)                                   ; 1600

                     002E                                                                                                    1600

00028   000C 000056 1CC2 C000 002E 20F1             CMPBLA(B) ?4TEMP0001 ,C'1'/NEQ(?FL00001)                             ; 1600

                     0010                                                                                                    1600

00029   000D 000060 1011 0011                     B LALA                                                                 ; 1600

00030                                     ?ICLBL00003:                                                                    ; 1600

00031                                     ?FL00001:                                                                       ; 1600

00032                                               BRK 'LALA                 '                                          ; LALA

00033                                   LALA   :                                                                           ; LALA

00034                                               BRK '1800 '                                                        ; 1800

 

Instructions /0B and /0C are the placeholders for the CMPPTRT instructions.

The ODT references of CL variables &IN1, &IN2, &OPT, &P1, and &P2 are the following:

0026 &IN1                   37 47 73*

0027 &IN2                   38 47 74*

0028 &OPT                   22 75*

0029 &P1                   58 76*

002A &P2                   58 77*

Now let's assemble the CMPPTRT instructions to test &P1 and &P2 for null pointers:

00027   000B 00004C 18E2 4000 0029 0028           CMPPTRT(I) &P1, X'00' /   EQ(&IN1)                                     ; 1600

                     0026                                                                                                     1600

00028   000C   000056 18E2 4000 002A 0028           CMPPTRT(I) &P2, X'00' /   EQ(&IN2)                                     ; 1600

                     0027                                                                                                     1600

The final steps are replacing the placeholder instructions (/0B and /0C) in OPM CL program A322 with our newly assembled CMPPTRT instructions:

  • Issue a <i>MATPG PGM(A322) FILE(OMI) MBR(A322) command to retrieve the OPM program template.
  • Since the hexadecimal program template is hard to edit, you may need to convert it to character format first. A tiny tool program H2C80 (h2c80.c) reads each record of a physical file member with a record length of 80 bytes, converts hexadecimal content of the record to 160-byte character representation, and writes to a target physical file member with a record length of 160 bytes. Another tool program C2H80 (c2h80.c) does the reverse task of H2C80, i.e., converts 160-byte character records back to 80-byte hexadecimal representation. For example, the following commands will generate the character form program template in physical file member *CURLIB/OMIC(A322):

CRTPF FILE(*CURLIB/OMIC)   RCDLEN(160) MBR(*NONE) MAXMBRS(*NOMAX)

/* Create the RCDLEN(160) PF to store   character form program template */

ADDPFM FILE(OMIC) MBR(A322)

CALL H2C80 ('OMI(A322)' /* Hex form PGM template */

           'OMIC(A322)' /* Character form   PGM template for editing */ )

  • Edit the (character form) OMI program template via the EDTF command and replace the placeholder instructions (/0B and /0C) in OPM CL program A322 with the newly assembled CMPPTRT instructions: replace 184610000025000E002E with 18E24000002900280026; replace 1CC2C000002E20F10010 with 18E24000002A00280027.
  • Convert the edited OMI program template back to hexadecimal representationfor example, CALL C2H80 ('OMIC(A322)' 'OMI(A322)').
  • Create a new program object A322X using the modified OMI program template via the CRTPG command provided by Simon: CRTPG PGM(A322X) FILE(OMI) MBR(A322).
  • Test program A322 and its modified version (A322X) with the following test program, a322t.clp:

             PGM       PARM(&PGNAM)

             DCL       VAR(&PGNAM) TYPE(*CHAR) LEN(10)

             DCL       VAR(&P1) TYPE(*PTR)

             DCL       VAR(&P2) TYPE(*PTR)

             DCL       VAR(&RE) TYPE(*CHAR) LEN(2)

             DCL       VAR(&A) TYPE(*CHAR) LEN(1)

             DCL       VAR(&B) TYPE(*CHAR) LEN(1)

T1:           SNDPGMMSG MSG('Test 1: 2 null   pointers passed')

             CALL       PGM(&PGNAM) PARM(&P1 &P2   &RE)

             SNDPGMMSG MSG('Comparison result: *' *CAT &RE)

T2:           SNDPGMMSG MSG('Test 2: 1 null   pointer and 1 valid SPP +

                         passed')

             CHGVAR     VAR(&P2) VALUE(%ADDR(&A))

             CALL       PGM(&PGNAM) PARM(&P1 &P2   &RE)

             SNDPGMMSG MSG('Comparison result: *' *CAT &RE)

T3:           SNDPGMMSG MSG('Test 3: 2 valid   SPP with the same +

                         addressability   passed')

             CHGVAR     VAR(&P1) VALUE(%ADDR(&A))

             CALL       PGM(&PGNAM) PARM(&P1 &P2   &RE)

             SNDPGMMSG MSG('Comparison result: *' *CAT &RE)

TN:           SNDPGMMSG MSG('Test n: two   valid SPP with different +

                          addressability passed')

             CHGVAR     VAR(&P2) VALUE(%ADDR(&B))

             CALL       PGM(&PGNAM) PARM(&P1 &P2   &RE)

             SNDPGMMSG MSG('Comparison result: *' *CAT &RE)

ENDWHAT:     ENDPGM

Call A322T and specify A322 as the target program to test. A322 would fail in the first test with MCH3601.

4 > x a322t a322

     Test 1: 2 null pointers passed

     Pointer not set for location   referenced.

     MCH3601 received by A322 at 2600. (C D   I R)

   ? C

     CPF9999 received by A322T at 1000. (C D   I R)

   ? C

     Function check. MCH3601 unmonitored by   A322 at statement 2600,

       instruction X'001B'.

Test the re-created program A322X via A322T. All tests will complete successfully.

4 > x a322t a322x

       Test 1: 2 null pointers passed

     Comparison result: *EQ

     Test 2: 1 null pointer and 1 valid SPP   passed

     Comparison result: *NE

     Test 3: 2 valid SPP with the same   addressibility passed

     Comparison result: *EQ

     Test n: two valid SPP with different   addessibilities passed

     Comparison result: *NE

 

Junlei Li

Junlei Li is a programmer from Tianjin, China, with 10 years of experience in software design and programming. Junlei Li began programming under i5/OS (formerly known as AS/400, iSeries) in late 2005. He is familiar with most programming languages available on i5/OS—from special-purpose languages such as OPM/ILE RPG to CL to general-purpose languages such as C, C++, Java; from strong-typed languages to script languages such as QShell and REXX. One of his favorite programming languages on i5/OS is machine interface (MI) instructions, through which one can discover some of the internal behaviors of i5/OS and some of the highlights of i5/OS in terms of operating system design.

 

Junlei Li's Web site is http://i5toolkit.sourceforge.net/, where his open-source project i5/OS Programmer's Toolkit (https://sourceforge.net/projects/i5toolkit/) is documented.

BLOG COMMENTS POWERED BY DISQUS

LATEST COMMENTS

Support MC Press Online

$0.00 Raised:
$

Book Reviews

Resource Center

  • SB Profound WC 5536 Have you been wondering about Node.js? Our free Node.js Webinar Series takes you from total beginner to creating a fully-functional IBM i Node.js business application. You can find Part 1 here. In Part 2 of our free Node.js Webinar Series, Brian May teaches you the different tooling options available for writing code, debugging, and using Git for version control. Brian will briefly discuss the different tools available, and demonstrate his preferred setup for Node development on IBM i or any platform. Attend this webinar to learn:

  • SB Profound WP 5539More than ever, there is a demand for IT to deliver innovation. Your IBM i has been an essential part of your business operations for years. However, your organization may struggle to maintain the current system and implement new projects. The thousands of customers we've worked with and surveyed state that expectations regarding the digital footprint and vision of the company are not aligned with the current IT environment.

  • SB HelpSystems ROBOT Generic IBM announced the E1080 servers using the latest Power10 processor in September 2021. The most powerful processor from IBM to date, Power10 is designed to handle the demands of doing business in today’s high-tech atmosphere, including running cloud applications, supporting big data, and managing AI workloads. But what does Power10 mean for your data center? In this recorded webinar, IBMers Dan Sundt and Dylan Boday join IBM Power Champion Tom Huntington for a discussion on why Power10 technology is the right strategic investment if you run IBM i, AIX, or Linux. In this action-packed hour, Tom will share trends from the IBM i and AIX user communities while Dan and Dylan dive into the tech specs for key hardware, including:

  • Magic MarkTRY the one package that solves all your document design and printing challenges on all your platforms. Produce bar code labels, electronic forms, ad hoc reports, and RFID tags – without programming! MarkMagic is the only document design and print solution that combines report writing, WYSIWYG label and forms design, and conditional printing in one integrated product. Make sure your data survives when catastrophe hits. Request your trial now!  Request Now.

  • SB HelpSystems ROBOT GenericForms of ransomware has been around for over 30 years, and with more and more organizations suffering attacks each year, it continues to endure. What has made ransomware such a durable threat and what is the best way to combat it? In order to prevent ransomware, organizations must first understand how it works.

  • SB HelpSystems ROBOT GenericIT security is a top priority for businesses around the world, but most IBM i pros don’t know where to begin—and most cybersecurity experts don’t know IBM i. In this session, Robin Tatam explores the business impact of lax IBM i security, the top vulnerabilities putting IBM i at risk, and the steps you can take to protect your organization. If you’re looking to avoid unexpected downtime or corrupted data, you don’t want to miss this session.

  • SB HelpSystems ROBOT GenericCan you trust all of your users all of the time? A typical end user receives 16 malicious emails each month, but only 17 percent of these phishing campaigns are reported to IT. Once an attack is underway, most organizations won’t discover the breach until six months later. A staggering amount of damage can occur in that time. Despite these risks, 93 percent of organizations are leaving their IBM i systems vulnerable to cybercrime. In this on-demand webinar, IBM i security experts Robin Tatam and Sandi Moore will reveal:

  • FORTRA Disaster protection is vital to every business. Yet, it often consists of patched together procedures that are prone to error. From automatic backups to data encryption to media management, Robot automates the routine (yet often complex) tasks of iSeries backup and recovery, saving you time and money and making the process safer and more reliable. Automate your backups with the Robot Backup and Recovery Solution. Key features include:

  • FORTRAManaging messages on your IBM i can be more than a full-time job if you have to do it manually. Messages need a response and resources must be monitored—often over multiple systems and across platforms. How can you be sure you won’t miss important system events? Automate your message center with the Robot Message Management Solution. Key features include:

  • FORTRAThe thought of printing, distributing, and storing iSeries reports manually may reduce you to tears. Paper and labor costs associated with report generation can spiral out of control. Mountains of paper threaten to swamp your files. Robot automates report bursting, distribution, bundling, and archiving, and offers secure, selective online report viewing. Manage your reports with the Robot Report Management Solution. Key features include:

  • FORTRAFor over 30 years, Robot has been a leader in systems management for IBM i. With batch job creation and scheduling at its core, the Robot Job Scheduling Solution reduces the opportunity for human error and helps you maintain service levels, automating even the biggest, most complex runbooks. Manage your job schedule with the Robot Job Scheduling Solution. Key features include:

  • LANSA Business users want new applications now. Market and regulatory pressures require faster application updates and delivery into production. Your IBM i developers may be approaching retirement, and you see no sure way to fill their positions with experienced developers. In addition, you may be caught between maintaining your existing applications and the uncertainty of moving to something new.

  • LANSAWhen it comes to creating your business applications, there are hundreds of coding platforms and programming languages to choose from. These options range from very complex traditional programming languages to Low-Code platforms where sometimes no traditional coding experience is needed. Download our whitepaper, The Power of Writing Code in a Low-Code Solution, and:

  • LANSASupply Chain is becoming increasingly complex and unpredictable. From raw materials for manufacturing to food supply chains, the journey from source to production to delivery to consumers is marred with inefficiencies, manual processes, shortages, recalls, counterfeits, and scandals. In this webinar, we discuss how:

  • The MC Resource Centers bring you the widest selection of white papers, trial software, and on-demand webcasts for you to choose from. >> Review the list of White Papers, Trial Software or On-Demand Webcast at the MC Press Resource Center. >> Add the items to yru Cart and complet he checkout process and submit

  • Profound Logic Have you been wondering about Node.js? Our free Node.js Webinar Series takes you from total beginner to creating a fully-functional IBM i Node.js business application.

  • SB Profound WC 5536Join us for this hour-long webcast that will explore:

  • Fortra IT managers hoping to find new IBM i talent are discovering that the pool of experienced RPG programmers and operators or administrators with intimate knowledge of the operating system and the applications that run on it is small. This begs the question: How will you manage the platform that supports such a big part of your business? This guide offers strategies and software suggestions to help you plan IT staffing and resources and smooth the transition after your AS/400 talent retires. Read on to learn: