|
View previous topic :: View next topic
|
| Author |
Message |
qzphc5
New User
Joined: 24 May 2003
Posts: 3
Location: USA
|
|
|
|
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 |
|
 |
dick scherrer
Moderator Emeritus
Joined: 23 Nov 2006
Posts: 19243
Location: Inside the Matrix
|
|
|
|
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 |
|
|
qzphc5
New User
Joined: 24 May 2003
Posts: 3
Location: USA
|
|
|
|
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 |
|
|
expat
Global Moderator
Joined: 14 Mar 2007
Posts: 8796
Location: Welsh Wales
|
|
|
|
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 |
|
|
|
|
