* The XDLIPRE exit overlays the first two characters of the PSB name * with two characters that are passed in the Global Work Area * (initialised at CICS startup). It then writes a trace record * recording the change. If the exit is invoked as part of a DL/I call * (not a PSB schedule), then a trace entry is written with some brief * details of the call. This is not intended to be used in a production * environment! * * 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. * * I have also included the CICS startup program, UTP94. This will * establish the Global Work Area, setting the overlay characters to * two bytes determined from the CICS APPLID. This conversion in our * case is from a hard-coded table. It then starts the exits XDLIPRE * and XDLIPOST. * * Duncan Mead * GBFRIDME@IBMMAIL.COM * ********************************************************************** * * THIS IS THE GLOBAL USER EXIT XDLIPRE FOR TSCICS * * IT IS INVOKED PRIOR TO ANY DLI CALL BEING PASSED TO * THE LOCAL, REMOTE, OR DBCTL PROCESSORS. * * THE FIRST TWO CHARACTERS OF THE PSB NAME ARE CHANGED TO UT. * * A TRACE ENTRY IS WRITTEN DESCRIBING THE ACTION TAKEN, USING * TRACE-POINT 384 (HEX '0180') * ********************************************************************** * * 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=XDLIPRE 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 * COPY DFHTRPTY DEFINE PARAMETER LIST FOR * USE BY DFHTRPTX MACRO * COPY DFHSMMCY DEFINE PARAMETER LIST FOR * USE BY DFHSMMCX MACRO * ********************************************************************** *THE FOLLOWING DSECT MAPS A STORAGE AREA TO BE USED AS WORK AREA *FOR THE INFORMATION IN THE TRACE ENTRY. ********************************************************************** * DSA DSECT DSECT FOR TRACE STORAGE USING DSA,R7 * RETCODE DS F STORE RETURN CODE MESSAGEA DS F MESSAGE ADDRESS FOR TRACE MESSAGEL DS F MESSAGE LENGTH FOR TRACE MESSAGE DS 0CL37 OLDPSB DS CL8 MESS1 DS CL21 NEWPSB DS CL8 ORG MESSAGE CALLTYPE DC CL4' ' SPARE DC CL1' ' PCB DC CL08' ' SSA1 DC CL08' ' SSA2 DC CL08' ' SSA3 DC CL08' ' ORG * ********************************************************************** *THE FOLLOWING DSECT MAPS THE GLOBAL WORK AREA. ********************************************************************** * DMPCHA DSECT DSECT FOR STORAGE USING DMPCHA,R3 * EYECATCH DS CL8 EYECATCHER *XDLIPRE OVERLAY DS CL2 PSB OVERLAY CHARACTERS APPLID DS CL8 CICS APPLID * ********************************************************************** *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, AND *ESTABLISHING THE ADDRESSING OF THE USER EXIT PARAMETER LIST. ********************************************************************** * DMPCH CSECT DMPCH AMODE 31 * SAVE (14,12) SAVE CALLING PROGRAM'S RGSTRS * LR R11,R15 SET UP USER EXIT PROGRAM'S USING DMPCH,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 * ********************************************************************** *BEFORE ISSUING AN XPI FUNCTION CALL, SET UP AN ADDRESSING TO XPI *PARAMETER LIST. ********************************************************************** * L R5,UEPXSTOR SET UP ADDRESSING FOR XPI * PARAMETER LIST USING DFHTRPT_ARG,R5 SET UP ADDRESSING FOR TRACE LA R7,DFHTRPT_LEN(R5) WORK AREA * L R3,UEPGAA SET UP ADDRESSING FOR GWA * PARAMETER LIST * ********************************************************************** *BEFORE ISSUING AN XPI FUNCTION CALL, YOU MUST ENSURE THAT REGISTER *13 ADDRESSES THE KERNEL STACK. ********************************************************************** * L R13,UEPSTACK ADDRESS KERNEL STACK * ********************************************************************** *PASS ON THE PREVIOUS EXIT RETURN CODE ********************************************************************** * L R6,UEPCRCA PREV EXIT RETURN CODE ADDR L R6,0(R6) PREV EXIT RETURN CODE * LA R6,UERCNORM ST R6,RETCODE * ********************************************************************** *SEE IF A PSB EXISTS ********************************************************************** * L R6,UEPPSBNX PSB EXISTANCE FLAG TM 0(R6),UEPPSB1 PSB EXISTS? BO PSBCALL YES CLI SPARE,C' ' CLEAN UP L R6,UEPAPLIST APPLICATION'S PARM LIST L R8,0(R6) 1ST PARAM L R10,=F'255' LOAD DUMMY COUNT FIELD CLI 0(R8),X'00' IS IT THE COUNT FIELD? BNE NOCOUNT NO PARM-COUNT PRESENT L R10,0(R6) LOAD TRUE COUNT POINTER L R10,0(R10) AND FOLLOW POINTER A R6,=F'4' SKIP TO NEXT PARM NOCOUNT L R8,0(R6) CALL TYPE PARM S R10,=F'1' DECREMENT COUNT L R9,UEPLANG PROG LANGUAGE ADDRESS CLI 0(R9),UEPPLI PLI PROG? BNE MVCALL NO L R8,0(R8) YES - FOLLOW POINTER MVCALL MVC CALLTYPE,0(R8) MOVE CALL TYPE TO MESSAGE TM 0(R6),B'10000000' LAST PARAMETER? BO TRACE YES S R10,=F'1' DECREMENT COUNT BZ TRACE IF LAST PARM L R8,04(R6) SKIP TO NEXT PARM CLI 0(R9),UEPPLI PLI PROG? BNE MVPCB NO L R8,0(R8) YES - FOLLOW POINTER MVPCB MVC PCB,0(R8) MOVE PCB TO MESSAGE TM 4(R6),B'10000000' LAST PARAMETER? BO TRACE YES S R10,=F'1' DECREMENT COUNT BZ TRACE IF LAST PARM TM 8(R6),B'10000000' IS I/O AREA LAST PARAMETER? BO TRACE YES S R10,=F'1' DECREMENT COUNT BZ TRACE IF LAST PARM L R8,12(R6) SKIP TO NEXT PARM CLI 0(R9),UEPPLI PLI PROG? BNE MVSSA1 NO L R8,0(R8) YES - FOLLOW POINTER MVSSA1 C R8,=F'0' END OF PARMS? BE TRACE MVC SSA1,0(R8) MOVE SSA1 TO MESSAGE TM 12(R6),B'10000000' LAST PARAMETER? BO TRACE YES S R10,=F'1' DECREMENT COUNT BZ TRACE IF LAST PARM L R8,16(R6) SKIP TO NEXT PARM CLI 0(R9),UEPPLI PLI PROG? BNE MVSSA2 NO L R8,0(R8) YES - FOLLOW POINTER MVSSA2 C R8,=F'0' END OF PARMS? BE TRACE MVC SSA2,0(R8) MOVE SSA2 TO MESSAGE TM 16(R6),B'10000000' LAST PARAMETER? BO TRACE YES S R10,=F'1' DECREMENT COUNT BZ TRACE IF LAST PARM L R8,20(R6) SKIP TO NEXT PARM CLI 0(R9),UEPPLI PLI PROG? BNE MVSSA3 NO L R8,0(R8) YES - FOLLOW POINTER MVSSA3 C R8,=F'0' END OF PARMS? BE TRACE MVC SSA3,0(R8) MOVE SSA3 TO MESSAGE B TRACE * ********************************************************************** *CREATE NEW PSB NAME AND SETUP MESSAGE BLOCK FOR TRACE ENTRY ********************************************************************** * PSBCALL EQU * L R6,UEPPSBNM ADDRESS OF PASSED PSB NAME MVC MESS1,MESS1T SET UP MESSAGE MVC OLDPSB,0(R6) SUPPLIED PSB NAME MVC NEWPSB,0(R6) SUPPLIED PSB NAME MVC NEWPSB(2),OVERLAY OVERLAY TO CREATE NEW PSB NAME MVC 0(8,R6),NEWPSB MOVE NEW PSB NAME IN * ********************************************************************** *ISSUE TRACE PUT MACRO ********************************************************************** * TRACE EQU * LA R6,MESSAGE STORE ADDRESS... ST R6,MESSAGEA ...INTO BLOCK DESCRIPTOR LA R6,L'MESSAGE STORE LENGTH... ST R6,MESSAGEL ...INTO BLOCK DESCRIPTOR LA R8,384 SET UP TRACE-ID * DFHTRPTX CALL, CLEAR, IN, FUNCTION(TRACE_PUT), POINT_ID((R8)), DATA1(MESSAGEA,MESSAGEL), OUT, RESPONSE(*) * ********************************************************************** *RESTORE REGISTERS, SET RETURN CODE, AND RETURN TO USER EXIT HANDLER ********************************************************************** * L R13,UEPEPSA L R6,RETCODE PICK UP SAVED RETURN CODE ST R6,16(13) STORE INTO R15 SLOT OF SA RETURN (14,12) * ********************************************************************** *CONSTANTS ********************************************************************** * MESS1T DC CL21' HAS BEEN CHANGED TO ' LTORG END DMPCH