Quantcast
Channel: IBM Mainframe Computers Forums
Viewing all articles
Browse latest Browse all 8500

COBOL Programming :: RE: How to get the program name of calling module in called prog

$
0
0
Author: Rohit Umarjikar
Posted: Mon Aug 01, 2016 9:39 pm (GMT 5.5)

This is what I found on internet, Retrieve Call Stack (QWVRCSTK) API.
Code:
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.

_________________
Regards,
Rohit Umarjikar
"Some things Man was never meant to know. For everything else, there's Google"


Viewing all articles
Browse latest Browse all 8500

Trending Articles