friedkiwi/ibm-information-center
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
master
ibm-information-center/dist/eclipse/plugins/i5OS.ic.apiref_5.4.0.1/MIenhver.htm

507 lines
26 KiB
HTML
Raw Permalink Normal View History

Add readme and dist folders
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="task" />
<meta name="DC.Title" content="Enhanced version of the MICRTPG program" />
<meta name="abstract" content="A new version of MICRTPG (named MICRTPG2) incorporateS the functions of the CL03 program and the CL05 program." />
<meta name="description" content="A new version of MICRTPG (named MICRTPG2) incorporateS the functions of the CL03 program and the CL05 program." />
<meta name="DC.Relation" scheme="URI" content="MIpgmg.htm" />
<meta name="DC.Relation" scheme="URI" content="../rzatk/mitoc.htm" />
<meta name="DC.Relation" scheme="URI" content="MIprosto.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="MIenhver" />
<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>Enhanced version of the MICRTPG program</title>
</head>
<body id="MIenhver"><a name="MIenhver"><!-- --></a>
<!-- Java sync-link --><script language="Javascript" src="../rzahg/synch.js" type="text/javascript"></script>
<h1 class="topictitle1">Enhanced version of the MICRTPG program</h1>
<div><p>A new version of MICRTPG (named MICRTPG2) incorporateS the functions
of the CL03 program and the CL05 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>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.</p>
<p>The
MICRTPG2 program demonstrates how to do the following tasks:</p>
<ul><li>Receive a variable number of parameters</li>
<li>Use static and automatic storage</li>
<li>Create a space object</li>
<li>Perform arithmetic operations</li>
</ul>
</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="relconcepts"><strong>Related concepts</strong><br />
<div><a href="MIprosto.htm" title="Two steps are needed to run a program: program activation and program invocation.">Program storage</a></div>
</div>
<div class="relref"><strong>Related reference</strong><br />
<div><a href="../rzatk/mitoc.htm">iSeries Machine Interface instructions</a></div>
</div>
</div><div class="nested1" xml:lang="en-us" id="micrtpg2prog"><a name="micrtpg2prog"><!-- --></a><h2 class="topictitle2">Understand the MICRTPG2 program (by sections of code)</h2>
<div><div class="section">Writing the program code for MICRTPG2:</div>
<ol><li class="stepexpand"><span>Define the entry point and associated parameters:</span> <pre>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);</pre>
</li>
<li class="stepexpand"><span>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).</span> <p>The following template creates a space (type and subtype equal to
X'19EF') that is defined through the OBJCRTOPT data element <span class="uicontrol">(1)</span>.
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).</p>
<pre>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'); <span class="uicontrol">(1)</span>
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');</pre>
</li>
<li class="stepexpand"><span>Establish addressability to the CRTS template:</span> <pre>DCL SPCPTR CRTSTMPLT@ INIT(CRTSTMPLT);</pre>
</li>
<li class="stepexpand"><span>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:</span> <pre>DCL SYSPTR QTEMP@ BASPCO POS(65);</pre>
<p>Use
the copy bytes with pointers instruction (CPYBWP) to set the template context
data element.</p>
<pre>CPYBWP CONTEXT, QTEMP@;</pre>
</li>
<li class="stepexpand"><span>In the instruction stream, create the space:</span> <pre>CRTS USRSPC@, CRTSTMPLT@;</pre>
<p>This
returns a system pointer to the created space in the system pointer:</p>
<pre>DCL SYSPTR USRSPC@;</pre>
</li>
<li class="stepexpand"><span>Declare a space pointer for addressability to the space through
a space pointer (as opposed to the system pointer returned by the CRTS instruction):</span> <pre>DCL SPCPTR USRSPC;</pre>
</li>
<li class="stepexpand"><span>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:</span> <pre>DCL DD BINOFFSET BIN(4) AUTO INIT(0);</pre>
</li>
<li class="stepexpand"><span>Because the size of the source is also a parameter to the QPRCRTPG
API, define a space pointer to refer to BINOFFSET:</span> <pre>DCL SPCPTR BINOFFSET@ AUTO INIT(BINOFFSET);</pre>
<p>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.</p>
<p>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.</p>
</li>
<li class="stepexpand"><span>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:</span> <pre>DCL SYSPTR QCMDEXC INIT("QCMDEXC", CTX("QSYS"), TYPE(PGM));</pre>
</li>
<li class="stepexpand"><span>Format the appropriate character strings for the Override with
Database File (OVRDBF) CL command: </span> <div class="note"><span class="notetitle">Note:</span> 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:</div>
<pre>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);</pre>
</li>
<li class="stepexpand"><span>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:</span> <pre>DCL DD CLDLTCMD CHAR(12) INIT("DLTOVR MISRC");</pre>
</li>
<li class="stepexpand"><span>Establish space pointers to the CL command parameters, and, because
the QCMDEXC API is being used, define the CL command string lengths as parameters:</span> <pre>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);</pre>
</li>
<li class="stepexpand"><span>Define the operand list (OL) definitions for calling the QCMDEXC
API under the two different conditions: </span> <pre>DCL OL QCMDOVROL (CLOVRCMD@, CLOVRLNG@) ARG;
DCL OL QCMDDLTOL (CLDLTCMD@, CLDLTLNG@) ARG;</pre>
</li>
<li class="stepexpand"><span>Because CALLX CL06 is called to load the space, declare its system
pointer, parameters, and OL: </span> <pre>DCL SYSPTR CL06 INIT("CL06", TYPE(PGM));
DCL DD OFFSET PKD(15,5);
DCL SPCPTR OFFSET@ INIT(OFFSET);
DCL OL CL06OL (USRSPC, OFFSET@) ARG;</pre>
</li>
<li class="stepexpand"><span>Declare the system pointer, parameters, and OL for the QPRCRTPG
API:</span> <pre>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));</pre>
</li>
</ol>
</div>
</div>
<div class="nested1" xml:lang="en-us" id="begininstructstream"><a name="begininstructstream"><!-- --></a><h2 class="topictitle2">Beginning the instruction stream</h2>
<div><div class="section">Begin the instruction stream definition by doing the following:</div>
<ol><li class="stepexpand"><span>Use the store parameter list length (STPLLEN) instruction to determine
the number of parameters that were passed to the program:</span> <pre> STPLLEN NUM_PARMS;</pre>
</li>
<li class="stepexpand"><span>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:</span> <pre> CMPNV(B) NUM_PARMS, 2 / EQ(PARM2);
CPYBLAP FILNAM, 'MISRC', ' ';
B PARM1;</pre>
</li>
<li class="stepexpand"><span>If the number of parameters is 2, assign FILNAM to the value of
the second parameter:</span> <pre> PARM2: CPYBLA FILNAM, FIL;</pre>
</li>
<li class="stepexpand"><span>Assign the source member name:</span> <pre> PARM1: CPYBLA MBRNAM, MBR;</pre>
</li>
<li class="stepexpand" id="begininstructstream__LIA"><a name="begininstructstream__LIA"><!-- --></a><span>Assign the proper context for the space:</span> <pre> CPYBWP CONTEXT, QTEMP@;</pre>
</li>
<li class="stepexpand" id="begininstructstream__LIB"><a name="begininstructstream__LIB"><!-- --></a><span>After establishing the context of the space, now create
the space:</span> <pre> CRTS USRSPC@, CRTSTMPLT@;</pre>
</li>
<li class="stepexpand" id="begininstructstream__LIC"><a name="begininstructstream__LIC"><!-- --></a><span>Assign the space pointer USRSPC to address the first byte
of the space:</span> <pre> SETSPPFP USRSPC, USRSPC@;</pre>
</li>
<li class="stepexpand"><span>Set the OVRDBF CL command to start with POSITION(1):</span> <pre> CPYNV RECNUM, 1;</pre>
</li>
</ol>
</div>
</div>
<div class="nested1" xml:lang="en-us" id="usingstaticstorageadvantage"><a name="usingstaticstorageadvantage"><!-- --></a><h2 class="topictitle2">Using static storage to your advantage</h2>
<div><div class="section"><p>In <a href="#begininstructstream">Beginning the instruction stream</a>, the instructions
in steps <a href="#begininstructstream__LIA">5</a>, <a href="#begininstructstream__LIB">6</a>,
and <a href="#begininstructstream__LIC">7</a> 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:</p>
<pre> 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;</pre>
<p>Resuming the program flow of the MICRTPG2
program from <a href="#begininstructstream">Beginning the instruction stream</a>, you should have the
program perform the following:</p>
</div>
<ol><li class="stepexpand"><span>Fall into a loop (the MORE label) until all source records are
loaded as the source physical file member position is overridden:</span> <pre>MORE: CALLX QCMDEXC, QCMDOVROL, *;</pre>
</li>
<li class="stepexpand"><span>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:</span> <pre> CPYNV OFFSET,1;
CALLX CL06, CL06OL, *;</pre>
</li>
<li class="stepexpand"><span>Back out (subtract) the base-1 nature of CL using the short (the
(S) extender) form of the subtract numeric (SUBN) instruction:</span> <pre> SUBN(S) OFFSET, 1;</pre>
</li>
<li class="stepexpand"><span>Add the number of MI source bytes processed by CL06 to the offset
into the space (for the next call):</span> <pre> ADDN(S) BINOFFSET, OFFSET;
SETSPPO USRSPC, BINOFFSET;</pre>
</li>
<li class="stepexpand"><span>Update the Override with Database File (OVRDBF) position parameter
for the next call to CL06:</span> <pre> ADDN(S) RECNUM, 20;</pre>
</li>
<li class="stepexpand"><span>Delete the previous OVRDBF:</span> <pre> CALLX QCMDEXC, QCMDDLTOL, *;</pre>
</li>
<li class="stepexpand"><span>Check to see if all records were processed, and if not, branch
to label MORE to load more source records:</span> <pre> CMPNV(B) OFFSET, 1600 /EQ(MORE);</pre>
<p>Otherwise,
assume that all source was loaded and prepare for calling the QPRCRTPG API
by setting the program name:</p>
<pre> CPYBLA PGMNAM, MBR;</pre>
</li>
<li class="stepexpand"><span>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:</span> <pre> SETSPPO USRSPC,0;</pre>
</li>
<li class="stepexpand"><span>Call the QPRCRTPG API to create the MI program:</span> <pre> CALLX QPRCRTPG, QPRCRTPGOL, *;</pre>
</li>
<li class="stepexpand"><span>Indicate that the program is done:</span> <pre> RTX *;
PEND;</pre>
</li>
</ol>
</div>
</div>
<div class="nested1" xml:lang="en-us" id="micodeex"><a name="micodeex"><!-- --></a><h2 class="topictitle2">MI code example: MICRTPG2 complete program</h2>
<div><div class="section"><p>In its consolidated state, this is the new MICRTPG2 program:</p>
<pre>/********************************************************************/
/********************************************************************/
/* */
/* 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;</pre>
</div>
</div>
</div>
<div class="nested1" xml:lang="en-us" id="updatedcl06program"><a name="updatedcl06program"><!-- --></a><h2 class="topictitle2">Updated CL06 program</h2>
<div><div class="section"><p>Following is the updated CL06 program:</p>
<pre>/********************************************************************/
/********************************************************************/
/* */
/* program Name: CL06 */
/* */
/* programming Language: CL */
/* */
/* Description: Load a source physical file member into the */
/* *USRSPC addressed by &amp;BUFFER. */
/* */
/* */
/* Header Files Included: None */
/* */
/* */
/********************************************************************/
PGM PARM(&amp;BUFFER &amp;OFFSET)
DCLF FILE(MISRC)
DCL VAR(&amp;BUFFER) TYPE(*CHAR) LEN(1600)
DCL VAR(&amp;OFFSET) TYPE(*DEC) LEN(15 5)
LOOP: RCVF
MONMSG MSGID(CPF0864 CPF4137) EXEC(GOTO CMDLBL(DONE))
CHGVAR VAR(%SST(&amp;BUFFER &amp;OFFSET 80)) VALUE(&amp;SRCDTA)
CHGVAR VAR(&amp;OFFSET) VALUE(&amp;OFFSET + 80)
IF COND(&amp;OFFSET *GT 1600) THEN(GOTO CMDLBL(DONE))
GOTO CMDLBL(LOOP)
DONE: ENDPGM</pre>
</div>
</div>
</div>
</body>
</html>
Reference in New Issue Copy Permalink