Portal | Manuals | References | Downloads | Info | Programs | JCLs | Mainframe wiki | Quick Ref
IBM Mainframe Computers Forums Index
 
Register
 
IBM Mainframe Computers Forums Index Mainframe: Search IBM Mainframe Forum: FAQ Memberlist Profile Log in to check your private messages Log in
 
Accessing control blocks to retrieve job number using cobol

 
Post new topic   Reply to topic    IBMMAINFRAMES.com Support Forums -> COBOL Programming
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    Post subject: Accessing control blocks to retrieve job number using cobol
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: 681
Location: The Universe

PostPosted: Thu Nov 15, 2018 2:17 am    Post subject:
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: 1121
Location: Vilnius, Lithuania

PostPosted: Thu Nov 15, 2018 3:36 am    Post subject:
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: 2123
Location: UK

PostPosted: Thu Nov 15, 2018 3:51 am    Post subject: Reply to: Accessing control blocks to retrieve job number using cobol
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: 681
Location: The Universe

PostPosted: Thu Nov 15, 2018 7:21 am    Post subject: Re: Reply to: Accessing control blocks to retrieve job number using cobol
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    Post subject: Reply to: Accessing control blocks to retrieve job number using cobol
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    IBMMAINFRAMES.com Support Forums -> COBOL Programming All times are GMT + 6 Hours
Page 1 of 1

 

Search our Forum:

Similar Topics
Topic Author Forum Replies Posted
No new posts COBOL D2 program execution without us... dipsybaby DB2 3 Mon Dec 10, 2018 2:08 pm
No new posts calling java code(on mainframe from c... elixir1986 COBOL Programming 1 Fri Nov 30, 2018 1:57 am
No new posts COBOL file declaration jithinraghavan COBOL Programming 2 Fri Nov 16, 2018 10:54 pm
No new posts How to count the number of times key ... vnktrrd DFSORT/ICETOOL 14 Thu Nov 15, 2018 9:19 pm
No new posts Get line number where cursor is from ... satish.ms10 CLIST & REXX 3 Wed Oct 24, 2018 12:23 am

Facebook
Back to Top
 
Job Vacancies | Forum Rules | Bookmarks | Subscriptions | FAQ | Polls | Contact Us