It's easy with the Retrieve Call Stack API.
In our last column, "More-Flexible Testing of Your CL Program Error-Handling," we left the SNDESCAPE program with the limitation of our having to hardcode the name of the program being tested: MONESCAPE. Today, we will look at how to dynamically determine the program that we want to send an escape message to. We will do this by using the Retrieve Call Stack (QWVRCSTK) API, which is documented here.
The latest version of SNDESCAPE will send the appropriate escape message to whatever program is running immediately before SNDESCAPE and does not start with the letter "Q." Escapes will continue to be sent to MONESCAPE (as it qualifies due to not starting with a "Q"), but escapes will now also be sent from SNDESCAPE to countless other programs under test. The signed-on user, however, will still need to be VININGTEST (though that's easy enough to change). This is the source for this version of SNDESCAPE:
Pgm Parm(&Parm)
Dcl Var(&Parm) Type(*Char) Len(38)
Dcl Var(&CmdName) Type(*Char) Stg(*Defined) +
Len(10) DefVar(&Parm 29)
Dcl Var(&User) Type(*Char) Len(10)
Dcl Var(&Caller) Type(*Char) Len(10)
Dcl Var(&Count) Type(*Int)
Dcl Var(&MsgTxt) Type(*Char) Len(80)
Dcl Var(&Dta_414E) Type(*Char) Len(58)
Dcl Var(&Device) Type(*Char) Stg(*Defined) +
Len(10) DefVar(&Dta_414E 41)
Dcl Var(&Small_Rcv) Type(*Char) Len(8)
Dcl Var(&Sm_BytAvl) Type(*Int) Stg(*Defined) +
DefVar(&Small_Rcv 5)
Dcl Var(&Len_Sm_Rcv) Type(*Int) Value(8)
Dcl Var(&Lrg_RcvPtr) Type(*Ptr)
Dcl Var(&Lrg_Rcv) Type(*Char) Stg(*Based) +
Len(29) BasPtr(&Lrg_RcvPtr)
Dcl Var(&Offset) Type(*Int) Stg(*Defined) +
DefVar(&Lrg_Rcv 13)
Dcl Var(&Nbr_Rtn) Type(*Int) Stg(*Defined) +
DefVar(&Lrg_Rcv 17)
Dcl Var(&Info_Sts) Type(*Char) Stg(*Defined) +
Len(1) DefVar(&Lrg_Rcv 29)
Dcl Var(&CSE_Ptr) Type(*Ptr)
Dcl Var(&CSE_Entry) Type(*Char) Stg(*Based) +
Len(34) BasPtr(&CSE_Ptr)
Dcl Var(&Len_Ent) Type(*Int) Stg(*Defined) +
DefVar(&CSE_Entry)
Dcl Var(&PgmName) Type(*Char) Stg(*Defined) +
Len(10) DefVar(&CSE_Entry 25)
Dcl Var(&JobID) Type(*Char) Len(56)
Dcl Var(&JobName) Type(*Char) Stg(*Defined) +
Len(10) DefVar(&JobID)
Dcl Var(&Reserved) Type(*Char) Stg(*Defined) +
Len(2) DefVar(&JobID 43)
Dcl Var(&Thread) Type(*Int) Stg(*Defined) +
DefVar(&JobID 45)
Dcl Var(&Thread_ID) Type(*Char) Stg(*Defined) +
Len(8) DefVar(&JobID 49)
Dcl Var(&ErrCdeBPrv) Type(*Int) Value(0)
RtvJobA User(&User)
If Cond(&User *Eq ViningTest) Then(Do)
CallSubr Subr(FindCaller)
If Cond(&MsgTxt *NE ' ') Then( +
SndPgmMsg MsgID(CPF9897) MsgF(QCPFMsg) +
MsgDta(&MsgTxt) ToPgmQ(*Prv) +
MsgType(*Escape))
Select
When Cond(&CmdName = DONOTHING) Then(Do)
ChgVar Var(&Device) Value(MyDevice)
SndPgmMsg MsgID(CPF414E) MsgF(QCPFMsg) +
MsgDta(&Dta_414E) ToPgmQ(*Same +
(&Caller)) MsgType(*Escape)
EndDo
When Cond(&CmdName = XXX) Then(Do)
SndPgmMsg MsgID(CPF415B) MsgF(QCPFMsg) +
ToPgmQ(*Same (&Caller)) MsgType(*Escape)
EndDo
EndSelect
EndDo
Subr Subr(FindCaller)
/* Setup JobID structure for calling QWVRCSTK */
ChgVar Var(&JobID) Value(' ')
ChgVar Var(&JobName) Value('*')
ChgVar Var(&Reserved) Value(x'0000')
ChgVar Var(&Thread) Value(1)
ChgVar Var(&Thread_ID) Value(x'0000000000000000')
/* Call QWVRCSTK to find out how large of a receiver */
/* variable we need */
Call Pgm(QWVRCSTK) Parm(&Small_Rcv &Len_Sm_Rcv +
'CSTK0100' &JobID 'JIDF0100' &ErrCdeBPrv)
/* Get the necessary storage */
CallPrc Prc('malloc') Parm((&Sm_BytAvl *ByVal)) +
RtnVal(&Lrg_RcvPtr)
/* Call QWVRCSTK using a receiver variable large enough */
/* for all entries */
Call Pgm(QWVRCSTK) Parm(&Lrg_Rcv &Sm_BytAvl +
'CSTK0100' &JobID 'JIDF0100' &ErrCdeBPrv)
/* Check to see if information was returned */
If Cond(&Info_Sts *NE 'N') Then(Do)
/* If good information, process all call */
/* stack entries until we find one that doesn't */
/* start with a 'Q' */
ChgVar Var(&CSE_Ptr) Value(&Lrg_RcvPtr)
ChgVar Var(%ofs(&CSE_Ptr)) +
Value(%ofs(&CSE_Ptr) + &Offset)
DoFor Var(&Count) From(1) To(&Nbr_Rtn)
If Cond((&PgmName *NE SNDESCAPE) *AND +
(%sst(&PgmName 1 1) *NE Q)) +
Then(Do)
ChgVar Var(&Caller) Value(&PgmName)
CallPrc Prc('free') +
Parm((&Lrg_RcvPtr *ByVal))
Leave
EndDo
ChgVar Var(%ofs(&CSE_Ptr)) +
Value(%ofs(&CSE_Ptr) + &Len_Ent)
EndDo
If Cond(&Caller *EQ ' ') Then( +
ChgVar Var(&MsgTxt) +
Value('No entry found'))
EndDo
Else Cmd(ChgVar Var(&MsgTxt) Value('Bad Status'))
EndSubr
EndPgm
You probably noticed that the program size has grown quite a bit with this latest enhancement. There are also some APIs being used (specifically the APIs malloc and free), which may require a change in how we compile SNDESCAPE. If you are on V6R1, you can continue to simply use CRTBNDCL VINING/SNDESCAPE. If, however, you are on V5R4, you will need to use two steps. The first step is CRTCLMOD MODULE(VINING/SNDESCAPE). The second step is CRTPGM PGM(SNDESCAPE) BNDDIR(QC2LE). This two-step process allows us to specify the binding directory QC2LE, which is where we will find the two APIs.
To review the program changes, we will look at the program flow and discuss the various variable declares as we encounter them.
After verifying that the signed-on user is VININGTEST, the program now runs the subroutine FindCaller. This subroutine determines the name of the program that is running the command that caused SNDESCAPE to be called from the Command Analyzer Retrieve exit point.
FindCaller will be using the Retrieve Call Stack (QWVRCSTK) API. This API is a standard retrieve type of API, so we will not review the API in any great detail. Essentially, the API returns a list of programs and procedures that are in the call list to see how we got to SNDESCAPE. We may, for instance, find a call list showing that the first program in the job is QCMD, followed by MONESCAPE, the Command Analyzer Retrieve exit point, and finally SNDESCAPE. By working through this list, we can determine what program used the command that caused SNDESCAPE to be called. And this program is the one we will want to send the escape message to.
The QWVRCSTK API can work with any job on the system. You identify the job with the Job Identification parameter. This parameter corresponds to the structure declared in SNDESCAPE as &JobID. The five ChgVar commands at the start of FindCaller are initializing &JobID to indicate that the job (and thread) we are interested in is our own. Following that, FindCaller calls the QWVRCSTK API.
When calling the API, SNDESCAPE is passing a small receiver variable (&Small_Rcv) that is only eight bytes in length. Being a standard retrieve API, QWVRCSTK uses the first eight bytes of the receiver variable to return the number of bytes that are returned by the API and the number of bytes that could be returned (are available) from the API. This second piece of information--what could be returned--is of key interest to us and is declared in the program as variable &Sm_BytAvl (Bytes available). As we don't know when we compile SNDESCAPE how many programs might be in the call list or how many IBM-supplied programs might be in between SNDESCAPE and the program using the command we want to test, we can, by calling QWVRCSTK with a small receiver (one just large enough to get the bytes available information), have the API tell us how much storage is needed to hold the entire call list. This sure beats having to guess and then having to change SNDESCAPE down the road if we happen to guess wrong.
After initially calling the QWVRCSTK API, SNDESCAPE uses the API malloc to dynamically allocate storage (or if you will, memory) of the size QWVRCSTK indicates it needs to return all available information (&Sm_BytAvl). The malloc API returns a pointer to this dynamically allocated storage, and SNDESCAPE stores this pointer in the variable &Lrg_RcvPtr. Looking back at the declares that have been added to SNDESCAPE, you will see that the structure &Lrg_Rcv is defined as being *Based on the pointer &Lrg_RcvPtr and that the &Lrg_Rcv structure is defined like the structure CSTK0100 documented with the QWVRCSTK API. In particular, the fields Offset to call stack entry information (&Offset), Number of call stack entries returned (&Nbr_Rtn), and Information Status (&Info_Sts) of format CSTK0100 are *Defined over &Lrg_Rcv. So if we were to call the QWVRCSTK API again, using &Lrg_Rcv as the receiver variable, SNDESCAPE would automatically have access to this information.
As you might expect, this is exactly what SNDESCAPE does next. The program calls QWVRCSTK a second time, this time using a receiver variable of &Lrg_Rcv and a length of receiver variable set to the size of the allocated storage for &Lrg_Rcv, which is &Sm_BytAvl.
The program now checks to see if valid information was returned (&Info_Sts not being set to a value of 'N') and if so prepares to process the call list. If the information status field is set to 'N', FindCaller sets the variable &MsgTxt to 'Bad Status', and the subroutine ends.
To process the call list, SNDESCAPE needs to access the first call stack entry and then start working backward through the list to find what calls are in effect. This first entry will correspond to the most recent program on the call stack, which will be SNDESCAPE, the program that called the QWVRCSTK API. To access the first call stack entry, SNDESCAPE assigns the address of the receiver variable (&Lrg_RcvPtr) to the variable &CSE_Ptr (Pointer to a Call Stack Entry). The program then adds to &CSE_Ptr the offset to the first call stack entry (&Offset). The pointer variable &CSE_Ptr is now pointing at the first call stack entry.
Returning to the declares that were added to SNDESCAPE, we find the structure &CSE_Entry, which is *Based on the pointer &CSE_Ptr. &CSE_Entry is defined like the repeating substructure found in format CSTK0100 (the fields documented as 'These fields repeat, in the order listed, for the number of call stack entries'). Of particular interest, the fields' Length of this call stack entry (&Len_Ent) and Program name (&PgmName) are *Defined over &CSE_Entry.
At this point, SNDESCAPE has found the first call stack entry and enters into a DoWhile loop to process all call stack entries returned (&Nbr_Rtn). The first step in this processing is to determine whether the program name (&PgmName) of the call stack entry is not SNDESCAPE and does not start with a Q. If the program name is SNDESCAPE or starts with a Q, FindCaller locates the next call stack entry by adding the length of the current entry (&Len_Ent) to &CSE_Ptr and starts processing the next entry. If the program name is not SNDESCAPE and does not start with a Q, then we have found the call stack entry we are looking for: the program running the command that needs to be tested. FindCaller then sets the variable &Caller to the name of the program found, releases the storage previously allocated with the malloc API by calling the free API, and leaves the DoWhile loop.
If all call stack entries are searched and FindCaller never finds a call stack entry that isn't SNDESCAPE and isn't an IBM-provided program, then the DoWhile loop will complete with the &Caller variable still set to the initial value of blanks. In this case, FindCaller will set the variable &MsgTxt to 'No entry found'.
Upon return from the FindCaller subroutine, SNDESCAPE checks to see if &MsgTxt is set to blanks. If not, then an error was found in the FindCaller subroutine, so SNDESCAPE sends the escape message CPF9897 to the program that called SNDESCAPE (in this case, that would be the Command Analyzer Retrieve exit point). The exit point effectively has an active MONMSG for any possible error that might be sent from the exit program. The CPF9897 escape will be received by the exit point and will not be seen by the program running the command to be tested (MONESCAPE if you will), though the CPF9897 will be retained in the job log. The exit point will also log the informational message CPI0002 (Error in exit program) to the job log and allow the original program (MONESCAPE) to continue running. By sending the CPF9897 escape, SNDESCAPE is able to show in the job log that a problem was encountered.
If &MsgTxt is blank, SNDESCAPE falls into the previous Select processing. The only change here is that the hardcoded MONESCAPE program name has now been replace by the variable &Caller. So now SNDESCAPE can be used to test any program's error-handling, not just MONESCAPE's.
After all of that, you probably think we're done. But I have a problem with SNDESCAPE as it is currently written. My problem is that every time we need to test another message, test with different message replacement data, or test with another user profile name, then we need to modify the SNDESCAPE program and recompile it. In the next article, we will look at how to eliminate this need to maintain the SNDESCAPE program while still changing the test cases driven by the SNDESCAPE program.
More CL Questions?
Wondering how to accomplish a function in CL? Send your CL-related questions to me at
More than ever, there is a demand for IT to deliver innovation. Your IBM i has been an essential part of your business operations for years. However, your organization may struggle to maintain the current system and implement new projects. The thousands of customers we've worked with and surveyed state that expectations regarding the digital footprint and vision of the company are not aligned with the current IT environment.
TRY the one package that solves all your document design and printing challenges on all your platforms. Produce bar code labels, electronic forms, ad hoc reports, and RFID tags – without programming! MarkMagic is the only document design and print solution that combines report writing, WYSIWYG label and forms design, and conditional printing in one integrated product. Make sure your data survives when catastrophe hits. Request your trial now! Request Now.
Forms of ransomware has been around for over 30 years, and with more and more organizations suffering attacks each year, it continues to endure. What has made ransomware such a durable threat and what is the best way to combat it? In order to prevent ransomware, organizations must first understand how it works.
Disaster protection is vital to every business. Yet, it often consists of patched together procedures that are prone to error. From automatic backups to data encryption to media management, Robot automates the routine (yet often complex) tasks of iSeries backup and recovery, saving you time and money and making the process safer and more reliable. Automate your backups with the Robot Backup and Recovery Solution. Key features include:
Business users want new applications now. Market and regulatory pressures require faster application updates and delivery into production. Your IBM i developers may be approaching retirement, and you see no sure way to fill their positions with experienced developers. In addition, you may be caught between maintaining your existing applications and the uncertainty of moving to something new.
IT managers hoping to find new IBM i talent are discovering that the pool of experienced RPG programmers and operators or administrators with intimate knowledge of the operating system and the applications that run on it is small. This begs the question: How will you manage the platform that supports such a big part of your business? This guide offers strategies and software suggestions to help you plan IT staffing and resources and smooth the transition after your AS/400 talent retires. Read on to learn:
LATEST COMMENTS
MC Press Online