Portal | Manuals | References | Downloads | Info | Programs | JCLs | Master the Mainframes
IBM Mainframe Computers Forums Index
 
Register
 
IBM Mainframe Computers Forums Index Mainframe: Search IBM Mainframe Forum: FAQ Memberlist Usergroups Profile Log in to check your private messages Log in
 

 

Accessing UCB from a COBOL program

 
Post new topic   Reply to topic    IBMMAINFRAMES.com Support Forums -> COBOL Programming
View previous topic :: :: View next topic  
Author Message
qzphc5

New User


Joined: 24 May 2003
Posts: 3
Location: USA

PostPosted: Tue Oct 21, 2008 12:59 am    Post subject: Accessing UCB from a COBOL program
Reply with quote

I have seen examples of COBOL Programs accessing different control blocks to fetch info. like the jobname, dsname and etc.

How can one access the UCB info. thru a cobol program ? Basically I need to know whether a dataset accessed by the COBOL program/job is on DASD or TAPE. I do not need to knwo the whether it is a 3390 or etc.

With the example posted somewhere in this forum I managed to get my program working until fetching the Dataset name and Volumes. When it comes to fetching the Device info. which is part of DCB we need to OPEN the FILE for which we need to define the job in File section with FD etc. I need to know if there is any I can find out if the Volume is Tape or DASD by accessing UCB and without an FD entry in File section and without have to OPEN the file etc. With File section entries you may not get it to work for any RECFM and LRECL etc.

Any help in this regard will be greatly appreciated.

BTW. We already have an assembler pgm that does this. I wonder if this could be done in COBOL
Back to top
View user's profile Send private message

dick scherrer

Site Director


Joined: 23 Nov 2006
Posts: 19270
Location: Inside the Matrix

PostPosted: Tue Oct 21, 2008 4:45 am    Post subject:
Reply with quote

Hello and welcome to the forum,

Quote:
With the example posted somewhere in this forum I managed to get my program working until fetching the Dataset name and Volumes.
Do you have this working in COBOL on a fairly recent level of the operating system?

If you post your cobol code that retrieves the dsn, i'll amend several topics that refer to doing this, but no longer work due to changed control blocks.

Quote:
I wonder if this could be done in COBOL
Very possibly with the newer versions of the compiler (since pointer and "address of" were implemented).
Back to top
View user's profile Send private message
qzphc5

New User


Joined: 24 May 2003
Posts: 3
Location: USA

PostPosted: Tue Oct 21, 2008 8:09 am    Post subject: Reply to: Accessing UCB from a COBOL program
Reply with quote

Thank You Dick.

We are z/OS 1.9 and my program is working at least until retrieving the job name, dataset name and volser parts.

