The following is a coded example of a program that generates an
extended status function call (SSI function code 80).
This program is reentrant and must run in an authorized library.
STATUS2 TITLE 'Sample expanded status SSI call'
STATUS2 CSECT ,
STATUS2 AMODE 31
STATUS2 RMODE ANY
USING STATWORK,R10 Est work area addressability
USING STATMAIN,R12 Est base addressability
STATMAIB STM R14,R12,12(R13) Save callers registers
LR R12,R15 Set base register
LR R8,R1 Save CPPL address
STORAGE OBTAIN,LENGTH=STATWLEN,ADDR=(R10),LOC=ANY C
Obtain local work area
LR R0,R10 Zero the
LA R1,STATWLEN work area
SLR R15,R15 that was
MVCL R0,R14 just obtained
ST R13,SAVEAREA+4 Chain
LA R15,SAVEAREA in
ST R15,8(R13) new
LR R13,R15 save area
***********************************************************************
* Determine the local userid *
***********************************************************************
IAZXJSAB READ,USERID=THISUSER Get execution user ID
***********************************************************************
* Set up basic extended status SSOB *
***********************************************************************
USING SSOB,STSSOB Est SSOB addressability
LA R0,STSSOB Ensure that
LA R1,L'STSSOB the SSOB
SLR R15,R15 area is
MVCL R0,R14 all zero
MVC SSOBID,=C'SSOB' Set SSOB eyecatcher
MVC SSOBLEN,=Y(SSOBHSIZ) Set length of SSOB header
MVC SSOBFUNC,=Y(SSOBESTA) Set status 2 function code
MVC SSOBSSIB,=F'0' Use LOJ SSIB
LA R0,SSOB+SSOBHSIZ Point to STAT extension
ST R0,SSOBINDV Point base to extension
USING STAT,SSOB+SSOBHSIZ Est STAT extension addr'blty
MVC STATEYE,=C'STAT' Move in the eyecatcher
MVC STATLEN,=Y(STATSIZE) Set length of extension
MVC STATVER,=AL1(STATCVRL,STATCVRM) Set current version
MVI STATTYPE,STATTERS Set terse data request
***********************************************************************
* Make only filter this userid *
***********************************************************************
OI STATSEL1,STATSOWN Indicate OWNER is a filter
LA R0,STATOWNR Get area in STAT
LA R1,L'STATOWNR and length
LA R14,THISUSER Get this userid
LA R15,L'THISUSER and length
ICM R15,B'1000',=C' ' Pad with blanks
MVCL R0,R14 Copy parm to STAT
***********************************************************************
* Call the subsystem *
***********************************************************************
MODESET MODE=SUP Supervisor state for SSI function
LA R1,STSSOB Get SSOB address
O R1,=X'80000000' Indicate last SSOB
ST R1,PARMPTR Set parm pointer
LA R1,PARMPTR Get R1 for IEFSSREQ
IEFSSREQ Issue extended status SSI call
LTR R15,R15 Any SSI errors?
BNZ SSREQERX Yes, go process errors
MODESET MODE=PROB Return to problem program state
***********************************************************************
* Process results for IEFSSREQ here *
***********************************************************************
USING STATJQ,R4 Est STATJQ addressability
LA R4,STATJOBF-(STJQNEXT-STATJQ) Get 0th STATJQ
LOOPSTJQ ICM R4,B'1111',STJQNEXT Get next area
BZ DONESTJQ No more, done with STATJQs
LH R3,STJQOHDR Get length of STATJQ
LA R5,STATJQ(R3) Point to 1st section
SLR R2,R2 Get total
ICM R2,B'0011',STHDLEN-STATJQHD(R5) Header length
LA R5,STHDSIZE(R5) Point to 1st variable section
SL R2,=A(STHDSIZE) Decriment for 1st header length
LOOPSECT CLC 2(2,R5),=AL1(STTRTERS,STTRTMOD) Terse section?
BNE NOTTERSE No, check next type
USING STATJQTR,R5 Est Terse section addr'blty
* Process terse section data
DROP R5 Drop terse section
B NEXTSECT Go process next section
NOTTERSE CLC 2(2,R5),=AL1(STJ2TERS,STJ2TMOD) JES2 section?
BNE NOTJES2 No, check next type
USING STATJ2TR,R5 Est JES2 section addr'blty
* Process JES2 section data
DROP R5 Drop JES2 section
B NEXTSECT Go process next section
NOTJES2 CLC 2(2,R5),=AL1(STAFFIN,STAFTMOD) Affinity section?
BNE NEXTSECT Not known, get next section
USING STATAFFS,R5 Est Affinity section addr'blty
* Process JES2 section data
DROP R5 Drop Affinity section
NEXTSECT SLR R15,R15 Get length of
ICM R15,B'0011',0(R5) current section
SR R2,R15 Decrement total count
BNP LOOPSTJQ None left, loop
ALR R5,R15 Point to next section
B LOOPSECT Loop for all sections
DONESTJQ DS 0H Done processing all elements
***********************************************************************
* Return data area passed *
***********************************************************************
MODESET MODE=SUP Supervisor state for SSI function
MVI STATTYPE,STATMEM Set memory management call
LA R1,STSSOB Get SSOB address
O R1,=X'80000000' Indicate last SSOB
ST R1,PARMPTR Set parm pointer
LA R1,PARMPTR Get R1 for IEFSSREQ
IEFSSREQ Issue extended status SSI call
MODESET MODE=PROB Return to problem program state
B EXIT Go exit the command processor
SSREQERX LR R2,R15 Save return code
MODESET MODE=PROB Return to problem program state
LR R15,R2 Restore return code
B SSREQERR Go process error
***********************************************************************
* Process IEFSSREQ error return codes *
***********************************************************************
USING GFDSECTD,R1 Est general failure parm list
SSREQERR LA R1,FAILPARM Get address of fail parm area
ST R1,PARMPTR Save in pointer word
ST R15,GFRCODE Save IEFSSREQ return code
MVC GFCALLID,=Y(GFSSREQ) Indicate IEFSSREQ error
ST R8,GFCPPLP Save CPPL pointer addr
MVC ECBADS,=F'0' Zero ECB address
LA R0,ECBADS Set ECB address
ST R0,GFECBP into the PPL
LA R1,PARMPTR Get addr of parm pointer
LINK EP=IKJEFF19 Call TSO GNRLFAIL service
B EXIT Return to caller
DROP R1 Drop GFDSECTD
***********************************************************************
* Return to the caller *
***********************************************************************
EXIT L R13,SAVEAREA+4 Get callers save area
STORAGE RELEASE,LENGTH=STATWLEN,ADDR=(R10) C
Return local work area
L R14,12(R13) Restore callers
LM R0,R12,20(R13) registers
SLR R15,R15 Set a zero return code
BR R14 Return to caller
DROP R10,R12 Drop STATWORK, Local
LTORG ,
***********************************************************************
* Work area DSECT *
***********************************************************************
STATWORK DSECT ,
SAVEAREA DS 18F Save area
THISUSER DS CL8 This user ID
PARMPTR DS A Pointer for MVS calls
ECBADS DS F CMD processor ECB
FAILPARM DS XL(GFLENGF) Parm area for GNRLFAIL
STSSOB DS XL(SSSTLEN8) Enhanced status SSOB
STATWLEN EQU *-STATWORK Length of local storage area
***********************************************************************
* Equates *
***********************************************************************
R0 EQU 0
R1 EQU 1
R2 EQU 2
R3 EQU 3
R4 EQU 4
R5 EQU 5
R6 EQU 6
R7 EQU 7
R8 EQU 8
R9 EQU 9
R10 EQU 10
R11 EQU 11
R12 EQU 12
R13 EQU 13
R14 EQU 14
R15 EQU 15
***********************************************************************
* TSO and MVS DSECTs *
***********************************************************************
IKJEFFGF GFDSECT=YES
IEFJESCT ,
IEFJSSOB ,
IAZSSST DSECT=YES
IAZJSAB ,
IHAPSA ,
IHAASCB ,
IHAASSB ,
IKJTCB ,
IHASTCB ,
CVT DSECT=YES
STATUS2 CSECT ,
END ,
z/OS MVS Using the Subsystem Interface
Copyright IBM Corporation 1990, 2014