Title : Exit to prevent BMP x22 abends

Submitter : Paul Wells
            TNT Express Worldwide
            Abeles Way
            Atherstone
            Warwickshire
            CV9 2RY

Phone : 01827 710642

Release Submitter Details - Y 

Text :-

MVS exit to automatically extend CPU & wait time limits and issue WTO to suggest /STO REG xx ABDUMP

*
* Name: IEFUTL
*
* Abstract: SMF User-Time-Limit Exit.
*
* Author: Paul Wells (ECSOFT) 09/08/96 for TNT Express Worldwide
*
* Entry: R1 -> JMR (SMF exit parameter area)
*        R0 = 0 for job CPU time exceeded
*        R0 = 4 for step CPU time exceeded
*        R0 = 8 for job wait time exceeded
*        Entered in IRB mode under the initator TCB.
*
* Exit:  R15 = 0 for continue with x22 abend
*        R15 = 4 extension granted in timer units
*        R15 = 8 extension granted in seconds
*        R1  = value of extension granted
*
* Attributes: RENT,authorised
*
* Processing: The purpose of the exit is to grant BMP jobs unlimited
*             time-limit extensions to prevent a control region U0113,
*             which occurs when an x22 abend occurs in a DL/1 call.
*
*             An BMP job is recognised by seeing whether DFSPCC20
*             is loaded in the job pack area of the jobstep TCB.
*             Also check for BTSPCC20 (BTS).
*             (DFSPCC20 is not used by DLI jobs and utilities)
*
*             If an BMP job is found, a 30 second CPU extension
*             is granted, or a 5 minute job wait extension.
*
*             Warning messages are issued to the operator which
*             contain the IMSID and region number to be used
*             with the 'STO REG x ABDUMP' command.
*
*             Most of the routine is protected by an ESTAE recovery
*             exit which will percolate a normal timeout in the
*             event of an abend.
*
* Mods:
*
*
IEFUTL   CSECT
IEFUTL   AMODE 31
IEFUTL   RMODE ANY
         USING IEFUTL,R15
         BAKR  R14,0                             Save REGs on stack
         B     IDEND                             Around ID
         DC    AL1(IDEND-ID)
ID       DC    C'IEFUTL &SYSDATE Paul Wells (ECSOFT)'
IDEND    DS    0H
         DROP  R15
         LR    R12,R15                           Set base reg
         USING IEFUTL,R12                        Map base reg
         LR    R2,R0                             Save parm
         L     R11,0(,R1)                        Save parm
         USING JMR,R11                           map parm area
         STORAGE OBTAIN,LENGTH=WORKL             getmain work area
         LR    R13,R1                            set work area reg
         USING WORKA,R13                         Map work area
         MVC   4(4,R13),=CL4'F1SA'               indicate linkage stack
         ST    R2,R0ENTRY                        save parm
*
         ESTAEX RECOVERY,PARAM=WORKA,           set recovery routine   *
               MF=(E,ESTAEX)
         BAL   R10,INIT                         initialise
         BAL   R10,GETREASON                    get entry reason
         NOP   DEBUGWTO1                   don't issue a debug message
*        BAL   R10,DEBUGWTO1                     issue debug message
         BAL   R10,IMSCHECK                      check for IMS BMP
         NOP   WAITWTOR                      no wait for operator reply
*        BAL   R10,WAITWTOR                     wait for reply
*
X0010    DS    0H
         L     R2,RETCODE                       set RC
         L     R4,EXT                           set extension
         ESTAEX 0                               cancel ESTAE
         B     X0030
X0020    DS    0H                               ESTAE retry point
         ESTAEX 0                               cancel ESTAE
         SR    R0,R0
         WTO   MF=(E,WTOM4)                     echo ESTAE entry
         SR    R2,R2                            set RC0 (x22 percolate)
         SR    R4,R4
X0030    DS    0H
         STORAGE RELEASE,LENGTH=WORKL,ADDR=(R13) free work area
         LR    R15,R2
         LR    R1,R4
         PR                                     return to system
*
* Initialise work fields
*
INIT     DS    0H
         LA    R14,MACROMASKS
         LA    R15,MACROMASKS_LENGTH
         LA    R0,MACROEXECS
         LR    R1,R15
         MVCL  R0,R14                            init macro list forms
         MVC   IMSID,=CL4' '
         XC    REGID,REGID
         XC    EXT,EXT                           clear extension
         XC    RETCODE,RETCODE                   clear RC
         CLI   JMRUCOM,0                         1st entry?
         BNE   NOTFIRST
         XC    JMRUSEID(4),JMRUSEID             clear user field
NOTFIRST DS    0H
         BR    R10
