this http://ibmmainframeforum.com seems to be the "light" version of this http://www.ibmmainframes.com.
Because it was not possible to register here http://www.ibmmainframes.com, my solution for http://www.ibmmainframes.com/about36566.html is as follows.
TEST:
PROC OPTIONS(MAIN) REORDER ;
/* Some information in this structure is only avialable if
the jcl provides the DCB parameter or the associated
dataset is open
*/
DEFINE STRUCTURE
1 tDSInfo
, 2 DD CHAR(8) /* DD Name from JCL */
, 2 DSN CHAR(44) /* Datasetname */
, 2 MEMBER CHAR(8) /* Membername */
, 2 DISP CHAR(3) /* Disposition */
, 2 DSORG CHAR(2) /* Datasetorganisation */
, 2 RECFM CHAR(3) /* Recordformat */
, 2 LRECL BIN FIXED(15) /* Logical Recordlength */
, 2 RESERVED CHAR(442) /* For future use */
;
MyCallback:
PROC(pDSInfo,pUserData) RETURNS(BIT(1));
DCL pDSInfo PTR ;
DCL pUSerData PTR ;
DCL 1 DSInfo TYPE tDSInfo BASED(pDSInfo) ;
PUT SKIP EDIT('DSInfo.DD = ' || DSInfo.DD ) (A);
PUT SKIP EDIT('DSInfo.DSN = ' || DSInfo.DSN ) (A);
PUT SKIP EDIT('DSInfo.Member = ' || DSInfo.Member ) (A);
PUT SKIP EDIT('DSInfo.Disp = ' || DSInfo.Disp ) (A);
PUT SKIP EDIT('DSInfo.DSORG = ' || DSInfo.DSORG ) (A);
PUT SKIP EDIT('DSInfo.RECFM = ' || DSInfo.RECFM ) (A);
PUT SKIP EDIT('DSInfo.LRECL = ' || CHAR(DSInfo.LRECL )) (A);
PUT SKIP EDIT('')(A);
PUT SKIP EDIT('')(A);
RETURN('1'B) ; /* Continue Processing */
END;
DCL OTTO1 FILE RECORD INPUT ;
OPEN FILE(OTTO1);
CALL DSInfo(MyCallback,NULL());
CLOSE FILE(OTTO1);
DSInfo:
/* Loops over the MVS Control blocks to get information
for all DD names associated with the current job.
For each DD Name the filenames and some other
data is fetched from then JFCB (Job File
Control Block).
A callback function is invoked for each file.
The callbackfunction is passed from the calling module.
*/
PROC(pEntry,pUserdata);
DCL pEntry ENTRY
( PTR /* Data for each DDName / Dataset */
, PTR /* Userdata */
) RETURNS(BIT(1)) VARIABLE ;
DCL pUserData PTR ; /* any data passed from the calling modul
an routed to the callback function */
DCL 1 DSInfo TYPE tDSInfo AUTO;
DCL pPSA PTR AUTO INIT(SYSNULL());
DCL 1 PSA BASED(pPSA) /* Prefixed Save Area */
, 2 FILLER1 CHAR(540)
, 2 pTCB PTR
;
DCL 1 TCB BASED(pTCB) /* Task Control Block */
, 2 FILLER1 CHAR(12)
, 2 pTIOT PTR
;
DCL pTIOTSEG PTR ;
DCL 1 TIOTSEG BASED (pTIOTSEG) /* Task Input/Output Table */
,2 TIOELNGH BIN FIXED(7) /* Length of this entry */
,2 FILLER2 CHAR(3)
,2 TIOEDDNM CHAR(8) /* DD Name of Dateset */
,2 TIOEJFCB CHAR(3) /* JFCB per SWAREQ MACRO */
;
DCL pJFCB PTR;
DCL 1 JFCB BASED(pJFCB) /* Job File Control Block */
,2 JFCBDSNM CHAR(44) /* DSN Name */
,2 JFCBELNM CHAR(8) /* Member */
,2 FILLER1 CHAR(35)
,2 JFCBIND2 CHAR(1) /* Indicator2 */
,2 FILLER2 CHAR(10)
,2 JFCDSRG1 CHAR(1) /* DSORG, Byte 1*/
,2 FILLER3 CHAR(1)
,2 JFCRECFM CHAR(1) /* RECFM */
,2 FILLER4 CHAR(3)
,2 JFCLRECL BIN FIXED(15) /* LRECL */
;
DCL Continue BIT(1) AUTO INIT('1'B) ;
/* Build address of first TIOT Segement by skipping */
/* bytes for jobname, stepname */
pTIOTSEG = TCB.PTIOT + 24 ;
/* Loop over all TIOT Segments */
DO WHILE ((TIOTSEG.TIOELNGH ^= 0) & (CONTINUE));
/* Convert SWA virtual address token to JFCB address */
pJFCB = SWAREQ(TIOEJFCB) ;
/* extract/prepare data from controlblocks to pass
to the callback function for the calling modul */
CALL PLIFILL(ADDR(DSInfo),'00'X,CSTG(DSInfo));/* Fill with '0'x */
DSInfo.DD = TIOTSEG.TIOEDDNM ;
DSInfo.DSN = JFCB.JFCBDSNM ;
DSInfo.Member = JFCB.JFCBELNM ;
SELECT (JFCB.JFCBIND2) ;
WHEN('40'x, '41'x) DSInfo.DISP = 'OLD' ;
WHEN('C0'x, 'C1'x) DSInfo.DISP = 'NEW' ;
WHEN('80'x, '81'x) DSInfo.DISP = 'MOD' ;
WHEN('48'x, '49'x) DSInfo.DISP = 'SHR' ;
OTHER DSInfo.DISP = '' ;
END;
SELECT (JFCB.JFCDSRG1) ;
WHEN('80'x, '81'x) DSInfo.DSORG = 'IS' ;
WHEN('40'x, '41'x) DSInfo.DSORG = 'PS' ;
WHEN('20'x, '21'x) DSInfo.DSORG = 'DA' ;
WHEN('02'x, '03'x) DSInfo.DSORG = 'PO' ;
OTHER DSInfo.DSORG = '' ;
END;
SELECT (JFCB.JFCRECFM) ;
WHEN('C0'x) DSInfo.RECFM = 'U' ;
WHEN('80'x) DSInfo.RECFM = 'F' ;
WHEN('40'x) DSInfo.RECFM = 'V' ;
WHEN('90'x) DSInfo.RECFM = 'FB' ;
WHEN('50'x) DSInfo.RECFM = 'VB' ;
OTHER DSInfo.RECFM = '' ;
END;
DSInfo.LRECL = JFCB.JFCLRECL ;
/* Pass data to callback function in calling module */
Continue = pEntry(ADDR(DSInfo),pUserdata);
/* Get next TIOTSEG */
pTIOTSEG = pTIOTSEG + TIOTSEG.TIOELNGH ;
END ;
SWAREQ:
/* Convert SWA virtual address token to 31 Bit address */
/* This submodule replaces assembler macro SWAREQ */
PROC(SWA) RETURNS(PTR);
DCL SWA CHAR(3) ; /* parameter SWA Virtual address token */
DCL 1 SVAS AUTO
,2 SVA1 CHAR(1) INIT(LOW(1))
,2 SVA2 CHAR(3) INIT(SWA)
;
DCL SVAP PTR BASED(ADDR(SVAS)) ;
DCL SVAB BIN FIXED(31) BASED(ADDR(SVAS));
DCL pPSA PTR AUTO INIT(SYSNULL());
DCL 1 PSA BASED(pPSA) /* Prefixed Save Area */
, 2 FILLER1 CHAR(540)
, 2 pTCB PTR
;
DCL 1 TCB BASED(pTCB) /* Task Control Block */
, 2 FILLER1 CHAR(180)
, 2 pJSCB PTR
;
DCL 1 JSCB BASED(pJSCB) /* Job / Step Control Block */
,2 FILLER1 CHAR(244)
,2 pJSCBQMPI PTR
;
DCL 1 QMPA BASED(pJSCBQMPI) /* Queue Manager
Parameter Area */
,2 Filler CHAR(24)
,2 QMAT BIN FIXED(31)
;
DCL l_QMAT BIN FIXED(31) AUTO NOINIT;
IF MOD(SVAB,2) = 1 THEN DO; /* 24 or 31 Bit address */
l_QMAT = QMPA.QMAT ;
DO WHILE(SVAB > 65536) ;
l_QMAT = l_QMAT + 12 ;
SVAB = SVAB - 65536;
END;
SVAB = SVAB + 1 + 16 + l_QMAT ;
END;
ELSE DO;
SVAB = SVAB + 16 ;
END ;
RETURN(SVAP); /* return 31 Bit address */
END ; /* SWAREQ procedure */
END ; /* DSInfo */
END;
