TITLE 'SAMPLE STORAGE CLASS INSTALLATION EXIT'
IGDACSSC CSECT ,
IGDACSSC AMODE 31                   Must run in 31-bit mode
IGDACSSC RMODE ANY                  Should have an RMODE of ANY
         USING *,15
         B     PROLOG
         DC    AL1(17)              Length of string that follows
         DC    C'IGDACSSC &SYSDATE' For save area trace in dump
PROLOG   STM   14,12,12(13)         Standard entry linkage
         L     PARMLIST,0(R1)       Establish addressability to
         USING ACSPMD,PARMLIST       exit parameter list
         L     WORKBASE,ACSPWORK    Establish addressability to
         USING WORKAREA,WORKBASE     work area
         LA    11,SAVEAREA          Standard save area chaining
         ST    13,4(11)             Point new save area to caller's
         ST    11,8(13)             Point caller's save area to ours
         LR    13,11                Establish new save area
 
         LR    12,15                Load base register
         DROP  15                   Drop addressability
         USING IGDACSSC,12
         LA    TOADDR,STARTWK       Set up to clear the work area
         LA    TOLEN,CLEARLEN       Following the save area
         LA    FROMLEN,0            Set length of source (null)
         MVCL  TOADDR,FROMADDR      Clear work area
*
 
*  Set up access to read-only variables.
         L     ERO,ACSPAERO
         USING ACERO,ERO            Anchor read-only variables
*
*  Set up access to read-write variables.
         L     ERW,ACSPERW
         USING ACERW,ERW            Anchor read/write variables
         MVC   ACERWVAL(L'BLANK8),BLANK8
*
*  Invoke ACS routine.  Note that it may put messages in ACERWTXT.
         LA    SERVICEP,ACSPACSP    Parameter list for ACS routine
         ST    SERVICEP,ACSPARM     Use standard MVS linkage
         LA    R1,ACSPARM            conventions
         L     15,ACSPACS           Load address of ACS interface rtn
         BASR  14,15                Call STORCLAS selection routine
*
*   Return message indicating exit was entered.

         LA    R1,MESSAGE1          Set address of message to write
         BAS   R14,WRITE            Call subroutine to return message
*
* If the ACS routine returned a null value, we need to do some resets.
         MVC   SCNAME(8),ACERWVAL   Prime area for message 2
         CLC   ACERWNCS,=F'0'       Is number of constructs = 0?
         BNE   CONTINUE             If ACS rtn set it, no change
         MVC   ACERWNCS,=F'1'       Set number of constructs = 1
         MVC   ACERWVLN,=H'0'       Set length of value
         MVC   SCNAME,NULLSC        Update area for message 2
*
* Build a message indicating a storage class was assigned.
CONTINUE EQU   *
         MVC   MSG2AOUT,MSG2A
         MVC   MSG2BOUT,MSG2B
         MVC   PAD,BLANK75
         LA    R1,MESSAGE2          Set address of message to write
         BAS   R14,WRITE            Call subroutine to return message
*
RETURN   EQU   *
         L     13,4(13)             Point to caller's save area
         LM    14,12,12(13)         Restore most of caller's registers
         LA    15,0                 Set return code
         BR    14                   Return to caller of exit routine
*
* Subroutine to add a message to those to be printed.  At entry to this
* routine R1 points to a 110-byte message.
WRITE    LH    WORKREG,ACERWNMG       Get number of existing messages
         LA    R0,1(,WORKREG)         Increment counter of messages
         CH    R0,=H'6'               Compare to max number of messages
         BHR   14                     Return if no more messages allowed
         STH   R0,ACERWNMG            Set new number of existing messages
         MH    WORKREG,=Y(L'ACERWTXT) Multiply number by length of each
         LA    WORKREG,ACERWTXT(WORKREG)  Point to appropriate msg area
         MVC   0(L'ACERWTXT,WORKREG),0(R1)  Move new message
         BR    14
******************************************************************
* The documented size of the area containing the work area is 4096
* bytes.  If this routine were to store even one byte past its end,
* there probably would be a disaster.  The following is a trap to
* cause an assembly error if the length of the DSECT exceeds 4096.
* The value of the expression must not exceed 15.
******************************************************************
 
         BR    ((WORKLEN-1)/4096)+15  Asm error if DSECT too long
*

******************************************************************
*                                   Start of constant area
MESSAGE1 DC    CL110'STORAGE CLASS  INSTALLATION EXIT ENTERED'
MSG2A    DC    CL14'STORAGE CLASS '
MSG2B    DC    CL13' WAS ASSIGNED'
NULLSC   DC    CL8' *NULL* '        Indicate no storage class
BLANK75  DC    CL75' '
BLANK8   EQU   BLANK75,8            For clearing message insert
*
* Map of dynamic storage used by this routine.  Supplied by caller.
WORKAREA DSECT ,
SAVEAREA DS    CL72                 Standard save area
STARTWK  EQU   *                    Start of non-save area stuff
ACSPARM  DS    F                    Pointer to ACS parameters
MESSAGE2 DS    0CL110               Message to issue so that
MSG2AOUT DS    CL14                  user knows we assigned a
SCNAME   DS    CL8                   storage class
MSG2BOUT DS    CL13
PAD      DS    CL75
*
CLEARLEN EQU   *-STARTWK            Length to clear
WORKLEN  EQU   *-WORKAREA           Amount of 4K area that we are using
* Register names.
R0       EQU   0                    Register 0
R1       EQU   1                    Register 1
WORKREG  EQU   2                    Work register
TOADDR   EQU   2                    Register for MVCL destination addr
TOLEN    EQU   3                    Register for MVCL destination length
ERO      EQU   3                    Address of IGDACERO
FROMADDR EQU   4                    Register for MVCL source
ERW      EQU   4                    Address of IGDACERW
FROMLEN  EQU   5                    Register for MVCL source length
SERVICEP EQU   6                    Address of parameters for service
WORKBASE EQU   7                    Address of work area
PARMLIST EQU   8                    Address of exit parameter list
*
IGDACSPM IGDACSPM                   Map exit parameter list (ACSPMD)
IGDACERO IGDACERO                   Map read-only variables (ACERO)
IGDACERW IGDACERW                   Map read/write variables (ACERW)
         END   IGDACSSC