 |
Figure 6 is a sample of IFG0199I. Its
source is available in SYS1.SAMPLIB member OPENEXIT.
Figure 1. Sample Listing of IFG0199I
Part 1 of 7.***********************************************************************
* *
* MODULE NAME = IFG0199I *
* *
* DESCRIPTIVE NAME = DATA MANAGEMENT ABEND INSTALLATION EXIT *
* *
* FUNCTION = THE SYSTEM CALLS THIS EXIT FOR MOST ABENDS ISSUED *
* IN OPEN,CLOSE,EOV FOR THE ACCESS METHODS OTHER THAN VSAM. *
* IF THE APPLICATION PROGRAM SUPPLIED A DCB ABEND EXIT, THEN *
* IT DID NOT RECOVER FROM OR PREVENT THE ABEND. THIS MODULE *
* DOES THE FOLLOWING: *
* *
* 1. GET STORAGE FOR A WORK AREA. *
* 2. BRANCH TO EXIT LOGIC TO CONTINUE THE ABEND IF IT IS NOT *
* A 613-08 OR 613-0C ABEND OR IF THE USER DCB ABEND EXIT *
* WAS CALLED. THESE TWO ABENDS HAVE TO DO WITH TAPE *
* POSITIONING ERRORS. *
* 3. IF THIS IS THE FIRST INSTANCE OF ONE OF THESE TWO ABENDS *
* DURING THIS OPEN, THEN BRANCH TO EXIT LOGIC TO RETRY. *
* 4. IF THIS IS THE SECOND TIME IT HAS OCCURRED IN THIS OPEN, *
* ENTER WTOR TO ASK AN OPERATOR WHETHER TO RETRY UP TO TWO *
* MORE TIMES OR TO CONTINUE THE ABEND. *
* *
* PATCH LABEL = PATCH *
* *
* ATTRIBUTES = REENTRANT, REFRESHABLE, ENABLED, READ ONLY, *
* PRIVILEGED, SUPERVISOR STATE, KEY ZERO, *
* LINK PACK AREA RESIDENT/PAGEABLE, 24-BIT *
* ADDRESSING MODE *
*
Figure 2. Sample Listing of IFG0199I
Part 2 of 7.* LINKAGE = BALR R14,R15 BRANCH AND LINK *
* *
* INPUT REGISTERS = *
* 1 - ADDRESS OF PARAMETER LIST MAPPED BY MACRO IECOIEXL *
* 13 - ADDRESS OF STANDARD SAVE AREA *
* 14 - ADDRESS OF CALLER *
* 15 - ADDRESS OF ENTRY POINT IN THIS MODULE. *
* *
* CONTROL BLOCK = JFCB, DCB, UCB, TIOT, OAIXL *
***********************************************************************
IFG0199I CSECT
START STM R14,R12,12(R13) SAVE SYSTEM REGISTERS
BASR R11,0 LOAD PROGRAM BASE
USING *,R11 USING R11 AS BASE REGISTER
L R0,SIZDATAD GET DSECT SIZE
GETMAIN R,LV=(0) GET DSECT STORAGE
LR R10,R1 SAVE GETMAINED AREA
USING DATAD,R10 REGISTER 10 DSECT REGISTER
ST R13,SAVEAREA+FOUR SAVE R13 FOR BACK POINTER
LM R15,R1,16(R13) RELOAD CALLERS REGISTERS
ST R10,8(R13) SAVE R10 FOR FORWARD POINTER
LR R13,R10 POINT TO NEW SAVE AREA
LR R12,R1 LOAD OAIXL REGISTER FROM PARM
USING OAIXL,R12 DEFINE BASE TO OAIXL
PSATOLD EQU X'21C' ADDRESS OF CURRENT TCB
TCBTIO EQU X'00C' DISPLACEMENT IN TCB
L R8,PSATOLD LOAD TCB ADDR FROM PSA
L R7,TCBTIO(,R8) LOAD TIOT ADDR FROM TCB
USING TIOT,R7 DEFINE BASE TO TIOT
*
L R6,OAIXUCBA LOAD UCB ADDR FROM PARAMETERS
USING UCB,R6 DEFINE BASE TO UCB
*
*
***********************************************************************
* CHECK THE ABEND CODE TO BE SURE THIS IS A 613-08/0C ABEND *
***********************************************************************
CHKABEND LH R8,OAIXCODE LOAD FIRST TWO BYTES OF CODE
CH R8,HEX613 COMPARE CODE TO ABEND 613
BNE CONTINUE CONTINUE WITH ABEND
CLI OAIXCODE+THREE,HEX08 COMPARE CODE TO ABEND 613-08
BE CHKEXIT YES, CHECK EXIT TAKEN
CLI OAIXCODE+THREE,HEX0C COMPARE CODE TO ABEND 613-0C
Figure 3. Sample Listing of IFG0199I
Part 3 of 7. BNE CONTINUE NO, CONTINUE WITH ABEND
*
***********************************************************************
* CHECK IF THE DCB USER ABEND EXIT WAS TAKEN *
***********************************************************************
CHKEXIT TM OAIXFLGS,OAIXEXIT TEST IF DCB USER EXIT TAKEN
BO CONTINUE DO NOT OVERRIDE THE USER EXIT'S
* DECISION TO ABEND
*
***********************************************************************
* CHECK THE COUNTER TO BE SURE WE HAVE RETRIED ONE TIME *
***********************************************************************
CHKAREA L R8,OAIXAREA LOAD AREA COUNTER INTO REG 8
LA R8,ONE(R8) ADD ONE TO AREA COUNTER
ST R8,OAIXAREA STORE NEW SUM INTO COUNTER
CLI OAIXAREA+THREE,MAXTRIES COMPARE COUNTER TO TWO
BL RETRY LOW, CONTINUE TO RETRY
SLR R9,R9 CLEAR REGISTER 9
ST R9,OAIXAREA STORE ZERO INTO COUNTER
*
***********************************************************************
* SETUP TO ENTER THE WTOR *
***********************************************************************
TRYAGAIN SLR R9,R9 CLEAR REGISTER 9
ST R9,REPLYECB STORE ZERO INTO REPLY ECB
*
MVC WTORAREA(WTORLEN),WTORLIST MOVE IN WTOR LIST
*
MVC WTOJOB,TIOCNJOB MOVE JOB NAME TO WTO AREA
OC WTOJOB,BLANKS FOLD TO UPPER CASE
CLI WTOJOB,BLANK JOB NAME BLANK?
BNE BLANKJOB NO, BRANCH
MVI WTOJOB,COMMA INDICATE MISSING JOB NAME
BLANKJOB EQU *
MVC WTOSTEP,TIOCSTEP MOVE STEP NAME - WTO AREA
OC WTOSTEP,BLANKS FOLD TO UPPER CASE
*
UNPK WTODEV(L'WTODEV+1),UCBCHAN(L'UCBCHAN+1) SPREAD DIGITS
MVI WTODEV+L'WTODEV,C',' FIX SIGN GARBAGE FROM UNPK
TR WTODEV,HEXTABLE-C'0' CONVERT TO PRINTABLE HEX CHARS
CLI WTODEV,C'0' TEST FOR LEADING ZERO DIGIT
BNE GETVOL BRANCH IF FOUR-DIGIT HEX NUMBER
MVI WTODEV,C' ' BLANK THE LEADING ZERO
GETVOL EQU *
Figure 4. Sample Listing of IFG0199I
Part 4 of 7. MVC WTOVOL,UCBVOLI MOVE VOLUME SERIAL
OC WTOVOL,BLANKS ENSURE UPPER CASE
*
LA R2,REPLY LOAD ADDRESS OF REPLY
LA R3,REPLYECB LOAD ADDRESS OF REPLY ECB
*
***********************************************************************
* ENTER MESSAGE TO THE OPERATOR, AND WAIT FOR *
* HER REPLY TO 'U' CONTINUE OR 'R' RETRY. *
***********************************************************************
WTOR ,(R2),,(R3),MF=(E,WTORAREA) ISSUE WTOR SVC
LR R9,R1 SAVE MSG ID FOR DOM
************************************************************************
* ISSUE WAIT *
***********************************************************************
WAIT ECB=REPLYECB WAIT ON REPLY
*
***********************************************************************
* ISSUE DOM *
***********************************************************************
DOM MSG=(R9) DOM MESSAGE
*
***********************************************************************
* CHECK REPLY FROM OPERATOR *
***********************************************************************
OC REPLY,BLANKS MAKE REPLY UPPER CASE
CLI REPLY,C'U' WAS REPLY A 'U'
BE CONTINUE GO AND CONTINUE WITH ABEND
CLI REPLY,C'R' WAS REPLY A 'R'
BE RETRY GO AND CONTINUE TO RETRY
B TRYAGAIN INVALID RESPONSE, TRY AGAIN
***********************************************************************
* SET THE RETURN CODE FOR RETRY OR CONTINUE WITH ABEND *
***********************************************************************
RETRY LA R15,FOUR SET RETURN CODE TO FOUR
OI OAIXFLGS,OAIXREW SET ON REW BEFORE RETRY FLAG
B EOJ BRANCH TO END OF JOB
CONTINUE LA R15,ZERO SET RETURN CODE TO ZERO
EOJ L R13,SAVEAREA+FOUR GET CALLERS SAVE AREA ADDRESS
ST R15,16(R13) SAVE RETURN CODE REGISTER
L R0,SIZDATAD GET DSECT STORAGE SIZE
Figure 5. Sample Listing of IFG0199I
Part 5 of 7. FREEMAIN R,LV=(0),A=(R10) ISSUE FREEMAIN
LM R14,R12,12(R13) RESTORE ALL REGISTERS
BR R14 RETURN TO CALLER
*
***********************************************************************
* CONSTANTS *
***********************************************************************
*
WTORLIST WTOR 'IEC613A JJJJJJJJ,SSSSSSSS,DEVN,VOLSER TAPE POSITION ERRX
OR -- REPLY 'R'' RETRY OR ''U'' CONTINUE WITH ABEND', X
,4,ROUTCDE=(1,3,5),MF=L
WTORLEN EQU *-WTORLIST LENGTH OF WTOR
*
DS 0H
HEX613 DC X'6130' CONSTANT FOR 613 ABEND
*
BLANKS DC C' ' BLANKS FOR REPLY
*
HEXTABLE DC C'0123456789ABCDEF' TO TRANSLATE TO PRINTABLE HEX
*
PATCH DC ((*-START)/20)X'00' PROGRAM PATCH AREA
***********************************************************************
* DSECT STORAGE *
***********************************************************************
*
DATAD DSECT
DS 0D
WTORAREA DS CL20
WTOJOB DS CL8 JOB NAME
DS C
WTOSTEP DS CL8 STEP NAME
DS C
WTODEV DS CL4 DEVICE NUMBER
DS C
WTOVOL DS CL6 VOLUME SERIAL
DS CL74 REMAINDER OF MESSAGE
*
REPLYECB DS F REPLY ECB
REPLY DS CL4 REPLY RETURN AREA
*
SAVEAREA DS 18F PROGRAM SAVE AREA
*
R0 EQU 0
Figure 6. Sample Listing
of IFG0199I Part 6 of 7.R1 EQU 1
R2 EQU 2
R3 EQU 3
R4 EQU 4
R5 EQU 5
R6 EQU 6
R7 EQU 7
R8 EQU 8
R9 EQU 9
R10 EQU 10
R11 EQU 11
R12 EQU 12
R13 EQU 13
R14 EQU 14
R15 EQU 15
ZERO EQU 0
ONE EQU 1
MAXTRIES EQU 2 MAXIMUM NUMBER OF TRIES
TWO EQU 2
THREE EQU 3
K3 EQU 3
FOUR EQU 4
FIVE EQU 5
K6 EQU 6
K8 EQU 8
HEX08 EQU X'08'
HEX0C EQU X'0C'
BLANK EQU C' ' CHARACTER ' ' (BLANK)
COMMA EQU C',' CHARACTER ',' (COMMA)
***********************************************************************
* OPEN ABEND INSTALLATION EXIT PARAMETER LIST *
***********************************************************************
*
OAIXL DSECT ABEND INSTALLATION EXIT LIST
OAIXUKEY DS XL1 PROTECT KEY OF USER DCB
OAIXFLGS DS XL1 OAIXL FLAG BYTE
OAIXEXIT EQU X'80' DCB USER EXIT TAKEN (SET BY SYSTEM)
* 00 = DCB USER EXIT NOT TAKEN
* 80 = DCB USER EXIT TAKEN
OAIXREW EQU X'40' REWIND TAPE BEFORE RETRY (CAN BE SET
BY THE EXIT ROUTINE)
* 00 = DO NOT REWIND THE TAPE
* 40 = REWIND THE TAPE
OAIXRESV DS H Reserved
OAIXPDCB DS A ADDRESS OF PROTECTED COPY OF THE DCB
Figure 7. Sample Listing of IFG0199I
Part 7 of 7.OAIXUDCB DS A ADDRESS OF THE USER'S DCB
OAIXUCBA DS A UCB ADDRESS
OAIXJFCB DS A JFCB ADDRESS
OAIXTIOT DS A TIOT ADDRESS
OAIXCODE DS F ABEND CODE- EXAM X'6130000C'
OAIXAREA DS F INSTALLATION WORK AREA
OAIXLEN EQU *-OAIXL LENGTH OF OAIXL
*
***********************************************************************
* DCB - THE DCBD MACRO IS IN SYS1.MACLIB
***********************************************************************
DCBD DSORG=(PS,IS,DA,TQ),DEVD=(DA,TA) MAP FOR DCB
***********************************************************************
* UCB - THE IEFUCBOB MACRO IS IN SYS1.AMODGEN *
***********************************************************************
UCB DSECT
IEFUCBOB LIST=YES
***********************************************************************
* TIOT - THE IEFTIOT1 MACRO IS IN SYS1.AMODGEN *
***********************************************************************
TIOT DSECT
IEFTIOT1
***********************************************************************
* JFCB - THE IEFJFCBN MACRO IS IN SYS1.AMODGEN *
***********************************************************************
JFCB DSECT
IEFJFCBN LIST=YES
***********************************************************************
* DATA DEFINITIONS FOR DYNAMIC STORAGE AREA *
***********************************************************************
IFG0199I CSECT
DS 0F
SIZDATAD DC AL1(230) SUBPOOL NUMBER
DC AL3(ENDDATA-DATAD) SIZE OF DSECT
DATAD DSECT
ORG *+1-(*-DATAD)/(*-DATAD) INSURE DSECT DATA
ENDDATA EQU *
END
|
z/OS DFSMS Installation Exits
Copyright IBM Corporation 1990, 2014