Find Call Stack Entry

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.

Service Procedure

**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;

/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_RetrieveCallStack   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-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_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;

References

• Retrieve Call Stack (QWVRCSTK) API
• Send Program Message (QMHSNDPM) API