321 lines
14 KiB
HTML
321 lines
14 KiB
HTML
<?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> |