To compile an MI program, use the Create Program (QPRCRTPG) API.
If you enter the source into a source physical file, you can now compile the source and create an MI program.
Assume that the source is in a member named MI01 in the source file MISRC, which is created with a default record length (RCDLEN) of 92. The following CLCRTPG CL program can be used to create an MI program called MI01. (An MI program to call the Create Program (QPRCRTPG) API is developed in Creating an MI version of CLCRTPG.)
The following program reads a source file member into a program variable (&MIPGMSRC) and then does a CALL to the QPRCRTPG API. This program has many limitations (the major limitation is a program variable-size limit of 2000 bytes for the source), but provides for a reasonably simple MI program creation scenario.
/********************************************************************/
/********************************************************************/
/* */
/* Program Name: CLCRTPG */
/* */
/* Programming Language: CL */
/* */
/* Description: Create an MI program using the QPRCRTPG API. */
/* */
/* */
/* Header Files Included: None */
/* */
/* */
/********************************************************************/
PGM PARM(&SRCMBR)
DCLF FILE(MISRC)
DCL VAR(&SRCMBR) TYPE(*CHAR) LEN(10)
DCL VAR(&MIPGMSRC) TYPE(*CHAR) LEN(2000)
DCL VAR(&MIPGMSRCSZ) TYPE(*CHAR) LEN(4)
DCL VAR(&OFFSET) TYPE(*DEC) LEN(5 0) VALUE(1)
DCL VAR(&PGMNAM) TYPE(*CHAR) LEN(20) +
VALUE(' *CURLIB ')
DCL VAR(&PGMTXT) TYPE(*CHAR) LEN(50) +
VALUE('Compare two packed arguments and +
return larger')
DCL VAR(&PGMSRCF) TYPE(*CHAR) LEN(20) +
VALUE('*NONE')
DCL VAR(&PGMSRCM) TYPE(*CHAR) LEN(10) VALUE(' ')
DCL VAR(&PGMSRCCHG) TYPE(*CHAR) LEN(13) VALUE(' ')
DCL VAR(&PRTFNAM) TYPE(*CHAR) LEN(20) +
VALUE('QSYSPRT *LIBL ')
DCL VAR(&PRTSTRPAG) TYPE(*CHAR) LEN(4) +
VALUE(X'00000001')
DCL VAR(&PGMPUBAUT) TYPE(*CHAR) LEN(10) +
VALUE('*ALL ')
DCL VAR(&PGMOPTS) TYPE(*CHAR) LEN(22) +
VALUE('*LIST *REPLACE ')
DCL VAR(&NUMOPTS) TYPE(*CHAR) LEN(4) +
VALUE(X'00000002')
LOOP: RCVF
MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(CRTPGM))
CHGVAR VAR(%SST(&MIPGMSRC &OFFSET 80)) VALUE(&SRCDTA)
CHGVAR VAR(&OFFSET) VALUE(&OFFSET + 80)
GOTO CMDLBL(LOOP)
CRTPGM: CHGVAR VAR(%SST(&PGMNAM 1 10)) VALUE(&SRCMBR)
CHGVAR VAR(%BIN(&MIPGMSRCSZ)) VALUE(&OFFSET)
CALL PGM(QSYS/QPRCRTPG) PARM(&MIPGMSRC +
&MIPGMSRCSZ &PGMNAM &PGMTXT &PGMSRCF +
&PGMSRCM &PGMSRCCHG &PRTFNAM &PRTSTRPAG +
&PGMPUBAUT &PGMOPTS &NUMOPTS)
ENDPGM
After creating the CL program (assumed to be called CLCRTPG), the following statements create the previous MI program MI01:
DLTOVR MISRC OVRDBF MISRC MBR(MI01) CALL CLCRTPG MI01
Further, if the error message is CPF6399 (Identifier not declared), you can get an object definition table (ODT) listing by adding *XREF to the option template parameter (variable &PGMOPTS in the CLCRTPG program) when calling the QPRCRTPG API. Add *XREF to the existing *LIST and *REPLACE options, and change the number of option template entries parameter (variable &NUMOPTS) to 3.
/********************************************************************/
/********************************************************************/
/* */
/* Program Name: CL01 */
/* */
/* Programming Language: CL */
/* */
/* Description: Test the MI program MI01. */
/* */
/* */
/* Header Files Included: None */
/* */
/* */
/********************************************************************/
PGM PARM(&ARG1 &ARG2)
DCL VAR(&ARG1) TYPE(*DEC) LEN(15 5)
DCL VAR(&ARG2) TYPE(*DEC) LEN(15 5)
DCL VAR(&RESULT) TYPE(*DEC) LEN(15 5)
DCL VAR(&MSG) TYPE(*CHAR) LEN(20)
DCL VAR(&USR) TYPE(*CHAR) LEN(10)
RTVJOBA USER(&USR)
CALL PGM(MI01) PARM(&ARG1 &ARG2 &RESULT)
CHGVAR VAR(&MSG) VALUE(&RESULT)
SNDMSG MSG(&MSG) TOUSR(&USR)
ENDPGM
The following statement calls the CL01 program:
CALL CL01 (-5 6)
This test should cause a message to be sent to your user message queue with the following value:
00000000000006.00000
The MI program (MI01) that you created is a standard *PGM object on the iSeries system. As you would expect, you can call MI01 from other high-level languages. You can delete MI01 with the Delete Program (DLTPGM) command, save and restore MI01 using the standard save (SAV) and restore (RST) commands, and so on.
You can also debug it using the standard debugger on the system. To debug it, you need to look at the listing produced by the QPRCRTPG API to determine the MI instruction number. Then use that number with the Add Breakpoint (ADDBKP) CL command. For example, when creating MI01 in the previous exercise, the following listing was generated by QPRCRTPG:
5763SS1 V3R1M0 940909 Generated Output 08/08/94 09:46:36 Page 1 SEQ (1)INST Offset Generated Code *... ... 1 ... ... 2 ... ... 3 ... ... 4 ... ... 5 ... ... 6 ... ... 7 ... ... 8 00001 ENTRY * (PARM_LIST) EXT ; 00002 DCL SPCPTR ARG1@ PARM ; 00003 DCL SPCPTR ARG2@ PARM ; 00004 DCL SPCPTR RESULT@ PARM ; 00005 DCL OL PARM_LIST (ARG1@, ARG2@, RESULT@) PARM EXT ; 00006 DCL DD ARG1 PKD(15,5) BAS(ARG1@) ; 00007 DCL DD ARG2 PKD(15,5) BAS(ARG2@) ; 00008 DCL DD RESULT PKD(15,5) BAS(RESULT@) ; 00009 0001 000004 3C46 2000 0006 0007 CMPNV(B) ARG1,ARG2 / LO(ITS2) ; 0009 00010 0002 00000E 1042 0008 0006 CPYNV RESULT,ARG1 ; 00011 0003 000014 1011 000A B RETURN ; 00012 0004 000018 3042 0008 0007 ITS2: CPYNV RESULT,ARG2 ; 00013 0005 00001E 22A1 0000 (2) RETURN: RTX * ; 00014 0006 000022 0260 PEND ; 5763SS1 V3R1M0 940909 Generated Output 08/08/94 09:46:36 Page 2 MSGID ODT ODT Name Semantics and ODT Syntax Diagnostics 5763SS1 V3R1M0 940909 Generated Output 08/08/94 09:46:36 Page 3 MSGID MI Instruction Stream Semantic Diagnostics |
To view the value of RESULT at label RETURN, you first determine that RETURN corresponds to MI instruction ((1)) 0005 ((2)) and enter the following CL commands:
STRDBG PGM(MI01)
ADDBKP STMT('/0005') PGMVAR((RESULT ()))
CALL CL01 (-5 6)
The following display is shown:
+--------------------------------------------------------------------------------+ | | | Display Breakpoint | | | | Statement/Instruction . . . . . . . . . : /0005 | | Program . . . . . . . . . . . . . . . . : MI01 | | Recursion level . . . . . . . . . . . . : 1 | | Start position . . . . . . . . . . . . : 1 | | Format . . . . . . . . . . . . . . . . : *CHAR | | Length . . . . . . . . . . . . . . . . : *DCL | | | | Variable . . . . . . . . . . . . . . . : RESULT | | Type . . . . . . . . . . . . . . . . : PACKED | | Length . . . . . . . . . . . . . . . : 15 5 | | ' 6.00000' | | | +--------------------------------------------------------------------------------+
Breakpoints also can be set with a directive statement. Given that the MI01 program is able to be debugged and a break directive was not used, the purpose for which you use the directive may not be obvious. As mentioned in Create the MI example program, many expected users of the QPRCRTPG API are compilers of HLLs. The break (BRK) directive allows users of the QPRCRTPG API to associate an HLL statement identifier with a generated MI instruction. For example, assume that MI01 was developed to be an implementation of a fictional HLL language statement such as:
RESULT = MAX(ARG1, ARG2)
This assigns the MAX (defined as the largest argument) of ARG1 or ARG2 to RESULT. Also assume that an HLL programmer had written a program called HLLEXAMPLE with the following statements:
00001 RESULT = MAX(ARG1, ARG2) 00002 EXIT
By using break (BRK) directives, the QPRCRTPG user or compiler could associate the HLL statements with the generated MI instructions in the following way.
/********************************************************************/
/********************************************************************/
/* */
/* Program Name: MI01 */
/* */
/* Programming Language: MI */
/* */
/* Description: Demonstrate how to associate HLL statement */
/* identifiers with MI instructions using BRK */
/* directives. */
/* */
/* Header Files Included: None */
/* */
/* */
/********************************************************************/
ENTRY * (PARM_LIST) EXT;
DCL SPCPTR ARG1@ PARM;
DCL SPCPTR ARG2@ PARM;
DCL SPCPTR RESULT@ PARM;
DCL OL PARM_LIST
(ARG1@,
ARG2@,
RESULT@)
PARM EXT;
DCL DD ARG1 PKD(15,5) BAS(ARG1@);
DCL DD ARG2 PKD(15,5) BAS(ARG2@);
DCL DD RESULT PKD(15,5) BAS(RESULT@);
BRK "00001";
CMPNV(B) ARG1,ARG2 / LO(ITS2);
CPYNV RESULT,ARG1;
B RETURN;
ITS2: CPYNV RESULT,ARG2;
BRK "00002";
RETURN: RTX *;
PEND;
This allows the HLL programmer to use the following to debug the HLL program by using the statement identifiers of the HLL:
STRDBG PGM(HLLEXAMPLE) ADDBKP STMT(00002) PGMVAR((RESULT ()))
The following display shows that the HLL statement 00002 has been equated with MI instruction 0005 due to the use of BRK directives:
+--------------------------------------------------------------------------------+ | | | | | | | Display Breakpoint | | | | Statement/Instruction . . . . . . . . . : 00002 /0005 | | Program . . . . . . . . . . . . . . . . : HLLEXAMPLE | | Recursion level . . . . . . . . . . . . : 1 | | Start position . . . . . . . . . . . . : 1 | | Format . . . . . . . . . . . . . . . . : *CHAR | | Length . . . . . . . . . . . . . . . . : *DCL | | | | Variable . . . . . . . . . . . . . . . : RESULT | | Type . . . . . . . . . . . . . . . . : PACKED | | Length . . . . . . . . . . . . . . . : 15 5 | | ' 6.00000' | | | +--------------------------------------------------------------------------------+
As coded, the MI01 program works fine when it is passed packed decimal parameters. But when the MI01 program is passed other data types, such as in CALL CL01 (abc 6), exceptions occur. To handle these exceptions, additional statements could be added to MI01 so that:
Add the following statements to MI01:
DCL SPCPTR RC@ PARM;
DCL OL PARM_LIST
(ARG1@,
ARG2@,
RESULT@,
RC@) /* the new parameter */
PARM EXT;
DCL DD RC CHAR(1) BAS(RC@);
DCL EXCM DATAERROR EXCID(H'0C02') BP (M1202) IMD;
M1202: CPYBLA RC,'1';
RTX *;
PEND;
A more complete example of how to handle exceptions is provided in Handling exceptions in the MICRTPG2 program.
RETURN: CPYBLA RC,'0';
The an updated view of the MI01 program is as follows:
/********************************************************************/
/********************************************************************/
/* */
/* Program Name: MI01 */
/* */
/* Programming Language: MI */
/* */
/* Description: Enhanced version of MI program MI01 that */
/* demonstrates enabling an exception monitor. */
/* */
/* Header Files Included: None */
/* */
/* */
/********************************************************************/
ENTRY * (PARM_LIST) EXT;
DCL SPCPTR ARG1@ PARM;
DCL SPCPTR ARG2@ PARM;
DCL SPCPTR RESULT@ PARM;
DCL SPCPTR RC@ PARM;
DCL OL PARM_LIST
(ARG1@,
ARG2@,
RESULT@,
RC@)
PARM EXT;
DCL DD ARG1 PKD(15,5) BAS(ARG1@);
DCL DD ARG2 PKD(15,5) BAS(ARG2@);
DCL DD RESULT PKD(15,5) BAS(RESULT@);
DCL DD RC CHAR(1) BAS(RC@);
DCL EXCM DATAERROR EXCID(H'0C02') BP (M1202) IMD;
CMPNV(B) ARG1,ARG2 / LO(ITS2);
CPYNV RESULT,ARG1;
B RETURN;
ITS2: CPYNV RESULT,ARG2;
RETURN: CPYBLA RC,'0';
RTX *;
M1202: CPYBLA RC,'1';
RTX *;
PEND;
The following example updates CL01 to support the new return code parameter:
/********************************************************************/
/********************************************************************/
/* */
/* Program Name: CL01 */
/* */
/* Programming Language: CL */
/* */
/* Description: Enhanced version of CL program CL01 that */
/* demonstrates the use of enhanced MI01. */
/* */
/* Header Files Included: None */
/* */
/* */
/********************************************************************/
PGM PARM(&ARG1 &ARG2)
DCL VAR(&ARG1) TYPE(*DEC) LEN(15 5)
DCL VAR(&ARG2) TYPE(*DEC) LEN(15 5)
DCL VAR(&RESULT) TYPE(*DEC) LEN(15 5)
DCL VAR(&RC) TYPE(*CHAR) LEN(1)
DCL VAR(&MSG) TYPE(*CHAR) LEN(20)
DCL VAR(&USR) TYPE(*CHAR) LEN(10)
RTVJOBA USER(&USR)
CALL PGM(MI01) PARM(&ARG1 &ARG2 &RESULT &RC)
IF COND(&RC = '0') +
THEN(CHGVAR VAR(&MSG) VALUE(&RESULT))
ELSE +
CHGVAR VAR(&MSG) VALUE('ERROR FOUND')
SNDMSG MSG(&MSG) TOUSR(&USR)
ENDPGM
After recompiling the MI01 program and the CL01 program, CALL CL01 (abc 6) now results in the following message (not the previous MCH1202):
ERROR FOUND