02
Sat, Nov
2 New Articles

The CL Corner: Determining What Program Is Being Tested

CL
Typography
  • Smaller Small Medium Big Bigger
  • Default Helvetica Segoe Georgia Times

 

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 This email address is being protected from spambots. You need JavaScript enabled to view it.. I'll try to answer your burning questions in future columns.

 

Bruce Vining

Bruce Vining is president and co-founder of Bruce Vining Services, LLC, a firm providing contract programming and consulting services to the System i community. He began his career in 1979 as an IBM Systems Engineer in St. Louis, Missouri, and then transferred to Rochester, Minnesota, in 1985, where he continues to reside. From 1992 until leaving IBM in 2007, Bruce was a member of the System Design Control Group responsible for OS/400 and i5/OS areas such as System APIs, Globalization, and Software Serviceability. He is also the designer of Control Language for Files (CLF).A frequent speaker and writer, Bruce can be reached at This email address is being protected from spambots. You need JavaScript enabled to view it.. 


MC Press books written by Bruce Vining available now on the MC Press Bookstore.

IBM System i APIs at Work IBM System i APIs at Work
Leverage the power of APIs with this definitive resource.
List Price $89.95

Now On Sale

BLOG COMMENTS POWERED BY DISQUS

LATEST COMMENTS

Support MC Press Online

$

Book Reviews

Resource Center

  • SB Profound WC 5536 Have you been wondering about Node.js? Our free Node.js Webinar Series takes you from total beginner to creating a fully-functional IBM i Node.js business application. You can find Part 1 here. In Part 2 of our free Node.js Webinar Series, Brian May teaches you the different tooling options available for writing code, debugging, and using Git for version control. Brian will briefly discuss the different tools available, and demonstrate his preferred setup for Node development on IBM i or any platform. Attend this webinar to learn:

  • SB Profound WP 5539More 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.

  • SB HelpSystems ROBOT Generic IBM announced the E1080 servers using the latest Power10 processor in September 2021. The most powerful processor from IBM to date, Power10 is designed to handle the demands of doing business in today’s high-tech atmosphere, including running cloud applications, supporting big data, and managing AI workloads. But what does Power10 mean for your data center? In this recorded webinar, IBMers Dan Sundt and Dylan Boday join IBM Power Champion Tom Huntington for a discussion on why Power10 technology is the right strategic investment if you run IBM i, AIX, or Linux. In this action-packed hour, Tom will share trends from the IBM i and AIX user communities while Dan and Dylan dive into the tech specs for key hardware, including:

  • Magic MarkTRY 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.

  • SB HelpSystems ROBOT GenericForms 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.

  • SB HelpSystems ROBOT GenericIT security is a top priority for businesses around the world, but most IBM i pros don’t know where to begin—and most cybersecurity experts don’t know IBM i. In this session, Robin Tatam explores the business impact of lax IBM i security, the top vulnerabilities putting IBM i at risk, and the steps you can take to protect your organization. If you’re looking to avoid unexpected downtime or corrupted data, you don’t want to miss this session.

  • SB HelpSystems ROBOT GenericCan you trust all of your users all of the time? A typical end user receives 16 malicious emails each month, but only 17 percent of these phishing campaigns are reported to IT. Once an attack is underway, most organizations won’t discover the breach until six months later. A staggering amount of damage can occur in that time. Despite these risks, 93 percent of organizations are leaving their IBM i systems vulnerable to cybercrime. In this on-demand webinar, IBM i security experts Robin Tatam and Sandi Moore will reveal:

  • FORTRA 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:

  • FORTRAManaging messages on your IBM i can be more than a full-time job if you have to do it manually. Messages need a response and resources must be monitored—often over multiple systems and across platforms. How can you be sure you won’t miss important system events? Automate your message center with the Robot Message Management Solution. Key features include:

  • FORTRAThe thought of printing, distributing, and storing iSeries reports manually may reduce you to tears. Paper and labor costs associated with report generation can spiral out of control. Mountains of paper threaten to swamp your files. Robot automates report bursting, distribution, bundling, and archiving, and offers secure, selective online report viewing. Manage your reports with the Robot Report Management Solution. Key features include:

  • FORTRAFor over 30 years, Robot has been a leader in systems management for IBM i. With batch job creation and scheduling at its core, the Robot Job Scheduling Solution reduces the opportunity for human error and helps you maintain service levels, automating even the biggest, most complex runbooks. Manage your job schedule with the Robot Job Scheduling Solution. Key features include:

  • LANSA 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.

  • LANSAWhen it comes to creating your business applications, there are hundreds of coding platforms and programming languages to choose from. These options range from very complex traditional programming languages to Low-Code platforms where sometimes no traditional coding experience is needed. Download our whitepaper, The Power of Writing Code in a Low-Code Solution, and:

  • LANSASupply Chain is becoming increasingly complex and unpredictable. From raw materials for manufacturing to food supply chains, the journey from source to production to delivery to consumers is marred with inefficiencies, manual processes, shortages, recalls, counterfeits, and scandals. In this webinar, we discuss how:

  • The MC Resource Centers bring you the widest selection of white papers, trial software, and on-demand webcasts for you to choose from. >> Review the list of White Papers, Trial Software or On-Demand Webcast at the MC Press Resource Center. >> Add the items to yru Cart and complet he checkout process and submit

  • Profound Logic Have you been wondering about Node.js? Our free Node.js Webinar Series takes you from total beginner to creating a fully-functional IBM i Node.js business application.

  • SB Profound WC 5536Join us for this hour-long webcast that will explore:

  • Fortra 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: