|
View previous topic :: View next topic
|
| Author |
Message |
parsesource
New User
Joined: 06 Feb 2006
Posts: 97
|
|
|
|
Hello,
i want to get jobid,stepname,jobname,system symbols etc. in an enterprise pli program.
There´s no api for that, so i have to extract these information from control-blocks.
I´m looking for sample code.
if sombody is doing this in pl/1 already please post it here. thanks |
|
| Back to top |
|
 |
Bill O'Boyle
CICS Moderator
Joined: 14 Jan 2008
Posts: 2501
Location: Atlanta, Georgia, USA
|
|
|
|
I have an Assembler Sub-Program on my home machine which you CALL from PL/I (or COBOL) and it will return this information.
I'll post it as soon as I have some free time.
Regards,
Bill |
|
| Back to top |
|
|
PeD
Active User
Joined: 26 Nov 2005
Posts: 459
Location: Belgium
|
|
|
|
I have these info from withion a PL/I program.
For me too give me one day to post or I can mail it to you if you want it.
Cheers
Pierre |
|
| Back to top |
|
|
parsesource
New User
Joined: 06 Feb 2006
Posts: 97
|
|
|
|
| Bill O'Boyle wrote: |
I have an Assembler Sub-Program on my home machine which you CALL from PL/I (or COBOL) and it will return this information.
I'll post it as soon as I have some free time.
Regards,
Bill |
thanks, but i try to avoid asm.
we use such asm programs too. but for new projects i try to use native pl/I |
|
| Back to top |
|
|
parsesource
New User
Joined: 06 Feb 2006
Posts: 97
|
|
|
|
| PeD wrote: |
I have these info from withion a PL/I program.
For me too give me one day to post or I can mail it to you if you want it.
Cheers
Pierre |
thanks, please post. |
|
| Back to top |
|
|
Bill O'Boyle
CICS Moderator
Joined: 14 Jan 2008
Posts: 2501
Location: Atlanta, Georgia, USA
|
|
|
|
I understand management's "fear" of Assembler. 
But, for the benefit of others, please see attached....
Regards,
Bill |
|
| Back to top |
|
|
Bill O'Boyle
CICS Moderator
Joined: 14 Jan 2008
Posts: 2501
Location: Atlanta, Georgia, USA
|
|
|
|
Because GETJOBI is in .txt format (doesn't format too good), here it is again, unattached -
| Code: |
*PROCESS RENT PROGRAM IS RE-ENTRANT
***********************************************************************
*---------------------------------------------------------------------*
* < G E T J O B I > *
* (GET JOB INFORMATION) *
*---------------------------------------------------------------------*
* *
* THIS SUB-PROGRAM IS CALLED TO OBTAIN THE JOB-NAME, PROCSTEP *
* NAME, STEP-NAME AND JOB-NUMBER (IN THIS ORDER). NOTE THE *
* REQUIRED 128-BYTE WORKAREA (FOR REENTRANCY PURPOSES). *
* *
* EXAMPLE SYNTAX: *
* *
* 03 WS-GETJOBI-PARM-REC. *
* 05 WS-GETJOBI-JOB-NAME *
* PIC X(08). *
* 05 WS-GETJOBI-PROCSTEP-NAME *
* PIC X(08). *
* 05 WS-GETJOBI-STEP-NAME *
* PIC X(08). *
* 05 WS-GETJOBI-JOB-NBR *
* PIC X(08). *
* 05 WS-GETJOBI-WORKAREA *
* PIC X(128). *
* *
* CALL WS-GETJOBI USING WS-GETJOBI-PARM-REC *
* END-CALL *
* *
* THANK YOU FOR YOUR SUPPORT.... *
* *
*---------------------------------------------------------------------*
***********************************************************************
PRMDSECT DSECT PRMDSECT-DSECT
USING *,R7 INFORM ASSEMBLER
PARMAREA EQU * BEGIN PARMAREA
PARMJNME DS CL8 JOB-NAME
PARMPSTP DS CL8 PROCSTEP-NAME
PARMSTPN DS CL8 STEP-NAME
PARMJNBR DS CL8 JOB-NUMBER
PARMLGTH EQU *-PARMAREA CALCULATE PARM-LGTH
STGDSECT DSECT CALLER-STORAGE DSECT
USING *,R9 INFORM ASSEMBLER
STGAREA DS 0XL128 BEGIN STORAGE-AREA
FWORD DS F ALIGNED-FULLWORD WORKAREA
REGSAVEA DS XL72 72-BYTE REGISTER SAVEAREA
EXTRPLST EXTRACT MF=L EXTRACT PARAMETER-LIST (XL12)
STGRMDR EQU STGAREA+L'STGAREA-* REMAINING-STORAGE
DS XL(STGRMDR) STORAGE-REMAINDER
GETJOBI CSECT PROGRAM IS RE-ENTRANT
USING *,R3 INFORM ASSEMBLER
SAVE (14,12) SAVE REGISTERS
LA R3,0(,R15) CSECT ADDRESSABILITY
J CHKRNENV CHECK RUN-ENVIRONMENT
EYECTCHR DC CL47' <<< ASSEMBLY DATE/TIME: &SYSDATC/&SYSTIME..00 >>>'
ORG EYECTCHR+6 REDEFINITION
DC X'A2A285948293A8' LOWER-CASE 'SSEMBLY'
ORG EYECTCHR+15 REDEFINITION
DC X'81A385' LOWER-CASE 'ATE'
ORG EYECTCHR+20 REDEFINITION
DC X'899485' LOWER-CASE 'IME'
ORG EYECTCHR+L'EYECTCHR RESET LOCATION-COUNTER
CHKRNENV DS 0H ENSURE ALIGNMENT
XR R10,R10 ENSURE X'00'S
LLGT R15,540 ADDRESS CURRENT TCB
L R15,208(,R15) ADDRESS TCB EXTN
L R15,20(,R15) ADDRESS AFCB
LTR R15,R15 BATCH ENVIRONMENT?
JZ ADDRPLST YES, ADDRESS THE PARMLIST
CLC =CL3'AFC',0(R15) BATCH ENVIRONMENT?
JNE ADDRPLST YES, ADDRESS THE PARMLIST
LA R10,4095 INVALID FOR USE IN CICS
ADDRPLST EQU *
L R7,0(,R1) ADDRESS THE PARMLIST
LA R7,0(,R7) CLEAR TOP-BIT
MVI PARMAREA,C' ' ENSURE ALL SPACES
MVC PARMAREA+1(PARMLGTH-1),PARMAREA
LA R9,PARMLGTH(,R7) ADDRESS CALLER'S WORKAREA
XC STGAREA,STGAREA ENSURE X'00'S
LA R15,REGSAVEA POINT TO OUR SAVEAREA
ST R13,4(,R15) BACKWARD-CHAIN
ST R15,8(,R13) FORWARD-CHAIN
LR R13,R15 POINT TO OUR SAVEAREA
LTR R15,R10 BATCH ENVIRONMENT?
JNZ RTN2CLLR NO, RETURN TO CALLER
LA R10,FWORD POINT TO FWORD
EXTRACT (R10),'S',FIELDS=TIOT,MF=(E,EXTRPLST)
L R10,FWORD LOAD FROM FWORD
MVC PARMAREA(PARMLGTH-L'PARMJNBR),0(R10)
LLGT R10,540 CURRENT TCB
L R10,180(,R10) POINT TO JFCB
L R10,316(,R10) POINT TO SSID
MVC PARMJNBR,12(R10) POPULATE JOB-NUMBER
XR R15,R15 ENSURE X'00'S
RTN2CLLR EQU *
L R13,4(,R13) RESTORE CALLER'S R13
XC STGAREA,STGAREA ENSURE X'00'S
RETURN (14,12),RC=(15) RESTORE AND RETURN
YREGS , MVS REGISTER-MACRO
LTORG ,
GETJOBI AMODE 31 ,
GETJOBI RMODE ANY ,
END , END 'GETJOBI'
|
Regards,
Bill |
|
| Back to top |
|
|
dick scherrer
Moderator Emeritus
Joined: 23 Nov 2006
Posts: 19243
Location: Inside the Matrix
|
|
|
|
Hello,
To download/ view a .txt attachment, it is often necessary to right-click and Save Target As to the local hard drive. Trying to open in the browser often loses formatting and everything is run together. |
|
| Back to top |
|
|
PeD
Active User
Joined: 26 Nov 2005
Posts: 459
Location: Belgium
|
|
|
|
Here in PL/I.
What is incomplete or missing : all info on allocated datasets in JFCB, because I need to translate in PL/I the SWAREQ macro.
( If interested, tell me - I will pass when done ).
Cheers
Pierre
PS : this version ( which is an exercise version ) is not really documented , but is , I believe, selfspeaking.
| Code: |
PED827: PROC OPTIONS(MAIN);
/*-------------------------------------------------------------------*/
/* */
/* DESCRIP : TEST DATA AREAS FROM PED827 */
/* */
/* CREATION: PIERRE DEVILLERS DATE : SEPT 2005 */
/* */
/*-------------------------------------------------------------------*/
/* MODIF NAME DATE Change ref */
/*-------------------------------------------------------------------*/
/*-------------------------------------------------------------------*/
/* E N T R Y */
/*-------------------------------------------------------------------*/
DCL SYSPRINT FILE OUTPUT PRINT;
/*-------------------------------------------------------------------*/
/* DECLARATION */
/*-------------------------------------------------------------------*/
DCL 01 JESNODE CHAR(8) INIT(' ');
DCL 01 AVAIL BIN FIXED(31) INIT(0);
DCL 01 EAVAIL BIN FIXED(31) INIT(0);
/*-------------------------------------------------------------------*/
/* CONTROL BLOCK */
/*-------------------------------------------------------------------*/
DCL FBNULL FIXED BIN(31) INIT(0),
PT_PSA PTR BASED(ADDR(FBNULL)),
01 PSA BASED(PT_PSA),
03 * CHAR(540),
03 PT_TCB PTR,
03 * CHAR(4),
03 PT_ASCB1 PTR,
01 TCB BASED(PT_TCB),
03 * CHAR(12),
03 PT_TIOT PTR,
01 TIOT BASED(PT_TIOT),
03 F_TIOT1 CHAR(8),
03 F_TIOT2 CHAR(8),
03 F_TIOT3 CHAR(8),
03 S_TIOT(30),
05 S1_TIOT CHAR(1),
05 S2_TIOT CHAR(3),
05 S3_TIOT CHAR(8),
05 S4_TIOT CHAR(3),
05 S5_TIOT CHAR(5),
01 JSCB BASED(PT_TCB),
03 * CHAR(180),
03 PT_JSCB PTR,
03 * CHAR(060),
03 PT_QMPL PTR,
03 * CHAR(012),
03 PT_JCT PTR,
01 JCT BASED(PT_JCT),
03 * CHAR(36),
03 PT_JCTX PTR,
03 * CHAR(16),
03 PT_ACT CHAR(3),
01 JCTX BASED(PT_JCTX),
03 ZJCTX CHAR(176),
01 QMPL BASED(PT_QMPL),
03 * CHAR(24),
03 PT_QMAT PTR,
01 SSIB BASED(PT_JSCB),
03 * CHAR(316),
03 PT_SSIB PTR,
01 SICI BASED(PT_SSIB),
03 * CHAR(12),
03 JOBNUME CHAR(8),
01 PSA2 BASED(PT_PSA),
03 * CHAR(224),
03 PT_ASCB PTR,
01 ASCB BASED(PT_ASCB1),
03 * CHAR(48),
03 PT_LDA PTR,
03 * CHAR(56),
03 PT_ASXB PTR,
03 * CHAR(224),
03 PT_ASSB PTR,
01 ASXB BASED(PT_ASXB),
03 * CHAR(200),
03 PT_ACEE PTR,
01 ACEE BASED(PT_ACEE),
03 * CHAR(100),
03 PT_UNAM PTR,
01 ACEENAM BASED(PT_UNAM),
03 * CHAR(1),
03 PGMNAM2 CHAR(20),
01 ASSB BASED(PT_ASSB),
03 * CHAR(168),
03 PT_JSAB PTR,
01 JSAB BASED(PT_JSAB),
03 * CHAR(44),
03 ASUSERID CHAR(8),
01 LDA BASED(PT_LDA),
03 * CHAR(204),
03 LDAREGRQ BIN FIXED(31),
03 LDALIMIT BIN FIXED(31),
03 * CHAR(4),
03 LDAELIM BIN FIXED(31),
03 * CHAR(12),
03 LDALOAL BIN FIXED(31),
03 * CHAR(4),
03 LDAELOAL BIN FIXED(31),
01 CVT BASED(PT_PSA),
03 * CHAR(16),
03 PT_CVT PTR,
/*-----serial number -----*/
01 CVTPCCAT BASED(PT_CVT),
03 * CHAR(764),
03 PT_CVTPCCAT PTR,
01 PCCAVT BASED(PT_CVTPCCAT),
03 PT_PCCAT00P PTR,
03 PT_PCCAT01P PTR,
03 PT_PCCAT02P PTR,
03 PT_PCCAT03P PTR,
03 PT_PCCAT04P PTR,
03 PT_PCCAT05P PTR,
03 PT_PCCAT06P PTR,
03 PT_PCCAT07P PTR,
03 PT_PCCAT08P PTR,
03 PT_PCCAT09P PTR,
03 PT_PCCAT10P PTR,
03 PT_PCCAT11P PTR,
03 PT_PCCAT12P PTR,
03 PT_PCCAT13P PTR,
03 PT_PCCAT14P PTR,
03 PT_PCCAT15P PTR,
01 PCCA BASED(PT_PCCAT00P),
03 PCCA1 CHAR(4),
03 PCCA2 CHAR(2),
03 PCCA3 CHAR(1),
03 PCCA4 CHAR(5),
03 PCCA5 CHAR(4),
01 CVTSYSN BASED(PT_CVT),
03 * CHAR(340),
03 SYSNAM CHAR(8),
01 CVTJESCT BASED(PT_CVT),
03 * CHAR(296),
03 PT_CVTJESCT PTR,
01 SSCVT BASED(PT_CVTJESCT),
03 * CHAR(24),
03 PT_SSCVT PTR,
01 SSCTSUSE BASED(PT_SSCVT),
03 * CHAR(20),
03 PT_SSCTSUSE PTR,
01 JESLVL BASED(PT_SSCTSUSE),
03 JESLEV CHAR(8),
01 SSCTSUS2 BASED(PT_SSCVT),
03 * CHAR(28),
03 PT_SSCTSUS2 PTR,
01 JESINF1 BASED(PT_SSCTSUS2),
03 * CHAR(532),
03 JESN106 CHAR(8),
01 JESINF2 BASED(PT_SSCTSUS2),
03 * CHAR(616),
03 JESN107 CHAR(8),
01 JESINF3 BASED(PT_SSCTSUS2),
03 * CHAR(620),
03 JESN108 CHAR(8),
01 JESINF4 BASED(PT_SSCTSUS2),
03 * CHAR(708),
03 JESN109 CHAR(8);
DCL 01 T_TIOT,
03 TIOTLNGH CHAR(1),
03 TIOESTTA CHAR(1),
03 TIOERLOC,
05 TIOEWTCT CHAR(1),
05 TIOELINK CHAR(1),
03 TIOEDDNM CHAR(8),
03 TIOEJFCB CHAR(3),
03 TIOESTTC CHAR(1),
03 TIOESTTB CHAR(1),
03 TIOEFSRT CHAR(3),
03 TIOFILL1 CHAR(1),
03 TIOPNSLT CHAR(1),
03 TIOFILL2 CHAR(1),
03 TIOPNSRT CHAR(1),
03 TIOPPOOL CHAR(8),
03 TIOPSTTB CHAR(1),
03 TIOPSLOT CHAR(3),
03 TIOTFEND CHAR(4);
DCL 01 BJFCB,
03 BJFCB1 CHAR(1) INIT('00'X),
03 BJFCB2 CHAR(3) INIT('000000'X);
DCL 01 PT_BJFCB PTR BASED(ADDR(BJFCB));
DCL 01 ZJFCB BASED(PT_BJFCB),
03 DJFCB0 CHAR(16),
03 DJFCB1 CHAR(50),
03 DJFCB2 CHAR(50),
03 DJFCB3 CHAR(50),
03 DJFCB4 CHAR(16);
DCL 01 ZONEE CHAR(1) INIT('00'X);
DCL 01 BIT1 BIT(8) BASED(ADDR(ZONEE));
DCL 01 BITA BIT(8) INIT('00000000'B);
DCL 01 BITB BIT(8) INIT('00001111'B);
DCL 01 BITC BIT(8) INIT('00000000'B);
/*-------------------------------------------------------------------*/
/* BUILTIN */
/*-------------------------------------------------------------------*/
DCL ONCODE BUILTIN;
DCL DECIMAL BUILTIN;
DCL DATETIME BUILTIN;
DCL TIME BUILTIN;
DCL NULL BUILTIN;
DCL FLOAT BUILTIN;
DCL ADDR BUILTIN;
DCL LENGTH BUILTIN;
DCL INDEX BUILTIN;
DCL TRIM BUILTIN;
DCL STRING BUILTIN;
DCL STORAGE BUILTIN;
DCL SUBSTR BUILTIN;
DCL SYSNULL BUILTIN;
/*----------------------------------------------------------------*/
/*----------------------------------------------------------------*/
/*- -*/
/*- H O U S E K E E P I N G -*/
/*- -*/
/*----------------------------------------------------------------*/
/*-----HOUSEKEEPING-----------------------------------------------*/
/*----------------------------------------------------------------*/
PUT SKIP LIST ('-----------------------------------------');
PUT SKIP LIST ('JESLEV - '||JESLEV||'-');
SELECT (JESLEV);
WHEN ( 'z/OS 1.9') JESNODE = JESN109;
WHEN ( 'z/OS 1.8') JESNODE = JESN108;
WHEN ( 'z/OS 1.7') JESNODE = JESN107;
WHEN ( 'z/OS 1.6'
, 'z/OS 1.5'
, 'z/OS 1.4') JESNODE = JESN106;
OTHERWISE;
END;
PUT SKIP LIST ('JESNODE- '||JESNODE||'-');
PUT SKIP LIST ('CPU NR - '||PCCA1||'-'
||PCCA2||'-'
||PCCA3||'-'
||PCCA4||'-'
||PCCA5||'-');
PUT SKIP LIST ('-----------------------------------------');
PUT SKIP LIST (' ');
PUT SKIP LIST ('ASUSERID - '||ASUSERID||'-');
PUT SKIP LIST ('PGMNAM2 - '||PGMNAM2||'-');
PUT SKIP LIST ('SYSNAM - '||SYSNAM||'-');
PUT SKIP LIST ('-----------------------------------------');
PUT SKIP LIST (' ');
PUT SKIP LIST ('-----memory allocation ------------------');
AVAIL = LDA.LDALIMIT - LDA.LDALOAL;
EAVAIL = LDA.LDAELIM - LDA.LDAELOAL;
PUT SKIP LIST ('LDALIMIT - '||LDALIMIT||'-');
PUT SKIP LIST ('LDALOAL - '||LDALOAL||'-');
PUT SKIP LIST ('LDAELIM - '||LDAELIM||'-');
PUT SKIP LIST ('LDAELOAL - '||LDAELOAL||'-');
PUT SKIP LIST ('AVAIL - '||AVAIL||'-');
PUT SKIP LIST ('EAVAIL - '||EAVAIL||'-');
PUT SKIP LIST ('-----------------------------------------');
PUT SKIP LIST (' ');
PUT SKIP LIST ('JOBNUME - '||JOBNUME||'-');
PUT SKIP LIST ('JOBNAME - '||F_TIOT1||'-');
PUT SKIP LIST ('STEPNAME - '||F_TIOT2||'-');
PUT SKIP LIST ('F_TIOT3 - '||F_TIOT3||'-');
PUT SKIP LIST ('-----------------------------------------');
PUT SKIP LIST (' ');
PUT SKIP LIST ('S1_TIOT 1- '||S1_TIOT(1)||'-');
PUT SKIP LIST ('S1_TIOT 2- '||S1_TIOT(2)||'-');
PUT SKIP LIST ('S1_TIOT 3- '||S1_TIOT(3)||'-');
PUT SKIP LIST ('S1_TIOT 4- '||S1_TIOT(4)||'-');
PUT SKIP LIST ('S1_TIOT 5- '||S1_TIOT(5)||'-');
PUT SKIP LIST ('S1_TIOT 6- '||S1_TIOT(6)||'-');
PUT SKIP LIST ('S1_TIOT 7- '||S1_TIOT(7)||'-');
PUT SKIP LIST ('-----------------------------------------');
/*-------------------------------------------------------------------*/
/* END OF PROGRAM */
/*-------------------------------------------------------------------*/
END PED827;
|
|
|
| Back to top |
|
|
parsesource
New User
Joined: 06 Feb 2006
Posts: 97
|
|
|
|
thanks PeD!
this sample code is exactly what i need! |
|
| Back to top |
|
|
PeD
Active User
Joined: 26 Nov 2005
Posts: 459
Location: Belgium
|
|
|
|
Do you need more regarding the files used in a program?
I will try to decode during my "forced" vacation period of end of year.
Cheers
Pierre |
|
| Back to top |
|
|
dick scherrer
Moderator Emeritus
Joined: 23 Nov 2006
Posts: 19243
Location: Inside the Matrix
|
|
|
|
Hi Pierre,
| Quote: |
| Do you need more regarding the files used in a program? |
DDnames and their DSNs would be helpful to several who have looked in the past.
Enjoy the holidays!
d |
|
| Back to top |
|
|
parsesource
New User
Joined: 06 Feb 2006
Posts: 97
|
|
|
|
| PeD wrote: |
Do you need more regarding the files used in a program?
I will try to decode during my "forced" vacation period of end of year.
Cheers
Pierre |
i´m quite happy with this code.
but would be helpful for others |
|
| Back to top |
|
|
parsesource
New User
Joined: 06 Feb 2006
Posts: 97
|
|
|
|
| PeD wrote: |
Here in PL/I.
What is incomplete or missing : all info on allocated datasets in JFCB, because I need to translate in PL/I the SWAREQ macro.
( If interested, tell me - I will pass when done ).
|
i´d be interested :-)
(because FILEDDWORD only returns the first dataset in a concatenation) |
|
| Back to top |
|
|
PeD
Active User
Joined: 26 Nov 2005
Posts: 459
Location: Belgium
|
|
|
|
Not yet done.
I wil work on that. Give me days with 30 hours.
Cheers
Pierre |
|
| Back to top |
|
|
Bill O'Boyle
CICS Moderator
Joined: 14 Jan 2008
Posts: 2501
Location: Atlanta, Georgia, USA
|
|
|
|
Ped,
Moving to Mars may help as a Mars day is 25.5 hours.  |
|
| Back to top |
|
|
PeD
Active User
Joined: 26 Nov 2005
Posts: 459
Location: Belgium
|
|
|
|
Good
Connected thru a MAinframe Remote System |
|
| Back to top |
|
|
parsesource
New User
Joined: 06 Feb 2006
Posts: 97
|
|
|
|
| PeD wrote: |
Not yet done.
I wil work on that. Give me days with 30 hours.
Cheers
Pierre |
Thanks
Dont worry, days are getting longer
This will solve your problem in the long term 
www.slate.com/id/2133359/ |
|
| Back to top |
|
|
parsesource
New User
Joined: 06 Feb 2006
Posts: 97
|
|
|
|
i´ve found a gold-nugget (bpxwdyn)
if you loop through all allocation with 'INFO INRELNO' you get all allocations
this is the code in rexx (tested, displays all allocations)
drawback: if you want to return the dsn of a special ddname, you have to go through all allocations until you find it
| Code: |
/* REXX */
do i=1 by 1 until last<>0
IF BPXWDYN('info inrelno('i') inrtddn(dd) inrtdsn(ds)',
' inrtpath(path) inrtlst(last)')^=0 THEN INRTLST(LAST);
if path<>'' then
say left(dd,8) path
else
say left(dd,8) ds
end
|
this is a SAMPLE for calling bpxwdyn in pl/1 (not tested)
| Code: |
dyntst: proc(parm) options(main);
dcl bpxwdyn external entry options(asm inter retcode);
on endfile($tmp) goto eof;
dcl parm char(255) var;
dcl dynstr char(255) var;
dcl datastr char(255) var;
dynstr = 'ALLOC FI($TMP) DA(''' || parm || ''') SHR REUSE';
call bpxwdyn(dynstr);
do while('1'b);
read file($tmp) into(datastr) ;
end ;
eof: dynstr = 'FREE FI($TMP)' ;
call bpxwdyn(dynstr);
return ;
never_call_me: proc;
release bpxwdyn;
end never_call_me ;
end dyntst ;
|
so it should be possible to get all allocated dataset-names in pl/1 without doing ugly things (swareq etc.) |
|
| Back to top |
|
|
bauer
New User
Joined: 03 Mar 2009
Posts: 28
Location: germany
|
|
| Back to top |
|
|
dick scherrer
Moderator Emeritus
Joined: 23 Nov 2006
Posts: 19243
Location: Inside the Matrix
|
|
|
|
Hello and welcome to this forum,
Thank you for the code
d |
|
| Back to top |
|
|
bauer
New User
Joined: 03 Mar 2009
Posts: 28
Location: germany
|
|
|
|
Try this:
| Code: |
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;
CALL DSInfo(MyCallback,NULL());
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;
|
|
|
| Back to top |
|
|
PeD
Active User
Joined: 26 Nov 2005
Posts: 459
Location: Belgium
|
|
|
|
Brillant!
For my coding here , Ein Sonnenschein zwischen den Wolken !!
Thanks
Pierre |
|
| Back to top |
|
|
bauer
New User
Joined: 03 Mar 2009
Posts: 28
Location: germany
|
|
| Back to top |
|
|
parsesource
New User
Joined: 06 Feb 2006
Posts: 97
|
|
|
|
great stuff, i´ll try. thank you!
|
|
| Back to top |
|
|
|
|
|
