Here is sample code that handles SWAREQ logic in COBOL:
=======================================================
IDENTIFICATION DIVISION.
PROGRAM-ID. GETJFCB.
DATA DIVISION.
******************************************************************
WORKING-STORAGE SECTION.
******************************************************************
* MVS DATA AREAS MISC
01 MVS-MISC.
05 JFCB-HI-HEX PIC S9(8) COMP-5 VALUE ZERO.
05 JFCB-LO-HEX PIC S9(8) COMP-5 VALUE ZERO.
05 TIOE-LEN-CHAR.
10 TIOE-LEN PIC S9(4) COMP-5 VALUE ZERO.
05 TIOE-POINT.
10 TIOE-PTR POINTER.
10 TIOE-PNUM REDEFINES TIOE-PTR
PIC 9(8) COMP-5.
05 QMAT-POINT.
10 QMAT-PTR POINTER.
10 QMAT-PNUM REDEFINES QMAT-PTR
PIC 9(8) COMP-5.
05 JFCB-POINT.
10 JFCB-PTR POINTER.
10 JFCB-PNUM REDEFINES JFCB-PTR
PIC 9(8) COMP-5.
10 FILLER REDEFINES JFCB-PNUM.
15 JFCB-PTR-HI1 PIC X.
15 JFCB-PTR-LO3 PIC X(3).
******************************************************************
LINKAGE SECTION.
******************************************************************
* PROGRAM STATUS AREA.
01 PSA.
05 FILLER PIC X(540).
05 PSA-PSATOLD POINTER.
* TASK CONTROL BLOCK
01 TCB.
05 FILLER PIC X(12).
05 TCB-TCBTIO POINTER.
05 FILLER PIC X(164).
05 TCB-TCBJSCB POINTER.
* TASK I/O TABLE SEGMENT
01 TIOENTRY.
05 TIOT-TIOELNGH PIC X.
05 FILLER PIC X(3).
05 TIOT-TIOEDDNM PIC X(8).
05 TIOT-TIOEJFCB PIC X(3).
* JOB/STEP CONTROL BLOCK
01 JSCB.
05 FILLER PIC X(244).
05 JSCB-JSCBQMPI POINTER.
* JOB FILE CONTROL BLOCK (FORMAT 1 DSCB)
01 JFCB.
05 JFCBDSNM PIC X(44).
01 QMPI.
05 FILLER PIC X(24).
05 QMPI-QMPIQMAT POINTER.
01 QMAT.
05 FILLER PIC X(12).
05 QMAT-QMATNEXT POINTER.
01 JNXT-POINT.
05 JNXT-PTR POINTER.
05 JNXT-PNUM REDEFINES JNXT-PTR
PIC 9(8) COMP-5.
******************************************************************
PROCEDURE DIVISION.
******************************************************************
* SET ADDRESSABILITY TO THE TIOT
SET ADDRESS OF PSA TO NULL
SET ADDRESS OF TCB TO PSA-PSATOLD
* WALK THE TIOT ENTRIES TO FIND THE ALLOCATED DDNAMES
SET TIOE-PTR TO TCB-TCBTIO
ADD 24 TO TIOE-PNUM
SET ADDRESS OF TIOENTRY TO TIOE-PTR
PERFORM UNTIL TIOT-TIOELNGH = LOW-VALUES
PERFORM 8888-JFCB-SWAREQ THRU 8888-EXIT
DISPLAY TIOT-TIOEDDNM ' DD DSN=' JFCBDSNM
* POINT TO NEXT DDNAME ENTRY IN TIOT
MOVE ZERO TO TIOE-LEN
MOVE TIOT-TIOELNGH TO TIOE-LEN-CHAR(2:1)
ADD TIOE-LEN TO TIOE-PNUM
SET ADDRESS OF TIOENTRY TO TIOE-PTR
END-PERFORM
GOBACK
.
*****************************************************************
8888-JFCB-SWAREQ.
*****************************************************************
MOVE LOW-VALUES TO JFCB-PTR-HI1
MOVE TIOT-TIOEJFCB TO JFCB-PTR-LO3
DIVIDE JFCB-PNUM BY 16 GIVING JFCB-HI-HEX
REMAINDER JFCB-LO-HEX
IF JFCB-LO-HEX NOT = 15
COMPUTE JFCB-PNUM = JFCB-PNUM + 16
ELSE
SET ADDRESS OF JSCB TO TCB-TCBJSCB
SET ADDRESS OF QMPI TO JSCB-JSCBQMPI
SET QMAT-PTR TO QMPI-QMPIQMAT
PERFORM UNTIL JFCB-PNUM <= 65536
SET ADDRESS OF QMAT TO QMAT-PTR
SET QMAT-PTR TO QMAT-QMATNEXT
COMPUTE JFCB-PNUM = JFCB-PNUM - 65536
END-PERFORM
COMPUTE JFCB-PNUM = JFCB-PNUM + QMAT-PNUM + 1
SET ADDRESS OF JNXT-POINT TO JFCB-PTR
COMPUTE JFCB-PNUM = JNXT-PNUM + 16
END-IF
SET ADDRESS OF JFCB TO JFCB-PTR
.
8888-EXIT. EXIT.
=======================================================
Walter (Bill) Bass | Optum
Senior Applications Development Consultant, Optum Tech App Srvcs Grp - 630
2 Independence Pt., Ste. 100, Greenville, SC 29615, USA
T +1 864-213-2773
[email protected]
www.optum.com
-----Original Message-----
From: IBM Mainframe Discussion List [mailto:[email protected]] On Behalf
Of Farley, Peter x23353
Sent: Wednesday, June 11, 2014 9:33 AM
To: [email protected]
Subject: Re: Accessing TIOT->JFCB segments from COBOL
Richard,
The problem with that code is that it does not account for the XTIOT above the
line. For some of the TIOT entries the "JFCB" pointer is really an SWA Virtual
Address and in assembler must be processed with the SWAREQ macro to resolve to
an actual JFCB address.
Below is Gilbert Saint-Flour's Rexx code (in File 183 on CBT) to do the SWAREQ
function, you should be able to adapt this to the COBOL program to accomplish
the same task. Use this code instead of just using the 3-byte "JFCB-ADDRESS"
pointer as-is.
HTH
Peter
/*--------------------------------------------------------------------*\00010000
|* *|00020000
|* MODULE NAME = SWAREQ *|00030000
|* *|00040000
|* DESCRIPTIVE NAME = Convert an SVA to a 31-bit address *|00050000
|* *|00060000
|* STATUS = R200 *|00070000
|* *|00080000
|* FUNCTION = The SWAREQ function simulates the SWAREQ macro to *|00090000
|* convert an SWA Virtual Address (SVA) to a full 31-bit *|00100000
|* address which can be used to access SWA control blocks *|00110000
|* in the SWA=ABOVE environment. The input is a 3-byte *|00120000
|* SVA; the output value is a 10-digit decimal number. *|00130000
|* *|00140000
|* AUTHOR = Gilbert Saint-Flour <[email protected]>
*|00150000
|* *|00160000
|* DEPENDENCIES = TSO/E V2 *|00170000
|* *|00180000
|* SYNTAX = SWAREQ(sva) *|00190000
|* *|00200000
|* sva must contain a 3-byte SVA. *|00210000
|* *|00220000
|* Sample Invocation: *|00230000
|* *|00240000
|* NUMERIC DIGITS 10 *|00250000
|* tcb = C2D(STORAGE(21C,4)) /* TCB PSATOLD */ *|00260000
|* tiot= C2D(STORAGE(D2X(tcb+12),4)) /* TIOT TCBTIO */ *|00270000
|* sva = STORAGE(D2X(tiot+36),3) /* First JFCB TIOEJFCB */ *|00280000
|* jfcb=SWAREQ(sva) /* convert SVA to 31-bit addr */ *|00290000
|* dsn=STORAGE(D2X(jfcb),44) /* dsname JFCBDSNM */ *|00300000
|* vol=STORAGE(D2X(jfcb+118),6) /* volser JFCBVOLS */ *|00310000
|* SAY 'sva='C2X(sva) 'jfcb='D2X(jfcb) 'dsn='dsn 'vol='vol *|00320000
|* *|00330000
\*--------------------------------------------------------------------*/00340000
/*SWAREQ: PROCEDURE */ 00350000
IF RIGHT(C2X(ARG(1)),1) \= 'F' THEN /* SWA=BELOW ? */ 00360000
RETURN C2D(ARG(1))+16 /* yes, return sva+16 */ 00370000
NUMERIC DIGITS 10 /* allow up to 7FFFFFFF */ 00380000
sva=C2D(ARG(1)) /* convert to decimal */ 00390000
tcb = C2D(STORAGE(21C,4)) /* TCB PSATOLD */ 00400000
jscb = C2D(STORAGE(D2X(tcb+180),4)) /* JSCB TCBJSCB */ 00410000
qmpl = C2D(STORAGE(D2X(jscb+244),4)) /* QMPL JSCBQMPI */ 00420000
qmat = C2D(STORAGE(D2X(qmpl+24),4)) /* QMAT QMADD */ 00430000
DO WHILE sva>65536 00440000
qmat = C2D(STORAGE(D2X(qmat+12),4)) /* next QMAT QMAT+12 */ 00450000
sva=sva-65536 /* 010006F -> 000006F */ 00460000
END 00470000
RETURN C2D(STORAGE(D2X(qmat+sva+1),4))+16 00480000
-----Original Message-----
From: IBM Mainframe Discussion List [mailto:[email protected]] On Behalf
Of Richard Pinion
Sent: Wednesday, June 11, 2014 8:18 AM
To: [email protected]
Subject: Accessing TIOT->JFCB segments from COBOL
I have a COBOL program, RENT/31/ANY, that does the following
PSAOLD->TCB->TIOT->JFCB segments.
The program is run on z/OS 1.11 system. I don't know the PTF level, it is a
customer site.
If the program is run from a one step job, or as the first step of a job it
works.
However, subsequent executions of the program, second step and so on, fail with
a S0C4
while checking the JFCB TIO-LEN field. I have added Displays to the code
below, and
it appears that JFCB-ADDR, from TIOT-SEG, for the first DDNAME, is 1024 bytes
greater
in the second execution of the program from a job that executes the program two
times.
I take no credit or blame for the logic of the program. But I do need to
determine
the cause of the failure.
Any ideas???
<Snipped>
--
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 [email protected] with the message: INFO IBM-MAIN
This e-mail, including attachments, may include confidential and/or
proprietary information, and may be used only by the person or entity
to which it is addressed. If the reader of this e-mail is not the intended
recipient or his or her authorized agent, the reader is hereby notified
that any dissemination, distribution or copying of this e-mail is
prohibited. If you have received this e-mail in error, please notify the
sender by replying to this message and delete this e-mail immediately.
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to [email protected] with the message: INFO IBM-MAIN
