*  The XDLIPOST exit overlays the first two characters of the DBD name
*  returned in each PCB to 'DB'. This was required for an application
*  that expected the returned DBD name to be the same as in production.
*
*  Duncan Mead
*  GBFRIDME@IBMMAIL.COM
*
**********************************************************************
*
*  THIS IS THE GLOBAL USER EXIT XDLIPOST FOR TSCICS
*
*  IT IS INVOKED AFTER ANY DLI CALL BEING PASSED TO
*  THE LOCAL, REMOTE, OR DBCTL PROCESSORS.
*
*  THE FIRST TWO CHARACTERS OF THE DBD NAME ARE CHANGED TO DB.
*
**********************************************************************
*
*  THE FIRST FEW INSTRUCTIONS SET UP THE GLOBAL USER EXIT
*  ENVIRONMENT, IDENTIFY THE USER EXIT POINT, PREPARE FOR THE USE OF
*  THE EXIT PROGRAMMING INTERFACE, AND COPY IN THE DEFINITIONS THAT
*  ARE TO BE USED BY THE XPI FUNCTION.
*
**********************************************************************
*
         DFHUEXIT TYPE=EP,ID=XDLIPOST   PROVIDE DFHUEPAR PARAMETER
*                                       LIST FOR ZFCREQ IN THE FILE
*                                       CONTROL PROGRAM AND LIST
*                                       OF EXITED EQUATES
*
         DFHUEXIT TYPE=XPIENV           SET UP ENVIRONMENT FOR
*                                       EXIT PROGRAMMING INTERFACE
*                                       MUST BE ISSUED BEFORE ANY
*                                       XPI MACROS ARE ISSUED
*
         DLIUIB TYPE=SPECIAL            DEFINE PARAMETER LIST FOR
*                                       USE BY DFHUIB MACRO
*
**********************************************************************
*THE NEXT INSTRUCTIONS FORM THE NORMAL START OF A GLOBAL USER
*EXIT PROGRAM, SETTING THE PROGRAM ADDRESSING MODE TO 31-BIT, SAVING
*THE CALLING PROGRAM'S REGISTERS, ESTABLISHING BASE ADDRESSING.
**********************************************************************
*
DMPCI CSECT
DMPCI AMODE 31
*
         SAVE (14,12)                   SAVE CALLING PROGRAM'S RGSTRS
*
         LR    R11,R15                  SET UP USER EXIT PROGRAM'S
         USING DMPCI,R11                BASE REGISTER
*
         LR    R2,R1                    SET UP ADDRESSING FOR USER
         USING DFHUEPAR,R2              EXIT PARAMETER LIST -- USE
*                                       REGISTER 2 AS XPI CALLS USE
*                                       REGISTER 1
*
**********************************************************************
*PASS ON THE PREVIOUS EXIT RETURN CODE
**********************************************************************
*
         L     R6,UEPCRCA               PREV EXIT RETURN CODE ADDR
         L     R7,0(R6)                 PREV EXIT RETURN CODE
*        LA    R6,UERCNORM
*
**********************************************************************
* FIND PCB ADDRESS AND OVERLAY DDBD NAME
**********************************************************************
*
         L     R6,UEPUIBX               UIB EXISTANCE FLAG
         TM    0(R6),UEPUIB1            UIB EXISTS?
         BZ    CARRYON                  NO
         L     R6,UEPUIB                UIB POINTER
         USING DLIUIB,R6
         CLI   UIBFCTR,X'00'            UIBFCTR
         BE    CHECKPCB                 CALL SUCCESSFUL
         CLI   UIBDLTR,X'03'            PSB ALREADY SCHEDULED
         BE    CARRYON                  PSB NOT VALID
*        CLI   UIBDLTR,X'07'            NO PSB SCHEDULED - TERM
*        BE    CARRYON                  PSB NOT VALID
         CLI   UIBDLTR,X'08'            NO PSB SCHEDULED - FUNC
         BE    CARRYON                  PSB NOT VALID
         CLI   UIBDLTR,X'FF'            DL/I NOT ACTIVE
         BE    CARRYON                  PSB NOT VALID
CHECKPCB L     R6,0(0,R6)               PCB ADDRESS LST
         LR    R9,R6                    STORE PCB MASK ADDRESS
NEXTPCB  L     R6,0(0,R9)               PCB ADDR
         MVC   0(2,R6),OVERLAY          OVERLAY TO CREATE NEW DBD NAME
         TM    0(R9),B'10000000'        LAST PCB?
         BNZ   CARRYON                  YES
         A     R9,=F'4'                 NEXT PCB
         B     NEXTPCB
CARRYON  EQU   *
*
**********************************************************************
*RESTORE REGISTERS, SET RETURN CODE, AND RETURN TO USER EXIT HANDLER
**********************************************************************
*
         L     R13,UEPEPSA
         ST    R7,16(13)                STORE PREV RETCODE
         RETURN (14,12)
*
**********************************************************************
*CONSTANTS
**********************************************************************
*
OVERLAY  DC    CL2'DB'
         LTORG
         END DMPCI