TITLE 'IEFVHN' 00050001 *********************************************************************** 00100002 * 00109002 * MODULE NAME= IEFVHN 00118002 * 00127002 * DESCRIPTIVE NAME= INTERPRETER TERMINATION ROUTINE 00136002 * 00145002 * COPYRIGHT= N/A 00154002 * 00163002 * STATUS= VS2 SU16 - IN THIS MODULE, SU 16 SUPPORTS @G16AP2F 00172003 * VPSS SUPPORT (SU 29 - @G29AN2F). @G16AP2F 00175003 * MERGE SU4,10,16 CODE TO REL 037 PTF @ZA27750 00178003 * 00181002 * FUNCTION= THIS ROUTINE PERFORMS CLEAN UP FUNCTIONS 00190002 * JUST PRIOR TO INTERPRETER TERMINATION. IT FREES AREAS 00199002 * GOTTEN BY THE INITIALIZATION ROUTINE(IEFVHE), ISSUES 00208002 * WTO'S INFORMING THE OPERATOR OF JOB STATUS AT 00217002 * INTERPRETER END, AND SETS RETURN CODES TO BE PASSED 00226002 * TO THE INTERPRETER'S CALLER. 00235002 * SWA SUPPORT - 00244002 * ALL CODE REFERENCING THE 3RD BYTE OF A TTR HAS BEEN 00253002 * REMOVED.THE SWA VIRTUAL ADDRESSING MAKES THIS TEST 00262002 * INVALID. 00271002 * 00280002 * 00289002 * OPERATION= 00298002 * .A CHECK IS MADE TO SEE IF A JCL OR I/O ERROR HAS 00307002 * OCCURRED. IF A JCL ERROR, A WTO IS ISSUED ( JOB NOT 00316002 * RUN JCL ERROR), AND A RETURN CODE OF 4 IS PLACED IN 00325002 * REG 15. IF AN I/O ERROR, A RETURN CODE OF 8 IS PLACED 00334002 * IN REG 15. 00343002 * .INPUT AND OUTPUT BUFFERS ARE FREED. 00352002 * .FREE LOCAL WORK AREA 00361002 * .IF LOADED, SWA MANAGER IS DELETED 00370002 * .IF SPECIAL ACCESS METHOD PROVIDED, FREE IT 00379002 * .RESTORE QMPA FOR RETURN TO CALLER 00388002 * .INITIALIZE NELJCT PTR 00397002 * .CHECK FOR SMF. IF FUNCTIONAL, CHECK IF USER RTN 00406002 * WAS LOADED. IF YES, DELETE IT. 00415002 * MOVE UPDATED JMR BACK TO CALLER'S STORAGE AND 00424002 * FREE CORE THAT HELD IT. 00433002 * .FREE DSENQ TABLE CORE. 00442002 * .FREE INTERPRETER WORK AREA 00451002 * .CHECK IF SPECIAL RETURN PROVIDED. IF YES, SET 00460002 * UP FOR XCTL OR BR, AND TAKE SPECIAL EXIT. 00469002 * IF NORMAL RETURN, RE-LOAD CALLER'S REGS AND EXIT. 00478002 * 00487002 * 00496002 * NOTES 00505002 * CHARACTER CODE DEPENDENCIES= EBCDIC 00514002 * DEPENDENCIES= NONE 00523002 * RESTRICTIONS= NONE 00532002 * REGISTER CONVENTIONS= REG11 - BASE REGISTER 00541002 * REG12 - INTERPRETER WORK AREA PTR 00550002 * REG13 - REG SAVE AREA PTR 00559002 * PATCH-LABEL= PATCH 00568002 * 00577002 * 00586002 * MODULE TYPE= BAL CSECT 00595002 * PROCESSOR= ASSEMBLER 00604002 * ATTRIBUTES= NCAL,LET,LIST,XREF,RENT,REFR 00613002 * KEY 0, PAGEABLE LPA 00622002 * 00631002 * 00640002 * ENTRY POINT= IEFVHN FROM IEFVHH,IEFKG, AND IEFVHQ 00649002 * PURPOSE= TO TERMINATE INTERPRETER 00658002 * LINKAGE= BALR AND BR 14 00667002 * INPUT DATA= R12 - IWA PTR, R13 - RSA PTR 00676002 * REGISTERS SAVED= NONE 00685002 * REGISTER CONTENTS DURING PROCESSING= 00694002 * R0 - WORK REG 00703002 * R1 - PARMLIST PTR AND WORK REG 00712002 * R2 - NEL PTR 00721002 * R3 - SUBROUTINE LINKAGE AND WORK REG 00730002 * R4 - MSG AREA PTR AND WORK REG 00739002 * R5 - REG SAVE AREA INDEX REG 00748002 * R6 - SUBROUTINE LINKAGE AND WORK REG 00757002 * R7 - NEL EXIT LIST PTR 00766002 * R8 - JCT BASE AND NEL EXIT LIST PTR 00775002 * R9 - MSG CODE AND WORK REG 00784002 * R10 - WORK REG 00793002 * R11 - CSECT BASE REG 00802002 * R12 - PTR TO INTERPRETER WORK AREA 00811002 * R13 - PTR TO REG SAVE AREA 00820002 * R14 - LINKAGE AND WORK REG 00829002 * R15 - LINKAGE AND WORK REG 00838002 * REGISTERS RESTORED= R14-R12 00847002 * 00856002 * 00865002 * EXIT - MORMAL= BR 14 TO INTERPRETER'S CALLER 00874002 * CONDITIONS= CLEAN UP PROCESSING COMPLETE 00883002 * OUTPUT DATA= R1 - PTR TO NEL, R15 - RETURN CODE 00892002 * RETURN CODES= ZERO(0) INDICATES INTERPRETATION SUCCESSFUL 00901002 * 00910002 * 00919002 * EXIT - ERROR= BR 14 TO INTERPRETER'S CALLER 00928002 * CONDITIONS= CLEAN UP PROCESSING COMPLETE 00937002 * OUTPUT DATA= R1 - PTR TO NEL, R15 - RETURN CODE 00946002 * RETURN CODES= 4 - JCL ERROR 00955002 * 8 - I/O ERROR 00964002 * 00973002 * 00982002 * EXTERNAL REFERENCES= 00991002 * ROUTINES= IEFKG 01000002 * DATA AREAS= IWA,QMPA 01009002 * CONTROL BLOCKS= JCT,JMR,NEL 01018002 * TABLE= NONE 01027002 * MACROS= IEFVMIWA,IEFAJCTB,IEFJMRIEFRELSE,FREEPOOL,MODID,XCTL, 01036002 * IEFQMNGR,IEFNEL,DELETE,FREEMAIN,GETMAIN,RETURN 01045002 * ENQUEUE RESOURCES= NONE 01054002 * 01072002 * 01081002 * MESSAGES= 01090002 * IEF428I TERMINATED DUE TO I/O ERROR 01099002 * IEF452I JJJ JOB NOT RUN JCL ERROR 01108002 * 01117002 * CHANGE LEVEL = Y02668, Z40MPTH, OZ10444, G29AN2F, OZ27750 @ZA27750 01120003 * 01123003 *********************************************************************** 01126002 EJECT 01135002 IEFCOMWA 01250002 IEFVMIWA 01270002 EJECT 01300001 IEFVMEWA 01350001 ENDLAREA EQU * 01400001 EJECT 01450001 EJECT 01850001 JCTD DSECT 01900001 IEFAJCTB 01950001 IEFJMR 02000001 EJECT 02050001 IEFZB9RD 02070002 EJECT 02100001 IEFQMNGR 02150001 QPARMEND DS 0D 02200001 EJECT 02250001 IEFTXTFT 02350002 EJECT 02750001 ********* 02800001 NELHERE DSECT 02850001 IEFNEL SUBCOM=I,EXITS=(RTN,QEP,SMF) 02900002 EJECT 03000001 IEFVHN CSECT M1865 03050001 * CODE ADDED TO VHNEXOUT ROUTINE @ZA10444 03070003 * RD=PTR TO CURRENT REG SAVE AREA 03100001 * AND CANNOT BE CLOBBERED 03150001 BALR RB,0 03200001 USING *,RB * 03250001 * 03300001 *****************************************************************Y02668 03405002 * MODULE TRACE CODE - FOR TESTING. Y02668 03410002 L RF,TRACEV LOAD TRACE RTNE ADDR. Y02668 03415002 BALR RE,RF ENTER MOD ID IN TRACE RECORD. Y02668 03420002 TRACEV DC V(TRACE) TRACE RTNE ADDR. Y02668 03425002 DC C'VHN ' MOD ID USED BY TRACE. Y02668 03430002 * TRACE RETURNS HERE. Y02668 03435002 *****************************************************************Y02668 03440002 B HN1 BRANCH AROUND ID. Y02668 03450002 MODID BR=NO Y02668 03455002 * DC C'SU16' FUNCTION ID @G16AP2F 03460003 * DC C'01' LEVEL # (SU16) @G16AP2F 03462003 DC C'02' LEV # (MERGE SU4,10,16 CODE TO 037 PTF) @ZA27750 03464003 HN1 DS 0H Y02668 03480002 EJECT 03500002 *****************************************************************Y02668 03600002 * *Y02668 03700002 * TERMINATION - RETURN CODE PROCESSING *Y02668 03800002 * *Y02668 03900002 *****************************************************************Y02668 04000002 SPACE 2 Y02668 04100002 VHN0010 DS 0H Y02668 04200002 L R1,WORD(RD) PICK UP PTR TO REG SAVE Y02668 04300002 * AREA OF INTERPRETER'S CALLER Y02668 04400002 CL R1,IWASAVPT IS THIS, IN FACT THE CORRECT Y02668 04500002 * SAVE AREA PTR(SAVED ON ENTRY Y02668 04600002 * BY NB903) Y02668 04700002 BE VHN0020 YES, CONTINUE TERMINATION Y02668 04800002 * NO, FREE EXCESS RSA AND CHECK Y02668 04900002 IEFRELSE , NEXT BACKWARD CHAIN PTR Y02668 05000002 B VHN0010 GO BACK AND CHECK AGAIN Y02668 05100002 SPACE 2 Y02668 05200002 VHN0020 DS 0H **RETURN CODE PROCESSING Y02668 05300002 L R1,WORD(RD) ADDRESS CALLER'S RSA Y02668 05400002 XC SAVERF(WORD,R1),SAVERF(R1) ZERO RETURN CODE REG Y02668 05500002 * IN CALLER'S SAVE AREA Y02668 05600002 CLC IWARET(2),IOERROR TEMP *** I/O ERROR?/PGM CHK Y02668 05700002 BL VHN0030 NO, CHECK FOR JCL ERROR Y02668 05800002 MVC SAVERF+2(HALFWORD,R1),IWARET INITIALIZE CALLER'S Y02668 05900002 * REG15 TO I/O ERR RETURN CODE Y02668 06000002 B VHN0040 CONTINUE TERMINATION Y02668 06100002 VHN0030 DS 0H Y02668 06200002 LA R2,JCT GET PTR TO JCT Y02668 06250002 USING JCTD,R2 ADDRESSABILITY OF JCT Y02668 06300002 TM JCTJSTAT,INCMSTS WAS JOB FAILED Y02668 06350002 BZ VHN0040 NO, THEREFORE, JOB IS Y02668 06400002 MVI SAVERF+3(R1),JCLERROR INDICATE JCL ERROR IN Y02668 06410002 DROP R2 Y02668 06420002 LA R2,WAJOBPFX GET PTR TO SAVED JOB PFX Y02668 06430002 USING TEXT,R2 ADDRESSABILITY OF JOB PFX Y02668 06440002 TM STRJINDC,JTXJOBFL WAS JOB FAILED IN THE CONV. Y02668 06450002 BO VHN0040 YES - NO MSG ISSUED Y02668 06460002 LA R5,IEF452I GET JCL ERROR MSG KEY Y02668 06470002 L RF,IEFVHRV GET WTO RTN ADDR Y02668 06480002 BALR RE,RF GO ISSUE ERROR MSG Y02668 06490002 * SUCCESSFUL AND REG15=0 Y02668 06500002 * CALLER'S REG15 Y02668 06700002 VHN0040 DS 0H Y02668 06800002 EJECT Y02668 06900002 *****************************************************************Y02668 07000002 * *Y02668 07100002 * EXIT LIST PROCESSING - WTO PROCESSING *Y02668 07200002 * *Y02668 07300002 *****************************************************************Y02668 07400002 SPACE 2 Y02668 07500002 VHNEXLST DS 0H 07600002 * THE EXIT LIST ENTRY FOR THE ALTERNATE SWA @G29AN2F 07600303 * MANAGER FOR LOCATE MODE WAS SAVED BY IEFNB903 @G29AN2F 07600603 * IN THE IWA. IF THE EXIT LIST NAME ENTRY HAS @G29AN2F 07600903 * THE NAME OF THE MODULE IN IT, THEN THE NAME @G29AN2F 07601203 * WILL BE LEFT JUSTIFIED IN THE FIELD AND PADDED @G29AN2F 07601503 * WITH BLANKS. THE DELETE WILL BE ISSUED @G29AN2F 07601803 * POINTING TO THE NAME @G29AN2F 07602103 SPACE 1 07602403 L R3,AOQLOCEP ADDR OF ALT SWA MNGR LOC EP @G29AN2F 07602703 LTR R3,R3 DOES THE ENTRY EXIST? @G29AN2F 07603003 BZ VHNEXLS2 NO, TEST FOR ALT SWA MNGR @G29AN2F 07603303 * MOVE MODE @G29AN2F 07603603 LA R3,AOQLOCEX ADDR OF EXIT LIST ENTRY @G29AN2F 07603903 USING NELEXENT,R3 ADDR OF EXIT LIST @G29AN2F 07604203 CLI NELEXLK,NELEXNAM DOES LIST HAVE 6 BYTE NAME? @G29AN2F 07604503 BNE VHNEXLS2 NO, CHECK MOVE MODE @G29AN2F 07604803 BAL RA,VHNDEL GO DO DELETE @G29AN2F 07605103 XC AOQLOCEP,AOQLOCEP ZERO ADDRESS TO AVOID SECOND @G29AN2F 07605403 * DELETE @G29AN2F 07605703 VHNEXLS2 DS 0H @G29AN2F 07606003 * Y02621 07608002 * THE JOURNAL MERGE EXIT LIST ENTRY WAS SAVED BY Y02621 07616002 * IEFNB903 IN THE IWA.IF THE EXIT LIST ENTRY HAS THEY02621 07624002 * NAME OF A MODULE IN IT,THEN THE NAME WILL BE LEFT Y02621 07632002 * JUSTIFIED IN THE FIELD AND PADDED WITH BLANKS.THE Y02621 07640002 * DELETE WILL BE ISSUED POINTING TO THE NAME. Y02621 07648002 SPACE 1 Y02621 07656002 L R3,AOJMRGEP ADDRESS OF EP TO JOURNAL MERGE Y02621 07664002 LTR R3,R3 DOES THE ENTRY EXIST? Y02621 07672002 BZ VHNEXOUT NO,BYPASS DELETION CODE Y02621 07680002 LA R3,AOJRNLEX ADDRESS OF EXIT LIST ENTRY Y02621 07688002 CLI NELEXLK,NELEXNAM DOES LIST HAVE 6 BYTE NAME? Y02621 07696003 BNE VHNEXOUT NO-NO NEED TO DELETE Y02621 07706003 BAL RA,VHNDEL GO DO DELETE @G29AN2F 07716003 XC AOJMRGEP,AOJMRGEP ZERO ADDRESS TO AVOID SECOND @G29AN2F 07726003 * DELETE @G29AN2F 07736003 DROP R3 RELEASE REG @G29AN2F 07746003 VHNEXOUT DS 0H Y02621 07768002 EJECT Y02668 07776002 *****************************************************************Y02668 07800002 * *Y02668 07900002 * SET UP NEL TO BE RETURNED TO INTERPRETER'S CALLER *Y02668 08000002 * *Y02668 08100002 *****************************************************************Y02668 08200002 SPACE 2 Y02668 08300002 L R3,WANELPTR GET PTR TO NEL Y02668 08400002 USING NELHERE,R3 ADDRESS NEL Y02668 08500002 L RE,NELQMPA GET PTR TO QMPA IN CALLER'S Y02668 08600002 * CORE Y02668 08700002 MVC NONE(QMPALEN,RE),QPARM OVERLAY CALLER'S QMPA WITH Y02668 08800002 * THE QMPA THE INTERPRETER USED Y02668 08900002 LA R2,JCT GET PTR TO JCT Y02668 09000002 USING JCTD,R2 ADDRESS THE JCT Y02668 09100002 MVC NELJCT(WORD),JCTDSKAD PUT THE SVA OF THE JCT Y02668 09200002 * INTO THE NEL Y02668 09300002 DROP R2 Y02668 09400002 EJECT Y02668 09500002 *****************************************************************Y02668 09600002 * *Y02668 09700002 * FREE I/O BUFFERS *Y02668 09800002 * *Y02668 09900002 *****************************************************************Y02668 10000002 SPACE 2 Y02668 10100002 L R1,TEXTBUFP GET ADDR OF INTERNAL TEXT Y02668 10200002 * BUFFER Y02668 10300002 LTR R1,R1 ALREADY FREE IF ZERO @ZA10444 10330003 BZ VHN0050 BYPASS FREEMAIN IF PTR ZERO @ZA10444 10360003 LA R2,WORD*2 GET TXTBUF HEADER LENGTH Y02668 10400002 SR R1,R2 PUSH TEXTBUF PTR BACK TO Y02668 10430002 * POINT TO TEXTBUF HEADER Y02668 10460002 LH R0,TXTBUFLT GET TEXT BUFFER LENGTH Y02668 10500002 BAL RA,VHNFREE FREE THE TEXT BUFFER Y02668 10600002 XC TEXTBUFP,TEXTBUFP ZERO POINTER SO WON'T TRY FREE 10620003 * AGAIN IF ENTERED ON RETRY @ZA10444 10640003 VHN0050 EQU * @ZA10444 10660003 * Y02668 10700002 L R1,AOWSTMT GET ADDR OF SYSTEM OUTPUT Y02668 10800002 * BUFFER Y02668 10900002 LTR R1,R1 ALREADY FREE IF ZERO @ZA10444 10930003 BZ VHN0055 BYPASS FREEMAIN IF PTR ZERO @ZA10444 10960003 LA R0,AOWBFLTH GET BUFFER LENGTH Y02668 11000002 BAL RA,VHNFREE GO TO FREE SYSTEM OUTPUT BUF Y02668 11100002 XC AOWSTMT,AOWSTMT ZERO PTR AFTER BUFFER FREED @ZA10444 11106003 VHN0055 EQU * @ZA10444 11112003 L R1,WAMSGBUF GET PTR TO MSG BUFFER Y02668 11120002 LTR R1,R1 ALREADY FREE IF ZERO @ZA10444 11126003 BZ VHN0060 BYPASS FREEMAIN IF PTR ZERO @ZA10444 11132003 LA R0,MSBUFLEN GET MSG BUFFER LENGTH YM00364 11140002 BAL RA,VHNFREE GO TO FREE MSG BUFFER Y02668 11160002 XC WAMSGBUF,WAMSGBUF ZERO PTR AFTER BUFFER FREED @ZA10444 11170003 VHN0060 EQU * @ZA10444 11180003 EJECT Y02668 11200002 *****************************************************************Y02668 11300002 * *Y02668 11400002 * FREE CORE USED FOR TABLES AND WORK AREAS *Y02668 11500002 * DELETE IEFUJV *YM0581 11550002 * *Y02668 11600002 *****************************************************************Y02668 11700002 SPACE 2 Y02668 11800002 TM NELOPSWT,NELSMF WAS A JMR CREATED FOR SMF Y02668 11900002 * PROCESSING Y02668 12000002 BZ VHN0100 NO, BYPASS FREEING OF Y02668 12100002 * JMR CODE Y02668 12200002 L R1,IWAJMRPT GET ADDR OF JMR CORE Y02668 12300002 LTR R1,R1 ALREADY FREE IF ZERO @ZA10444 12330003 BZ VHN0100 BYPASS FREEMAIN IF PTR ZERO @ZA10444 12360003 LA R0,TABLEN GET LENGTH OF GOTTEN CORE Y02668 12400002 BAL RA,VHNFREE Y02668 12500002 XC IWAJMRPT,IWAJMRPT ZERO PTR AFTER BUFFER FREED @ZA10444 12520003 DELETE EP=IEFUJV DELETE USER ROUTINE. YM00581 12550002 VHN0100 DS 0H Y02668 12600002 L R1,DSENQTP GET ADDR OF DSENQ TABLE Y02668 12700002 LTR R1,R1 ALREADY FREE IF ZERO @ZA10444 12730003 BZ VHN0110 BYPASS FREEMAIN IF PTR ZERO @ZA10444 12760003 LA R0,TABLEN GET TABLE LENGTH Y02668 12800002 BAL RA,VHNFREE FREE THE DSENQ TABLE Y02668 12900002 XC DSENQTP,DSENQTP ZERO PTR AFTER BUFFER FREED @ZA10444 12930003 VHN0110 EQU * @ZA10444 12960003 * Y02668 13000002 L R1,CTRLWAP GET ADDR OF LOCAL WORK Y02668 13100002 * AREA Y02668 13200002 LTR R1,R1 ALREADY FREE IF ZERO @ZA10444 13230003 BZ VHN0120 BYPASS FREEMAIN IF PTR ZERO @ZA10444 13260003 L R0,IWALWLGN LOAD LWA LENGTH FROM IWA TO FREE. @Z40MPTH 13300003 BAL RA,VHNFREE FREE THE LOCAL WORK AREA Y02668 13400002 XC CTRLWAP,CTRLWAP ZERO PTR AFTER BUFFER FREED @ZA10444 13420003 VHN0120 EQU * @ZA10444 13440003 L R1,BUFADDR GET 'TRACE ' RTN BUFFER ADDR Y02668 13470002 LTR R1,R1 WAS 'TRACE' ACTIVE? Y02668 13540002 BZ VHN0125 NO, GO TO FREE OTHER WORK AREAY02668 13610002 LH R0,BUFLTH YES, GET BUFFER LENGTH Y02668 13680002 BAL RA,VHNFREE FREE THE 'TRACE' BUFFER Y02668 13750002 VHN0125 DS 0H Y02668 13820002 EJECT Y02668 13900002 *****************************************************************Y02653 13903002 * Y02653 13906002 * DEACTIVATE THE ESTAE ENVIRONMENT OVER INTERPRETER Y02653 13909002 * Y02653 13912002 *****************************************************************Y02653 13915002 SPACE 1 13918002 L R1,AOSTAPRM ADDRESS OF USER PARAM AREA Y02653 13921002 LTR R1,R1 WAS ESTAE ACTIVE? Y02653 13924002 BZ VHN0150 NO IF POINTER IS ZERO-BYPASS Y02653 13927002 * FREEING THE USER AREA SINCE IT DOESN NOT EXIST,ANDY02653 13930002 * BYPASS CANCELLING ESTAE SINCE IT WAS NOT ACTIVE. Y02653 13933002 LA R0,EREPLEN LENGHT OF USER PARMAETER LIST Y02653 13936002 BAL RA,VHNFREE FREE USER PARAMTER LIST Y02653 13939002 SPACE 1 13942002 ESTAE 0 Y02653 13945002 SPACE 1 13948002 VHN0150 DS 0H Y02653 13951002 EJECT 13954002 *****************************************************************Y02668 13957002 * *Y02668 13960002 * FREE THE IWA *Y02668 13963002 * *Y02668 13966002 *****************************************************************Y02668 13969002 LR R1,RC GET ADDR OF IWA Y02668 13972002 LA R0,WALTH GET IWA LENGTH. Y02668 13975002 BAL RA,VHNFREE GO TO FREE IWA Y02668 13978002 EJECT 13984002 *****************************************************************Y02668 14000002 * *Y02668 14100002 * RESTORE CALLER'S REGS AND EXIT *Y02668 14200002 * *Y02668 14300002 *****************************************************************Y02668 14400002 SPACE 2 Y02668 14500002 IEFRELSE , RESTORE CALLER'S RSA PTR Y02668 14600002 RETURN (14,12) RETURN TO INTERP'S CALLER Y02668 14700002 EJECT 14800002 *****************************************************************Y02668 14900002 * *Y02668 15000002 * SUBROUTINE TO CLEAR CORE *Y02668 15100002 * R0 - LENGTH OF CORE TO FREE *Y02668 15200002 * R1 - ADDRESS OF CORE TO BE FREED *Y02668 15300002 * *Y02668 15400002 *****************************************************************Y02668 15500002 SPACE 2 15600002 VHNFREE DS 0H Y02668 15700002 FREEMAIN R,LV=(0),A=(1) FREE CORE AS REQUESTED Y02668 15800002 BR RA RETURN TO CALLER Y02668 15900002 SPACE 4 15905003 ***************************************************************@G29AN2F 15910003 * @G29AN2F 15915003 * SUBROUTINE TO DELETE EXIT LIST ENTRY POINT @G29AN2F 15920003 * @G29AN2F 15925003 * R3 - ADDRESS OF NEL EXIT LIST ENTRY @G29AN2F 15930003 * @G29AN2F 15935003 ***************************************************************@G29AN2F 15940003 SPACE 2 15945003 VHNDEL DS 0H @G29AN2F 15950003 USING NELEXENT,R3 SET UP ADDRESSABILITY @G29AN2F 15955003 MVC ZERO(MVSIX,R3),NELEXEP LEFT JUSTIFY NAME IN FIELDY02621 15960003 MVC SIX(MVTWO,R3),BLANK2 PAD FIELD WITH BLANKS Y02621 15965003 DROP R3 Y02621 15970003 SPACE 1 15975003 DELETE EPLOC=(3) DELETE JOURNAL MERGE ROUTINE Y02621 15980003 SPACE 1 15985003 BR RA RETURN TO CALLER @G29AN2F 15990003 EJECT 16000002 *****************************************************************Y02668 16100002 * DECLARED STORAGE *Y02668 16200002 *****************************************************************Y02668 16300002 IOERROR DC X'0008' TEMP*** 16400002 TXTBUFLT DC H'8192' 8K INTERNAL TEXT BUFFER Y02668 16500002 BLANK2 DC X'4040' BLANKS TO PAD MODULE NAME 16550002 BUFLTH DC H'2048' 'TRACE' BUFFER LENGTH Y02668 16620002 ***************************************************************** 16700002 * * 16800002 * EQUATES * 16900002 * * 17000002 ***************************************************************** 17100002 SPACE 2 17200002 MSBUFLEN EQU 160 MSG BUF LEN Y02668 17360002 WORD EQU 4 Y02668 17500002 SAVERF EQU 16 DISPL OF R15 IN SAVE AREA Y02668 17700002 HALFWORD EQU 2 Y02668 17800002 JCLERROR EQU 4 JCL ERROR RETURN CODE Y02668 18100002 QMPALEN EQU 32 Y02668 18300002 AOWBFLTH EQU 90 Y02668 18600002 TABLEN EQU 176 Y02668 18800002 NONE EQU 0 Y02668 19000002 ZERO EQU 0 Y02668 19020002 SIX EQU 6 Y02668 19040002 MVSIX EQU 6 Y02668 19060002 MVTWO EQU 2 Y02668 19080002 IEF452I EQU 6 JCL ERROR MSG KEY Y02668 19084002 *****************************************************************Y02668 19086002 * VCONS *Y02668 19088002 *****************************************************************Y02668 19090002 IEFVHRV DC V(IEFVHR) WTO RTN Y02668 19092002 PATCH DC 25F'0' **********PATCH SPACE*********Y02668 19094002 END IEFVHN 19100002