Took me a while to find it, but I *think* this is my re-implementation for TIOT
access in Rexx when SWA=ABOVE (I know I copied this technique from another
author whose name I did not save, so my apologies to that author - if you are
still reading this list, please take credit where it is due).
Notes about errors or omissions in the below logic are welcomed. The date on
the source member where I found these routines was 2006, so things may be
different now. I haven't had a need to use this code since 2006, and I can't
test it again right at this moment.
If I can find any round tuits I can try to convert the logic to valid
Enterprise COBOL and test it. If someone else has the time now, please be my
guest and let us know your results.
Peter
---------------------------
alldsn: procedure
parse upper arg ddname
nextdsn = getdsn(ddname)
dsnlist = ''
do xi = 1 by 1 while nextdsn /= (ddname 'NOT FOUND')
dsnlist = dsnlist nextdsn
nextdsn = getdsn(ddname'+'xi)
end
if xi = 1 then ,
dsnlist = nextdsn
return dsnlist
getdsn: procedure
parse upper arg ddname
parse var ddname ddname '+' concat
if concat = '' then concat = 0
tcb_address = storage(21C,4)
tiot_address = storage(d2x(c2d(tcb_address)+12),4)
dd_address = d2x(c2d(tiot_address)+28)
dd_length = storage(d2x(c2d(tiot_address)+24),1)
tiot_address = d2x(c2d(tiot_address)+24)
jfcb_address = storage(d2x(x2d(tiot_address)+12),3)
do while dd_length /= '00'x
if storage(dd_address,8) = ddname then leave
tiot_address = d2x(x2d(tiot_address)+c2d(dd_length))
dd_length = storage(tiot_address,1)
dd_address = d2x(x2d(tiot_address)+4)
jfcb_address = storage(d2x(x2d(tiot_address)+12),3)
end
if dd_length = '00'x then return ddname 'NOT FOUND'
do concat
tiot_address = d2x(x2d(tiot_address)+c2d(dd_length))
dd_length = storage(tiot_address,1)
dd_address = d2x(x2d(tiot_address)+4)
jfcb_address = storage(d2x(x2d(tiot_address)+12),3)
if dd_length = '00'x then return ddname 'NOT FOUND'
if storage(dd_address,8) /== ' ' then ,
return ddname 'NOT FOUND'
end
return strip(storage(d2x(c2d(jfcb_address)+16),44),'T')
-------------------------
-----Original Message-----
From: IBM Mainframe Discussion List <IBM-MAIN@LISTSERV.UA.EDU> On Behalf Of
Farley, Peter
Sent: Friday, May 5, 2023 5:58 PM
To: IBM-MAIN@LISTSERV.UA.EDU
Subject: Re: COBOL to dynamic DD name
EXTERNAL EMAIL
That logic is fine for SWA below the line, but I don't think many shops still
run that way, at least not the larger ones.
ISTR there was at one time a published Rexx implementation of the SWA-above
logic, but I can't put my finger on it just yet. That logic (if found) should
be transferable to Enterprise COBOL.
Peter
-----Original Message-----
From: IBM Mainframe Discussion List <IBM-MAIN@LISTSERV.UA.EDU> On Behalf Of
rpinion865
Sent: Friday, May 5, 2023 2:00 PM
To: IBM-MAIN@LISTSERV.UA.EDU
Subject: COBOL to dynamic DD name
I don't know if this program is of any use to the original poster. But, I came
across the source this afternoon. It would seem if you can read the JFCB, maybe
you could update it?
IDENTIFICATION DIVISION.
PROGRAM-ID. COBJFCB.
INSTALLATION.
AUTHOR. KEVIN.
DATE-WRITTEN. 11/07/2005.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 TCB-ADDRESS-POINTER.
05 TCB-ADDR-POINTER USAGE IS POINTER.
01 TIOT-SEG-POINT.
05 TIOT-SEG-POINTER USAGE IS POINTER.
05 TIOT-SEG-PNT REDEFINES TIOT-SEG-POINTER
PIC S9(9) COMP.
01 JFCB-POINT.
05 JFCB-POINTER USAGE IS POINTER.
05 JFCB-POINT-RED REDEFINES JFCB-POINTER.
10 FILLER PIC X.
10 JFCB-LOW-3 PIC X(3).
LINKAGE SECTION.
01 DDNAME-DSN-ARRAY.
05 DDNAME-DSN OCCURS 100 TIMES INDEXED BY NDX1.
10 DDA-DDNAME PIC X(8).
10 DDA-DSN PIC X(44).
01 TCB-POINTER USAGE IS POINTER.
01 TCB.
05 FILLER PIC X(12).
05 TIOT-POINTER USAGE IS POINTER.
01 TIOT-START PIC X(24).
01 TIOT-SEG.
05 TIO-LEN PIC X.
05 FILLER PIC X(3).
05 DD-NAME PIC X(8).
05 JFCB-ADDR PIC X(3).
01 JFCB.
05 FILLER PIC X(16).
05 DS-NAME PIC X(44).
PROCEDURE DIVISION USING DDNAME-DSN-ARRAY.
MOVE LOW-VALUES TO JFCB-POINT.
MOVE X'0000021C' TO TCB-ADDRESS-POINTER.
SET ADDRESS OF TCB-POINTER TO TCB-ADDR-POINTER.
SET ADDRESS OF TCB TO TCB-POINTER.
SET ADDRESS OF TIOT-START TO TIOT-POINTER.
SET TIOT-SEG-POINTER TO TIOT-POINTER.
ADD 24 TO TIOT-SEG-PNT.
SET ADDRESS OF TIOT-SEG TO TIOT-SEG-POINTER.
SET NDX1 TO 1.
PERFORM UNTIL TIO-LEN = LOW-VALUES OR NDX1 > 100
MOVE DD-NAME TO DDA-DDNAME(NDX1)
MOVE JFCB-ADDR TO JFCB-LOW-3
SET ADDRESS OF JFCB TO JFCB-POINTER
MOVE DS-NAME TO DDA-DSN(NDX1)
DISPLAY DDA-DDNAME(NDX1) DDA-DSN(NDX1)
ADD 20 TO TIOT-SEG-PNT
SET ADDRESS OF TIOT-SEG TO TIOT-SEG-POINTER
SET NDX1 UP BY 1
END-PERFORM.
GOBACK.
--
This message and any attachments are intended only for the use of the addressee
and may contain information that is privileged and confidential. If the reader
of the message is not the intended recipient or an authorized representative of
the intended recipient, you are hereby notified that any dissemination of this
communication is strictly prohibited. If you have received this communication
in error, please notify us immediately by e-mail and delete the message and any
attachments from your system.
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to lists...@listserv.ua.edu with the message: INFO IBM-MAIN
This message and any attachments are intended only for the use of the addressee
and may contain information that is privileged and confidential. If the reader
of the message is not the intended recipient or an authorized representative of
the intended recipient, you are hereby notified that any dissemination of this
communication is strictly prohibited. If you have received this communication
in error, please notify us immediately by e-mail and delete the message and any
attachments from your system.
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to lists...@listserv.ua.edu with the message: INFO IBM-MAIN
