&MDLNM SETC 'MODLUXIT' SET THIS MODULE NAME &MDLNM TITLE 'MODEL USER EXIT ROUTINE - XXXXXXXXXXXXXXXXXXXXXXXXXXXX' *********************************************************************** * MVS ADVANCED SKILL SAMPLE PROGRAM CODE. 2011 ARTECEED CO.,LTD. * *---------------------------------------------------------------------* * MODIFICATION RECORD * * =================== * * DATE DESCRIPTION MODID * * ----------- ------------------------------------------------- ----- * * 2011/12/21 NEW MODULE CREATED. * * 2020/04/05 CLEANED UP FOR SOME CODE. * *---------------------------------------------------------------------* * MODULE NAME -------- XXXXXXXX * * MODULE ATTRIBUTE --- AMODE=31,RMODE=ANY,RENT,APF(NO),NOLOCKS * * PSW=KEY(0),SUP,ENABLE * * ENTRY POINTS ------- XXXXXXXX * * AUTHORIZE ---------- NONE(MVS INSTALLATION EXIT ROUTINE) * *---------------------------------------------------------------------* * DESCRIPTION: * * * * RESTRICTION: * * NOTES: * *---------------------------------------------------------------------* * INPUTS: * * GR0 --- N/A * * GR1 --- N/A * * GR13 -- CALLER GPR SAVEAREA * * GR14 -- RETURN ADDRESS * * GR15 -- ENTRY ADDRESS * * * * OUTPUTS: * * NONE * * * * ABENDS: * * NONE * * * * REGISTER USAGE: * * GR2 --- * * GR3 --- * * GR4 --- * * GR5 --- * * GR6 --- * * GR7 --- * * GR8 --- * * GR9 --- * * GR10 -- RETURN ADDRESS FROM INTERNAL SUB-ROUTINES * * GR11 -- (RESERVED FOR 2ND BASE) * * GR12 -- MODULE BASE(1ST) * * GR13 -- OUR LOCAL WORKAREA * * * * CALLING MODULE: * * MVS COMPONENT(MVS INSTALLATION EXIT ROUTINE) * * CALLED MODULE: * * NONE * *********************************************************************** EJECT , *---------------------------------------------------------------------* * MVS INSTALLATION EXIT ROUTINE HOUSEKEEPING PROCEDURE * * ===================================================== * *---------------------------------------------------------------------* * *----------------------------------* * * ENTRY PROCESSING * * *----------------------------------* &MDLNM CSECT , DEFINE CODE SECTION &MDLNM AMODE 31 DEFINE DEFAULT AMODE &MDLNM RMODE ANY DEFINE DEFAULT RMODE B ENTRPROC-(&MDLNM)(,15) AROUND MODULE HEADER DC AL1(8) MODULE NAME LENGTH DC CL8'&MDLNM' MODULE NAME DC CL8'&SYSDATC' ASSEMBLY DATE DC CL5'&SYSTIME' ASSEMBLY TIME DC 102X'FF' MODULE PATCH SPACE ENTRPROC DS 0H STM R14,R12,12(R13) SAVE CALLER REGISTERS LR R12,R15 GR12 --> OUR BASE ADDRESS(1ST) USING &MDLNM,R12 DEFINE OUR BASE REGISTER GETMAIN RU, OBTAIN OUR LOCAL WORKAREA + LV=LWORK,SP=230 ST R13,4(,R1) SAVE CALLER SAVEAREA ST R1,8(,R13) CHAIN SAVEAREA POINTER LR R13,R1 GR13 --> OUR LOCAL WORKAREA USING DWORK,R13 ADDRESS TO OUR LOCAL WORKAREA SPACE , * *----------------------------------* * * INITIALIZE OUR LOCAL WORKAREA * * *----------------------------------* MVI FLAGS,0 CLEAR WORKING FLAGS SPACE , * *----------------------------------* * * BUILD OUR RECOVERY ENVIRONMENT * * *----------------------------------* MVC DWKESTAE(LDLESTAE),MDLESTAE INIT ESTAE PLIST ESTAE ESTAEXIT, BUILD OUR RECOVERY ENVIRONMENT + PARAM=DWORK, PASS OUR LOCAL WORKAREA + MF=(E,DWKESTAE) LTR R15,R15 SUCCESSFUL ? BZ DONESTAE YES, SPACE , MVC DERRMSG1(LERRMSG1),CERRMSG1 INIT WTO PLIST LR R0,R15 SET RETURN CODE LA R1,DOUBLE LOAD WORKAREA BAS R14,CNVRTX CONVERT IT TO HEX-TEXT MVC DERRMSG1+4+21(2),DOUBLE+6 SET RETURN CODE INTO MSG TEXT WTO MF=(E,DERRMSG1) INFORM ESTAE ERROR MSG OI FLAGS,ESTAERR INDICATE ESTAE ERROR DONESTAE DS 0H SPACE , L R1,4(,R13) LOAD CALLER SAVEAREA LM R0,R1,20(R1) RELOAD GR0-1 AT ENTERED B MAINPROC DO MAIN PROCESSING SPACE , * *----------------------------------* * * EXIT PROCESSING * * *----------------------------------* EXITPROC DS 0H L R14,4(,R13) LOAD CALLER SAVEAREA ST R15,16(,R14) PASS RETURN CODE TO CALLER TM FLAGS,ESTAERR OCCURRED ESTAE ERROR ? BO RTRNPROC YES, WE DONfT HAVE ESTAE ENV. ESTAE 0, DELETE OUR RECOVERY ENVIRONMENT+ MF=(E,DWKESTAE) RTRNPROC DS 0H LR R1,R13 GR1 --> OUR LOCAL WORKAREA L R13,4(,R13) RESTORE CALLER SAVEAREA FREEMAIN RU, RELEASE OUR LOCAL WORKAREA + LV=LWORK,SP=230,A=(1) LM R14,R12,12(R13) RESTORE CALLER REGISTERS AND + RELOAD RETURN CODE OI 15(R13),X'01' SET RETURN INDICATOR BSM 0,R14 RETURN TO CALLER SPACE , *********************************************************************** * MAIN LINE PROCESSING * * ===================================================== * * GR1 -- CALLING PARAMETER PLIST * * GR12 - OUR BASE REGISTER * * GR13 - OUR LOCAL WORKAREA(INCLUDED OUR REGISTER SAVEAREA) * *---------------------------------------------------------------------* * * * * *********************************************************************** MAINPROC DS 0H SPACE , * *----------------------------------* * * * * * ============================== * * * * * * * * *----------------------------------* SPACE , * *----------------------------------* * * * * * ============================== * * * * * * * * *----------------------------------* SPACE , * *----------------------------------* * * * * * ============================== * * * * * * * * *----------------------------------* SPACE , B EXITPROC DO EXIT PROCESSING EJECT , *********************************************************************** * I N T E R N A L S U B R O U T I N E S * *********************************************************************** *---------------------------------------------------------------------* * CNVRTX - CONVERT BINARY TO HEX-DECIMAL TEXT (REGISTER TYPE) * * CALL INTERFACE - * * GR0: FULL-WORD BINARY VALUE * * GR1: 8BYTES OUTPUT-AREA ADDRESS * * BAS 14,CNVRTX * *---------------------------------------------------------------------* CNVRTX DS 0H CONVERT GR0 TO HEX-DECIMAL LA 1,7(,1) LA 15,8 STC 0,0(,1) NI 0(1),X'0F' TR 0(1,1),CNVTRT2 SRL 0,4 BCTR 1,0 BCT 15,*-2-4-6-4-4 BR 14 CNVTRT2 DC CL16'0123456789ABCDEF' TRANS TABLE FOR HEX-CHARACTER EJECT , *********************************************************************** * OS ASYNC EXIT ROUTINES * * ACCESS METHOD EXIT ROUTINES * *********************************************************************** *---------------------------------------------------------------------* * ESTAE EXIT ROUTINE * * ================== * * !! ENTERED PSW STATE(SUP/PROB) AS SAME AS AT ESTAE SVC ISSUED !! * * INPUT: * * GR0 --- OS RTM STATUS CODE * * 12: SDWA NOT AVAILABLE(MAY BE STORAGE SHORTAGE) * * GR1 --- SDWA OR TCBCMP(IF GR0=12) * * GR2 --- PARMLIST AT ESTAE ISSUED(IF GR0=12) * * GR13 -- OS STANDARD SAVEAREA(IF SDWA AVAILABLE ONLY) * * GR14 -- RETURN ADDRESS * * GR15 -- ENTRY ADDRESS * * OUTPUT: * * NONE * *---------------------------------------------------------------------* ESTAEXIT DS 0H USING *,R15 DEFINE TEMP BASE CH R0,=H'12' AVAILABLE SDWA ? BNE HAVESDWA YES, DO STD PROCESSING + NO, GR0=12 + GR1=ABEND CODE(00XXX000) + GR2=ESTAE PARM A(RTRY RTN) LR R13,R2 RELOAD OUR LOCAL WORKAREA ST R1,DOUBLE PASS ABEND CODE TO RETRY RTN LA R0,NSDWARTR LOAD NO SDWA RETRY RTN ENTRY LA R15,4 INDICATE RETRY B 0(,R14) DO RETRY PROCESSING... SPACE , * *----------------------------------* * * RECOVERY PROCESSING WITH SDWA * * *----------------------------------* HAVESDWA DS 0H L R12,AOURBASE ESTABLISH OUR BASE REGISTER DROP R15 FORGET TEMP BASE LR R11,R1 GR11 --> SDWA USING SDWA,R11 ADDRESS IT L R13,SDWAPARM LOAD OUR LOCAL WORKAREA ST R14,DWORK+12 SAVE RETURN ADDRESS SPACE , MVC DWKSDUMP(LDLSDUMP),MDLSDUMP INIT SDUMP PARMLIST SDUMP MF=(E,DWKSDUMP), CALL MVS SDUMP SERVICE + HDR='&MDLNM DIAGNOSIS DUMP', + SDATA=(CSA,LPA,RGN,SUM,TRT) SPACE , L R14,DWORK+12 LOAD RETURN ADDRESS SETRP WKAREA=(11), SDWA ADDRESS + DUMP=NO, INDICATE IGNORE RTM DUMP + RETADDR=EXITPROC, RETRY ROUTINE ADDRESS + RETREGS=YES, PASS REGS FROM SDWA + FRESDWA=YES, NO LONGER NEED SDWA + RC=4 INDICATE SCHEDULING RETRY RTN B 0(,R14) DO RETRY PROCESSING... DROP R11 FORGET SDWA SPACE , * *----------------------------------* * * RETRY PROCESSING FOR NO SDWA * * *----------------------------------* NSDWARTR DS 0H USING *,R15 DEFINE TEMP BASE L R12,AOURBASE ESTABLISH OUR BASE REGISTER DROP R15 FORGET TEMP BASE LR R13,R1 RELOAD OUR LOCAL WORKAREA SLR R0,R0 CLEAR WORKREG ICM R0,B'0111',DOUBLE LOAD ABEND CODE SRL R0,12 ABEND CODE SHIFT TO LOWER BYTE LA R1,DOUBLE LOAD WORKAREA BAS R14,CNVRTX CONVERT IT TO HEX-TEXT MVI DOUBLE+4,C'S' INDICATE SYSTEM ABEND(SXXX) MVC WTLPARM(LWTLPARM),CWTLPARM INIT WTL PLIST MVC WTLPARM+21(4),DOUBLE+4 SET ABEND CODE INTO MSG TEXT WTL MF=(E,WTLPARM) WRITE ABENDED MSG INTO SYSLOG B EXITPROC GO TO EXIT PROCESSING EJECT , *********************************************************************** * DATA AREA (CONSTANTS) * *********************************************************************** AOURBASE DC A(&MDLNM) OUR BASE ADDRESS MDLESTAE ESTAE MF=L MODEL ESTAE PLIST LDLESTAE EQU *-MDLESTAE LENGTH OF MODEL MDLSDUMP SDUMP HDRAD=0,MF=L MODEL SDUMP PLIST LDLSDUMP EQU *-MDLSDUMP LENGTH OF MODEL CERRMSG1 WTO 'USEREXIT ESTAE ERROR(XX)',MF=L MODEL WTO PLIST LERRMSG1 EQU *-CERRMSG1 LENGTH OF MODEL CWTLPARM WTL 'WTONOTFY ABENDED(XXXX)',MF=L MODEL WTL PLIST LWTLPARM EQU *-CWTLPARM LENGTH OF MODEL DROP , DROP ALL BASE REGISTER LTORG , EJECT , *********************************************************************** * DATA AREA (OUTSIDE OUR BASE) * *********************************************************************** EJECT , *---------------------------------------------------------------------* * LOCAL WORKAREA * *---------------------------------------------------------------------* DWORK DSECT OUR LOCAL WORKAREA SAVEAREA DS 0F MVS STANDARD REGISTER SAVEAREA SAVEA EQU * START GPR SAVEAREA AT HERE SAVEH DC A(0) USE FOR HIGH LEVEL LANGUAGE(PL1 SAVEP DC A(0) CALLER REGISTER SAVE AREA SAVEN DC A(0) CALLED REGISTER SAVE AREA SAVERE DC A(0) REGISTER 14 SAVERF DC A(0) REGISTER 15 SAVER0 DC A(0) REGISTER 0 SAVER1 DC A(0) REGISTER 1 SAVER2 DC A(0) REGISTER 2 SAVER3 DC A(0) REGISTER 3 SAVER4 DC A(0) REGISTER 4 SAVER5 DC A(0) REGISTER 5 SAVER6 DC A(0) REGISTER 6 SAVER7 DC A(0) REGISTER 7 SAVER8 DC A(0) REGISTER 8 SAVER9 DC A(0) REGISTER 9 SAVERA DC A(0) REGISTER 10 SAVERB DC A(0) REGISTER 11 SAVERC DC A(0) REGISTER 12 SAVEALNG EQU *-SAVEAREA LENGTH OF MVS STANDARD SAVEAREA SPACE , * *----------------------------------* * * MISCELLANEOUS * * *----------------------------------* DOUBLE DC D'0' DOUBLE WORD WORKAREA FLAGS DC XL1'00' WORKING FLAGS ESTAERR EQU X'80' OCCURED ESTAE ERROR SPACE , * *----------------------------------* * * * * *----------------------------------* SPACE , * *----------------------------------* * * MVS SVC SERVICE PLISTS * * *----------------------------------* DWKESTAE ESTAE MF=L WORK ESTAE PLIST DWKSDUMP SDUMP HDRAD=0,MF=L OS SDUMP PARMLIST DERRMSG1 WTO 'USEREXIT ESTAE ERROR(XX)',MF=L ORG DERRMSG1 (REDEFINE FOR NEXT WTO PARMS) WTLPARM WTL 'WTONOTFY ABENDED(XXXX)',MF=L ORG DERRMSG1 (REDEFINE FOR NEXT WTO PARMS) ORG , DS 0D LWORK EQU *-DWORK LENGTH OF WORKAREA EJECT , *---------------------------------------------------------------------* * OS CONTROL BLOCKS * *---------------------------------------------------------------------* IHASDWA , SDWA *---------------------------------------------------------------------* * REGISTER EQUATES * *---------------------------------------------------------------------* YREGS , OS: REGISTER EQUATES END