Code:
**-- Program description: ----------------------------------------------**--------------------- ** ** This program was intended to ease the process of retrieving the ** current job's call stack. The information returned are the program ** names and program library names that are displayed by the DSPJOB or ** WRKJOB command's call stack panel. Running the command DSPJOB ** OPTION( *PGMSTK ) will show the information referred to above. ** ** ** ** **-- Parameters: ** ** PxEntNbr BOTH The maximum number of call stack entries ** to return in the output array. A maximum ** of 128 call stack entries can be returned. ** ** On return this parameter specifies the ** actual number of call stack entries loaded ** in the second parameter. ** ** PxStkEnt OUTPUT The retrieved call stack entries are returned ** in this parameter. Both the program name and ** program library is returned for each call ** stack entry as illustrated below: ** ** 1 21 41 ** | entry 1 | entry 2 | entry 3 | -- ** ** 1 11 21 31 41 51 ** | pgm | lib | pgm | lib | pgm | lib | -- ** ** The call stack entries are returned in ** descending call level order. ** ** This means that the name of the caller of ** this program will be returned in the first ** entry, and the name of the first program ** that was called in this job is found in ** the last entry returned. ** ** **-- Compilation specification: ** ** CrtBndRpg Pgm( <library>/callstack ) ** SrcFile( <library>/QRPGLESRC ) ** ** **-- Header specification: ---------------------------------------------** H Option( *SrcStmt ) **-- System information: -----------------------------------------------** D PgmSts SDs D PsPgmNam *Proc **-- Global variables: -------------------------------------------------** D EntNbr s 10i 0 D Eix s 10i 0 **-- API error data structure: -----------------------------------------** D ApiError Ds D AeBytPrv 10i 0 Inz( %Size( ApiError )) D AeBytAvl 10i 0 D AeExcpId 7a D 1a D AeExcpDta 128a **-- Retrieve call stack API parameters: -------------------------------** D CsRcvVar Ds D CsBytRtn 10i 0 D CsBytAvl 10i 0 D CsNbrStkE 10i 0 D CsOfsStkE 10i 0 D CsNbrEntRtn 10i 0 D CsThrId 8a D CsInfSts 1a D CsCalStk 32767a ** D CsCalStkE Ds Based( pCalStkE ) D CsStkEntLen 10i 0 D CsOfsStmIds 10i 0 D CsNbrStmIds 10i 0 D CsOfsPrcNam 10i 0 D CsLenPrcNam 10i 0 D CsRqsLvl 10i 0 D CsPgmNam 10a D CsPgmLib 10a D CsMiInst 10i 0 D CsModNam 10a D CsModLib 10a D CsCtlBdy 1a D CsRsv 3a D CsActGrpNbr 10u 0 D CsActGrpNam 10a D CsAddInf 4096a ** D CsStmIds 10a Dim( 256 ) D CsPrcNam 512a ** D CsJobId Ds D JiJobNam 10a Inz( '*' ) D JiUsrNam 10a D JiJobNbr 6a D JiIntId 16a D JiRsv 2a Inz( *Allx'00' ) D JiThrInd 10i 0 Inz( 1 ) D JiThrId 8a Inz( *Allx'00' ) ** D RtvCalStk Pr ExtPgm( 'QWVRCSTK' ) D RcRcvVar 32767a D RcRcvVarLen 10i 0 Const D RcRcvInfFmt 8a Const D RcJobId 56a Const D RcJobIdFmt 8a Const D RcError 32767a Options( *VarSize ) **-- Parameters: -------------------------------------------------------** D PxEntNbr s 5p 0 inz(10) D PxStkEnt s 20a Dim( 128 ) ** ** **-- Mainline: ---------------------------------------------------------** ** /free if PxEntNbr > *Zero; RtvCalStk( CsRcvVar : %Size( CsRcvVar ) : 'CSTK0100' : CsJobId : 'JIDF0100' : ApiError ); if AeBytAvl = *Zero; pCalStkE = %Addr( CsRcvVar ) + CsOfsStkE; for EntNbr = 1 to CsNbrEntRtn; if CsPgmNam <> PsPgmNam; Eix +=1; PxStkEnt(Eix) = CsPgmNam + CsPgmLib; endif; if EntNbr = PxEntNbr or EntNbr = CsNbrEntRtn or EntNbr = %Elem( PxStkEnt ); leave; endif; pCalStkE += CsStkEntLen; endfor; endif; endif; PxEntNbr = Eix; *InLr = *On; Return; /end-free **
Comment