*
* Get entry reason
*
GETREASON DS   0H
         ICM   R0,15,R0ENTRY
         BNZ   GETREA10
         MVC   REASON,=CL8'JOB CPU'
         B     GETREA30
GETREA10 DS    0H
         CL    R0,=F'4'
         BNE   GETREA20
         MVC   REASON,=CL8'STEP CPU'
         B     GETREA30
GETREA20 DS    0H
         MVC   REASON,=CL8'JOB WAIT'
GETREA30 DS    0H
         BR    R10
*
* (optional DEBUG subroutine)
* WTO out interesting fields for testing
*
DEBUGWTO1 DS   0H
         MVC   WTOTXTG(MTOTXTL1+2),MTOTXT1       set up debug wto
         MVC   M1JOB,JMRJOB                      jobname
         MVC   M1SYS,JMRCPUID                    system name
         L     R4,PSATOLD-PSA(,0)               initiator TCB
         L     R4,TCBLTC-TCB(,R4)               last daughter TCB
         ST    R4,FWORD
         UNPK  UNPKR15,FWORD(5)
         TR    R15HEX,HEXTAB-C'0'
         MVC   M1TCB,R15HEX                     TCB printable addr
         L     R4,TCBJPQ-TCB(,R4)               JPQ addr
         ST    R4,FWORD
         UNPK  UNPKR15,FWORD(5)
         TR    R15HEX,HEXTAB-C'0'
         MVC   M1JPQ,R15HEX                     JPQ printable addr
         SR    R4,R4
         IC    R4,JMRUCOM                       extension count
         CVD   R4,DWORD
         UNPK  M1EXT,DWORD+6(2)
         OI    M1EXT+L'M1EXT-1,X'F0'            printable ext count
         MVC   M1REAS,REASON
         SR    R0,R0                            Clear R0 for WTO
         WTO   TEXT=WTOTXTG,                                           *
               MF=(E,WTOE)
         BR    R10
*
* (optional DEBUG subroutine)
* WTOR for operator confirmation if required
*
WAITWTOR DS    0H
         XC    ECB,ECB                          clear ECB
         LA    R4,WT1                           WTOR text
         LA    R5,ECB
         LA    R6,REPLY                         space for reply
         SR    R0,R0                            Clear R0 for WTOR
         WTOR  TEXT=((R4),(R6),1,(R5)),                                *
               MF=(E,WTORE)
         WAIT  ECB=(R5),LONG=YES
         BR    R10
*
* Check for an IMS BMP
*
IMSCHECK DS    0H
         L     R4,PSATOLD-PSA(,0)               initiator TCB
         ICM   R4,15,TCBLTC-TCB(R4)             last daughter TCB
         BZ    IMSNO
         ICM   R6,15,TCBJPQ-TCB(R4)             JPQ addr
         BZ    IMSNO
IMSLOOK  DS    0H
         CLC   IMSBMP_REGION_INIT_MODULE,CDNAME-CDENTRY(R6)
         BE    IMSLOOK2
         CLC   BTSBMP_REGION_INIT_MODULE,CDNAME-CDENTRY(R6)
         BNE   IMSCONT
IMSLOOK2 DS    0H
         OI    FLAG,FLAGIMS
IMSCONT  DS    0H
         CLC   IMS_SECONDARY_SCD_MODULE,CDNAME-CDENTRY(R6)
         BNE   IMSCONT2
         ICM   R15,15,CDENTPT-CDENTRY(R6)
         MVC   IMSID,SSCDIMID-SSCDORG(R15)
IMSCONT2 DS    0H
         CLC   IMS_DEP_REG_COMM_AREA,CDNAME-CDENTRY(R6)
         BNE   IMSCONT3
         ICM   R15,15,CDENTPT-CDENTRY(R6)
         MVC   REGID,DIRPSTNR-DIRCA(R15)
IMSCONT3 DS    0H
         ICM   R6,15,CDCHAIN-CDENTRY(R6)
         BNZ   IMSLOOK
         TM    FLAG,FLAGIMS                   IMS job
         BO    IMSYES
IMSNO    DS    0H
         XC    RETCODE,RETCODE                   not IMS (no extension)
         MVC   WTOTXTG(MTOTXTL3+2),MTOTXT3       set up wto
         MVC   M3JOB,JMRJOB
         MVC   M3REAS,REASON
         SR    R0,R0                            Clear R0 for WTOR
         WTO   TEXT=WTOTXTG,MF=(E,WTOE)         issue MSG
         B     IMSCEXIT
IMSYES   DS    0H
         CLC   REASON,=CL8'JOB WAIT'
         BNE   IMSCPU
         MVC   EXT,X522INC                      ext to prevent 522
         B     IMSCPU2
