ibm-information-center/dist/eclipse/plugins/i5OS.ic.apiref_5.4.0.1/MIcrepro.htm

321 lines
14 KiB
HTML
Raw Normal View History

2024-04-02 14:02:31 +00:00
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html
PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html lang="en-us" xml:lang="en-us">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<meta name="security" content="public" />
<meta name="Robots" content="index,follow" />
<meta http-equiv="PICS-Label" content='(PICS-1.1 "http://www.icra.org/ratingsv02.html" l gen true r (cz 1 lz 1 nz 1 oz 1 vz 1) "http://www.rsac.org/ratingsv01.html" l gen true r (n 0 s 0 v 0 l 0) "http://www.classify.org/safesurf/" l gen true r (SS~~000 1))' />
<meta name="DC.Type" content="reference" />
<meta name="DC.Title" content="Create the MICRTPG2 program" />
<meta name="abstract" content="This topic shows how to create the MICRTPG2 program and how to handle exceptions in the MICRTPG2 program." />
<meta name="description" content="This topic shows how to create the MICRTPG2 program and how to handle exceptions in the MICRTPG2 program." />
<meta name="DC.Relation" scheme="URI" content="MIpgmg.htm" />
<meta name="DC.Relation" scheme="URI" content="MIcompprog.htm" />
<meta name="copyright" content="(C) Copyright IBM Corporation 1998, 2006" />
<meta name="DC.Rights.Owner" content="(C) Copyright IBM Corporation 1998, 2006" />
<meta name="DC.Format" content="XHTML" />
<meta name="DC.Identifier" content="MIcrepro" />
<meta name="DC.Language" content="en-us" />
<!-- All rights reserved. Licensed Materials Property of IBM -->
<!-- US Government Users Restricted Rights -->
<!-- Use, duplication or disclosure restricted by -->
<!-- GSA ADP Schedule Contract with IBM Corp. -->
<link rel="stylesheet" type="text/css" href="./ibmdita.css" />
<link rel="stylesheet" type="text/css" href="./ic.css" />
<title>Create the MICRTPG2 program</title>
</head>
<body id="MIcrepro"><a name="MIcrepro"><!-- --></a>
<!-- Java sync-link --><script language="Javascript" src="../rzahg/synch.js" type="text/javascript"></script>
<h1 class="topictitle1">Create the MICRTPG2 program</h1>
<div><p>This topic shows how to create the MICRTPG2 program and how to
handle exceptions in the MICRTPG2 program.</p>
<div class="section"><div class="note"><span class="notetitle">Note:</span> Read the <a href="codedisclaimer.htm">Code license and disclaimer information</a> for important
legal information.</div>
<p>To create the MICRTPG2 program, use:</p>
<pre>DLTOVR MISRC
CALL CL03 (MISRC MICRTPG2)</pre>
<p>After the successful creation of
MICRTPG2, you can create any new MI programs by entering the following, where
SourceFileName is an optional parameter:</p>
<pre>CALL MICRTPG2 (MemberName SourceFileName)</pre>
</div>
<div class="section"><h4 class="sectiontitle">Handle exceptions in the MICRTPG2 program</h4><p>Some exceptions
that are not being handled by the MICRTPG2 program might occur. For example,
if you used MICRTPG2 to compile MICRTPG2 two times in succession, the exception
MCH1401 occurs. This occurs because the most recent activation of the MICRTPG2
program has its own static storage and is not aware of the earlier instances
of MICRTPG2 creating the space named MICRTPG2 in QTEMP.</p>
<p>To correct this
problem do the following:</p>
<ol><li>Define an exception description that passes control to an internal exception
handler: <pre> DCL EXCM DUPERROR EXCID(H'0E01') INT(M1401) IMD;</pre>
</li>
<li>Define the internal entry point: <pre> ENTRY M1401 INT;</pre>
</li>
<li>Define related data elements for the M1401 exception: <pre> /* Exception description template for RETEXCPD */
DCL DD EXCPDBUF CHAR(200) BDRY(16);
DCL DD BYTPRV BIN(4) DEF(EXCPDBUF) POS(1) INIT(200);
DCL DD BYTAVL BIN(4) DEF(EXCPDBUF) POS(5);
DCL DD EXCPID CHAR(2) DEF(EXCPDBUF) POS(9);
DCL DD CMPLEN BIN(2) DEF(EXCPDBUF) POS(11);
DCL DD CMPDTA CHAR(32) DEF(EXCPDBUF) POS(13);
DCL DD MSGKEY CHAR(4) DEF(EXCPDBUF) POS(45);
DCL DD EXCDTA CHAR(50) DEF(EXCPDBUF) POS(49);
DCL SYSPTR EXC_OBJ@ DEF(EXCDTA) POS(1);
DCL DD EXC_OBJ CHAR(32) DEF(EXCDTA) POS(17);
DCL PTR INV_PTR DEF(EXCPDBUF) POS(97);
DCL DD * CHAR(87) DEF(EXCPDBUF) POS(113);
DCL SPCPTR EXCPDBUF@ INIT(EXCPDBUF);
/* Template for RTNEXCP */
DCL DD RTNTMPLT CHAR(19) BDRY(16);
DCL PTR INV_PTR2 DEF(RTNTMPLT) POS(1);
DCL DD * CHAR(1) DEF(RTNTMPLT) POS(17) INIT(X'00');
DCL DD ACTION CHAR(2) DEF(RTNTMPLT) POS(18);
DCL SPCPTR RTNTMPLT@ INIT(RTNTMPLT);</pre>
</li>
<li>Retrieve the exception data associated with the MCH1401 exception: <pre> RETEXCPD EXCPDBUF@, X'01';</pre>
</li>
<li>Compare the exception data object identifier to the space identifier you
create. If they are the same, branch to label SAME: <pre> CMPBLA(B) EXC_OBJ, OBJID / EQ(SAME);</pre>
<ol type="a"><li>If the exception data object identifier and the space identifier are not
the same, the program is truly in an unexpected error condition and the exception
description needs to be disabled: <pre> MODEXCPD DUPERROR, X'2000', X'01';</pre>
<p>Retry
the failing instruction. As the exception description is disabled, the exception
is sent to the caller of the program:</p>
<pre> CPYBLA ACTION, X'0000';
B E1401;</pre>
</li>
<li>If the exception data object identifier and the space identifier are the
same, the static storage must have been effectively reset. The program reassigns
USRSPC@ by using the returned system pointer in the exception data and continues
with the next instruction following the failed CRTS: <pre> SAME: CPYBWP USRSPC@, EXC_OBJ@;
CPYBLA ACTION, X'0100';
E1401: CPYBWP INV_PTR2, INV_PTR;
RTNEXCP RTNTMPLT@;
PEND;</pre>
</li>
</ol>
</li>
</ol>
</div>
<div class="section"><h4 class="sectiontitle">MI code example: MICRTPG2 complete program (enhanced)</h4><p>In
its consolidated state, this is the new MICRTPG2 program:</p>
<pre>/********************************************************************/
/********************************************************************/
/* */
/* program Name: MICRTPG2 */
/* */
/* programming Language: MI */
/* */
/* Description: Enhanced version of MI program MICRTPG2, */
/* which provides for exception handling. */
/* */
/* */
/* Header Files Included: None */
/* */
/* */
/********************************************************************/
/* Entry point and associated parameters */
ENTRY * (*ENTRY) EXT;
DCL SPCPTR FIL@ PARM;
DCL SPCPTR MBR@ PARM;
DCL OL *ENTRY (MBR@, FIL@) PARM EXT MIN(1);
DCL DD FIL CHAR(10) BAS(FIL@);
DCL DD MBR CHAR(10) BAS(MBR@);
DCL DD NUM_PARMS BIN( 4);
/* Control field for first time initialization */
DCL DD READY CHAR( 1) INIT("0");
/* Binary offset into the space */
DCL DD BINOFFSET BIN(4) AUTO INIT(0);
DCL SPCPTR BINOFFSET@ AUTO INIT(BINOFFSET);
/* Pointers for accessing the space */
DCL SPCPTR USRSPC;
DCL SYSPTR USRSPC@;
/* QCMDEXC and associated CL commands */
DCL SYSPTR QCMDEXC INIT("QCMDEXC", CTX("QSYS"), TYPE(PGM));
DCL DD CLOVRCMD CHAR(65);
DCL DD OVRSTR CHAR(39) DEF(CLOVRCMD) POS(1)
INIT("OVRDBF MISRC 1234567890 MBR(1234567890)");
DCL DD OVRSTR2 CHAR(26) DEF(CLOVRCMD) POS(40)
INIT(" POSITION(*RRN 1234567890)");
DCL DD FILNAM CHAR(10) DEF(CLOVRCMD) POS(14);
DCL DD MBRNAM CHAR(10) DEF(CLOVRCMD) POS(29);
DCL DD RECNUM ZND(10,0) DEF(CLOVRCMD) POS(55);
DCL SPCPTR CLOVRCMD@ INIT(CLOVRCMD);
DCL DD CLOVRLNG PKD(15,5) INIT(P'65');
DCL SPCPTR CLOVRLNG@ INIT(CLOVRLNG);
DCL OL QCMDOVROL (CLOVRCMD@, CLOVRLNG@) ARG;
DCL DD CLDLTCMD CHAR(12) INIT("DLTOVR MISRC");
DCL SPCPTR CLDLTCMD@ INIT(CLDLTCMD);
DCL DD CLDLTLNG PKD(15,5) INIT(P'12');
DCL SPCPTR CLDLTLNG@ INIT(CLDLTLNG);
DCL OL QCMDDLTOL (CLDLTCMD@, CLDLTLNG@) ARG;
/* CL06 and associated parameters */
DCL SYSPTR CL06 INIT("CL06", TYPE(PGM));
DCL DD OFFSET PKD(15,5);
DCL SPCPTR OFFSET@ INIT(OFFSET);
DCL OL CL06OL (USRSPC, OFFSET@) ARG;
/* Access QTEMP address */
DCL SYSPTR QTEMP@ BASPCO POS(65);
/* Template for CRTS MI instruction */
DCL DD CRTSTMPLT CHAR(160) BDRY(16);
DCL DD TMPLTSPEC CHAR(8) DEF(CRTSTMPLT) POS(1);
DCL DD TMPLTSIZE BIN(4) DEF(TMPLTSPEC) POS(1) INIT(160);
DCL DD TMPLTBA BIN(4) DEF(TMPLTSPEC) POS(5) INIT(0);
DCL DD OBJID CHAR(32) DEF(CRTSTMPLT) POS(9);
DCL DD SPCTYPE CHAR(1) DEF(OBJID) POS(1) INIT(X'19');
DCL DD SPCSUBTYPE CHAR(1) DEF(OBJID) POS(2) INIT(X'EF');
DCL DD SPCNAME CHAR(30) DEF(OBJID) POS(3) INIT("MICRTPG2");
DCL DD OBJCRTOPT CHAR(4) DEF(CRTSTMPLT) POS(41) INIT(X'60020000');
DCL DD OBJRCVOPTS CHAR(4) DEF(CRTSTMPLT) POS(45);
DCL DD * CHAR(2) DEF(OBJRCVOPTS) POS(1) INIT(X'0000');
DCL DD ASP CHAR(2) DEF(OBJRCVOPTS) POS(3) INIT(X'0000');
DCL DD SPCSIZ BIN(4) DEF(CRTSTMPLT) POS(49) INIT(1);
DCL DD INTSPCVAL CHAR(1) DEF(CRTSTMPLT) POS(53) INIT(X'00');
DCL DD PERFCLASS CHAR(4) DEF(CRTSTMPLT) POS(54) INIT(X'00000000');
DCL DD * CHAR(1) DEF(CRTSTMPLT) POS(58) INIT(X'00');
DCL DD PUBAUT CHAR(2) DEF(CRTSTMPLT) POS(59) INIT(X'0000');
DCL DD TMPLTEXTN BIN(4) DEF(CRTSTMPLT) POS(61) INIT(96);
DCL SYSPTR CONTEXT DEF(CRTSTMPLT) POS(65);
DCL SYSPTR ACCESSGRP DEF(CRTSTMPLT) POS(81);
DCL SYSPTR USRPRF DEF(CRTSTMPLT) POS(97);
DCL DD MAXSPCSIZ BIN(4) DEF(CRTSTMPLT) POS(113) INIT(0);
DCL DD DOMAIN CHAR(2) DEF(CRTSTMPLT) POS(117) INIT(X'0001');
DCL DD * CHAR(42) DEF(CRTSTMPLT) POS(119) INIT((42)X'00');
DCL SPCPTR CRTSTMPLT@ INIT(CRTSTMPLT);
/* QPRCRTPG and associated parameters */
DCL DD PGM CHAR(20);
DCL DD PGMNAM CHAR(10) DEF(PGM) POS(1);
DCL DD PGMLIBNAM CHAR(10) DEF(PGM) POS(11) INIT("*CURLIB ");
DCL SPCPTR PGM@ INIT(PGM);
DCL DD PGMTXT CHAR(50) INIT(" ");
DCL SPCPTR PGMTXT@ INIT(PGMTXT);
DCL DD PGMSRCF CHAR(20) INIT("*NONE");
DCL SPCPTR PGMSRCF@ INIT(PGMSRCF);
DCL DD PGMSRCM CHAR(10) INIT(" ");
DCL SPCPTR PGMSRCM@ INIT(PGMSRCM);
DCL DD PGMSRCCHG CHAR(13) INIT(" ");
DCL SPCPTR PGMSRCCHG@ INIT(PGMSRCCHG);
DCL DD PRTFNAM CHAR(20) INIT("QSYSPRT *LIBL ");
DCL SPCPTR PRTFNAM@ INIT(PRTFNAM);
DCL DD PRTSTRPAG BIN(4) INIT(1);
DCL SPCPTR PRTSTRPAG@ INIT(PRTSTRPAG);
DCL DD PGMPUBAUT CHAR(10) INIT("*ALL ");
DCL SPCPTR PGMPUBAUT@ INIT(PGMPUBAUT);
DCL DD PGMOPTS(16) CHAR(11) INIT((1)"*LIST", *(2)(1)"*REPLACE",
*(3)(1)"*XREF");
DCL SPCPTR PGMOPTS@ INIT(PGMOPTS);
DCL DD NUMOPTS BIN(4) INIT(3);
DCL SPCPTR NUMOPTS@ INIT(NUMOPTS);
DCL OL QPRCRTPGOL (USRSPC, BINOFFSET@, PGM@, PGMTXT@, PGMSRCF@,
PGMSRCM@, PGMSRCCHG@, PRTFNAM@, PRTSTRPAG@,
PGMPUBAUT@, PGMOPTS@, NUMOPTS@) ARG;
DCL SYSPTR QPRCRTPG INIT("QPRCRTPG", CTX("QSYS"), TYPE(PGM));
/* Exception Description Monitor for MCH1401 */
DCL EXCM DUPERROR EXCID(H'0E01') INT(M1401) IMD;
/* Start of instruction stream */
STPLLEN NUM_PARMS;
CMPNV(B) NUM_PARMS, 2 / EQ(PARM2);
CPYBLAP FILNAM, 'MISRC', ' ';
B PARM1;
PARM2: CPYBLA FILNAM, FIL;
PARM1: CPYBLA MBRNAM,MBR;
CMPBLA(B) READY, '1' / EQ(SKIP);
CPYBWP CONTEXT, QTEMP@;
CRTS USRSPC@, CRTSTMPLT@;
SETSPPFP USRSPC,USRSPC@;
CPYBLA READY, '1';
SKIP: CPYNV RECNUM, 1;
MORE: CALLX QCMDEXC, QCMDOVROL, *;
CPYNV OFFSET,1;
CALLX CL06, CL06OL, *;
SUBN(S) OFFSET, 1;
ADDN(S) BINOFFSET, OFFSET;
SETSPPO USRSPC, BINOFFSET;
ADDN(S) RECNUM, 20;
CALLX QCMDEXC, QCMDDLTOL, *;
CMPNV(B) OFFSET, 1600 /EQ(MORE);
CPYBLA PGMNAM, MBR;
SETSPPO USRSPC, 0;
CALLX QPRCRTPG, QPRCRTPGOL, *;
RTX *;
/* Entry point for internal exception handler */
ENTRY M1401 INT;
/* Exception description template for RETEXCPD */
DCL DD EXCPDBUF CHAR(200) BDRY(16);
DCL DD BYTPRV BIN(4) DEF(EXCPDBUF) POS(1) INIT(200);
DCL DD BYTAVL BIN(4) DEF(EXCPDBUF) POS(5);
DCL DD EXCPID CHAR(2) DEF(EXCPDBUF) POS(9);
DCL DD CMPLEN BIN(2) DEF(EXCPDBUF) POS(11);
DCL DD CMPDTA CHAR(32) DEF(EXCPDBUF) POS(13);
DCL DD MSGKEY CHAR(4) DEF(EXCPDBUF) POS(45);
DCL DD EXCDTA CHAR(50) DEF(EXCPDBUF) POS(49);
DCL SYSPTR EXC_OBJ@ DEF(EXCDTA) POS(1);
DCL DD EXC_OBJ CHAR(32) DEF(EXCDTA) POS(17);
DCL PTR INV_PTR DEF(EXCPDBUF) POS(97);
DCL DD * CHAR(87) DCF(EXCPDBUF) POS(113);
DCL SPCPTR EXCPDBUF@ INIT(EXCPDBUF);
/* Template for RTNEXCP */
DCL DD RTNTMPLT CHAR(19) BDRY(16);
DCL PTR INV_PTR2 DEF(RTNTMPLT) POS(1);
DCL DD * CHAR(1) DEF(RTNTMPLT) POS(17) INIT(X'00');
DCL DD ACTION CHAR(2) DEF(RTNTMPLT) POS(18);
DCL SPCPTR RTNTMPLT@ INIT(RTNTMPLT);
/* Start of internal handler */
RETEXCPD EXCPDBUF@, X'01';
CMPBLA(B) EXC_OBJ, OBJID / EQ(SAME);
MODEXCPD DUPERROR, X'2000', X'01';
CPYBLA ACTION, X'0000';
B E1401;
SAME: CPYBWP USRSPC@, EXC_OBJ@;
CPYBLA ACTION, X'0100';
E1401: CPYBWP INV_PTR2, INV_PTR;
RTNEXCP RTNTMPLT@;
PEND;</pre>
</div>
</div>
<div>
<div class="familylinks">
<div class="parentlink"><strong>Parent topic:</strong> <a href="MIpgmg.htm" title="Provides information about creating machine interface (MI) programs.">Machine interface programming</a></div>
</div>
<div class="relref"><strong>Related reference</strong><br />
<div><a href="MIcompprog.htm" title="To compile an MI program, use the Create Program (QPRCRTPG) API.">Compile an MI program</a></div>
</div>
</div>
</body>
</html>