IBM Mainframe Forum Index
 
Log In
 
IBM Mainframe Forum Index Mainframe: Search IBM Mainframe Forum: FAQ Register
 

Accessing control blocks to retrieve job number using cobol


IBM Mainframe Forums -> COBOL Programming
Post new topic   Reply to topic
View previous topic :: View next topic  
Author Message
menonkiran

New User


Joined: 24 Apr 2016
Posts: 4
Location: India

PostPosted: Wed Nov 14, 2018 9:08 pm
Reply with quote

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
View user's profile Send private message
steve-myers

Active Member


Joined: 30 Nov 2013
Posts: 917
Location: The Universe

PostPosted: Thu Nov 15, 2018 2:17 am
Reply with quote

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
View user's profile Send private message
prino

Senior Member


Joined: 07 Feb 2009
Posts: 1306
Location: Vilnius, Lithuania

PostPosted: Thu Nov 15, 2018 3:36 am
Reply with quote

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
View user's profile Send private message
Nic Clouston

Global Moderator


Joined: 10 May 2007
Posts: 2455
Location: Hampshire, UK

PostPosted: Thu Nov 15, 2018 3:51 am
Reply with quote

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
View user's profile Send private message
steve-myers

Active Member


Joined: 30 Nov 2013
Posts: 917
Location: The Universe

PostPosted: Thu Nov 15, 2018 7:21 am
Reply with quote

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
View user's profile Send private message
menonkiran

New User


Joined: 24 Apr 2016
Posts: 4
Location: India

PostPosted: Thu Nov 29, 2018 9:26 pm
Reply with quote

Thank you
Back to top
View user's profile Send private message
View previous topic :: :: View next topic  
Post new topic   Reply to topic View Bookmarks
All times are GMT + 6 Hours
Forum Index -> COBOL Programming

 


Similar Topics
Topic Forum Replies
No new posts COBOL -Linkage Section-Case Sensitive COBOL Programming 1
No new posts COBOL ZOS Web Enablement Toolkit HTTP... COBOL Programming 0
No new posts Pulling a fixed number of records fro... DB2 2
No new posts Substring number between 2 characters... DFSORT/ICETOOL 2
No new posts Calling DFSORT from Cobol, using OUTF... DFSORT/ICETOOL 5
Search our Forums:

Back to Top