IEA793AX CSECT
IEA793AX AMODE 31
IEA793AX RMODE ANY
*        COPY ASLEQUC
***********************************************************************
**                        I E A 7 9 3 A X                            **
***********************************************************************
** Purpose :- To issue a reply of D to delete a dump if no dump      **
**            datasets are available.                                **
**                                                                   **
***********************************************************************
**            Copyright 1998 (C) Abbydale Systems LLC.               **
***********************************************************************
***********************************************************************
*                         REGISTER 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                       A S L E Q U C                  *
R9       EQU   9                                                      *
R10      EQU   10      EQUATE PREFIX TO NUMERIC SYMBOLS IN ORDER      *
R11      EQU   11       TO MAKE THE USE OF REGISTER OPERANDS IN       *
R12      EQU   12       INSTRUCTIONS SELF EXPLANITORY.THIS ALSO       *
R13      EQU   13         CREATES ENTRIES IN CROSS REFERENCE.         *
R14      EQU   14                                                     *
R15      EQU   15                                                     *
FPR0     EQU   0                                                      *
FPR2     EQU   2                                                      *
FPR4     EQU   4                                                      *
FPR6     EQU   6                                                      *
         EJECT
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*                     MISCELLANEOUS EQUATES                           *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
EQUHOBON EQU   X'80000000'   SET HIGH ORDER BIT ON                    *
PACKDIG  EQU   X'0F'         PACK DIGIT                               *
*                                                              K.E.F. *
* ******************************************************************* *
         STM   R14,R12,12(R13)    Save callers registers
         BALR  R12,0              Load base register ...
         USING *,R12              ... and establish addressability
         L     R5,0(R1)           CTXT address into R5 ...
         USING CTXT,R5            ... and establish addressability
***********************************************************************
**  Get Storage for SVC 34 (below the line)                          **
***********************************************************************
         STORAGE OBTAIN,LENGTH=DATAEND,ADDR=(R11),LOC=BELOW
         USING DATA,R11           Address the area returned
         ST    R13,SAVEAREA+4     Set backwards pointer
         LA    R15,SAVEAREA       Get our savearea address ...
         ST    R15,8(R13)         ... and set forward pointer
         LR    R13,R15            Load r13 with savearea address
         L     R2,CTXTTXPJ        Get address of message attributes ...
         USING CTXTATTR,R2        ... and establish addressability
         LA    R4,CTXTTMSG        Get address of the text area ...
         USING MSGTEXT,R4         ... and establish addressability
         OI    CTXTRFB2,CTXTRHCO  Set to suppress the message
         XC    MGCRPL(MGCRLTH),MGCRPL Clear SVC 34 area
         MVC   MGCRTEXT(L'REPLYT),REPLYT Move our repy in
         MVC   MGCRTEXT+6(2),CTXTRPID Move in reply number
         LA    R1,(MGCRTEXT-MGCRPL)+L'REPLYT  Get length
         STC   R1,MGCRLGTH        ... and save in reply area
         XR    R0,R0              Clear register 0
         MGCR  MGCRPL             Issue the stop command
EXIT     DS    0H
         L     R13,4(R13)         Restore register
         STORAGE RELEASE,LENGTH=DATAEND,ADDR=(R11)
         LM    R14,R12,12(R13)    Restore callers registers
         PR                       ... and get out
         DS    0H
REPLYT   DC    CL10'REPLY XX,D'   Reply to be issued
DATA     DSECT
         DS    0F
SAVEAREA DS    18F                Register save area
MGCR     IEZMGCR DSECT=NO
         ORG   MGCRTEXT
COMMAND  DS    CL6
REPLY    DS    CL2
REPLYMSG DS    CL3
         ORG
DATAEND  EQU   *-DATA
MSGTEXT  DSECT
MSGIDNT  DS   CL8                 Message identifier (IEA793A)
         DS   CL4
         DS   CL19
         ORG  MSGTEXT
         IEZVX100
         END  IEA793AX