My little subprog:
***********************************************************************
* SUBROUTINE TO OBTAIN SYSTEM INFORMATION *
***********************************************************************
GETJINFO CSECT
GETJINFO AMODE 31
GETJINFO RMODE ANY
LENTRY STM 14,12,12(13)
BALR 12,0
USING *,12
L 2,0(1) GET PTR TO RETURN AREA
USING ZSYSINFO,2
*
* ADDRESS KEY CB'S
* ----------------
USING PSA,0
L 3,PSAAOLD LOCATE ASCB
USING ASCB,3
L 4,PSATOLD LOCATE TCB
USING TCB,4
L 5,TCBTIO LOCATE TIOT
USING TIOT1,5
L 6,TCBJSCB LOCATE JSCB
USING IEZJSCB,6
L 7,ASCBASXB LOCATE ASXB
USING ASXB,7
L 8,ASXBSENV LOCATE ACEE
USING ACEE,8
*
* SAVE SYSTEM INFO FIELDS
* -----------------------
XC ZSYSINFO(256),ZSYSINFO
MVC ZSYSPGMN,JSCBPGMN GET PROGRAM NAME
MVC ZSYSUSER,ACEEUSRI GET USERID
MVC ZSYSGRPN,ACEEGRPN GET GROUP
MVC ZSYSJOBN,TIOCNJOB GET JOB NAME
MVC ZSYSSTEP,TIOCSTEP GET STEP NAME
*
* BUILD THE DDNAME LIST
* ---------------------
ZAP ZSYSNDDN,=P'0' SET DDNAME COUNTER
LA 11,SSYSDD POINT TO DUMMY ENTRY
LA 15,ZSYSDD POINT TO FIRST SLOT
LA 14,TIOENTRY POINT TO FIRST TIOT DD ENTRY
USING TIOENTRY,14
LDDN01 DS 0H
CLI TIOELNGH,X'00' IS THIS THE END OF THE TIOT?
BE LDDN99 YEAH - BREAK OUT
CP ZSYSNDDN,=P'512' ABOUT TO OVERFLOW?
BNL LDDN99 YES - STOP B4 WE BUST LIMIT
AP ZSYSNDDN,=P'1' NO - BUMP COUNT
XC 0(64,15),0(15) CLEAR SLOT
MVC 0(8,15),TIOEDDNM SAVE DDNAME
ZAP 8(2,15),=P'0' PRESET CONCAT SEQUENCE
CLI TIOEDDNM,X'40' IS THIS A CONCAT ENTRY?
BNE LDDN02 NO - SKIP
MVC 0(8,15),0(11) YES - RESET DDNAME
ZAP 8(2,15),8(2,11) PROPAGATE ...
AP 8(2,15),=P'1' ... CONCAT SEQUENCE
LDDN02 DS 0H
LR 11,15 SAVE PTR TO PRIOR ENTRY
SR 1,1
ICM 1,B'0111',TIOEJFCB LOCATE JFCB
MVC 10(44,15),16(1)
LA 15,54(15) BUMP SLOT POINTER
SR 1,1
IC 1,TIOELNGH LOAD CURRENT ENTRY LENGTH
LA 14,0(1,14) POINT TO NEXT TIOT DD ENTRY
B LDDN01
LDDN99 DS 0H
DROP 14
*
* EXIT
* ----
SR 15,15 SET RC=0
L 14,12(13) RESTORE R14
LM 0,12,20(13) RESTORE R0 TO R12
BR 14 RETURN
SSYSDD DS 0CL54 DUMMY DD ENTRY
DC CL8'********'
DC PL2'0'
DC CL44'*'
LTORG
ZSYSINFO DSECT
ZSYSJOBN DS CL8 CURRENT JOB NAME
ZSYSSTEP DS CL16 CURRENT JOBSTEP AND PROCSTEP
ZSYSPGMN DS CL8 CURRENT PROGRAM NAME
ZSYSUSER DS CL8 CURRENT USERID
ZSYSGRPN DS CL8 CURRENT GROUP
DS CL206 RESERVED FOR EXPANSION
ZSYSNDDN DS PL2 COUNT OF DDNAME ENTRIES
ZSYSDD DS 512XL54 ARRAY OF DDNAME ENTRIES
IHAPSA DSECT=YES,LIST=YES
IHAASCB DSECT=YES,LIST=YES
IHAASXB DSECT=YES,LIST=YES
IHAACEE
IEZJSCB
IKJTCB DSECT=YES,LIST=YES
TIOT DSECT
IEFTIOT1
END
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to [email protected] with the message: GET IBM-MAIN INFO
Search the archives at http://bama.ua.edu/archives/ibm-main.html
