|
|
| Line 30: |
Line 30: |
| | | | |
| | == Example == | | == 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.
| + | See the [[Find Call Stack Entry]] service procedure. |
| − | | |
| − | <pre>
| |
| − | **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;
| |
| − | </pre>
| |
| | | | |
| | == References == | | == References == |
| | * [[ApiErrC — API Error Code]] | | * [[ApiErrC — API Error Code]] |
| − | * [[QMHSNDPM — Send Program Message]]
| |