Code:


       IDENTIFICATION DIVISION.
       PROGRAM-ID.  XXXXXXXX.
       
      *****************************************************************
      *                                                               *
      * THIS PROGRAM USES POINTERS TO FETCH THE JOB/DATASET DETAILS   *
      * AND RETURNS IT TO THE CALLER.                                 *
      *                                                               *
      * IT ONLY LOOKS AT THE DD NAME ASSOCIATED WITH THIS STEP.       *
      *                                                               *
      *****************************************************************

       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
     
       INPUT-OUTPUT SECTION.
       DATA DIVISION.
      *****************************************************************
      *                                                               *
      *            WORKING STORGAE SECTION STARTS HERE                *
      *                                                               *
      *****************************************************************
       WORKING-STORAGE SECTION.
      *
       01  WS-WORK                             PIC S9(9) COMP.
       01  WS-RIGHT-HEX-DIGIT                  PIC S9(4) COMP.
       01  WS-LEN                              PIC S9(4) COMP.
       01  WS-LENGTH REDEFINES WS-LEN          PIC X(02).
       01  WS-FLAG                             PIC S9(4) COMP.
       01  WS-FLAG1 REDEFINES WS-FLAG          PIC X(02).

       01  WS-TCB-ADDRESS-POINTER.
           05  WS-TCB-ADDR-POINTER             USAGE IS POINTER.

       01  WS-TIOT-SEG-POINT.
           05  WS-TIOT-SEG-POINTER             USAGE IS POINTER.
           05  WS-TIOT-SEG-PNT REDEFINES WS-TIOT-SEG-POINTER
                                               PIC S9(9) COMP.
       01  WS-JFCB-POINT.
           05  WS-JFCB-POINTER                 USAGE IS POINTER.
           05  WS-JFCB-PTR REDEFINES WS-JFCB-POINTER
                                               PIC S9(9) COMP.
           05  WS-JFCB-POINT-RED REDEFINES  WS-JFCB-PTR.
               07  FILLER                      PIC X.
               07  WS-JFCB-LOW-3               PIC X(3).

       01  WS-POINT.
           05  WS-POINTER                      USAGE IS POINTER.
           05  WS-PTR REDEFINES WS-POINTER
                                               PIC S9(9) COMP.
           05  WS-POINT-RED REDEFINES WS-PTR.
               07  FILLER                      PIC X.
               07  WS-LOW-3                    PIC X(3).
       01  WS-SWA-POINT.
           05  WS-SWA-POINTER                  USAGE IS POINTER.
           05  WS-SWA-PTR REDEFINES WS-SWA-POINTER
                                               PIC S9(9) COMP.
           05  WS-SWA-POINT-RED REDEFINES WS-SWA-PTR.
               07  FILLER                      PIC X.
               07  WS-SWA-LOW-3                PIC X(3).
       01  WS-QMAT-POINT.
           05  WS-QMAT-POINTER                 USAGE IS POINTER.
           05  WS-QMAT-PTR REDEFINES WS-QMAT-POINTER
                                               PIC S9(9) COMP.
      /
       01  WS-UCB-POINT.
           05  WS-UCB-POINTER                  USAGE IS POINTER.
           05  WS-UCB-POINT-RED REDEFINES WS-UCB-POINTER.
               07  FILLER                      PIC X.
               07  WS-UCB-LOW-3                PIC X(3).

       01  WS-DEB-POINT.
           05  WS-DEB-POINTER                  USAGE IS POINTER.
           05  WS-DEB-POINT-RED REDEFINES WS-DEB-POINTER.
               07  FILLER                      PIC X.
               07  WS-DEB-LOW-3                PIC X(3).

      *01  SYSDD-STATUS                  PIC XX  VALUE '00'.

       01  WS-LEN1                       PIC 9(05) COMP.

       01  WS-DCB-POINT.
                  05  WS-DCB-POINTER                  USAGE IS POINTER.
                  05  WS-DCB-POINT-RED REDEFINES WS-DCB-POINTER.
                      07  FILLER                      PIC X.
                      07  WS-DCB-LOW-3                PIC X(3).

       01  WS-CVT-ADDRESS-POINTER.
           05  WS-CVT-ADDR-POINTER             USAGE IS POINTER.
       01  WS-ASCB-ADDRESS-POINTER.
           05  WS-ASCB-ADDR-POINTER            USAGE IS POINTER.
       01  WS-ASSB-ADDRESS-POINTER.
           05  WS-ASSB-ADDR-POINTER            USAGE IS POINTER.
       01  WS-JSAB-ADDRESS-POINTER.
           05  WS-JSAB-ADDR-POINTER            USAGE IS POINTER.

       LINKAGE SECTION.
       01  LINK-COMM-AREA.
            10  LINK-JOB-NAME           PIC X(08).
            10  LINK-DD-NAME            PIC X(08).
            10  LINK-DS-NAME            PIC X(44).
            10  LINK-VOLUME-COUNT       PIC 9(01).
            10  LINK-VOLUMES            PIC X(30).
            10  LINK-DEV-TYPE           PIC X(01).

       01  TCB-POINTER                      USAGE IS POINTER.

       01  TCB.
           05  FILLER             PIC X(08).
           05  DEB-ADDR                     USAGE IS POINTER.
           05  TIOT-POINTER                 USAGE IS POINTER.
           05  FILLER             PIC X(164).
           05  JSCB-POINTER                 USAGE IS POINTER.
           05  FILLER             PIC X(128).
           05  STCB-POINTER                 USAGE IS POINTER.

       01  TIOT.
           05  JOB-NAME           PIC X(08).
           05  JOB-STEP           PIC X(08).
           05  JOB-PROC           PIC X(08).

       01  TIOT-SEG.
           05  TIO-LEN            PIC X.
           05  FILLER             PIC X(03).
           05  DD-NAME            PIC X(08).
           05  SWA-V-ADDR         PIC X(03).
           05  FILLER             PIC X(02).
           05  UCB-ADDR           PIC X(03).

       01 TIOENTRY REDEFINES TIOT-SEG.
           05 TIOELNGH            PIC X.
           05 FILLER              PIC X(03).
           05 TIOEDDNM            PIC X(08).
           05 TIOEJFCB            PIC X(03).
           05 FILLER              PIC X(02).
           05 TIOEFSRT            PIC X(03).

       01  DEB.
           05  FILLER             PIC X(05).
           05  NEXT-DEB-ADDR      PIC X(03).
           05  FILLER             PIC X(17).
           05  DCB-ADDR           PIC X(03).

       01  DCB.
           05  FILLER             PIC X(17).
           05  DEVICE-TYPE        PIC X.
               88  DISK-3380-X2E  VALUE X'2E'.
               88  DISK-3390-X2F  VALUE X'2F'.
           05  FILLER             PIC X(08).
           05  DSORG              PIC X(02).
           05  FILLER             PIC X(08).
           05  RECFM              PIC X(02).
           05  FILLER             PIC X(02).
           05  DDNAME             PIC X(08).
           05  FILLER             PIC X(14).
           05  BLKSIZE            PIC S9(4) COMP.
           05  FILLER             PIC X(18).
           05  LRECL              PIC S9(4) COMP.
       01  DCB-ASM REDEFINES DCB.
           05  FILLER             PIC X(17).
           05  DCBDEVT            PIC X.
           05  FILLER             PIC X(08).
           05  DCBDSORG           PIC X(02).
           05  FILLER             PIC X(08).
           05  DCBRECFM           PIC X(02).
           05  FILLER             PIC X(02).
           05  DCBDDNAM           PIC X(08).
           05  FILLER             PIC X(14).
           05  DCBBLKSI           PIC S9(4) COMP.
           05  FILLER             PIC X(18).
           05  DCBLRECL           PIC S9(4) COMP.

       01  JFCB.
           05  DS-NAME            PIC X(44).
           05  FILLER             PIC X(74).
           05 VOL-SER.
              10  VOL-SER1           PIC X(06).
              10  VOL-SER2           PIC X(06).
              10  VOL-SER3           PIC X(06).
              10  VOL-SER4           PIC X(06).
              10  VOL-SER5           PIC X(06).

       01  UCB.
           05  UCB-INFO           PIC X(80).

       01  SWA.
           05  JFCB-ADDR          USAGE IS POINTER.

       01  JSCB.
           05  FILLER             PIC X(244).
           05  QMPL-POINTER       USAGE IS POINTER.

       01  QMPL.
           05  FILLER             PIC X(24).
           05  QMAT-POINTER       USAGE IS POINTER.

       01  QMAT.
           05  FILLER             PIC X(12).
           05  QMAT-NEXT-POINTER  USAGE IS POINTER.

       PROCEDURE DIVISION USING LINK-COMM-AREA.
           PERFORM 1000-FETCH-JFCB-INFO THRU 1000-EXIT.
           PERFORM 2000-FETCH-DCB-INFO  THRU 2000-EXIT.
      *    PERFORM 3000-FETCH-UCB-INFO  THRU 3000-EXIT.
           GOBACK.

       1000-FETCH-JFCB-INFO.
      *---------------------------------------------------------------
      *    FIND DDNAMES AND ASSOCIATED DSNAMES
      *    PSA+X'21C' -> TCB -> TIOT -> TIOT SEG -> SWAREQ(SVA) -> JFCB
      *---------------------------------------------------------------
           MOVE X'0000021C'                TO WS-TCB-ADDRESS-POINTER.

           SET ADDRESS OF TCB-POINTER      TO WS-TCB-ADDR-POINTER.
           SET ADDRESS OF TCB              TO TCB-POINTER.
           SET ADDRESS OF TIOT             TO TIOT-POINTER.

           MOVE JOB-NAME                   TO LINK-JOB-NAME

           SET WS-TIOT-SEG-POINTER         TO TIOT-POINTER.
           ADD 24                          TO WS-TIOT-SEG-PNT.
           SET ADDRESS OF TIOT-SEG         TO WS-TIOT-SEG-POINTER.

           PERFORM UNTIL TIO-LEN = LOW-VALUES
               MOVE ALL LOW-VALUES         TO WS-POINT
               MOVE ALL LOW-VALUES         TO WS-JFCB-POINT
               MOVE ALL LOW-VALUES         TO WS-SWA-POINT
               MOVE SWA-V-ADDR             TO WS-SWA-LOW-3

               PERFORM 1100-PERFORM-SWAREQ THRU 1100-EXIT

               SET ADDRESS OF JFCB         TO  WS-POINTER

               IF DD-NAME = LINK-DD-NAME
                  DISPLAY 'DD-NAME:' DD-NAME
                  MOVE DD-NAME             TO LINK-DD-NAME
                  MOVE DS-NAME             TO LINK-DS-NAME
                  MOVE VOL-SER             TO LINK-VOLUMES

                  MOVE ZEROES              TO LINK-VOLUME-COUNT

                  IF VOL-SER1 > '      '
                     ADD  1                TO LINK-VOLUME-COUNT
                  END-IF

                  IF VOL-SER2 > '      '
                     ADD  1                TO LINK-VOLUME-COUNT
                  END-IF

                  IF VOL-SER3 > '      '
                     ADD  1                TO LINK-VOLUME-COUNT
                  END-IF

                  IF VOL-SER4 > '      '
                     ADD  1                TO LINK-VOLUME-COUNT
                  END-IF

                  IF VOL-SER5 > '      '
                     ADD  1                TO LINK-VOLUME-COUNT
                  END-IF

               END-IF

               MOVE ZERO                   TO WS-LEN
               MOVE TIO-LEN                TO WS-LENGTH(2:1)
               ADD WS-LEN                  TO WS-TIOT-SEG-PNT
               SET ADDRESS OF TIOT-SEG     TO WS-TIOT-SEG-POINTER
           END-PERFORM
           .

      /
       1000-EXIT.  EXIT.
           EJECT

       1100-PERFORM-SWAREQ.

           DIVIDE WS-SWA-PTR BY 16
               GIVING WS-WORK
               REMAINDER WS-RIGHT-HEX-DIGIT.

           IF WS-RIGHT-HEX-DIGIT NOT = 15
               COMPUTE WS-PTR = WS-SWA-PTR + 16
           ELSE
               MOVE X'0000021C'            TO WS-TCB-ADDRESS-POINTER

               SET ADDRESS OF TCB-POINTER  TO WS-TCB-ADDR-POINTER
               SET ADDRESS OF TCB          TO TCB-POINTER
               SET ADDRESS OF JSCB         TO JSCB-POINTER
               SET ADDRESS OF QMPL         TO QMPL-POINTER
               SET ADDRESS OF QMAT         TO QMAT-POINTER
               SET WS-QMAT-POINTER         TO QMAT-POINTER

               PERFORM UNTIL WS-SWA-PTR <= 65536
                   SET WS-QMAT-POINTER     TO QMAT-NEXT-POINTER
                   SET ADDRESS OF QMAT     TO QMAT-NEXT-POINTER
                   COMPUTE WS-SWA-PTR = WS-SWA-PTR - 65536
               END-PERFORM

               COMPUTE WS-PTR = WS-SWA-PTR + WS-QMAT-PTR + 1
               SET ADDRESS OF SWA          TO WS-POINTER
               SET WS-POINTER              TO JFCB-ADDR
               COMPUTE WS-PTR = WS-PTR + 16
            END-IF.
      /
       1100-EXIT.  EXIT.
           EJECT


       2000-FETCH-DCB-INFO.
      *---------------------------------------------------------------*
      *    DISPLAY DCB INFORMATION                                    *
      *    PSA+X'21C' - > TCB -> DEB -> DCB                           *
      *---------------------------------------------------------------*


           MOVE ALL LOW-VALUES         TO WS-UCB-POINT.

           MOVE X'0000021C'            TO WS-TCB-ADDRESS-POINTER.

           SET ADDRESS OF TCB-POINTER  TO WS-TCB-ADDR-POINTER.
           SET ADDRESS OF TCB          TO TCB-POINTER.
           SET WS-UCB-POINTER          TO UCB-ADDR.

           PERFORM UNTIL WS-UCB-POINTER IS = NULL

               SET ADDRESS OF UCB      TO WS-UCB-POINTER
      *        MOVE ALL LOW-VALUES     TO WS-DCB-POINT
      *        MOVE DCB-ADDR           TO WS-DCB-LOW-3
      *        SET ADDRESS OF DCB      TO WS-DCB-POINTER
               DISPLAY 'UCB:' UCB-INFO
          IF DDNAME = LINK-DD-NAME
                  DISPLAY 'UCB:' UCB-INFO
