COBOL SUBROUTINES : FINDING OUT THE NAME OF THE CALLING PROGRAM.

70 pts.
Tags:
COBOL
Within COBOL, at execution time within a sub program, is there a way of knowing the name of the calling program ? Thanking you.
ASKED: February 11, 2008  1:14 PM
UPDATED: February 12, 2008  4:57 PM

Answer Wiki

Thanks. We'll let you know when a new response is added.

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>

Discuss This Question:  

 
There was an error processing your information. Please try again later.
Thanks. We'll let you know when a new response is added.
Send me notifications when members answer or reply to this question.

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy

Forgot Password

No problem! Submit your e-mail address below. We'll send you an e-mail containing your password.

Your password has been sent to:

To follow this tag...

There was an error processing your information. Please try again later.

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy

Thanks! We'll email you when relevant content is added and updated.

Following