DA$MPF09 TITLE '                   Enhance CSV019I error for ABENDAID'
***********************************************************************
***                                                                 ***
** Name: DA$MPF09                                                    **
**                                                                   **
** Author: David Alcock                                              **
**         dalcock@csw.com                                           **
**                                                                   **
** Purpose: MPF exit -- Enhance CSV019I message if for ABENDAID      **
**          module.  This message looks like:                        **
**                                                                   **
**            CSV019I REQUESTED MODULE #XAAINTR NOT ACCESSED, IS IN  **
**                    NON-APF LIBRARY/CONCATENATION                  **
**                                                                   **
**          This is a normal message if an authorized program ABENDs **
**          and ABENDAID gets control.  If you have ABENDAID         **
**          installed correctly, it will get this error when an APF  **
**          authorized program ABENDs and you have not turned off    **
**          ABENDAID for that step.                                  **
**                                                                   **
** Attributes: Reentrant, Reusable, must be in LNKLST.               **
**                                                                   **
** Requirements:                                                     **
** - Assembler H or higher                                           **
** - MVS 4.1 and higher (for WTO TEXT= (I think))                    **
**                                                                   **
** Activated by:                                                     **
** - SET MPF=xx                                                      **
**   (Where xx is a member in parmlib, MPFLSTxx)                     **
** - Reference in MPFLSTXX:                                          **
**  CSV019I,SUP(NO),USEREXIT(DA$MPF09)                               **
***                                                                 ***
***********************************************************************
         EJECT
         IEZVX100 ,                       WTO exit parameter list
         PRINT NOGEN
         YREGS ,                          Equate registers to R0-R15
         PRINT GEN
