September 11

0 comments

RPG program to retrieve the current job call stack

By NickLitten

September 11, 2013

#snippet, #callstack

Retrieve the Jobs Program Call Stack – RPGLE Example

The RPG IV provided in this tip uses a simpler method to provide this function.

The program sends messages up the call stack one at a time (to a maximum of 10 entries) until the top is reached. For each send, a retrieve is also performed and the receiving program name is captured. The program has three parameters: PStack (call stack returned), PStartPoint (relative starting point), and PEntries (number of entries returned).

When you call the program, set the PStartPoint parameter to the call stack entry at which you want to start. Entries are returned starting with the latest entry in the first array element. You can easily modify the program to include more or fewer call stack entries.

 F*****************************************************************
 F* Author: Adam White **
 F* Crude program to retrieve last 10 entries in the call **
 F* stack excluding the current program **
 F* **
 F* This program accepts three parameters. **
 F* Stack (Array of 10 x 10) entries **
 F* Relative starting position (3,0 P) **
 F* No of Entries to return. **
 F* **
 F*****************************************************************
 /EJECT
 D*****************************************************************
 D*Data Definitions
 D*****************************************************************
 D* Call Stack
 D DSStack ds
 D @Stack 10 Dim(10)
 D* Stack counter
 D #PCounter s 9b 0
 D* Wait time on receive message
 D #PWait s 9b 0
 D* Type Definition for the RCVM0200 format.
 D RCVM0200 DS
 D RCVPgm 111 120
 D RCVM0200Len s 9b 0 INZ(%Size(RCVM0200))
 D*****
 D* API Error Data structure
 D*****
 D DSERR DS 256
 D ERBYTP 1 4B 0 INZ(256)
 D ERBYTA 5 8B 0
 D ERMSID 9 15
 D ERMSDT 17 256
 D*****************************************************************
 D* Calc Specs
 D*****************************************************************
 C* Entry parameters
 C *Entry Plist
 C Parm PStack 100
 C Parm PStartPoint 3 0
 C Parm PEntries 3 0
 C*****
 C* Initialize parameters
 C*****
 C Move *Blanks PStack
 C Z-Add *Zero PEntries
 C Z-Add PStartPoint StartPoint 3 0
 C StartPoint IfLt 1
 C Z-Add 1 StartPoint
 C EndIf
 C Z-Add *Zero S 3 0
 C*****
 C* Loop around for maximum of 10 entries
 C*****
 C S DOUEQ 10
 C ERBYTA ORGT *ZERO
 C Add 1 S
 C StartPoint Add S #PCounter
 D*****
 D* Send A message to specified queue
 D*****
 C Call 'QMHSNDPM'
 C Parm #PMsId 7
 C Parm #PMsgf 20
 C Parm 'SLIC' #PMSDT 4
 C Parm X'00000004' #PLen 4
 C Parm '*INFO' #PType 10
 C Parm '*' #PMSGQ 10
 C Parm #PCounter
 C Parm #PKey 4
 C Parm DSERR
 D*****
 D* Receive the message
 D*****
 C Call 'QMHRCVPM'
 C Parm RCVM0200
 C Parm RCVM0200Len
 C Parm 'RCVM0200' #PFormat 8
 C Parm '*' #PMSGQ
 C Parm *ZERO #PCounter
 C Parm '*ANY ' #PType
 C Parm #PKey
 C Parm *Zero #PWait
 C Parm '*REMOVE' #PAction 10
 C Parm DSERR
 C*****
 C* If no error, return stack entry
 C*****
 C ERBYTA IFeq *ZERO
 C MOVE RCVPgm @Stack(S)
 C EndIf
 C*
 C ENDDO
 C*****
 C* Put data structure back into parameter and
 C* return no of entries processed
 C*****
 C Move DSSTack PStack
 C S Sub 1 PEntries
 C*
 C RETURN
{"email":"Email address invalid","url":"Website address invalid","required":"Required field missing"}

Join the IBM i Community for FREE Presentations, Lessons, Hints and Tips

>

Snug CBD

 20% Discount

I have partnered with SNUG CBD givING you Organic CBD
20% discount code "NL20"