Example use of global user exit XDLIPRE
You can use the global user exit XDLIPRE to change the PSB name that the application program has scheduled at execution time. You can also use the XDLIPRE exit to change the identity of the SYSID, enabling work to be rerouted from a SYSID that becomes unavailable to one that is available.
This section contains Product-sensitive Programming Interface information.
The following figures show an example of XDLIPRE that you can copy and modify. This example is provided for guidance only. For programming information about global user exits, see DFHZNEPI TYPE=INITIAL—specifying the default routine.
********************************************************************
* This is an example for global user exit XDLIPRE *
* *
* It is invoked before any DLI call being passed to *
* the remote or DBCTL processors. *
* *
* A check is made for the presence of a PSB. *
* If not, a normal return is made *
* *
* If the PSB is in a predefined table, it is changed to a *
* different value, and a normal return is made. *
* *
* If not, set PSB name to blanks and normal return. *
* *
* In all cases,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 AND LIST OF EXITID
* 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 GETMAINED 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
*********************************************************************
*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. *
*********************************************************************
*
DLIPR CSECT
DLIPR AMODE 31
*
SAVE (14,12) SAVE CALLING PROGRAM'S RGSTRS
*
LR R11,R15 SET UP USER EXIT PROGRAM'S
USING DLIPR,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 addressing to XPI *
*parameter list. *
********************************************************************
*
L R5,UEPXSTOR SET UP ADDRESSING FOR XPI
* PARAMETER LIST
**********************************************************************
* Before issuing an XPI function call, you must ensure that register*
* 13 addresses the kernel stack. *
**********************************************************************
*
L R13,UEPSTACK ADDRESS KERNEL STACK
*
**********************************************************************
* Issue a GETMAIN to get storage for work area *
**********************************************************************
*
USING DFHSMMC_ARG,R5 MAP PARAMETER LIST
*
DFHSMMCX CALL, X
CLEAR, X
IN, X
FUNCTION(GETMAIN), X
GET_LENGTH(100), X
STORAGE_CLASS(USER), X
SUSPEND(NO), X
OUT, X
ADDRESS((R7)), X
RESPONSE(*), X
REASON(*)
*
********************************************************************
* SET UP THE NORMAL RETURN CODE *
********************************************************************
*
LA R6,UERCNORM
ST R6,RETCODE
*
********************************************************************
* See if a PSB exists *
********************************************************************
*
L R6,UEPPSBNX PSB EXISTENCE FLAG
TM 0(R6),UEPPSB1 PSB EXISTS?
BO PSBCALL YES
MVC MESSAGE,MESS3T NO-MOVE MESSAGE TO DSA
B TRACE
*
********************************************************************
* See if we want to change a PSB name *
********************************************************************
*
PSBCALL EQU *
L R6,UEPPSBNM ADDRESS OF PASSED PSB NAME
LA R8,PSBS ADDRESS OF table of PSB pairs
CLC 0(8,R6),0(R8) SAME?
BE FOUND YES
LA R8,16(R8) BUMP TO NEXT PAIR
CLC 0(8,R6),0(R8)
BE FOUND
LA R8,16(R8) BUMP TO NEXT PAIR
CLC 0(8,R6),0(R8)
BE FOUND
B NOTFOUND NO MATCH - END
*
**********************************************************************
* Move new PSB name in *
**********************************************************************
*
FOUND EQU *
MVC 0(8,R6),8(R8)
*
**********************************************************************
* SET UP MESSAGE BLOCK FOR TRACE ENTRY FOR CHANGED NAME *
**********************************************************************
*
MVC MESS1,MESS1T SET UP MESSAGE
MVC NEWPSB,8(R8) NEW PSB NAME
MVC OLDPSB,0(R8) OLD PSB NAME
B TRACE GO PUT TRACE ENTRY
*
**********************************************************************
* SET UP MESSAGE BLOCK FOR TRACE ENTRY FOR PSB NOT FOUND *
* SETUP THE NORMAL RETURN CODE *
**********************************************************************
*
NOTFOUND EQU *
MVC 0(8,R6),DUMMYPSB
MVC MESS1,MESS2T SET UP MESSAGE
MVC OLDPSB,0(R6) SUPPLIED PSB NAME
MVC NEWPSB,=CL8'' CLEAR FIELD
LA R1,UERCNORM SET UP NORMAL RETURN CODE
B TRACE GO PUT TRACE ENTRY
*
**********************************************************************
* 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
* DROP R5 REUSE R5 TO MAP DFHTRPT
USING DFHTRPT_ARG,R5 XPI PARAMETER LIST
*
DFHTRPTX CALL, X
CLEAR, X
IN, X
FUNCTION(TRACE_PUT), X
POINT_ID((R8)), X
DATA1(MESSAGEA,MESSAGEL), X
OUT, X
RESPONSE(*)
*
********************************************************************
*When the rest of the exit program is complete, free the storage *
*and return. *
********************************************************************
*
DROP R5 REUSE REGISTER 5 TO MAP DFHSMMC
USING DFHSMMC_ARG,R5 XPI PARAMETER LIST
*
********************************************************************
* Issue the DFHSMMCX macro call *
* Store the return code in register 6 *
********************************************************************
*
L R6,RETCODE PICK UP SAVED RETURN CODE
*
DFHSMMCX CALL, X
CLEAR, X
IN, X
FUNCTION(FREEMAIN), X
ADDRESS((R7)), X
STORAGE_CLASS(USER), X
OUT, X
RESPONSE(*), X
REASON(*)
*
*********************************************************************
*Restore registers, set return code, and return to user exit handler*
*********************************************************************
*
L R13,UEPEPSA
ST R6,16(13) STORE INTO R15 SLOT OF SA
RETURN (14,12)
*
*********************************************************************
*old and new PSB names, in pairs *
*********************************************************************
* PSBS EQU *
DC CL8'PC3CONEW' VALID
DC CL8'PC3CONE2' VALID
DC CL8'PC3FRED' INVALID
DC CL8'PC3CONEW' VALID
DC CL8'PC3JOE' INVALID
DC CL8'PC3JOEX' INVALID
*
MESS1T DC CL21' HAS BEEN CHANGED TO '
MESS2T DC CL21' WAS NOT FOUND'
MESS3T DC CL37'THIS WAS NOT A DLI SCHEDULE CALL'
DUMMYPSB DC CL8' '
LTORG
END DLIPR