Enhanced version of the MICRTPG program

A new version of MICRTPG (named MICRTPG2) incorporateS the functions of the CL03 program and the CL05 program.

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

A modified form of CL04 (renamed to CL06) is used in these examples to read the MISRC source physical file because MI instruction support for database access is beyond the scope of this chapter.

The MICRTPG2 program demonstrates how to do the following tasks:

Parent topic: Machine interface programming
Related concepts
Program storage
Related reference
iSeries Machine Interface instructions

Understand the MICRTPG2 program (by sections of code)

Writing the program code for MICRTPG2:
  1. Define the entry point and associated parameters: 
    ENTRY * (PARM_LIST) EXT;
DCL SPCPTR FIL@ PARM;
DCL SPCPTR MBR@ PARM;
DCL OL PARM_LIST (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);
  2. Have MICRTPG2 create an automatically extendable space (it can automatically increase to as many as 16MB in size) using the Create Space (CRTS) instruction. Because the CRTS instruction requires a definition template, you need to define it (see iSeries™ Machine Interface instructions for details).

    The following template creates a space (type and subtype equal to X'19EF') that is defined through the OBJCRTOPT data element (1). The space is defined as temporary (the next initial program load (IPL) will free up the storage occupied by the space), extendable up to as many as 16MB, and within a context (a library).

    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(" ");
 DCL DD OBJCRTOPT CHAR(4) DEF(CRTSTMPLT) POS(41) INIT(X'60020000'); (1)
 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');
  3. Establish addressability to the CRTS template: 
    DCL SPCPTR CRTSTMPLT@ INIT(CRTSTMPLT);
  4. Because the space is defined to be in a context, supply the address of the context in the previous CRTS template. This program uses the QTEMP context that is identified by the following: 
    DCL SYSPTR QTEMP@ BASPCO POS(65);

    Use the copy bytes with pointers instruction (CPYBWP) to set the template context data element.

    CPYBWP CONTEXT, QTEMP@;
  5. In the instruction stream, create the space: 
    CRTS USRSPC@, CRTSTMPLT@;

    This returns a system pointer to the created space in the system pointer:

    DCL SYSPTR USRSPC@;
  6. Declare a space pointer for addressability to the space through a space pointer (as opposed to the system pointer returned by the CRTS instruction): 
    DCL SPCPTR USRSPC;
  7. To keep track of how many bytes of source are loaded into the *USRSPC, define BINOFFSET. BINOFFSET is also being defined very specifically as an integer (BIN(4)) because it will be used later in the program with the set space pointer offset (SETSPPO) MI instruction. This requires an integer argument to refer to the space: 
    DCL DD BINOFFSET BIN(4) AUTO INIT(0);
  8. Because the size of the source is also a parameter to the QPRCRTPG API, define a space pointer to refer to BINOFFSET: 
    DCL SPCPTR BINOFFSET@ AUTO INIT(BINOFFSET);

    The two previous declare statements have also introduced a new attribute to the DCL statement. Previously, all of the DCLs used the default of static (STAT) storage. BINOFFSET and BINOFFSET@, on the other hand, are being allocated from automatic (AUTO) storage. Many hours of debug time can be saved if you clearly understand how the iSeries manages these two types of storage. For more information on the types of storage, see Program storage.

    So that the program does not retain the size of the source loaded from previous invocations of the program, you can declare BINOFFSET as being automatic. Because BINOFFSET@ needs to be set to the address of BINOFFSET (so that BINOFFSET can be passed as a parameter to CL06), you will also declare it as automatic. An alternative to using automatic storage would have been to explicitly set a static storage BINOFFSET to 0 by using CPYNV, but this does not allow for a discussion of the storage management differences.

  9. Use the CL06 program to load the space after it is created. Because CL06 is limited to only 2000 bytes of addressability per parameter per call (CALLX), the MICRTPG2 program uses the Override with Database File (OVRDBF) CL command to cause the CL06 program to read and load twenty 80-byte source records per call. The source records are read starting at 1 on the first call, 21 on the second, 41 on the third, and so on. To run CL commands from the MICRTPG2 program, the program uses the Execute Command (QCMDEXC) API: 
    DCL SYSPTR QCMDEXC INIT("QCMDEXC", CTX("QSYS"), TYPE(PGM));
  10. Format the appropriate character strings for the Override with Database File (OVRDBF) CL command:
    Note: In the following declare (DCL) statement for CLOVRCMD, the 3 strings of '1234567890' are used strictly so that you can see that 10 bytes are being used. The strings themselves are overridden by the subsequent subelement DCLs for FILNAM, MBRNAM, and RECNUM, and could be replaced by 10 blanks:
    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);
  11. Format the appropriate character strings for the Delete Override (DLTOVR) CL command. Because the OVRDBF commands are issued repetitively to progress through the source, the previous overrides need to be deleted: 
    DCL DD CLDLTCMD CHAR(12) INIT("DLTOVR MISRC");
  12. Establish space pointers to the CL command parameters, and, because the QCMDEXC API is being used, define the CL command string lengths as parameters: 
    DCL SPCPTR CLOVRCMD@ INIT(CLOVRCMD);
DCL SPCPTR CLDLTCMD@ INIT(CLDLTCMD);
DCL DD CLOVRLNG PKD(15,5) INIT(P'65');  /* Length of OVRDBF CL cmd */
DCL SPCPTR CLOVRLNG@ INIT(CLOVRLNG);
DCL DD CLDLTLNG PKD(15,5) INIT(P'12');  /* Length of DLTOVR CL cmd */
DCL SPCPTR CLDLTLNG@ INIT(CLDLTLNG);
  13. Define the operand list (OL) definitions for calling the QCMDEXC API under the two different conditions: 
    DCL OL QCMDOVROL (CLOVRCMD@, CLOVRLNG@) ARG;