*
** Using the official ASMH/HLASM distinction trick, simulate the
** SYSVER and SYSDATEC variables of HLASM when assembled under
** ASMH...Taken from Gilbert Saint-flour's SHOWMVS.
*
         LCLA  &ASMH_HLASM
         AIF   (T'&ASMH_HLASM EQ 'N').ASMH1X
&SYSVER  SETC  'ASMH'
&SYSDATC SETC  '20'.'&SYSDATE'(7,2)'&SYSDATE'(1,2)'&SYSDATE'(4,2)
         AIF   ('&SYSDATC' LT '20500000').ASMH1X
&SYSDATC SETC  '19'.'&SYSDATE'(7,2)'&SYSDATE'(1,2)'&SYSDATE'(4,2)
.ASMH1X  ANOP
*-Convert assembly date from SYSDATC format "YYYYMMDD" to "YYYY/MM/DD"
         LCLC  &ASMDATE
&ASMDATE SETC  '&SYSDATC'(1,4).'/'.'&SYSDATC'(5,2).'/'.'&SYSDATC'(7,2)
         EJECT
***********************************************************************
***                                                                 ***
**       Intialization                                               **
***                                                                 ***
***********************************************************************
         SPACE 2
DA$MPF09 CSECT ,
DA$MPF09 AMODE 31
DA$MPF09 RMODE ANY
*
** Create a standard O/S eyecatcher
*
EC       B     ECL(0,R15)               Bump past Eyecatcher
         DC    AL1(ECLITL)              Length of eyecatcher
ECLIT    DC    C'DA$MPF09 &ASMDATE &SYSTIME'
         DC    C'- MPF EXIT: Enhance message CSV019I'
ECLITL   EQU   *-ECLIT
         DS    0H                       Ensure halfword alignment
ECL      EQU   *-EC
*
** Standard ESA entry housekeeping
*
         BAKR R14,0                     Save regs
         LAE   R12,0(R15,0)             Get base register
         USING DA$MPF09,R12             Get addressibility
         SAC  0
         SYSSTATE ASCENV=P
*
** Locate input parms
*
         EREG  R0,R1                    Restore regs 0 and 1
         L     R2,0(R1)                 Get CTXT Address
         ICM   R3,B'1111',CTXTTXPJ-CTXT(R2) Locate Major
         BZ    QUICKOUT                 Shouldn't happen, but leave
*
** Ensure that the message is the right one and for ABENDAID module:
**
** 0....+....1....+....2....+....
** CSV019I REQUESTED MODULE #XAAINTR NOT ACCESSED, IS IN
**         NON-APF LIBRARY/CONCATENATION
*
         CLC   CTXTTMSG-CTXTATTR(7,R3),=C'CSV019I'
         BNE   QUICKOUT
         CLC   CTXTTMSG+25-CTXTATTR(8,R3),=C'#XAAINTR'
         BNE   QUICKOUT
*
** We need a valid RSA since we are about to issue some WTOs
*
         STORAGE OBTAIN,LENGTH=WORKDSL,LOC=BELOW Obtain storage
         LR    R13,R1                   Point to Save Area
         MVC   4(4,R13),=C'F1SA'        Indicate stack SA
         USING WORKDS,R13               Get addressibility to area
*
** Leave some messages in the joblog regarding the CSV message. This is
** a multi-line WTO.
*
         XR    R0,R0                    Clear reg 0 before multiline
         MVC   PARMLIST(C_WTO1L),C_WTO1
         WTO   TEXT=((MSG1,D),(MSGB,D),(MSG2,D),(MSG3,D),(MSG4,D),     @
               (MSG5,D),(MSG6,D),(MSG7,D),(MSG8,D),(MSGB,DE)),         @
               MF=(E,PARMLIST)
*
         XR    R0,R0                    Clear reg 0 before multiline
         MVC   PARMLIST(C_WTO2L),C_WTO2
         WTO   TEXT=((MSG9,D),(MSGB,D),(MSG10,D),(MSG11,D),            @
               (MSGB,DE)),                                             @
               MF=(E,PARMLIST)
*
** Release resources and return to caller
*
EXIT     DS    0H
         LR    R2,R13                     Get storage address
         STORAGE RELEASE,LENGTH=WORKDSL,ADDR=(R2) Release storage
QUICKOUT DS    0H
         SLR   R15,R15                    Set return code
         PR                               Return to caller
         EJECT
***********************************************************************
***                                                                 ***
**       Constants                                                   **
***                                                                 ***
***********************************************************************
         SPACE 2
C_WTO1   WTO   TEXT=((MSG1,D),(MSGB,D),(MSG2,D),(MSG3,D),(MSG4,D),     @
               (MSG5,D),(MSG6,D),(MSG7,D),(MSG8,D),(MSGB,DE)),MF=L
C_WTO1L  EQU   *-C_WTO1
*
C_WTO2   WTO   TEXT=((MSG9,D),(MSGB,D),(MSG10,D),(MSG11,D),            @
               (MSGB,DE)),MF=L
C_WTO2L  EQU   *-C_WTO2
*
MSGB     DC    AL2(1),C' '
MSG1     DC    AL2(60),60C' '
MSG2     DC    AL2(60),60C' '
MSG3     DC    AL2(60),60C' '
MSG4     DC    AL2(60),60C' '
MSG5     DC    AL2(60),60C' '
MSG6     DC    AL2(60),60C' '
MSG7     DC    AL2(60),60C' '
MSG8     DC    AL2(60),60C' '
MSG9     DC    AL2(60),60C' '
MSG10    DC    AL2(60),60C' '
MSG11    DC    AL2(60),60C' '
*
*
* Note: This is pretty goofy but it makes the text easier to read
*       when composing the text.
*
*        ....+....1....+....2....+....3....+....4....+....5....+.....6
 ORG   MSG1+2
 DC    C'DA$MPF09-01I '
 ORG   MSG2+2
 DC    C'The CSV019I message below was issued because'
 ORG   MSG3+2
 DC    C'ABENDAID was invoked for an APF-authorized program.'
 ORG   MSG4+2
 DC    C'ABENDAID can''t handle APF-authorized programs.  Please add'
 ORG   MSG5+2
 DC    C'a "//ABNLIGNR DD DUMMY" line to the JCL to prevent this'
 ORG   MSG6+2
 DC    C'error.  Your ABEND did not occur because of problems with'
 ORG   MSG7+2
 DC    C'#XAAINTR, this program is an ABENDAID program that got'
 ORG   MSG8+2
 DC    C'invoked to process the original ABEND.'
*
 ORG   MSG9+2
 DC    C'DA$MPF09-02I '
 ORG   MSG10+2
 DC    C'Please consult the ABENDAID install manual for more details'
 ORG   MSG11+2
 DC    C'on this problem if needed.'
 ORG   ,
*
** Literals
*
         LTORG ,
         EJECT
***********************************************************************
***                                                                 ***
**       GETMAINed work area                                         **
***                                                                 ***
***********************************************************************
         SPACE 2
         DS    0D
WORKDS   DSECT ,
         DS    18F                    Register Save Area
PARMLIST DS    XL(C_WTO1L)
         DS    0D
WORKDSL  EQU   *-WORKDS
         END
