TSYSINIT RSECT
TSYSINIT AMODE ANY
TSYSINIT RMODE ANY
************************************************************************
* Function: *
* This is the TSYS subsystem initialization routine. It is *
* called as the result of subsystem definition in any of the *
* following ways: *
* *
* IEFSSNxx parmlib member *
* SETSSI ADD command *
* IEFSSI REQUEST=ADD macro *
* *
* Initialization for the TSYS subsystem consists of the following *
* steps: *
* *
* 1. Establish recovery *
* 2. Issue the IEFSSVT REQUEST=CREATE macro to create the *
* subsystem vector table *
* 3. Issue the IEFSSI REQUEST=OPTIONS macro to specify *
* optional information specific to the TSYS subsystem *
* 4. Issue the IEFSSI REQUEST=PUT macro to store information *
* for use by the TSYS subsystem function routines *
* 5. Issue the IEFSSI REQUEST=ACTIVATE macro to enable the *
* TSYS subsystem to receive function requests *
* 6. Cancel recovery and return *
* *
* INPUT *
* Register 1 points to a two-word parameter list *
* - Word 1 = address of the SSCVT for the TSYS subsystem *
* - Word 2 = address of the JSIPL *
* *
* REGISTER USE *
* 1 - TSYSCB *
* 10 - SSCVT *
* 11 - JSIPL *
* 12 - Code register *
* 13 - Data register *
* *
* MACROS *
* CVT *
* ESTAE *
* FREEMAIN *
* GETMAIN *
* IHASDWA *
* IEFJESCT *
* IEFJSCVT *
* IEFSSI *
* IEFSSVT *
* IEFSSVTI *
* RETURN *
* SETRP *
* WTO *
* *
************************************************************************
*
************************************************************************
* Chain saveareas. *
************************************************************************
USING TSYSINIT,12
SAVE (14,12) Save caller's registers
LR 12,15 Establish module base register
LR 10,1 Save pointer to parameter list
GETMAIN R,LV=WORKALEN Get working storage
ST 13,4(1) Chain saveareas backward
ST 1,8(13) Chain saveareas forward
LR 13,1 Point to this module's savearea
*
USING WORKAREA,13 Addressability to work area
L 11,4(10) Establish addressability
USING JSIPL,11 to the JSIPL
L 10,0(10) Establish addressability
USING SSCT,10 to the SSCVT
*
************************************************************************
* Establish ESTAE *
************************************************************************
XC ESTAED,ESTAED Clear ESTAE parameter list
L 8,=A(TSYSERR) Address of ESTAE routine
ESTAE (8),CT,PARAM=ARETRY,MF=(E,ESTAED)
LTR 15,15 If ESTAE failed
BNZ ESTAERR report it and return
*
************************************************************************
* Invoke the IEFSSVT REQUEST(CREATE) macro to build and initialize *
* the vector table, using the static function routine input table. *
* The function routines reside in LINKLIB and must be loaded to *
* global storage to make them available to all address spaces. *
* Register notation is used to identify the output token for *
* demonstration purposes. *
************************************************************************
LA 2,TOKEN1
*
IEFSSVT REQUEST=CREATE,SUBNAME=SSCTSNAM,SSVTDATA=ROUTINE1, *
OUTTOKEN=(2),LOADTOGLOBAL=YES,MAXENTRIES=ENTRIES, +
RETCODE=RC,RSNCODE=REASON, +
MF=(E,VTPARMS)
*
B TESTVTCR(15) Check return code
*
TESTVTCR EQU *
B ANCHORCB 0 - Processing successful
B VTERR 4 - Warning
B VTERR 8 - Invalid parameters
B VTERR 12 - Request failure
B VTERR 16 - Error loading subsystem
B VTERR 20 - System error
B VTERR 24 - SSI service not available
*
ANCHORCB EQU * Entry for vector table created
************************************************************************
* Initialize and anchor the subsystem-specific control block used *
* by TSYS and its function routines. *
************************************************************************
GETMAIN R,LV=CBLEN,SP=241 Get storage for TSYS control +
block
USING TSYSCB,1
XC TSYSCB,TSYSCB Clear control block
MVC TSYSID(4),CBACRO Move in eye-catcher
LA 7,1 Version 1
STH 7,TSYSVER Put version number in control +
block
LA 7,CBLEN Get control block length
STH 7,TSYSLEN Put length in control block
ST 1,CBADDR Save control block address
DROP 1
*
IEFSSI REQUEST=PUT,SUBNAME=SSCTSNAM,SUBDATA1=CBADDR, +
RETCODE=RC,RSNCODE=REASON, +
MF=(E,SSIPARMS)
*
B TESTPUT(15) Check return code
*
TESTPUT EQU *
B OPTIONS 0 - Processing successful
B SSIERR 4 - Warning
B SSIERR 8 - Invalid parameters
B SSIERR 12 - Request failure
B SSIERR 16 - Not defined
B SSIERR 20 - System error
B SSIERR 24 - SSI service not available
*
************************************************************************
* Inform the SSI that TSYS will respond to the SETSSI command. *
************************************************************************
OPTIONS EQU * Entry for successful PUT
*
IEFSSI REQUEST=OPTIONS,SUBNAME=SSCTSNAM,COMMAND=YES, +
RETCODE=RC,RSNCODE=REASON, +
MF=(E,SSIPARMS)
*
B TESTOPT(15) Check return code
*
TESTOPT EQU *
B ACTIVATE 0 - Processing successful
B SSIERR 4 - Warning
B SSIERR 8 - Invalid parameters
B SSIERR 12 - Request failure
B SSIERR 16 - Not defined
B SSIERR 20 - System error
B SSIERR 24 - SSI service not available
*
ACTIVATE EQU * Entry for successful OPTIONS
************************************************************************
* Activate the subsystem. *
************************************************************************
IEFSSI REQUEST=ACTIVATE,SUBNAME=SSCTSNAM,INTOKEN=TOKEN1, +
RETCODE=RC,RSNCODE=REASON, +
MF=(E,SSIPARMS)
*
B TESTACT(15)
*
TESTACT EQU *
B ACTIVEOK 0 - Processing successful
B SSIERR 4 - Warning
B SSIERR 8 - Invalid parameters
B SSIERR 12 - Request failed
B SSIERR 16 - Not defined
B SSIERR 20 - System error
B SSIERR 24 - SSI service not available
*
ACTIVEOK EQU *
WTO 'TSYS - SUBSYSTEM INITIALIZED'
B DONE
*
VTERR EQU * Entry for IEFSSVT error
MVC FAILSRV(L'SSVTSRV),SSVTSRV Get name of failing service
B ERRMSG Issue error message
*
SSIERR EQU * Entry for IEFSSI error
MVC FAILSRV(L'SSISRV),SSISRV Get name of failing service
*
************************************************************************
* Convert the return and reason code and issue an error message. *
************************************************************************
ERRMSG EQU *
MVC SERVERRD(SERVMSGL),SERVERRS Copy static message
*
L 7,RC Get return code
CVD 7,DOUBLE Convert to decimal
UNPK RCODE1,DOUBLE Make return code printable
MVZ RCODE1+3,RCODE1
MVC SERVERRD+43(2),RCODE1+2 Put return code in message
*
L 7,REASON Get reason code
CVD 7,DOUBLE Convert to decimal
UNPK RCODE1,DOUBLE Make reason code printable
MVZ RCODE1+3,RCODE1
MVC SERVERRD+55(4),RCODE1 Put reason code in message
*
MVC SERVERRD+18(L'FAILSRV),FAILSRV Put name of failing ++
service in message
WTO MF=(E,SERVERRD),CONSNAME=JSICNAME Issue message
B DONE
*
INITERR EQU *
MVC INITERRD(INITMSGL),INITERRS Copy static message
WTO MF=(E,INITERRD),CONSNAME=JSICNAME Issue message
B DONE
*
ESTAERR EQU *
MVC ESTAERRD(ESTAMSGL),ESTAERRS Copy static message
WTO MF=(E,ESTAERRD),CONSNAME=JSICNAME Issue message
B RETURN
*
************************************************************************
* Cancel the ESTAE and return to caller. *
************************************************************************
DONE EQU *
ESTAE 0
RETURN EQU *
L 8,4(13) Pointer to caller's savearea
FREEMAIN R,LV=WORKALEN,A=(13)
LR 13,8
RETURN (14,12),RC=0
*
************************************************************************
* ESTAE routine. *
************************************************************************
TSYSERR EQU *
DROP 12 Drop current addressability
USING TSYSERR,15 Set addressability to TSYSERR
LR 12,15 Copy address of TSYSERR
S 12,=A(TSYSERR-TSYSINIT) Reestablish code register
DROP 15 Drop addressability to TSYSERR
USING TSYSINIT,12 Reset addressability
CL 0,=F'12' If no SDWA provided
BE TSYSERRA Branch to percolate
USING SDWA,1
L 4,SDWAPARM
L 4,0(4)
DROP 1
SETRP WKAREA=(1),RC=4,RETADDR=(4),FRESDWA=YES,RETREGS=YES
TSYSERRA EQU *
XR 15,15 Indicate percolation
BR 14
*
************************************************************************
* Define static function routine input table. *
************************************************************************
IEFSSVTI TYPE=INITIAL,SSVTDATA=ROUTINE1,TABLEN=STABLEN
IEFSSVTI TYPE=ENTRY,NUMFCODES=1,FCODES=254,FUNCNAME=WRITEIT
IEFSSVTI TYPE=ENTRY,NUMFCODES=1,FCODES=255,FUNCNAME=DELETEIT
IEFSSVTI TYPE=ENTRY,NUMFCODES=1,FCODES=9,FUNCNAME=LISTEN
IEFSSVTI TYPE=FINAL
*
************************************************************************
* Function routine data. *
************************************************************************
WRITEIT DC CL8'WRITEIT '
LISTEN DC CL8'LISTEN '
DELETEIT DC CL8'DELETEIT'
ENTRIES DC H'4'
SSVTSRV DC CL7'IEFSSVT'
SSISRV DC CL7'IEFSSI '
CBACRO DC CL4'TSCB'
*
ARETRY DC A(INITERR)
*
SERVERRS WTO 'TSYS ERROR IN xxxxxxx SERVICE, RETCODE xx, RSNCODE xxxx',+
CONSNAME=,MF=L
SERVMSGL EQU *-SERVERRS
*
INITERRS WTO 'TSYS - SUBSYSTEM INITIALIZATION FAILED', +
CONSNAME=,MF=L
INITMSGL EQU *-INITERRS
*
ESTAERRS WTO 'TSYS - SUBSYSTEM ESTAE FAILED', +
CONSNAME=,MF=L
ESTAMSGL EQU *-ESTAERRS
*
*
LTORG
*
WORKAREA DSECT
SAVEAREA DS 18F
DS 0D
DOUBLE DS CL8 CVD work area
RCODE1 DS F Return/reason code in message
RC DS F Return code
REASON DS F Reason code
CBADDR DS F Control block address
FAILSRV DS CL7 Name of failing service
DS 0F
TOKEN1 DS F Vector table token
*
IEFSSVT MF=(L,VTPARMS)
*
IEFSSI MF=(L,SSIPARMS)
*
SERVERRD WTO 'TSYS ERROR IN xxxxxxx SERVICE, RETCODE xx, RSNCODE xxxx',+
CONSNAME=,MF=L
INITERRD WTO 'TSYS - SUBSYSTEM INITIALIZATION FAILED', +
CONSNAME=,MF=L
ESTAERRD WTO 'TSYS - SUBSYSTEM ESTAE FAILED', +
CONSNAME=,MF=L
*
ESTAED ESTAE PARAM=ARETRY,MF=L
*
WORKALEN EQU *-WORKAREA
*
TSYSCB DSECT 0D
TSYSID DS CL4 Acronym
TSYSVER DS H Version
TSYSLEN DS H Length
*
CBLEN EQU *-TSYSCB
*
CVT DSECT=YES CVT
*
IEFJESCT JESCT
*
IEFJSCVT SSCVT
*
IEFJSRC SSI return and reason codes
*
IEFJSIPL Initialization routine +
parameter list
*
IHASDWA
*
IEFSSVTI TYPE=LIST
*
END
z/OS MVS Using the Subsystem Interface
Copyright IBM Corporation 1990, 2014