Guest_imported
New member
- Jan 1, 1970
- 0
I am looking for a way to find out calling program name while control
is in the called program in batch mode.
is in the called program in batch mode.
Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations wOOdy-Soft on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
calling a program 1
- Thread starter Guest_imported
- Start date
- Status
Greenguy71
Programmer
Is this a one time deal, or is it a necessity for every calling module during your batch run? Adding a parm to pass the callers name could be one way to go about this, or, to find out who is calling the module in a specific situation, force the module to abend and look at the calling chain in the dump.
May need a little more information to go on in order to provide better help. Thanks,
s-)
May need a little more information to go on in order to provide better help. Thanks,
s-)
- Thread starter
- #3
Guest_imported
New member
- Jan 1, 1970
- 0
I need to identify calling program name each time it calls the submodule, something
similar to CICS command ASSIGN INVOKINGPROG (XXXXXXXX). Passing a parm
from calling program is not an option.
Thank you.
similar to CICS command ASSIGN INVOKINGPROG (XXXXXXXX). Passing a parm
from calling program is not an option.
Thank you.
-
1
- #4
Hi Viz,
If you want to code this feature into your subpgm you'll have to access system control blocks, and this will depend on what your hardware/software configuration is and, most importantly, what COBOL compiler/version you're using.
If you have the flexibility to do it, Greenguy's suggestion of passing the pgm name is the simplest solution.
Good Luck, Jack.
If you want to code this feature into your subpgm you'll have to access system control blocks, and this will depend on what your hardware/software configuration is and, most importantly, what COBOL compiler/version you're using.
If you have the flexibility to do it, Greenguy's suggestion of passing the pgm name is the simplest solution.
Good Luck, Jack.
Hi Viz,
Your reply slipped in before I sent my post. It sounds like you're running in a mainframe environment. Does the compiler you're using support the PROCEDURE POINTER facility? Let me know; if it does there should be a relatively simple solution.
Jack
Your reply slipped in before I sent my post. It sounds like you're running in a mainframe environment. Does the compiler you're using support the PROCEDURE POINTER facility? Let me know; if it does there should be a relatively simple solution.
Jack
- Thread starter
- #6
Guest_imported
New member
- Jan 1, 1970
- 0
Jack,
Yes, our compiler supports procedure pointer facility.
Yes, our compiler supports procedure pointer facility.
Hi Vis,
Couldn't sleep, so I thought I'd give this a go.
OK, you want to get the caller's pgm name.
One caveat before I start: this hasn't been tested, but it should work. I'll give you a plain English overview (well English anyway) and then a sort of pseudo pseudo code. If you have any ques, you know where I live.
The initialization code of a cobol pgm contains, among other things, its pgm name and its TGT address. The first 72 bytes of the TGT contain the register save area for the pgm. You want the pgm name of your caller, so we have to back chain to your caller’s caller register save area (in most cases an MVS module). Then we can use the register 15 save to get the entry point address of your caller. Five bytes from there is the 8 byte pgm name you’re looking for. That's for COBOLII, for VS/COBOL its 12 bytes. Now for the code.
As the song goes Oops, there it is. I've got a pgm that bounces around The MVS control blocks that may help in understanding the pointer facility and how it can be used to find system data. If you want it send me your e-mail addr. And remember, when going thru the code above, it's 5AM.
Good luck, Jack.
Couldn't sleep, so I thought I'd give this a go.
OK, you want to get the caller's pgm name.
One caveat before I start: this hasn't been tested, but it should work. I'll give you a plain English overview (well English anyway) and then a sort of pseudo pseudo code. If you have any ques, you know where I live.
The initialization code of a cobol pgm contains, among other things, its pgm name and its TGT address. The first 72 bytes of the TGT contain the register save area for the pgm. You want the pgm name of your caller, so we have to back chain to your caller’s caller register save area (in most cases an MVS module). Then we can use the register 15 save to get the entry point address of your caller. Five bytes from there is the 8 byte pgm name you’re looking for. That's for COBOLII, for VS/COBOL its 12 bytes. Now for the code.
Code:
ID DIV. PROGRAM-ID. MYPGMNM.
DATA DIV.
WS SECT.
01 ws-ptr-my-ep pointer.
LINK SECT.
01 lk-init-area.
05 filler pic x(005).
05 lk-init-pgm-name pic x(008).
05 filler pic x(079).
05 lk-init-tgt-ptr pointer.
01 lk-tgt-area.
05 lk-tgt-reg-save-area.
10 filler pic x(004).
10 lk-reg-save-area-ptr
pointer.
10 filler pic x(008).
10 lk-tgt-ep-ptr pointer.
P DIV.
set procedure-pointer ws-ptr-my-ep entry 'mypgmnm'
set address of lk-tgt-area to lk-init-tgt-ptr
****tgt area is now addressable
set address of lk-tgt-area to lk-reg-save-area-ptr
****lk-tgt-save-area now points to caller’s save area
set address of lk-tgt-area to lk-reg-save-area-ptr
****lk-tgt-save-area now points to caller’s caller save area
set address of lk-init-area to lk-tgt-ep-ptr
****lk-init-area now points to caller’s pgm
move lk-init-pgm-name to ws-your-name-save
****caller’s pgm now savedAs the song goes Oops, there it is. I've got a pgm that bounces around The MVS control blocks that may help in understanding the pointer facility and how it can be used to find system data. If you want it send me your e-mail addr. And remember, when going thru the code above, it's 5AM.
Good luck, Jack.
Viz,
I left out a statement that should go after the "set procedure pointer" statement. I'm enclosing the rewritten code below. I warned you it was 5AM.
Jack
I left out a statement that should go after the "set procedure pointer" statement. I'm enclosing the rewritten code below. I warned you it was 5AM.
Jack
Code:
ID DIV. PROGRAM-ID. MYPGMNM.
DATA DIV.
WS SECT.
01 ws-ptr-my-ep pointer.
LINK SECT.
01 lk-init-area.
05 filler pic x(005).
05 lk-init-pgm-name pic x(008).
05 filler pic x(079).
05 lk-init-tgt-ptr pointer.
01 lk-tgt-area.
05 lk-tgt-reg-save-area.
10 filler pic x(004).
10 lk-reg-save-area-ptr
pointer.
10 filler pic x(008).
10 lk-tgt-ep-ptr pointer.
P DIV.
set procedure-pointer ws-ptr-my-ep entry 'mypgmnm'
set address of lk-init-area to ws-ptr-my-ep
set address of lk-tgt-area to lk-init-tgt-ptr
****tgt area is now addressable
set address of lk-tgt-area to lk-reg-save-area-ptr
****lk-tgt-save-area now points to caller’s save area
set address of lk-tgt-area to lk-reg-save-area-ptr
****lk-tgt-save-area now points to caller’s caller save area
set address of lk-init-area to lk-tgt-ep-ptr
****lk-init-area now points to caller’s pgm
move lk-init-pgm-name to ws-your-name-save
****caller’s pgm now saved- Thread starter
- #9
Greenguy71
Programmer
Jack,
I am trying to get the code you suggested above to work, and am running into a few problems along the way. Could you please provide a little more information, specifically with regards to the first line of code:
Procedure-pointer, as well as entry, are giving me fits........
Thanks alot!!!! Thanks,
s-)
I am trying to get the code you suggested above to work, and am running into a few problems along the way. Could you please provide a little more information, specifically with regards to the first line of code:
Code:
set procedure-pointer ws-ptr-my-ep entry 'mypgmnm'Procedure-pointer, as well as entry, are giving me fits........
Thanks alot!!!! Thanks,
s-)
Greenguy71
Programmer
Jack,
As far as providing the code goes, I am using exactly what you gave above. I set up a five level call chain of programs that do nothing more than display their name and call the next one....until I get to the 5th module. That is where I plugged your exact code in and am trying to get my back chain of programs to be displayed.
I set up this simple test scenario to see if I could in fact get your code to work, and if so, I will use it to solve an existing business problem. The errors from my compiler are given below:
The only change that I made to your code was to insert "cobol5" where you had "mypgmnm", and displaying the callers program name rather than moving it to a hold field.
Thanks again for your time. Thanks,
s-)
As far as providing the code goes, I am using exactly what you gave above. I set up a five level call chain of programs that do nothing more than display their name and call the next one....until I get to the 5th module. That is where I plugged your exact code in and am trying to get my back chain of programs to be displayed.
I set up this simple test scenario to see if I could in fact get your code to work, and if so, I will use it to solve an existing business problem. The errors from my compiler are given below:
Code:
PP 5668-958 IBM VS COBOL II RELEASE 4.0 IN PROGRESS ...
LINEID MESSAGE CODE MESSAGE TEXT
114 IGYPS2121-S "PROCEDURE-POINTER" WAS NOT DEFINED AS A DATA-NAME. THE STATEMENT WAS DISCARDED.
114 IGYPS2106-S "ENTRY" WAS FOUND IN THE "SET" STATEMENT. THE STATEMENT WAS DISCARDED.
114 IGYPS0037-S "COBOL5" WAS NOT A UNIQUELY DEFINED NAME. THE DEFINITION TO BE USED COULD NOT BE DETERMINED FROM THE CONTEXT. THE REFERENCE TO THE NAME WAS DISCARDED.
MESSAGES TOTAL INFORMATIONAL WARNING ERROR SEVERE TERMINATING
PRINTED: 3 3
SUPPRESSED: 1 1
END OF COMPILATION 1, PROGRAM COBOL5, HIGHEST SEVERITY 12.
RETURN CODE 12Thanks again for your time. Thanks,
s-)
Greenguy71
Programmer
Ah......Thanks, I will try that.
No I was not, this has just been a sort of "when I feel like it" project. If if fact it does work, it is very slick! Thanks again! Thanks,
s-)
No I was not, this has just been a sort of "when I feel like it" project. If if fact it does work, it is very slick! Thanks again! Thanks,
s-)
Greenguy71
Programmer
Darn, shoot, gosh, heck!
Ok, still getting compile errors. Entry does not seem to be a cobol defined word in this context. It also does not like the program name reference. My cobol statements are as follows, and again I named the program cobol5:
And the compile errors returned are:
I am really sorry to bother you again, hopefully you are not getting to fed up! Thanks,
s-)
Ok, still getting compile errors. Entry does not seem to be a cobol defined word in this context. It also does not like the program name reference. My cobol statements are as follows, and again I named the program cobol5:
Code:
0000-MAINLINE.
DISPLAY 'NOW ENTERING COBOL5'.
SET WS-PTR-MY-EP TO ENTRY 'COBOL5'.
SET ADDRESS OF LK-INIT-AREA TO WS-PTR-MY-EP.
SET ADDRESS OF LK-TGT-AREA TO LK-INIT-TGT-PTR.
* ****TGT AREA IS NOW ADDRESSABLE
SET ADDRESS OF LK-TGT-AREA TO LK-REG-SAVE-AREA-PTR.
* ****LK-TGT-SAVE-AREA NOW POINTS TO CALLERS SAVE AREA
SET ADDRESS OF LK-TGT-AREA TO LK-REG-SAVE-AREA-PTR.
* ****LK-TGT-SAVE-AREA NOW POINTS TO CALLERS CALLER SAVE AREA
SET ADDRESS OF LK-INIT-AREA TO LK-TGT-EP-PTR.
* ****LK-INIT-AREA NOW POINTS TO CALLERS PGM
* MOVE LK-INIT-PGM-NAME TO WS-YOUR-NAME-SAVE.
DISPLAY 'LK-INIT-PGM-NAME OF CALLER IS '
LK-INIT-PGM-NAME.
* ****CALLERS PGM NOW SAVED
DISPLAY 'NOW RETURNING TO COBOL5'.
0000-EXIT.
GOBACK.
Code:
PP 5668-958 IBM VS COBOL II RELEASE 4.0 IN PROGRESS ...
LINEID MESSAGE CODE MESSAGE TEXT
116 IGYPS2106-S "ENTRY" WAS FOUND IN THE "SET" STATEMENT. THE STATEMENT
WAS DISCARDED.
116 IGYPS0037-S "COBOL5" WAS NOT A UNIQUELY DEFINED NAME. THE DEFINITION
TO BE USED COULD NOT BE DETERMINED FROM THE CONTEXT. THE
REFERENCE TO THE NAME WAS DISCARDED.
MESSAGES TOTAL INFORMATIONAL WARNING ERROR SEVERE TERMINATING
PRINTED: 2 2
SUPPRESSED: 1 1
END OF COMPILATION 1, PROGRAM COBOL5, HIGHEST SEVERITY 12.
RETURN CODE 12s-)
Hi GG,
Didn't notice this in your previous post. COBOLII doesn't support procedure pointers. I know LE/COBOL for MVS and VM
(they keep changing the name of COBOL/370) supports it. You
might check w/your sysprogs; they may have it laying around,
IBM is dropping COBOLII support very soon. Thanx for finding that error of mine though.
Thanx, Jack.
P.S. Don't worry about bothering me; whatever it takes.
Didn't notice this in your previous post. COBOLII doesn't support procedure pointers. I know LE/COBOL for MVS and VM
(they keep changing the name of COBOL/370) supports it. You
might check w/your sysprogs; they may have it laying around,
IBM is dropping COBOLII support very soon. Thanx for finding that error of mine though.
Thanx, Jack.
P.S. Don't worry about bothering me; whatever it takes.
Hi GG,
I'm enclosing some code I used to provide run info
in a VSCOBOL/COBOLII environment.
Look at the code commented:
*===> SET UP PGM NAME FOR DISPLAY
If you eliminate the PERFORM and execute
SET ADDRESS OF LK-CDE TO LK-PREV-CDE-ADDR
only once, I think that will give you the pgm name
of the caller.
Scan the code and decide what parts of it you need
to get to the caller's pgm name.
You might want to test both a static and a dynamic
call to your pgm. I was using a static call.
Hope this helps, Jack.
P.S. Let me know how you make out. Code follows.
I'm enclosing some code I used to provide run info
in a VSCOBOL/COBOLII environment.
Look at the code commented:
*===> SET UP PGM NAME FOR DISPLAY
If you eliminate the PERFORM and execute
SET ADDRESS OF LK-CDE TO LK-PREV-CDE-ADDR
only once, I think that will give you the pgm name
of the caller.
Scan the code and decide what parts of it you need
to get to the caller's pgm name.
You might want to test both a static and a dynamic
call to your pgm. I was using a static call.
Hope this helps, Jack.
P.S. Let me know how you make out. Code follows.
Code:
IDENTIFICATION DIVISION.
PROGRAM-ID. RUNINFO.
AUTHOR. JACK SLEIGHT.
ENVIRONMENT DIVISION.
*****************************************************************
* DISPLAYS THE FOLLOWING RUN INFO FOR THE CALLING PROGRAM: *
* *
* * PGM/JOB/JOBSTEP/PROCSTEP NAMES *
* * ENTRY/LOAD/END POINTS AND LENGTH OF PROGRAM *
* *
* FOR COBOL II PROGRAMS ALSO DISPLAYS 4 BYTES OF HEX INDICAT- *
* ORS SHOWING THE COMPILE OPTIONS SELECTED AT COMPILE TIME. *
*****************************************************************
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
DATA DIVISION.
FILE SECTION.
*****************************************************************
WORKING-STORAGE SECTION.
*****************************************************************
01 WS-TCB-ADDR-01.
10 WS-TCB-ADDR POINTER.
01 WS-CVT-ADDR-01.
10 WS-CVT-ADDR POINTER.
*****************************************************************
01 WS-DISPLAY-FIELDS.
*****************************************************************
10 WS-PN-DISPLAY PIC X(008).
10 WS-STEP-DISPLAY.
20 WS-JSTP-NAME PIC X(008) VALUE "NOT USED".
20 FILLER PIC X(001) VALUE "/".
20 WS-PSTP-NAME PIC X(008) VALUE "NOT USED".
10 WS-CTYPE-DISPLAY PIC X(002).
10 WS-CREL-DISPLAY PIC X(005).
10 WS-CTIME-DISPLAY PIC X(008).
10 WS-OPTBYTE-DISPLAY PIC X(008).
10 WS-CDATE-DISPLAY PIC X(012).
10 REDEFINES WS-CDATE-DISPLAY.
15 WS-CDATE-DISPLAY-RED.
20 WS-VSMO-DAY-DISPLAY PIC X(008).
20 WS-VSYEAR-DISPLAY PIC X(004).
10 WS-EP-DISPLAY PIC X(008).
10 WS-LP-DISPLAY PIC X(008).
10 WS-FP-DISPLAY PIC X(008).
10 WS-LEN-DISPLAY PIC X(008).
*****************************************************************
01 WS-WORK-FIELDS.
*****************************************************************
05 WS-ZERO PIC 9(009) VALUE 0 COMP.
05 WS-WORK-FP PIC 9(009) COMP.
05 WS-WORK-PACKED PIC 9(009) COMP-3.
05 REDEFINES WS-WORK-PACKED.
10 WS-WORK-X5.
20 WS-WORK-X1 PIC X(001).
20 WS-WORK-X3 PIC X(003).
05 REDEFINES WS-WORK-PACKED.
10 WS-WORK-BIN4 PIC 9(009) COMP.
05 WS-WORK-UNPACKED PIC 9(009).
05 REDEFINES WS-WORK-UNPACKED.
10 WS-WORK-UNPACKED-8 PIC 9(008).
1 /
*****************************************************************
LINKAGE SECTION.
*****************************************************************
01 LK-TCB-ADDR POINTER.
*---------------------------------------------------------------
*===> T A S K C O N T R O L B L O C K
*---------------------------------------------------------------
01 LK-TCB.
10 FILLER PIC X(012).
10 LK-TIOT-ADDR POINTER.
10 FILLER PIC X(028).
10 LK-LAST-CDE-ADDR POINTER.
*---------------------------------------------------------------
*===> T A S K I/O T A B L E
*---------------------------------------------------------------
01 LK-TIOT.
10 LK-JOB-NAME PIC X(008).
10 LK-JSTP-NAME PIC X(008).
10 LK-PSTP-NAME PIC X(008).
*---------------------------------------------------------------
*===> C O N T E N T S D I R E C T O R Y E N T R Y
*---------------------------------------------------------------
01 LK-CDE.
10 LK-PREV-CDE-ADDR POINTER.
10 FILLER PIC X(004).
10 LK-PGM-NAME PIC X(008).
10 LK-EP-ADDR PIC X(004).
10 LK-EXTENT-LST-ADDR POINTER.
*---------------------------------------------------------------
*===> E X T E N T L I S T
*---------------------------------------------------------------
01 LK-EXTENT-LST.
10 FILLER PIC X(009).
10 LK-PGM-LEN PIC X(003).
10 LK-LP-ADDR PIC X(004).
10 REDEFINES LK-LP-ADDR.
15 LK-LP-ADDR-BIN PIC 9(009) COMP.
10 REDEFINES LK-LP-ADDR.
15 LK-LP-ADDR-PTR POINTER.
*****************************************************************
01 LK-COMPILER-INFO.
*****************************************************************
05 LK-VSCOB-INFO.
10 FILLER PIC X(020).
10 LK-TYPE-VS PIC X(002).
88 LK-VSCOBOL VALUE "VS".
10 FILLER PIC X(001).
10 LK-VSREL-NBR PIC X(001).
10 FILLER PIC X(112).
10 LK-VSTIME PIC X(008).
10 LK-VSMO-DAY PIC X(008).
10 LK-VSYEAR PIC X(004).
05 REDEFINES LK-VSCOB-INFO.
10 LK-COBII-INFO.
20 FILLER PIC X(014).
20 LK-TYPE-II PIC X(002).
20 FILLER PIC X(001).
20 LK-IIREL-NBR PIC X(006).
20 LK-IIMON-DAY-YR PIC X(009).
20 LK-IITIME PIC X(008).
20 FILLER PIC X(004).
20 LK-IIOPT-BYTES PIC X(004).
1 /
*****************************************************************
PROCEDURE DIVISION.
*****************************************************************
000-MAINLINE.
*---------------------------------------------------------------
*===> ESTABLISH ADDRESSABILITY FOR TIOT
*---------------------------------------------------------------
MOVE X"0000021C" TO WS-TCB-ADDR-01
SET ADDRESS OF LK-TCB-ADDR TO WS-TCB-ADDR
SET ADDRESS OF LK-TCB TO LK-TCB-ADDR
SET ADDRESS OF LK-TIOT TO LK-TIOT-ADDR
*---------------------------------------------------------------
*===> SET UP STEP NAMES FOR DISPLAY
*---------------------------------------------------------------
IF LK-JSTP-NAME = SPACES
AND
LK-PSTP-NAME = SPACES
GO TO 000-CONTINUE
END-IF
IF LK-PSTP-NAME = SPACES
MOVE LK-JSTP-NAME TO WS-JSTP-NAME
ELSE
MOVE LK-PSTP-NAME TO WS-JSTP-NAME
MOVE LK-JSTP-NAME TO WS-PSTP-NAME
END-IF
.
000-CONTINUE.
*---------------------------------------------------------------
*===> SET UP PGM NAME FOR DISPLAY
*---------------------------------------------------------------
SET ADDRESS OF LK-CDE TO LK-LAST-CDE-ADDR
PERFORM WITH TEST BEFORE UNTIL LK-PREV-CDE-ADDR = NULLS
SET ADDRESS OF LK-CDE TO LK-PREV-CDE-ADDR
END-PERFORM
MOVE LK-PGM-NAME TO WS-PN-DISPLAY
*---------------------------------------------------------------
*===> SET UP ENTRY POINT ADDR FOR DISPLAY
*---------------------------------------------------------------
MOVE LK-EP-ADDR TO WS-WORK-X5
PERFORM 100-CONVERT-HEX-DATA
MOVE WS-WORK-UNPACKED-8 TO WS-EP-DISPLAY
*---------------------------------------------------------------
*===> SET UP LOAD POINT ADDR FOR DISPLAY
*---------------------------------------------------------------
SET ADDRESS OF LK-EXTENT-LST TO LK-EXTENT-LST-ADDR
MOVE LK-LP-ADDR TO WS-WORK-X5
PERFORM 100-CONVERT-HEX-DATA
MOVE WS-WORK-UNPACKED-8 TO WS-LP-DISPLAY
*---------------------------------------------------------------
*===> SET UP PGM LENGTH FOR DISPLAY
*---------------------------------------------------------------
MOVE X"00" TO WS-WORK-X1
MOVE LK-PGM-LEN TO WS-WORK-X3
PERFORM 100-CONVERT-HEX-DATA
MOVE WS-WORK-UNPACKED-8 TO WS-LEN-DISPLAY
*---------------------------------------------------------------
*===> SET UP PGM END POINT ADDR FOR DISPLAY
*---------------------------------------------------------------
COMPUTE
WS-WORK-FP = LK-LP-ADDR-BIN + (WS-WORK-BIN4 - 1)
MOVE WS-WORK-FP TO WS-WORK-X5
PERFORM 100-CONVERT-HEX-DATA
MOVE WS-WORK-UNPACKED-8 TO WS-FP-DISPLAY
*---------------------------------------------------------------
*===> SET UP COMPILER INFORMATION FOR DISPLAY
*---------------------------------------------------------------
SET ADDRESS OF LK-COMPILER-INFO TO LK-LP-ADDR-PTR
IF LK-TYPE-VS = "VS"
MOVE SPACES TO WS-CTYPE-DISPLAY
MOVE LK-VSREL-NBR TO WS-CREL-DISPLAY
MOVE LK-VSTIME TO WS-CTIME-DISPLAY
MOVE LK-VSMO-DAY TO WS-VSMO-DAY-DISPLAY
MOVE LK-VSYEAR TO WS-VSYEAR-DISPLAY
ELSE
* IF LK-TYPE-II = "C2"
MOVE "II" TO WS-CTYPE-DISPLAY
MOVE LK-IIREL-NBR TO WS-CREL-DISPLAY
MOVE LK-IITIME TO WS-CTIME-DISPLAY
MOVE LK-IIMON-DAY-YR TO WS-CDATE-DISPLAY
END-IF
DISPLAY " "
*---------------------------------------------------------------
*===> DISPLAY ALL INFORMATION PREVIOUSLY SET UP
*---------------------------------------------------------------
DISPLAY "*****************************"
"**************************************************"
DISPLAY " PROGRAM " WS-PN-DISPLAY
" RUN FROM JOB " LK-JOB-NAME
" IN STEP/PROCSTEP ===> " WS-STEP-DISPLAY
DISPLAY " COMPILED UNDER VSCOBOL" WS-CTYPE-DISPLAY
" REL " WS-CREL-DISPLAY
" AT " WS-CTIME-DISPLAY
" ON " WS-CDATE-DISPLAY
*---------------------------------------------------------------
*===> DISPLAY COBOL II OPTION BITS
*---------------------------------------------------------------
IF NOT LK-VSCOBOL DISPLAY " "
MOVE LK-IIOPT-BYTES TO WS-WORK-X5
PERFORM 100-CONVERT-HEX-DATA
MOVE WS-WORK-UNPACKED-8 TO WS-OPTBYTE-DISPLAY
DISPLAY " INDICATORS FOR COMPILER OPTIONS IN EFFECT ==> "
WS-OPTBYTE-DISPLAY
END-IF
DISPLAY " "
DISPLAY " " "ENTRY POINT " WS-EP-DISPLAY
DISPLAY " " " LOAD POINT " WS-LP-DISPLAY
DISPLAY " " " END POINT " WS-FP-DISPLAY
DISPLAY " " " LENGTH " WS-LEN-DISPLAY
DISPLAY "*****************************"
"**************************************************"
DISPLAY " "
****************************************************************
* USED TO FORCE A DUMP AT EOJ
*---------------------------------------------------------------
* COMPUTE WS-WORK-BIN4 = WS-WORK-BIN4 / WS-ZERO
****************************************************************
GOBACK
.
100-CONVERT-HEX-DATA.
*---------------------------------------------------------------
*===> CONVERTS HEX DATA FOR DISPLAY PURPOSES
* E.G. X"04FB" ====> X"F0F4C6C2" OR 04FB CHARACTER
*---------------------------------------------------------------
MOVE WS-WORK-PACKED TO WS-WORK-UNPACKED
INSPECT WS-WORK-UNPACKED CONVERTING
X"FAFBFCFDFEFF" TO "ABCDEF"
.
IDENTIFICATION DIVISION.
PROGRAM-ID. RUNINFO.
AUTHOR. JACK SLEIGHT.
ENVIRONMENT DIVISION.
*****************************************************************
* DISPLAYS THE FOLLOWING RUN INFO FOR THE CALLING PROGRAM: *
* *
* * PGM/JOB/JOBSTEP/PROCSTEP NAMES *
* * ENTRY/LOAD/END POINTS AND LENGTH OF PROGRAM *
* *
* FOR COBOL II PROGRAMS ALSO DISPLAYS 4 BYTES OF HEX INDICAT- *
* ORS SHOWING THE COMPILE OPTIONS SELECTED AT COMPILE TIME. *
*****************************************************************
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
DATA DIVISION.
FILE SECTION.
*****************************************************************
WORKING-STORAGE SECTION.
*****************************************************************
01 WS-TCB-ADDR-01.
10 WS-TCB-ADDR POINTER.
01 WS-CVT-ADDR-01.
10 WS-CVT-ADDR POINTER.
*****************************************************************
01 WS-DISPLAY-FIELDS.
*****************************************************************
10 WS-PN-DISPLAY PIC X(008).
10 WS-STEP-DISPLAY.
20 WS-JSTP-NAME PIC X(008) VALUE "NOT USED".
20 FILLER PIC X(001) VALUE "/".
20 WS-PSTP-NAME PIC X(008) VALUE "NOT USED".
10 WS-CTYPE-DISPLAY PIC X(002).
10 WS-CREL-DISPLAY PIC X(005).
10 WS-CTIME-DISPLAY PIC X(008).
10 WS-OPTBYTE-DISPLAY PIC X(008).
10 WS-CDATE-DISPLAY PIC X(012).
10 REDEFINES WS-CDATE-DISPLAY.
15 WS-CDATE-DISPLAY-RED.
20 WS-VSMO-DAY-DISPLAY PIC X(008).
20 WS-VSYEAR-DISPLAY PIC X(004).
10 WS-EP-DISPLAY PIC X(008).
10 WS-LP-DISPLAY PIC X(008).
10 WS-FP-DISPLAY PIC X(008).
10 WS-LEN-DISPLAY PIC X(008).
*****************************************************************
01 WS-WORK-FIELDS.
*****************************************************************
05 WS-ZERO PIC 9(009) VALUE 0 COMP.
05 WS-WORK-FP PIC 9(009) COMP.
05 WS-WORK-PACKED PIC 9(009) COMP-3.
05 REDEFINES WS-WORK-PACKED.
10 WS-WORK-X5.
20 WS-WORK-X1 PIC X(001).
20 WS-WORK-X3 PIC X(003).
05 REDEFINES WS-WORK-PACKED.
10 WS-WORK-BIN4 PIC 9(009) COMP.
05 WS-WORK-UNPACKED PIC 9(009).
05 REDEFINES WS-WORK-UNPACKED.
10 WS-WORK-UNPACKED-8 PIC 9(008).
1 /
*****************************************************************
LINKAGE SECTION.
*****************************************************************
01 LK-TCB-ADDR POINTER.
*---------------------------------------------------------------
*===> T A S K C O N T R O L B L O C K
*---------------------------------------------------------------
01 LK-TCB.
10 FILLER PIC X(012).
10 LK-TIOT-ADDR POINTER.
10 FILLER PIC X(028).
10 LK-LAST-CDE-ADDR POINTER.
*---------------------------------------------------------------
*===> T A S K I/O T A B L E
*---------------------------------------------------------------
01 LK-TIOT.
10 LK-JOB-NAME PIC X(008).
10 LK-JSTP-NAME PIC X(008).
10 LK-PSTP-NAME PIC X(008).
*---------------------------------------------------------------
*===> C O N T E N T S D I R E C T O R Y E N T R Y
*---------------------------------------------------------------
01 LK-CDE.
10 LK-PREV-CDE-ADDR POINTER.
10 FILLER PIC X(004).
10 LK-PGM-NAME PIC X(008).
10 LK-EP-ADDR PIC X(004).
10 LK-EXTENT-LST-ADDR POINTER.
*---------------------------------------------------------------
*===> E X T E N T L I S T
*---------------------------------------------------------------
01 LK-EXTENT-LST.
10 FILLER PIC X(009).
10 LK-PGM-LEN PIC X(003).
10 LK-LP-ADDR PIC X(004).
10 REDEFINES LK-LP-ADDR.
15 LK-LP-ADDR-BIN PIC 9(009) COMP.
10 REDEFINES LK-LP-ADDR.
15 LK-LP-ADDR-PTR POINTER.
*****************************************************************
01 LK-COMPILER-INFO.
*****************************************************************
05 LK-VSCOB-INFO.
10 FILLER PIC X(020).
10 LK-TYPE-VS PIC X(002).
88 LK-VSCOBOL VALUE "VS".
10 FILLER PIC X(001).
10 LK-VSREL-NBR PIC X(001).
10 FILLER PIC X(112).
10 LK-VSTIME PIC X(008).
10 LK-VSMO-DAY PIC X(008).
10 LK-VSYEAR PIC X(004).
05 REDEFINES LK-VSCOB-INFO.
10 LK-COBII-INFO.
20 FILLER PIC X(014).
20 LK-TYPE-II PIC X(002).
20 FILLER PIC X(001).
20 LK-IIREL-NBR PIC X(006).
20 LK-IIMON-DAY-YR PIC X(009).
20 LK-IITIME PIC X(008).
20 FILLER PIC X(004).
20 LK-IIOPT-BYTES PIC X(004).
1 /
*****************************************************************
PROCEDURE DIVISION.
*****************************************************************
000-MAINLINE.
*---------------------------------------------------------------
*===> ESTABLISH ADDRESSABILITY FOR TIOT
*---------------------------------------------------------------
MOVE X"0000021C" TO WS-TCB-ADDR-01
SET ADDRESS OF LK-TCB-ADDR TO WS-TCB-ADDR
SET ADDRESS OF LK-TCB TO LK-TCB-ADDR
SET ADDRESS OF LK-TIOT TO LK-TIOT-ADDR
*---------------------------------------------------------------
*===> SET UP STEP NAMES FOR DISPLAY
*---------------------------------------------------------------
IF LK-JSTP-NAME = SPACES
AND
LK-PSTP-NAME = SPACES
GO TO 000-CONTINUE
END-IF
IF LK-PSTP-NAME = SPACES
MOVE LK-JSTP-NAME TO WS-JSTP-NAME
ELSE
MOVE LK-PSTP-NAME TO WS-JSTP-NAME
MOVE LK-JSTP-NAME TO WS-PSTP-NAME
END-IF
.
000-CONTINUE.
*---------------------------------------------------------------
*===> SET UP PGM NAME FOR DISPLAY
*---------------------------------------------------------------
SET ADDRESS OF LK-CDE TO LK-LAST-CDE-ADDR
PERFORM WITH TEST BEFORE UNTIL LK-PREV-CDE-ADDR = NULLS
SET ADDRESS OF LK-CDE TO LK-PREV-CDE-ADDR
END-PERFORM
MOVE LK-PGM-NAME TO WS-PN-DISPLAY
*---------------------------------------------------------------
*===> SET UP ENTRY POINT ADDR FOR DISPLAY
*---------------------------------------------------------------
MOVE LK-EP-ADDR TO WS-WORK-X5
PERFORM 100-CONVERT-HEX-DATA
MOVE WS-WORK-UNPACKED-8 TO WS-EP-DISPLAY
*---------------------------------------------------------------
*===> SET UP LOAD POINT ADDR FOR DISPLAY
*---------------------------------------------------------------
SET ADDRESS OF LK-EXTENT-LST TO LK-EXTENT-LST-ADDR
MOVE LK-LP-ADDR TO WS-WORK-X5
PERFORM 100-CONVERT-HEX-DATA
MOVE WS-WORK-UNPACKED-8 TO WS-LP-DISPLAY
*---------------------------------------------------------------
*===> SET UP PGM LENGTH FOR DISPLAY
*---------------------------------------------------------------
MOVE X"00" TO WS-WORK-X1
MOVE LK-PGM-LEN TO WS-WORK-X3
PERFORM 100-CONVERT-HEX-DATA
MOVE WS-WORK-UNPACKED-8 TO WS-LEN-DISPLAY
*---------------------------------------------------------------
*===> SET UP PGM END POINT ADDR FOR DISPLAY
*---------------------------------------------------------------
COMPUTE
WS-WORK-FP = LK-LP-ADDR-BIN + (WS-WORK-BIN4 - 1)
MOVE WS-WORK-FP TO WS-WORK-X5
PERFORM 100-CONVERT-HEX-DATA
MOVE WS-WORK-UNPACKED-8 TO WS-FP-DISPLAY
*---------------------------------------------------------------
*===> SET UP COMPILER INFORMATION FOR DISPLAY
*---------------------------------------------------------------
SET ADDRESS OF LK-COMPILER-INFO TO LK-LP-ADDR-PTR
IF LK-TYPE-VS = "VS"
MOVE SPACES TO WS-CTYPE-DISPLAY
MOVE LK-VSREL-NBR TO WS-CREL-DISPLAY
MOVE LK-VSTIME TO WS-CTIME-DISPLAY
MOVE LK-VSMO-DAY TO WS-VSMO-DAY-DISPLAY
MOVE LK-VSYEAR TO WS-VSYEAR-DISPLAY
ELSE
* IF LK-TYPE-II = "C2"
MOVE "II" TO WS-CTYPE-DISPLAY
MOVE LK-IIREL-NBR TO WS-CREL-DISPLAY
MOVE LK-IITIME TO WS-CTIME-DISPLAY
MOVE LK-IIMON-DAY-YR TO WS-CDATE-DISPLAY
END-IF
DISPLAY " "
*---------------------------------------------------------------
*===> DISPLAY ALL INFORMATION PREVIOUSLY SET UP
*---------------------------------------------------------------
DISPLAY "*****************************"
"**************************************************"
DISPLAY " PROGRAM " WS-PN-DISPLAY
" RUN FROM JOB " LK-JOB-NAME
" IN STEP/PROCSTEP ===> " WS-STEP-DISPLAY
DISPLAY " COMPILED UNDER VSCOBOL" WS-CTYPE-DISPLAY
" REL " WS-CREL-DISPLAY
" AT " WS-CTIME-DISPLAY
" ON " WS-CDATE-DISPLAY
*---------------------------------------------------------------
*===> DISPLAY COBOL II OPTION BITS
*---------------------------------------------------------------
IF NOT LK-VSCOBOL DISPLAY " "
MOVE LK-IIOPT-BYTES TO WS-WORK-X5
PERFORM 100-CONVERT-HEX-DATA
MOVE WS-WORK-UNPACKED-8 TO WS-OPTBYTE-DISPLAY
DISPLAY " INDICATORS FOR COMPILER OPTIONS IN EFFECT ==> "
WS-OPTBYTE-DISPLAY
END-IF
DISPLAY " "
DISPLAY " " "ENTRY POINT " WS-EP-DISPLAY
DISPLAY " " " LOAD POINT " WS-LP-DISPLAY
DISPLAY " " " END POINT " WS-FP-DISPLAY
DISPLAY " " " LENGTH " WS-LEN-DISPLAY
DISPLAY "*****************************"
"**************************************************"
DISPLAY " "
****************************************************************
* USED TO FORCE A DUMP AT EOJ
*---------------------------------------------------------------
* COMPUTE WS-WORK-BIN4 = WS-WORK-BIN4 / WS-ZERO
****************************************************************
GOBACK
.
100-CONVERT-HEX-DATA.
*---------------------------------------------------------------
*===> CONVERTS HEX DATA FOR DISPLAY PURPOSES
* E.G. X"04FB" ====> X"F0F4C6C2" OR 04FB CHARACTER
*---------------------------------------------------------------
MOVE WS-WORK-PACKED TO WS-WORK-UNPACKED
INSPECT WS-WORK-UNPACKED CONVERTING
X"FAFBFCFDFEFF" TO "ABCDEF"
.Here's the rest of it. The submit crapped out.
Code:
DISPLAY " "
*---------------------------------------------------------------
*===> DISPLAY ALL INFORMATION PREVIOUSLY SET UP
*---------------------------------------------------------------
DISPLAY "*****************************"
"**************************************************"
DISPLAY " PROGRAM " WS-PN-DISPLAY
" RUN FROM JOB " LK-JOB-NAME
" IN STEP/PROCSTEP ===> " WS-STEP-DISPLAY
DISPLAY " COMPILED UNDER VSCOBOL" WS-CTYPE-DISPLAY
" REL " WS-CREL-DISPLAY
" AT " WS-CTIME-DISPLAY
" ON " WS-CDATE-DISPLAY
*---------------------------------------------------------------
*===> DISPLAY COBOL II OPTION BITS
*---------------------------------------------------------------
IF NOT LK-VSCOBOL DISPLAY " "
MOVE LK-IIOPT-BYTES TO WS-WORK-X5
PERFORM 100-CONVERT-HEX-DATA
MOVE WS-WORK-UNPACKED-8 TO WS-OPTBYTE-DISPLAY
DISPLAY " INDICATORS FOR COMPILER OPTIONS IN EFFECT ==> "
WS-OPTBYTE-DISPLAY
END-IF
DISPLAY " "
DISPLAY " " "ENTRY POINT " WS-EP-DISPLAY
DISPLAY " " " LOAD POINT " WS-LP-DISPLAY
DISPLAY " " " END POINT " WS-FP-DISPLAY
DISPLAY " " " LENGTH " WS-LEN-DISPLAY
DISPLAY "*****************************"
"**************************************************"
DISPLAY " "
****************************************************************
* USED TO FORCE A DUMP AT EOJ
*---------------------------------------------------------------
* COMPUTE WS-WORK-BIN4 = WS-WORK-BIN4 / WS-ZERO
****************************************************************
GOBACK
.
100-CONVERT-HEX-DATA.
*---------------------------------------------------------------
*===> CONVERTS HEX DATA FOR DISPLAY PURPOSES
* E.G. X"04FB" ====> X"F0F4C6C2" OR 04FB CHARACTER
*---------------------------------------------------------------
MOVE WS-WORK-PACKED TO WS-WORK-UNPACKED
INSPECT WS-WORK-UNPACKED CONVERTING
X"FAFBFCFDFEFF" TO "ABCDEF"
.Greenguy71
Programmer
Thanks Jack! At long last I was able to get some sort of output......although, the manner in which you got to it still has me chasing my tail a little.
I displayed the program name inside of your perform varying loop and was able to come up with a chain of load modules. Where it goes from here is up to someone else........finally out of my hands!
Thanks again, that's a slick chunk of code.
Jeff Thanks,
s-)
I displayed the program name inside of your perform varying loop and was able to come up with a chain of load modules. Where it goes from here is up to someone else........finally out of my hands!
Thanks again, that's a slick chunk of code.
Jeff Thanks,
s-)
Hi GG,
Just a final caveat about the code. Since a lot of the code is assuming a predefined construct for certain OS cntl blocks, if that changes the code will go haywire. On the otherhand, these cntl blocks are fairly mature and shouldn't change (famous last words).
Jack
Just a final caveat about the code. Since a lot of the code is assuming a predefined construct for certain OS cntl blocks, if that changes the code will go haywire. On the otherhand, these cntl blocks are fairly mature and shouldn't change (famous last words).
Jack
- Status
Similar threads
- Locked
- Question
- Locked
- Question