|
View previous topic :: View next topic
|
| Author |
Message |
pkmurali
Warnings : 1
Active User
Joined: 15 Dec 2005
Posts: 271
|
|
|
|
Hi All,
I have a subroutine program(called module) program B static called by many programs. Since it is a maintenance project i dont have access to pass the calling module program through calling variables, is there anyway to get the calling program name without modifying the calling program?
Thanks
Murali |
|
| Back to top |
|
 |
Robert Sample
Global Moderator
Joined: 06 Jun 2008
Posts: 8696
Location: Dubuque, Iowa, USA
|
|
|
|
| There has been a SHARE requirement to access this information in Enterprise COBOL for a number of years, so yours is not the first request to do this. However, since the requirement exists, obviously it cannot currently be retrieved easily. |
|
| Back to top |
|
|
steve-myers
Active Member
Joined: 30 Nov 2013
Posts: 917
Location: The Universe
|
|
|
|
I can't think of a way to do this. You can try this.- Get a load module map of the module using JCL like this -
| Code: |
//A EXEC PGM=IMBLIST
//SYSPRINT DD SYSOUT=*
//SYSLIB DD DISP=SHR,DSN=--your load module library--
//SYSIN DD *
LISTLOAD OUTPUT=XREF,MEMBER=--your program's load module-- |
Part of this listing will look like this -
| Code: |
-------------------------------------------------------------------------------
LMOD LOC CSECT LOC IN CSECT REFERS TO SYMBOL AT LMOD LO
580 580 LOGTIME SMFETIME 690
584 584 LOGTIME LOGTMSGS 5C0 |
Look for your program in the REFERS TO SYMBOL AT LMOD column. The symbol in the IN CSECT column is usually (though not always) the calling program. Many compilers will put data (like the address of modules it is calling) in a CSECT separate from the program text. For example -
| Code: |
LMOD LOC CSECT LOC IN CSECT REFERS TO SYMBOL AT LMOD LOC
24 24 ICH408 ICH408D 2178
2675 4FD ICH408D ICH408 00
271C 5A4 ICH408D ICH408 00
2728 5B0 ICH408D ICH408 00
2734 5BC ICH408D ICH408 00
2740 5C8 ICH408D ICH408 00
274C 5D4 ICH408D ICH408 00
2758 5E0 ICH408D ICH408 00
2764 5EC ICH408D ICH408 00
27A8 630 ICH408D ICH408 00
27B4 63C ICH408D ICH408 00
28F0 778 ICH408D MINIFMT 16E8
2954 7DC ICH408D ICH408 00
2994 81C ICH408D QSORTL 15D0 |
Figuring out relations in this kind of structure is doable, though painful. |
|
| Back to top |
|
|
Akatsukami
Global Moderator
Joined: 03 Oct 2009
Posts: 1788
Location: Bloomington, IL
|
|
|
|
You'll have to chase control blocks for it. I wrote a callable module that did this for my last client, but
- I'm not at that client any more and therefore don't have access to that code, and
- it was in PL/I
I'll try to remember the sequence of control blocks tomorrow. |
|
| Back to top |
|
|
Bill Woodger
Moderator Emeritus
Joined: 09 Mar 2011
Posts: 7309
Location: Inside the Matrix
|
|
|
|
It's been discussed before. Here, and the links within.
It is not a good idea to use this to control program logic. What do you want the program name for? |
|
| Back to top |
|
|
Rohit Umarjikar
Global Moderator
Joined: 21 Sep 2010
Posts: 3051
Location: NYC,USA
|
|
| Back to top |
|
|
Rohit Umarjikar
Global Moderator
Joined: 21 Sep 2010
Posts: 3051
Location: NYC,USA
|
|
|
|
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. |
|
|
| Back to top |
|
|
Bill Woodger
Moderator Emeritus
Joined: 09 Mar 2011
Posts: 7309
Location: Inside the Matrix
|
|
|
|
Rohit,
That program is for iSeries again.
The CEEBINT is possible, but it is a bit blunt. There's discussion of it in another topic here, which the search should find. If COBOL can be calling CEEBINT, the exit cannot be written in COBOL (but an be PL/I, C/C++, Assembler). |
|
| Back to top |
|
|
Rohit Umarjikar
Global Moderator
Joined: 21 Sep 2010
Posts: 3051
Location: NYC,USA
|
|
|
|
| Thanks Bill. I never require to work on that but good to know. |
|
| Back to top |
|
|
|
|
