Find Call Stack Entry
From MidrangeWiki
Summary
The following are the RPG/LE fully free-form definitions and instructions needed for using the Retrieve Call Stack (QWVRCSTK) API in a service procedure. This service procedure allows the caller to search the call stack for specific information by program name.
By Dave Clark
Service Prototype
Place the following in a separate copybook for inclusion in both the caller and the service program source members.
**free //==================================================================== // Find the specified program's call stack entry or find the call stack // entry previous to it -- which is the caller of the specified program. // *FND option is the default for finding the specified program // *PRV option finds the previous caller of the specified program //==================================================================== dcl-pr GenUtl_FindCallStackEntry likeds(IBMAPI_CStkE); CStkFindOpt char(4) const; CStkPgmName char(10) const; CStkJInfo likeds(QWCF0100) options(*nopass: *varsize); CStkJFmt char(8) const options(*nopass); end-pr; // data structure to return a call stack entry dcl-ds IBMAPI_CStkE qualified; QWVEL int(10:0); // Entry Length QWVSD int(10:0); // Stmt Displacement QWVSRTN int(10:0); // Stmt Returned QWVPD int(10:0); // Proc Displacement QWVPL int(10:0); // Proc Length QWVRL01 int(10:0); // Request Level QWVPGMN char(10); // Program Name QWVPGML char(10); // Program Library QWVCTION int(10:0); // Instruction QWVMN char(10); // Module Name QWVMLIB char(10); // Module Library QWVCB char(1); // Control Bdy QWVERVED01 char(3); // Reserved QWVAGNBR uns(10:0); // Act Group Number QWVAGN char(10); // Act Group Name QWVRSV201 char(2); // Reserved 2 QWVPASPN char(10); // Program ASP Name QWVLASPN char(10); // Pgm Library ASP Name QWVPASPN00 int(10:0); // Program ASP Number QWVLASPN00 int(10:0); // Pgm Library ASP No. QWVAGNL uns(20:0); // Act Group No. (Long) QWVSI char(10); // Statement Ident. QWVPN char(200); // Procedure Name end-ds;
Service Procedure
Place the following in a service program source member.
**free
ctl-opt NoMain AlwNull(*UsrCtl) Debug Option(*SrcStmt:*NoDebugIo)
DatFmt(*ISO) TimFmt(*ISO);
//====================================================================
// Find the specified program's call stack entry or find the call stack
// entry previous to it -- which is the caller of the specified program.
// *FND option is the default for finding the specified program
// *PRV option finds the previous caller of the specified program
//====================================================================
dcl-proc GenUtl_FindCallStackEntry export;
dcl-pi *n likeds(IBMAPI_CStkE);
CStkFindOpt char(4) const;
CStkPgmName char(10) const;
CStkJInfo likeds(QWCF0100) options(*nopass: *varsize);
CStkJFmt char(8) const options(*nopass);
end-pi;
dcl-s x int(10:0) inz(*zero);
dcl-s iMsgKey int(10:0) inz(*zero);
dcl-ds CallStack len(65535) qualified;
Hdr likeds(QWVK0100);
end-ds;
dcl-ds CurrEntry likeds(IBMAPI_CStkE) Based(CurrPtr);
dcl-ds NotFound likeds(IBMAPI_CStkE) inz;
if CStkPgmName <= *blanks; // no program name specified?
callp IBMAPI_SendPgmMsg( 'CPF9897': 'QCPFMSG *LIBL'
: 'Call stack program name is required.': 36
: '*DIAG': '*': 0: iMsgKey: ApiErrC );
return NotFound; // exit
endif;
if %parms > %parmnum(CStkJInfo); // use caller's job info structure?
callp IBMAPI_RetrieveCallStack( CallStack: %len(CallStack): 'CSTK0100'
: CStkJInfo: CStkJFmt: ApiErrC );
else;
clear QWCF0100; // initialize job info structure
QWCJN02 = '*'; // for current job
QWCERVED06 = *loval; // no internal job identifier
QWCTI00 = 1; // use currently running thread
QWCTI01 = *loval; // no thread identifier
callp IBMAPI_RetrieveCallStack( CallStack: %len(CallStack): 'CSTK0100'
: QWCF0100: 'JIDF0100': ApiErrC );
endif;
if ApiErrC.BytAvail > *zero; // if API issued an error message
callp IBMAPI_SendPgmMsg( ApiErrC.MsgId: 'QCPFMSG *LIBL'
: ApiErrC.MsgData: %len(ApiErrC.MsgData)
: '*DIAG': '*': 0: iMsgKey: ApiErrC );
return NotFound; // exit
endif;
CurrPtr = %addr(CallStack) + CallStack.Hdr.QWVEO; // point to first entry
x = 1; // find specified program name
dow x <= CallStack.Hdr.QWVERTN
and CurrEntry.QWVPGMN <> CStkPgmName;
CurrPtr += CurrEntry.QWVEL; // point to next entry
x += 1;
enddo;
if x > CallStack.Hdr.QWVERTN // if none found
or CurrEntry.QWVPGMN <> CStkPgmName;
return NotFound; // exit
endif;
if CStkFindOpt = '*PRV'; // find the calling program name?
dow (x <= CallStack.Hdr.QWVERTN
and CurrEntry.QWVPGMN = CStkPgmName);
CurrPtr += CurrEntry.QWVEL; // point to next entry
x += 1;
enddo;
if x > CallStack.Hdr.QWVERTN; // if none found
return NotFound; // exit
endif;
endif;
IBMAPI_CStkE = CurrEntry; // return the current stack entry
IBMAPI_CStkE.QWVSI = %subst(CurrEntry: IBMAPI_CStkE.QWVSD + 1
: %len(IBMAPI_CStkE.QWVSI));
IBMAPI_CStkE.QWVPN = %subst(CurrEntry: IBMAPI_CStkE.QWVPD + 1
: IBMAPI_CStkE.QWVPL);
return IBMAPI_CStkE; // return the call stack entry
end-proc;
