70 pts.
 COBOL SUBROUTINES : FINDING OUT THE NAME OF THE CALLING PROGRAM.
Within COBOL, at execution time within a sub program, is there a way of knowing the name of the calling program ? Thanking you.

Software/Hardware used:
ASKED: February 11, 2008  1:14 PM
UPDATED: February 12, 2008  4:57 PM

Answer Wiki:
There are several ways to get the name of your caller. My personal choice is to use the <a href="http://publib.boulder.ibm.com/infocenter/iseries/v5r4/topic/apis/qwvrcstk.htm">Retrieve Call Stack API QWVRCSTK</a>. It's not necessarily the easiest, but it certainly gives you all the information you are likely to want concerning who is in the call chain before you. Here's a sample which displays the name of the caller (where "caller" is defined as being the most recent program that is not named the same as the current program). I provided a little bit of documentation, but if you're not familiar with system APIs this processing will most likely look a bit strange... <pre> PROCESS NOMONOPRC. * To compile: * CRTCBLMOD CALLSTACK * CRTPGM CALLSTACK BNDDIR(QC2LE) IDENTIFICATION DIVISION. PROGRAM-ID. CALLSTACK. DATA DIVISION. WORKING-STORAGE SECTION. COPY QUSEC OF QSYSINC-QCBLLESRC. COPY QWCATTR OF QSYSINC-QCBLLESRC. 01 Receiver. 05 Bytes-Returned PIC S9(9) BINARY. 05 Bytes-Available PIC S9(9) BINARY. 01 Memory-Pointer POINTER. 01 Stack-Pointer POINTER. 01 My-Name PIC X(10). LINKAGE SECTION. COPY QWVRCSTK OF QSYSINC-QCBLLESRC. PROCEDURE DIVISION. MAIN-LINE. MOVE 0 TO Bytes-Provided OF QUS-EC. PERFORM Get-Caller THRU Exit-Get-Caller. STOP RUN. Get-Caller. * Find out how much information is available * First initialize the Job Information structure MOVE LOW-VALUES TO QWC-JIDF0100. MOVE "*" TO JOB-NAME OF QWC-JIDF0100. MOVE SPACES TO USER-NAME OF QWC-JIDF0100. MOVE SPACES TO JOB-NUMBER OF QWC-JIDF0100. MOVE SPACES TO INT-JOB-ID OF QWC-JIDF0100. MOVE 1 TO THREAD-INDICATOR OF QWC-JIDF0100. * Then call the API CALL "QWVRCSTK" USING BY REFERENCE Receiver, BY CONTENT LENGTH OF Receiver, BY CONTENT "CSTK0100", BY REFERENCE QWC-JIDF0100, BY CONTENT "JIDF0100", BY REFERENCE QUS-EC. * Allocate enough memory for the information CALL LINKAGE PRC "malloc" USING BY VALUE Bytes-Available OF Receiver RETURNING Memory-Pointer. SET ADDRESS OF QWV-CSTK0100 TO Memory-Pointer. * Now get the information CALL "QWVRCSTK" USING BY REFERENCE QWV-CSTK0100, BY CONTENT Bytes-Available OF Receiver, BY CONTENT "CSTK0100", BY REFERENCE QWC-JIDF0100, BY CONTENT "JIDF0100", BY REFERENCE QUS-EC. * Not available for some reason? IF ENTRY-AVAILABLE OF QWV-CSTK0100 = 0 DISPLAY "Major problem accessing call stack" ELSE * Display the program name SET Stack-Pointer TO Memory-Pointer SET Stack-Pointer UP BY ENTRY-OFFSET OF QWV-CSTK0100 SET ADDRESS OF QWV-RCSTK-ENTRY TO Stack-Pointer MOVE PROGRAM-NAME OF QWV-RCSTK-ENTRY TO My-Name PERFORM TEST AFTER UNTIL PROGRAM-NAME OF QWV-RCSTK-ENTRY NOT EQUAL My-Name SET Stack-Pointer UP BY ENTRY-LENGTH OF QWV-RCSTK-ENTRY SET ADDRESS OF QWV-RCSTK-ENTRY TO Stack-Pointer END-PERFORM DISPLAY "My caller is: " PROGRAM-NAME OF QWV-RCSTK-ENTRY END-IF. * Now free the allocated memory CALL LINKAGE PRC "free" USING BY VALUE Memory-Pointer. Exit-Get-Caller. </pre> The references to QSYSINC are to pull in system provided copybooks for APIs. If you don't have this library on your system you can install it as option 13 (System Openness Includes) of i5/OS. Hope this helps, Bruce Vining <a href="http://www.brucevining.com/">http://www.brucevining.com/</a>
Last Wiki Answer Submitted:  February 12, 2008  4:57 pm  by  bvining   6,055 pts.
All Answer Wiki Contributors:  bvining   6,055 pts.
To see all answers submitted to the Answer Wiki: View Answer History.


Discuss This Question:
_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _