Figure 1 through Figure 5 show an example of a service stub for an installation-defined callable service.
**** START OF SPECIFICATIONS *****************************************
* *
* MODULE NAME = CSFGEN *
* DESCRIPTIVE NAME = SERVICE STUB *
* *
* FUNCTION = *
* THIS IS A SAMPLE SERVICE STUB. IT IS MEANT TO BE LINKEDITED *
* WITH THE APPLICATION AND ENTERED VIA A CALL CSFGEN. THIS STUB *
* CAUSES THE EXECUTION OF THE SERVICE WITH SERVICE NUMBER = 50 *
* (DECIMAL). *
* MODULE TYPE = ASSEMBLER *
* PROCESSOR = ASSEMBLER *
* MODULE SIZE = ONE BASE REGISTER *
* *
**** END OF SPECIFICATIONS *******************************************
CSFGEN START 0
GENSNUM EQU 50
CSFGEN CSECT
CSFGEN AMODE 31
CSFGEN RMODE ANY
MAINENT DS 0H
USING *,R15
LAE R15,0(R15,0)
L R15,=A(CICSTEST)
BAKR 0,R15 PR from CICSTEST will restore GPRs
LTR R15,R15
BC 2,NOCICS
*
YESCICS DS 0H
SAC 0
STM R14,R12,12(R13)
LR R12,R15
DROP R15
USING MAINENT,R12
LR R3,R0
B NORMAL
*
NOCICS DS 0H
USING MAINENT,R12
BSM R14,0
BAKR R14,0
LAE R12,0
LR R12,R15
SLR R13,R13
***************************************************************
* At this point, R0 must contain the service number.
* If we are to call the TRUE, R13 is non-zero
* R1 points to the caller's parameter list.
***************************************************************
NORMAL DS 0H
LA R0,GENSNUM R0 gets service number
SLR R10_ZERO,R10_ZERO
LR RC,R10_ZERO
L R2,CVTPTR
USING CVT,R2
L R2,CVTABEND CLR R2,R10_ZERO
BC 8,NOICSF
USING SCVTSECT,R2
L R2,SCVTCCVT
CLR R2,R10_ZERO
BC 8,NOICSF
USING CCVT,R2
TM CCVTSFG1,B'00110000' IS ICSF ACTIVE
BC 1,YESICSF
NOICSF LA RC,12 Set return code to 12 decimal
L R7,RETURN_CODE_PTR(,R1)
ST RC,RETURN_CODE(,R7)
SLR R0,R0
L R7,REASON_CODE_PTR(,R1)
ST R0,REASON_CODE(,R7)
B FINISHED
YESICSF DS 0H
**********************************************************************
* Note that, if we're in CICS, the prolog code pointed R3 at the AFCB
* and R13 at the caller's savearea--they're still pointing. Also, R0
* contains the service number, with the high order bit ON if the TRUE
* has been tried and found wanting. In this last case, CSFVCCPP will
* check the high order bit and not attempt to call the TRUE.
* If R13 is zero, we're using the linkage stack. That means we can
* call CSFAPRPC.
* If R13 is not zero, we're using non-stack linkage. That means the
* caller's savearea will be used. CSFVCCPP uses this kind of linkage.
* But note that CSFVCCPP won't return here. Instead, it will return
* directly to the caller--that is, to the owner of the only save
* area around.
**********************************************************************
CLR R13,R10_ZERO
BC 8,EXECPRPC
L R15,CCVTPRPD
BALR R14,R15
LR RC,R15
B FINISHED
EXECPRPC L R15,CCVTPRPC
BALR R14,R15
LR RC,R15
FINISHED DS 0H
*
****************************************************************
* This routine uses the linkage stack to save the caller's regs
* if this is not a CICS environment. In CICS, it uses the save
* area pointed to by register 13. So the epilog code takes one
* of two forms. If this is CICS (i.e. if R13 is non-zero),
* return is via LM and BR 14. If this is not CICS, return is
* via PR.
*
* On return, the PR of ESA linkage does not restore registers
* 0, 1, 14 and 15. In the LM of normal BR 14 linkage, however,
* everything but 13 gets restored. Since this routine has no
* autodata, there's no way to pass back return and reason codes
* unless we leave 0 and 15 intact. The solution is to deviate
* slightly from normal BR 14 linkage and restore only registers
* 1 through 12 and 14.
****************************************************************
LTR R13,R13
BC 8,ENDNOCICS ENDCICS LR R15,RC
L R14,SAVE14(,R13)
LM R1,R12,24(R13)
BR R14
*
EDNOCICS DS 0H
LR R15,RC
LA R7,12
CR R15,R7
BNE ENDSVC
LA R7,16
CR R0,R7
BNE ENDSVC
L R7,RETURN_CODE_PTR(,R1)
ST R15,RETURN_CODE(,R7)
L R7,REASON_CODE_PTR(,R1)
ST R0,REASON_CODE(,R7)
ENDSVC LR R15,RC
PR
**********************************************************************
**********************************************************************
** CICSTEST: Decides whether this is a CICS environment
**********************************************************************
**********************************************************************
CICSTEST DS 0H
LAE R12,0 Clear AR 12
LR R12,R15 Addressability via R12
USING CICSTEST,R12
L R15,=A(CSFGEN) R15 gets caller's base reg
L R2,CVTPTR GET CVT POINTER
USING CVT,R2
L R2,CVTABEND AND SECONDARY CVT POINTER
USING SCVTSECT,R2
L R2,SCVTCCVT POINT TO CSF CCVT
LTR R2,R2 IS CRYPTO INSTALLED?
BZ RETRN IF NOT, GO HOME
USING CCVT,R2
TM CCVTSFG1,B'00110000' IS ICSF ACTIVE
BNO RETRN IF NOT , GO HOME
* Check for wait list routine
*
TM CCVTCICS,B'10000000' Q. CCVTPRPA ON?
BZ RETRN no---No CICS capability
TM CCVTCICS,B'01000000' Q. CCVTCKWL ON?
BZ CKWLHERE no---use imbedded routine
* yes--use installed routine
LA R0,GENSNUM R0 gets service number
LR R3,R1 R3 saves R1
LR R4,R14 R4 saves R14
LR R5,R15 R5 saves R15
L R15,CCVTCKWL R15 gets routine address
BALR R14,R15 Go check for CICS
LR R0,R15 Save return code in R0
LR R15,R5 Restore R15
LR R14,R4 Restore R14
LR R1,R3 Restore R1
LTR R0,R0 Q. CICS?
BZ RETRN no---return
* yes--pass info along
O R15,M_CICS Enable high bit of R15 to CICS
B RETRN Return * Cannot use installed routine. Use imbedded routine
*
CKWLHERE DS 0H Imbedded check for TRUE routine
SLR R0,R0 Init R0 to 0
CPYA R8,R12 Zero AR 8
SLR R8,R8 Init R8 to 0
USING PSA,R8
L R8,PSATOLD R8->TCB
USING TCB,R8
LTR R8,R8 Q. Is there a TCB?
BC 8,RETRN no---return
* yes--check state and key
CPYA R11,R12 Zero AR 11
LA R11,1 Get PSW state and key in R6
ESTA R6,R11
LR R7,R6 Copy of state & key in R7
N R7,M_KEY Q. problem key?
BZ RETRN no---return
* yes--check state
N R6,M_STATE Q. problem state?
BZ RETRN no---return
* yes--get the CICS eye-catcher
LA R6,2 Set ARs 6 and 8 to home
SAR R6,R6
SAR R8,R6
L R8,TCBEXT2 R8->TCB extension
USING TCBXTNT2,R8
ICM R4,B'1111',TCBCAUF R4 gets AFCX address
* Q. Address there?
BZ RETRN no---return
* yes--check eye-catch
CLC 0(4,R4),CICS_EYE Q. CICS?
BNE RETRN no---return
* yes--pass info along
LR R0,R4 R0 gets the AFCX pointer
O R15,M_CICS Enable high order bit of R15
RETRN DS 0H
DROP R12 Free R12
PR Return from CICSTEST subroutine
*
LTORG
DS 0D
*
GENSDATA DS 0F
R10_ZERO EQU 10
RC EQU 05
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
* INPUT_PARMS EQU 0,8,C'C'
RETURN_CODE_PTR EQU INPUT_PARMS,4,C'A'
REASON_CODE_PTR EQU INPUT_PARMS+4,4,C'A'
RETURN_CODE EQU 0,4,C'F'
REASON_CODE EQU 0,4,C'F'
*
SAVAREA EQU 0,72,C'C'
SAVE14 EQU SAVAREA+12,4,C'A'
SAVE01 EQU SAVAREA+24,4,C'A'
SCVTSPTR EQU CVTABEND,4,C'F'
TCBPTR EQU PSATOLD,4,C'F'
DS 0D
*
DS 0F Align
M_KEY DC X'00800000' Problem key mask
M_STATE DC X'00010000' Problem state mask
M_NOCICS DC X'7FFFFFFF' Not-CICS mask
M_CICS DC X'80000000' Yes-CICS mask
DS 0D
CICS_EYE DC CL4'AFCX' CICS eye catcher
*
IHAPSA
TITLE 'DSECT CVT'
CVT DSECT=YES
TITLE 'DSECT SCVT'
IHASCVT DSECT=YES
TITLE 'DSECT TCB'
IKJTCB
TITLE 'DSECT CCVT'
CSFCCVT
*
LA R7,12
CR R15,R7
BNE ENDGSVC
LA R7,16
CR R0,R7
BNE ENDGSVC
L R7,RETURN_CODE_PTR(,R1)
ST R15,RETURN_CODE(,R7)
L R7,REASON_CODE_PTR(,R1)
ST R0,REASON_CODE(,R7)
ENDGSVC DS 0H
END In Figure 1, the service stub, CSFGEN, checks that ICSF is active, places the service number 50 into register 0, and calls CSFAPRPC.
The service number 50 (in the case of this example) must be bound to the installation-defined service by using the SERVICE keyword in the installation options data set. The service number is bound to the service when ICSF interprets the SERVICE installation option statement and loads the service at ICSF startup. To run the callable service that is associated with service number 50, call the service stub CSFGEN from an application program.
For flexibility, to create a service stub for a different installation-defined callable service, you can copy an existing service stub and just change the service number that you load into register 0.