Retrieve Call Stack (QWVRCSTK)
From MidrangeWiki
Revision as of 20:09, 4 December 2018 by DaveLClarkI (talk | contribs)
Summary
The following is an RPG/LE fully free-form prototype for the IBM QWVRCSTK API to retrieve the Call Stack content for the current job.
Prototype for the QWVRCSTK API
//=========================================================================
// IBM API to Retrieve Call Stack information
//
// EXAMPLE:
// callp IBMAPI_RtvCallStack( MyCallStack: %len(MyCallStack): 'CSTK0100'
// : MyJobInfo: 'JDIF0100': ApiErrC);
//
// DOCUMENTATION:
// https://www.ibm.com/support/knowledgecenter/en/ssw_ibm_i_72/apis/qwvrcstk.htm
//=========================================================================
dcl-pr IBMAPI_RtvCallStack
extpgm('QWVRCSTK');
CStkRcvr likeds(QWVK0100) options(*varsize);
CStkRLen int(10:0) const;
CStkRFmt char(8) const;
CStkJInfo likeds(QWCF0100) options(*varsize);
CStkJFmt char(8) const;
CStkErrC likeds(ApiErrC) options(*varsize);
end-pr;
Example
The following are the RPG/LE fully free-form definitions and instructions needed for using the above prototype in a service procedure. This service procedure allows the caller to search the call stack for specific information by program name.
**free
/include qsysinc/qrpglesrc,qwcattr // common job/thread API structures
/include qsysinc/qrpglesrc,qwvrcstk // QWVRCSTK API data structures
// 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;
// API error code data structure
dcl-ds ApiErrC inz qualified;
BytProv int(10:0) inz(%size(ApiErrC));
BytAvail int(10:0);
MsgId char(7);
Reserved char(1);
MsgData char(3000);
end-ds;
// Retrieve Call Stack API prototype
dcl-pr IBMAPI_RtvCallStack
extpgm('QWVRCSTK');
CStkRcvr likeds(QWVK0100) options(*varsize);
CStkRLen int(10:0) const;
CStkRFmt char(8) const;
CStkJInfo likeds(QWCF0100) options(*varsize);
CStkJFmt char(8) const;
CStkErrC likeds(ApiErrC) options(*varsize);
end-pr;
// Send Program Message API prototype
dcl-pr IBMAPI_SendPgmMsg
extpgm('QMHSNDPM');
MsgId char(7) const;
MsgFile char(20) const;
MsgData char(3000) const options(*varsize);
MsgDtaLen int(10:0) const;
MsgType char(10) const;
MsgCallStE char(200) const;
MsgCallStC int(10:0) const;
MsgKey int(10:0);
MsgErrC likeds(ApiErrC) options(*varsize);
end-pr;
//====================================================================
// 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 IBMAPI_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;
//====================================================================
// 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 IBMAPI_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_RtvCallStack( 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_RtvCallStack( 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;