*              END-IF
TEST***********DIVIDE WS-LEN BY WS-TEST GIVING WS-WORK
      *        MOVE NEXT-UCB-ADDR      TO WS-UCB-LOW-3
           END-PERFORM
   
           .

       2000-EXIT.  EXIT.
           EJECT

       3000-FETCH-UCB-INFO.
      *---------------------------------------------------------------*
      *    DISPLAY DCB INFORMATION                                    *
      *    PSA+X'21C' - > TCB -> DEB -> DCB                           *
      *---------------------------------------------------------------*


           MOVE ALL LOW-VALUES         TO WS-DEB-POINT.

           MOVE X'0000021C'            TO WS-TCB-ADDRESS-POINTER.

           SET ADDRESS OF TCB-POINTER  TO WS-TCB-ADDR-POINTER.
           SET ADDRESS OF TCB          TO TCB-POINTER.
           SET WS-DEB-POINTER          TO DEB-ADDR.

           PERFORM UNTIL WS-DEB-POINTER IS = NULL

               SET ADDRESS OF DEB      TO WS-DEB-POINTER
               MOVE ALL LOW-VALUES     TO WS-DCB-POINT
               MOVE DCB-ADDR           TO WS-DCB-LOW-3
               SET ADDRESS OF DCB      TO WS-DCB-POINTER

 *        IF DDNAME = LINK-DD-NAME
                  DISPLAY 'DCB    = ' DCB
                  DISPLAY 'DDNAME = ' DDNAME
                  DISPLAY 'DSORG  = ' DSORG
                  DISPLAY 'RECFM  = ' RECFM
                  DISPLAY 'BLKSIZE= ' BLKSIZE
                  DISPLAY 'LRECL  = ' LRECL

                  IF DISK-3380-X2E
                     DISPLAY 'DEVICE-TYPE=3380'
                     DISPLAY '**************************************'
                  ELSE IF DISK-3390-X2F
                          DISPLAY 'DEVICE-TYPE=3390'
                          DISPLAY '************************************'
                       ELSE
                          DISPLAY 'DEVICE-TYPE=????'
                          DISPLAY 'DEVICE-TYPE=' DEVICE-TYPE
                          DISPLAY '************************************'
                    END-IF
                  END-IF
  *        END-IF