DCL OL QCMDDLTOL (CLDLTCMD@, CLDLTLNG@) ARG;
  14. Because CALLX CL06 is called to load the space, declare its system pointer, parameters, and OL: 
    DCL SYSPTR CL06 INIT("CL06", TYPE(PGM));
DCL DD OFFSET PKD(15,5);
DCL SPCPTR OFFSET@ INIT(OFFSET);
DCL OL CL06OL (USRSPC, OFFSET@) ARG;
  15. Declare the system pointer, parameters, and OL for the QPRCRTPG API: 
    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");
DCL SPCPTR PGMOPTS@ INIT(PGMOPTS);
DCL DD NUMOPTS BIN(4) INIT(2);
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));

Beginning the instruction stream

Begin the instruction stream definition by doing the following:
  1. Use the store parameter list length (STPLLEN) instruction to determine the number of parameters that were passed to the program: 
        STPLLEN NUM_PARMS;
  2. If the number of parameters is 1, assign FILNAM to the value MISRC (the default that this program supports for the source physical file) and branch to label PARM1 to set the source member name: 
        CMPNV(B) NUM_PARMS, 2 / EQ(PARM2);
    CPYBLAP FILNAM, 'MISRC', ' ';
    B PARM1;
  3. If the number of parameters is 2, assign FILNAM to the value of the second parameter: 
        PARM2: CPYBLA FILNAM, FIL;
  4. Assign the source member name: 
        PARM1: CPYBLA MBRNAM, MBR;
  5. Assign the proper context for the space: 
        CPYBWP CONTEXT, QTEMP@;
  6. After establishing the context of the space, now create the space: 
        CRTS USRSPC@, CRTSTMPLT@;
  7. Assign the space pointer USRSPC to address the first byte of the space: 
        SETSPPFP USRSPC, USRSPC@;
  8. Set the OVRDBF CL command to start with POSITION(1): 
        CPYNV RECNUM, 1;

Using static storage to your advantage

In Beginning the instruction stream, the instructions in steps 5, 6, and 7 can be done once and the space reused on subsequent invocations of the program. As a performance enhancement, add a check to see if this program has been previously called. To do the check, add a control field, and conditionally branch around the CRTS-oriented instructions if this call is not the initial call:

       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;

Resuming the program flow of the MICRTPG2 program from Beginning the instruction stream, you should have the program perform the following:

  1. Fall into a loop (the MORE label) until all source records are loaded as the source physical file member position is overridden: 
    MORE: CALLX QCMDEXC, QCMDOVROL, *;
  2. Instruct the CL06 program to load source records from the start of the input buffer, which is actually the BINOFFSET into the space created earlier: 
          CPYNV OFFSET,1;
      CALLX CL06, CL06OL, *;
  3. Back out (subtract) the base-1 nature of CL using the short (the (S) extender) form of the subtract numeric (SUBN) instruction: 
          SUBN(S) OFFSET, 1;
  4. Add the number of MI source bytes processed by CL06 to the offset into the space (for the next call): 
          ADDN(S) BINOFFSET, OFFSET;
      SETSPPO USRSPC, BINOFFSET;
  5. Update the Override with Database File (OVRDBF) position parameter for the next call to CL06: 
          ADDN(S) RECNUM, 20;
  6. Delete the previous OVRDBF: 
          CALLX QCMDEXC, QCMDDLTOL, *;
  7. Check to see if all records were processed, and if not, branch to label MORE to load more source records: 
          CMPNV(B) OFFSET, 1600 /EQ(MORE);

    Otherwise, assume that all source was loaded and prepare for calling the QPRCRTPG API by setting the program name:

          CPYBLA PGMNAM, MBR;
  8. Reset the space pointer from the source of the input program to the start of the space. This resetting of the static storage USRSPC is also assumed in the branch to label SKIP earlier in the program: 
          SETSPPO USRSPC,0;
  9. Call the QPRCRTPG API to create the MI program: 
          CALLX QPRCRTPG, QPRCRTPGOL, *;
  10. Indicate that the program is done: 
          RTX *;
      PEND;

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;

Updated CL06 program

Following is the updated CL06 program:

/********************************************************************/
/********************************************************************/
/*                                                                  */
/*     program Name: CL06                                           */
/*                                                                  */
/*     programming Language: CL                                     */
/*                                                                  */
/*     Description: Load a source physical file member into the     */
/*                  *USRSPC addressed by &BUFFER.                   */
/*                                                                  */
/*                                                                  */
/*     Header Files Included: None                                  */
/*                                                                  */
/*                                                                  */
/********************************************************************/
             PGM        PARM(&BUFFER &OFFSET)
             DCLF       FILE(MISRC)
             DCL        VAR(&BUFFER) TYPE(*CHAR) LEN(1600)
             DCL        VAR(&OFFSET) TYPE(*DEC) LEN(15 5)
LOOP:        RCVF
             MONMSG     MSGID(CPF0864 CPF4137) EXEC(GOTO CMDLBL(DONE))
             CHGVAR     VAR(%SST(&BUFFER &OFFSET 80)) VALUE(&SRCDTA)
             CHGVAR     VAR(&OFFSET) VALUE(&OFFSET + 80)
             IF         COND(&OFFSET *GT 1600) THEN(GOTO CMDLBL(DONE))
             GOTO       CMDLBL(LOOP)
DONE:        ENDPGM