View previous topic :: View next topic
|
Author |
Message |
menonkiran
New User
Joined: 24 Apr 2016 Posts: 4 Location: India
|
|
|
|
Hello,
In some of the earlier older threads there were discussions about how to read the control blocks using cobol to retrieve information like job name, job number etc
Although many have suggested that they don’t recommend doing so, just wondering why it might be so?
Any thoughts
Kiran |
|
Back to top |
|
 |
steve-myers
Active Member
Joined: 30 Nov 2013 Posts: 917 Location: The Universe
|
|
|
|
This is the Assembler for a Cobol callable routine. It is far more maintainable than any direct Cobol code.
Code: |
* CALL GETJOBID(JOBID)
* JOBID DC CL8' '
GETJOBID CSECT
GETJOBID AMODE ANY
GETJOBID RMODE ANY
SAVE (14,1),,GETJOBID-&SYSDATE-&SYSTIME Save registers
L 1,0(,1) Load address where we store the ->
jobid
L 15,CVTPTR CVT -> TCB pointers -> TCB
L 15,CVTTCBP-CVTMAP(,15)
L 15,4(,15)
L 15,TCBJSCB-TCB(,15) TCB -> JSCB -> SSIB
L 15,JSCBSSIB-IEZJSCB(,15)
MVC 0(L'SSIBJBID,1),SSIBJBID-SSIB(15) SSIBJBID -> output
RETURN (14,1),RC=0 Restore registers & return
PRINT NOGEN
CVT DSECT=YES
IKJTCB
IEZJSCB
IEFJSSIB
END |
This much of the listing may give you enough to create Cobol code.
Code: |
000020 5810 1000 00000 14 L 1,0(,1)
000024 58F0 0010 00010 15 L 15,CVTPTR
000028 58F0 F000 00000 16 L 15,CVTTCBP-CVTMAP(,15)
00002C 58F0 F004 00004 17 L 15,4(,15)
000030 58F0 F0B4 000B4 18 L 15,TCBJSCB-TCB(,15)
000034 58F0 F13C 0013C 19 L 15,JSCBSSIB-IEZJSCB(,15)
000038 D207 1000 F00C 00000 0000C 20 MVC 0(L'SSIBJBID,1),SSIBJBID-SSIB(15) |
- |
|
Back to top |
|
 |
prino
Senior Member

Joined: 07 Feb 2009 Posts: 1318 Location: Vilnius, Lithuania
|
|
|
|
Or in REXX:
Code: |
/***********************************************************************
* GET_STEPNAME: *
* *
* This procedure finds the stepname to cater for special processing *
***********************************************************************/
get_stepname:
tcb = ptr(540, 4) /* PSATOLD in PSA */
tiot = ptr(tcb + 12, 4) /* TCBTIO in TCB */
jscb = ptr(tcb + 180, 4) /* TCBJSCB in TCB */
jct = swareq(stg(jscb + 260, 4)) /* JSCBJCTA in JSCB */
act = ptr(jct + 40, 3) /* JCTACTAD in JCT */
ssib = ptr(jscb + 316, 4) /* JSCBSSIB in JSCB */
programmer = stg(act + 24, 20)
jobid = stg(ssib + 12, 8)
jobidnc = strip(substr(stg(ssib + 12, 8), 4, 5))
msgclass = stg(jct + 6, 1)
jobname = stg(tiot, 8)
stepname = stg(tiot + 8, 8)
procstepname = stg(tiot + 16, 8)
/*********************************************************************
* *
**********************************************************************
say 'Job Name :' jobname
say 'Programmer name:' programmer
say 'Proc step name :' procstepname
say 'Step name :' stepname
say 'Message class :' msgclass
say 'Job number :' jobid
*********************************************************************/
return
/***********************************************************************
* PTR & STG & SWAREQ: *
* *
* Utility procedures to access z/OS control blocks *
***********************************************************************/
ptr: return c2d(storage(d2x(arg(1)), arg(2)))
stg: return storage(d2x(arg(1)), arg(2))
swareq: procedure
if right(c2x(arg(1)), 1) \= 'F' then /* SWA=BELOW ? */
return c2d(arg(1)) + 16 /* Yes, return SVA + 16 */
sva = c2d(arg(1)) /* Convert to decimal */
tcb = ptr(540, 4) /* TCB PSATOLD */
jscb = ptr(tcb + 180, 4) /* JSCB TCBJSCB */
qmpl = ptr(jscb + 244, 4) /* QMPL JSCBQMPI */
qmat = ptr(qmpl + 24, 4) /* QMAT QMADD */
do while sva > 65536
qmat = ptr(qmat + 12, 4) /* Next QMAT QMAT + 12 */
sva = sva - 65536 /* 010006F -> 000006F */
end
return ptr(qmat + sva + 1) + 16 |
or PL/I:
Code: |
dcl p ptr init (ptrvalue(16));
dcl w(0:3) ptr based (p);
dcl s(2) char (8) based (p);
p = w(0);
p = w(0);
p = w(1);
p = w(3);
put skip edit('jobname :', s(1)) (a(10), a(8));
put skip edit('stepname:', s(2)) (a(10), a(8));
/* or a bit more */
dcl p1 ptr init (ptrvalue(16)) static;
dcl 1 s1 based(p1),
2 p2 ptr;
dcl 1 s2 based(p2),
2 p3 ptr;
dcl 1 s3 based(p3),
2 * ptr,
2 tcb_ptr ptr;
dcl 1 tcb based(tcb_ptr),
2 *(3) ptr,
2 tiot_ptr ptr,
2 *(41) ptr,
2 jscb_ptr ptr;
dcl 1 tiot based(tiot_ptr),
2 jobname char (8),
2 stepname char (8);
dcl 1 jscb based(jscb_ptr),
2 *(65) ptr,
2 jscbjct ptr,
2 *(13) ptr,
2 jscbssib ptr;
dcl 1 jct based(jscbjct),
2 *(5) ptr,
2 * char,
2 jctjstat bit (8),
2 * char (2),
2 jctjname char (8), /* job name */
2 *(4) ptr,
2 jctsdkad char (3), /* sva of first sct */
2 * char,
2 jctjctx char (3), /* sva of jctx */
2 * char,
2 jctactad char (3), /* sva of first act */
2 * char,
2 *(26) ptr,
2 * char,
2 jmrjmrjd fixed dec(5,3), /* job start date (julian) */
2 *(2) ptr,
2 jctuser char (7), /* job user id */
2 * char,
2 jctacode char (4); /* job abend code */
dcl 1 ssib based(jscbssib),
2 *(3) ptr,
2 ssibjbid char (8); /* subsystem job id */
dcl act_ptr ptr;
dcl 1 act based(act_ptr),
2 * char (24),
2 actprgnm char (20),
2 * char (3),
2 actjnfld char,
2 actaccnt char (144);
dcl sct_ptr ptr;
dcl 1 sct based(sct_ptr),
2 *(6) ptr,
2 sctsexec fixed bin (15),
2 *(2) char,
2 *(2) ptr,
2 sctansct char (3), /* sva of next sct */
2 * char,
2 *(5) ptr,
2 sctsclpc char (8), /* name of step that called procedure */
2 sctsname char (8), /* step name */
2 *(2) ptr,
2 sctx_pch char (3),
2 * char,
2 *(9) ptr,
2 sctpgmnm char (8), /* program name */
2 * char (2),
2 sctcdent(8) char (6),
2 * char (6),
2 sctstend bit (8); /* bits and pieces */
dcl sctx_ptr ptr;
dcl 1 sctx based(sctx_ptr),
2 *(5) ptr,
2 sctxparm char (100); |
|
|
Back to top |
|
 |
Nic Clouston
Global Moderator
Joined: 10 May 2007 Posts: 2454 Location: Hampshire, UK
|
|
|
|
Nice answers but not to this question which is "why it is not a good idea to use COBOL for this?"
Quote: |
using cobol to retrieve information like job name, job number |
Quote: |
many have suggested that they don’t recommend doing so |
Quote: |
just wondering why it might be so |
|
|
Back to top |
|
 |
steve-myers
Active Member
Joined: 30 Nov 2013 Posts: 917 Location: The Universe
|
|
|
|
Nic Clouston wrote: |
Nice answers but not to this question which is "why it is not a good idea to use COBOL for this?"
Quote: |
using cobol to retrieve information like job name, job number |
Quote: |
many have suggested that they don’t recommend doing so |
Quote: |
just wondering why it might be so |
|
Part of the answer lies in Prino's Rexx "solution,"which has all sorts of what is called in our trade, "magic numbers" -
tcb = ptr(540, 4)
The "magic number" here is 540. As far as I know it has been 540 (X'21C') since the first release of MVS. But before MVS, the data areas now known as PSATNEW and PSATOLD moved all over the place. CVTTCBP always pointed to PSATNEW guaranteed. The ratio between PSATNEW and PSATOLD (the 'magic number" 4 in my Assembler code) has been fixed since OS/360 Release 1; that's one "magic number" unlikely to change! I also point out these data areas in the PSA --
Code: |
PSATNEW DC A(0) - TCB pointer. Field maintained for code
* compatability with previous MVS
* releases. DO NOT USE. @LQC
IEATCBP EQU PSATNEW - ALIAS
PSATOLD DC A(0) - Pointer to current TCB or zero if in SRB
* mode. Field fixed by architecture |
and the formal definition of CVTTCBP -
Code: |
CVTTCBP DC V(IEATCBP) - Address of PSATNEW. |
Now notice, it is not A(PSATNEW-PSA): it is the external address of IEATCBP which is resolved only when the system is IPLd, as both the PSA and the CVT are part of the nucleus. The PSA is forced to virtual address (and real address) 0 through a Linkage Editor trick (and nucleus loader trick, as the nucleus is not loaded by regular program fetch) most programmers have long since forgotten.
In any event, I do not use PSATOLD in any production program: CVTTCBP is much safer, even though I doubt PSATOLD is going to move.
Going back to Prino's "solution" we have -
jscb = ptr(tcb + 180, 4)
and
ssib = ptr(jscb + 316, 4)
These "magic numbers" are likely to leak into Cobol or PL/I "solutions." |
|
Back to top |
|
 |
menonkiran
New User
Joined: 24 Apr 2016 Posts: 4 Location: India
|
|
|
|
Thank you |
|
Back to top |
|
 |
|
|