TEST***********DIVIDE WS-LEN BY WS-TEST GIVING WS-WORK
               MOVE NEXT-DEB-ADDR      TO WS-DEB-LOW-3
           END-PERFORM
      *    CLOSE SYSDD.
           .

       3000-EXIT.  EXIT.
           EJECT




The main program might get a dataset with any RECFM/DCB attributes as input. The program code I posted above is for the subprogram that is supposed to get the Job name, Dataset name, Volume list and Device type(Unit Type) etc and pass the info back to the calling program.

I do not need specifics of a device like a 3380 or 3390 etc. Just the Unit info like DASD or TAPE would suffice.

Please let me know if you need any other details.
Back to top
View user's profile Send private message
expat

Global Moderator


Joined: 14 Mar 2007
Posts: 8593
Location: Back in jolly old England

PostPosted: Tue Oct 21, 2008 10:58 am    Post subject:
Reply with quote

Invoking IDCAMS from within your program, or outside of it, will tell you what you want to know.

Seems to me a far easier way to find the information than chasing control blocks.
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 XML Parse for COBOL 5.2 Bhanu Praveen COBOL Programming 1 Sat Jul 08, 2017 8:58 pm
No new posts Writing a file using online program grvtomar PL/I & Assembler 3 Fri Jun 30, 2017 1:06 pm
No new posts pre-compiler for program in an HFS Pedro DB2 0 Fri Jun 23, 2017 11:13 pm
No new posts Dynamic output file creation in cobol... smileheal COBOL Programming 7 Thu Jun 15, 2017 10:53 pm
No new posts Search utility(3.14) using JCl and Cobol RKS3 COBOL Programming 12 Sat Jun 10, 2017 10:24 pm


Facebook
Back to Top
 
Mainframe Wiki | Forum Rules | Bookmarks | Subscriptions | FAQ | Tutorials | Contact Us