IMSCPU   DS    0H
         MVC   EXT,X322INC                      ext to prevent 322
IMSCPU2  DS    0H
         MVC   RETCODE,=F'8'                    extension is in secs
         SR    R15,R15
         IC    R15,JMRUCOM
         LA    R15,1(,R15)                       increment extensions
         STC   R15,JMRUCOM                       save extensions
         MVC   WTOTXTG(MTOTXTL2+2),MTOTXT2       set up wto
         CVD   R15,DWORD
         UNPK  M2EXT,DWORD+6(2)
         OI    M2EXT+L'M2EXT-1,X'F0'
         MVC   M2JOB,JMRJOB
         CLC   =CL4' ',IMSID
         BE    IMSNOIID
         LA    R1,IMSID+L'IMSID-1
IMSBLK01 DS    0H
         CLI   0(R1),C' '
         BNE   IMSBLK02
         BCT   R1,IMSBLK01
IMSBLK02 DS    0H
         LA    R15,IMSID
         SR    R1,R15
         BM    IMSNOIID
         LR    R3,R1
         S     R3,=A(L'IMSID-1)                  sub max length -1
         LCR   R3,R3                             ignore sign
         LA    R3,M2IMSID(R3)                    dest for move
         EX    R1,*+8
         B     *+10
         MVC   0(0,R3),IMSID                     move in var len IMSID
IMSNOIID DS    0H
         SR    R15,R15
         ICM   R15,3,REGID
         BZ    IMSNOREG
         CVD   R15,DWORD
         MVC   M2REGID,=X'2120202020'
         ED    M2REGID,DWORD+5
IMSNOREG DS    0H
         MVC   M2REAS,REASON
         ICM   R15,15,EXT
         CVD   R15,DWORD
         UNPK  M2TIME,DWORD+4(4)
         OI    M2TIME+L'M2TIME-1,X'F0'
         ICM   R2,15,JMRUSEID                   peviously issued MSG?
         BZ    IMSCNODOM
         DOM   MSG=(R2)                         DOM previous MSG
IMSCNODOM DS   0H
         SR    R0,R0                            clear for WTO
         WTO   TEXT=WTOTXTG,MF=(E,WTOE2)        WTO msg
         ST    R1,JMRUSEID                      save for later DOM
IMSCEXIT DS    0H
         BR    R10
*
* ESTAE recovery routine (has own base register)
*
RECOVERY DS    0H
         PUSH  USING
         DROP  ,
         USING RECOVERY,R15
         L     R12,BASE                         base reg of main rtn
         DROP  R15
         USING IEFUTL,R12
         USING WORKA,R13
         C     R0,=F'12'                        SDWA ?
         BE    NOSDWA
HAVESDWA DS    0H
         USING SDWA,R1
         L     R13,SDWAPARM
         L     R13,0(,R13)                      get WORKA address
         MVC   SAVE_ABCC,SDWAABCC               save abend code
         B     RECOV1
NOSDWA   DS    0H
         LR    R13,R2                           get WORKA address
         ST    R1,SAVE_ABCC                     save abend code
         SR    R1,R1                            clear for SDWA addr
RECOV1   DS    0H
         ST    R1,SAVE_SDWA                     save SDWA addr
         ST    R14,SAVE_RETURNR14               save return addr
         ICM   R1,15,SAVE_SDWA                  SDWA ?
         BZ    NORETRY
         TM    SDWAERRD,SDWACLUP                retry allowed ?
         BNZ   NORETRY
         ST    R12,SDWASR12                     save reg for retry
         ST    R13,SDWASR13                     save reg for retry
         SETRP RETREGS=YES,RC=4,RETADDR=X0020,FRESDWA=YES
         B     RECOV2
NORETRY  DS    0H
         SR    R15,R15                          set no retry
RECOV2   DS    0H
         L     R14,SAVE_RETURNR14
         BR    R14                              return to system
         DROP  R1,R13
         POP   USING
*
         DROP  R13
         LTORG ,
HEXTAB   DC    C'0123456789ABCDEF'
X522INC  DC    F'300'                           increment for 522
X322INC  DC    F'30'                            increment for 322
BASE     DC    A(IEFUTL)                        entry address
IMSBMP_REGION_INIT_MODULE DC CL8'DFSPCC20'
BTSBMP_REGION_INIT_MODULE DC CL8'BTSPCC20'
IMS_SECONDARY_SCD_MODULE DC CL8'DFSVC000'
IMS_DEP_REG_COMM_AREA DC C'DIRCL'
WTOM4    WTO   'IEFUTL-04I ESTAE exit recovery - X22 abend follows',   *
               ROUTCDE=(2),DESC=(6,7),MF=L
*
MACROMASKS DS  0D
         WTO   TEXT=0,ROUTCDE=(2),DESC=(6,7),MF=L
         WTO   TEXT=0,ROUTCDE=(1),DESC=(2,7),MF=L
         WTOR  TEXT=(0,0,1,0),ROUTCDE=(2),DESC=(6,7),MF=L
         ESTAEX RECOVERY,MF=L
MACROMASKS_LENGTH EQU *-MACROMASKS
*
WT1      DC    AL2(WTL1)
         DC    C'IEFUTL-00I Reply U to continue with X22 abend'
WTL1     EQU   *-WT1-L'WT1
*
MTOTXT1  DC    AL2(MTOTXTL1)
         DC    C'IEFUTL-01I Entry to IEFUTL JOB='
         DS    CL8
         DC    C' SYS='
         DS    CL4
         DC    C' reas='
         DS    CL8
         DC    C' #='
         DS    CL3
         DC    C' TCB='
         DS    CL8
         DC    C' JPQ='
         DS    CL8
MTOTXTL1 EQU   *-MTOTXT1-L'MTOTXT1
*
MTOTXT2  DC    AL2(MTOTXTL2)
         DC    C'IEFUTL-02I '
         DS    CL8
         DC    C' extension no '
         DS    CL3
         DC    C' of '
         DS    CL8
         DC    C' seconds for IMS job '
         DS    CL8
         DC    C' - issue '
         DS    CL4
         DC    C'STO REG'
         DC    CL5' '
         DC    C' ABDUMP'
MTOTXTL2 EQU   *-MTOTXT2-L'MTOTXT2
*
MTOTXT3  DC    AL2(MTOTXTL3)
         DC    C'IEFUTL-03I '
         DS    CL8
         DC    C' time limit enforced for non-IMS job '
         DS    CL8
MTOTXTL3 EQU   *-MTOTXT3-L'MTOTXT3
*
WORKA    DSECT
SAVEA    DS    18F
MACROEXECS DS  0D
WTOE     WTO   TEXT=0,ROUTCDE=(2),DESC=(6,7),MF=L
WTOE2    WTO   TEXT=0,ROUTCDE=(1),DESC=(2,7),MF=L
WTORE    WTOR  TEXT=(0,0,1,0),ROUTCDE=(2),DESC=(6,7),MF=L
ESTAEX   ESTAEX RECOVERY,MF=L
*
EXT      DS    F                                value of extension
RETCODE  DS    F                                value of RC
ECB      DS    F                                ECB for WTOR
DWORD    DS    D
FWORD    DS    F
R0ENTRY  DS    F                                R0 on entry
REASON   DS    CL8                              entry reason
WTOTXTG  DS    CL200                            WTO work
R15SAVE  DS    F
UNPKR15  DS    0XL9
R15HEX   DS    XL8,X
REPLY    DS    X
SAVE_SDWA DS   F                                SDWA addr
SAVE_ABCC DS   F                                SDWA abend code
SAVE_RETURNR14 DS F                             SDWA return addr
IMSID    DS    CL4
FLAG     DS    X
FLAGIMS  EQU   1
REGID    DS    H
*
* Reentrant forms of messages issued
*
         ORG   WTOTXTG
         DS    AL2
         DC    C'IEFUTL-01I Entry to IEFUTL JOB='
M1JOB    DS    CL8
         DC    C' SYS='
M1SYS    DS    CL4
         DC    C' reas='
M1REAS   DS    CL8
         DC    C' #='
M1EXT    DS    CL3
         DC    C' TCB='
M1TCB    DS    CL8
         DC    C' JPQ='
M1JPQ    DS    CL8
         ORG
*
         ORG   WTOTXTG
         DS    AL2
         DC    C'IEFUTL-02I '
M2REAS   DS    CL8
         DC    C' extension no '
M2EXT    DS    CL3
         DC    C' of '
M2TIME   DS    CL8
         DC    C' seconds for IMS job '
M2JOB    DS    CL8
         DC    C' - issue '
M2IMSID  DS    CL4
         DC    C'STO REG'
M2REGID  DC    CL5' '
         DC    C' ABDUMP'
         ORG
*
         ORG   WTOTXTG
         DS    AL2
         DC    C'IEFUTL-03I '
M3REAS   DS    CL8
         DC    C' time limit enforced for non-IMS job '
M3JOB    DS    CL8
         ORG
*
WORKL    EQU   *-WORKA
*
* System DSECTs
*
         YREGS ,
         IHACDE ,
         IHAPSA ,
         IHASDWA ,
         IKJTCB ,
         IEFJMR ,
         ISCD  SCDBASE=0
         IRC   DIRCA=0
         DROP  R12,R11
         END

<END>