TITLE ' GRAPHICS CLOSE EXECUTOR ' 00050002 *********************************************************************** 00100002 * 00150002 * MODULE NAME: IGG0203Y (OS/VS2) 00200002 * 00250002 * DESCRIPTIVE NAME: GRAPHICS CLOSE EXECUTOR 00300002 * 00350002 * COPYRIGHT: NONE 00400002 * 00450002 * STATUS: RELEASE 2.0 00500002 * 00550002 * FUNCTION: THIS MODULE PERFORMS ALL CLOSE FUNCTIONS FOR 00600002 * THE 2250S AND 2260S SUPPORTED BY GPS. 00610002 * 00660002 * THIS INCLUDES: 00710002 * 1. VALIDITY CHECKS. 00760002 * A. UCB IS A GRAPHICS SUPPORTED DEVICE 00810002 * 1. 2250 ) ALL MODELS SUPPORTED 00860002 * 2. 2260 ))) AND 00910002 * 3. 1053 ) ALL LOCALLY ATTACHED 00960002 * B. CORRECT TASK IS REQUESTING CLOSE IF 01010002 * DCB SHOWS BASIC ATTN HDLING IS USED 01060002 * 2. DELETING SPECIAL ROUTINES NOT HANDLED BY 01110002 * SYSTEM CLOSE. 01160002 * A. IFFCAN03 FOR BASIC 2250 CANCEL KEY 01210002 * 3. RESET OR RELEASE CONTROL BLOCKS 01260002 * A. DCB 01310002 * B. IOB (PURGE & FREE) 01360002 * C. UCB 01410002 * D. BASIC REBS & TEB FOR THIS DCB 01460002 * E. BASIC IRBS & IQES FOR: 01510002 * 1. IGG019OE 01560002 * 2. IFFCAN03 01610002 * F. EXPRESS USER POLL LIST 01660002 * 4. SHUTDOWN I/O FOR 2250S 01710002 * A. SOUND ALARM TO NOTIFY 2250 OPERATOR 01760002 * B. HALT REGENERATION OF SCREEN 01810002 * C. TURN OFF PFK LIGHTS 01820002 * D. RELEASE 2250 BUFFER 01830002 * 01832002 ******************* PROLOGUE*CONTINUED*NEXT*PAGE ********************** 01840002 EJECT 01850002 *********************************************************************** 01900002 * NOTES: 01950002 * 02000002 * DEPENDENCIES: KEY 5 CONTROL IS RECEIVED FROM SYSTEM CLOSE. 02050002 * USER DCB ADDRESS, KEY AVAIL FROM SYS WORKAREA. 02100002 * SYSTEM NUCLEUS, KEY 0, IS NOT FETCH PROTECTED. 02110002 * IF FIRST UCB ON TIOT IS GRAPHIC TYPE, 02150002 * ALL FOLLOWING UCBS WILL BE GRAPHIC. 02200002 * 02250002 * RESTRICTION: FOR 2250S, ONE DEVICE PER DCB WHICH RESULTS 02300002 * IN ONE UCB PER DEB. 02350002 * 02400002 * RESISTERS: SEE EQUATE DEFINITIONS FOLLOWING PROLOG 02450002 * 02500002 * PATCH LABEL: PATCH, A 50 BYTE DC AREA AT END OF MODULE 02550002 * 02600002 * MODULE TYPE: EXECUTABLE CODE 02650002 * 02700002 * PROCESSOR: ASSEMBLER XF 02750002 * 02800002 * MODULE SIZE: SEE PAGE 1 OF THIS LISTING 02850002 * 02900002 * ATTRIBUTES: 02950002 * AT ENTRY: REENTRANT ENABLED SUPERVISOR STATE IN KEY 5 03000002 * ASSUMED KEYS: 0, USER (AS RECORDED IN SYSTEM CLOSE WORKAREA) 03050002 * 03100002 * ENTRY POINT: IGG0203Y 03150002 * 03200002 * PURPOSE: SEE 'FUNCTION' HEADING ABOVE 03250002 * 03300002 * LINKAGE: SEE 'INPUT', NEXT HEADING 03350002 * 03400002 * INPUT: REGISTERS 5 THRU 8 AS FOLLOWS: 03450002 * 5 ADDR OF: TOP OF DCB LIST BEING PROCESSED 03500002 * 6 TOP OF WHERE-TO-GO TABLE 03550002 * 7 CURRENT ENTRY OF DCB LIST 03600002 * 8 CURRENT ENTRY OF WHERE-TO-GO TAB 03650002 * NOTE: 4 CONTAINS A VALID WORKAREA ADDR 03700002 * ONLY IF CONTROL RECEIVED FROM SYS CLOSE 03750002 * 03800002 * OUTPUT: SEE 'FUNCTION' HEADING ABOVE 03850002 * 03900002 * EXITS: 03950002 * 04000002 * NORMAL: XCTL, USING WTG TABLE FOR MODULE ID 04050002 * 04100002 * ERROR: XCTL, USING PROBLEM DETERMINATION MACRO 04150002 * DMABCOND FOR MODULE ID 04200002 * 04250002 ******************* PROLOGUE*CONTINUED*NEXT*PAGE ********************** 04300002 EJECT 04350002 *********************************************************************** 04400002 * 04450002 * EXTERNAL REFERENCES: 04500002 * 04550002 * ROUTINES: EXCP TO SHUTDOWN 2250 04600002 * IGC0007A RELEASE 2250 BUFFER 04610002 * IGC0007D RELEASE REBS ON TEB FOR THIS DCB 04620002 * PURGE STOP I/O PENDING 04630002 * 04650002 * DATA AREAS: SEE DSECT SECTION AT END OF LISTING 04700002 * 04750002 * CONTROL BLOCKS: SEE DSECT SECTION AT END OF LISTING 04800002 * 04850002 * TABLES: TABLE OF TCB/ASCB ADDRESSES 04900002 * WHERE-TO-GO TABLE (SEE IECDSECS DSECT) 04950002 * 05000002 * MACROS: ABEND DEBCHK DELETE FREEMAIN GETMAIN 05050002 * MODESET RLSEBFR SETLOCK WAIT XCTL 05060002 * 05100002 * CHANGE ACTIVITY: MODULE HAS BEEN RESTRUCTURED TO CONSOLIDATE 05150002 * THE TWO PREVIOUS CLOSE LOADS INTO A SINGLE 05200002 * LOAD MODULE. CSECT FLAGS UPDATED WHERE 05250002 * APPROPIATE. 05300002 * 05350002 * FIXES DROPPED LIST: 05400002 * YA01037 OBSOLETE CLOSE MODULE, IGG0203X, DID 05450002 * NOT RECOGNIZE 1053 DEVICE. 05500002 * SA54346 MODULES LOADED BY OPEN ARE DELETED BY 05550002 * SYSTEM CLOSE USING DEBSUBID FIELD. 05600002 * SA42281 GRAPHICS 2280 DEVICES NOT SUPPORTED 05610002 * IN VS SYSTEMS. 05620002 * SA37923 OBSOLETE CLOSE MODULE, IGG0203X, DID 05630002 * NOT RECOGNIZE EXPRESS ATTN HANDLING. 05640002 * 05650002 *********************************************************************** 05700002 SPACE 05750002 IGG0203Y CSECT 05800002 * SEE LABEL 'MODID' FOR LAST CHANGE DATE; FORMAT: NAME.SYSREL.DATE 05850002 *D271100,A277000 LF YM7703 05860002 *A136000 LF YM4062 05900002 *A102000-102500,154000-154500,157000 LD YA01258 06000002 *C123500,124000 LB Y01021 06050002 *A135000,C343000-345000 LB AOS/1 06100002 *C180000-181000 LC S21016 06150002 *A179000-179500 LI SA45407 06200002 *A155000-155500,157500,339000-340500 LI SA42814 06300002 *C267000-269500 LI SA42542 06400002 *A125500,126000 LI SA37402 06500002 *C235500-236500,C239000 LG ZA00500 06510000 *C345000,A392100 LG @ZM2360 06520000 *A157600 L5 @ZA03992 06530000 EJECT 06550002 *********************************************************************** 06600002 * * 06650002 * REGISTER ASSIGNMENTS * 06700002 * * 06750002 * TEMPORARY ASSIGNMENTS IN LOW NUMBER REGS * 06800002 * PERMANENT ASSIGNMENTS IN HIGH NUMBER REGS * 06850002 * INPUT NAMES IDENTICAL TO THOSE IN SYSTEM OPEN * 06900002 *********************************************************************** 06950002 SPACE 07000002 RE EQU 0 TEMPORARY: ENTRY POINT ADDRESSES 07050002 RSIZE EQU 0 GETMAIN SIZES 07100002 RADR EQU 1 ADDR WORK REG 07150002 RCALC EQU 1 CALCULATIONS 07200002 RCCW1 EQU 5 * CCWS FOR I/O SHUTDOWN * 07210002 RCCW2 EQU 8 * HELD IN REGS * 07220002 RCCW3 EQU 10 * DURING KEY CHANGE * 07230002 RBACK EQU 14 RETURN ADDRESS FOR LINKAGES 07250002 RLINK EQU 15 BRANCH ADDRESS FOR LINKAGES 07300002 RCODE EQU 15 RETURN CODES FROM LINKAGES 07350002 SPACE 07400002 RBASE EQU 2 CONVENTIONS: BASE REGISTER 07450002 RDCB EQU 3 DCB ADDRESS REGISTER 07500002 RGMTCB EQU 4 TCB FOR GETMAIN 07550002 RASCB EQU 7 ASCB FOR GETMAIN 07600002 SPACE 07650002 RCTR EQU 4 CALCULATIONS: GENERAL COUNTER 07700002 RLOC EQU 5 LOCATION REG FOR INDEXING 07750002 RLAST EQU 6 ADDR OF LAST ENTRY IN POLL LIST 07800002 RNEXT EQU 7 ADDR OF NEXT ENTRY IN POLL LIST 07850002 REXT EQU 8 NUMBER OF UCB EXTENTS FROM DEB 07900002 RCOUNT EQU 10 LOOP COUNTER FOR NBR OF IQES 07950002 SPACE 08000002 RCORE EQU 4 INPUT ADDRESSES: WORKAREA ONLY IF FROM SYS OPEN 08050002 RPAR EQU 5 PARAMETER LIST OF DCB ADDRS 08100002 RWTG EQU 6 WTG TABLE, EG. LABEL 'DXXWTG' 08150002 RPARC EQU 7 CURRENT PARAMETER LIST ENTRY 08200002 RWTGC EQU 8 CURRENT WGT TABLE ENTRY 08250002 SPACE 08300002 RGACB EQU 5 ADDRESSES: GACB 08350002 RIRB EQU 6 IRB FOR IQES BEING RELEASED 08400002 RREB EQU 6 REB 08450002 RDEB EQU 9 DEB FOR DEVICES BEING CLOSED 08500002 RDECB EQU 10 DECB FOR I/O 08550002 RTCB EQU 10 CURRENT TCB FROM CVT TCB TABLE 08600002 RIOB EQU 11 IOB USED FOR SHUTDOWN I/O 08610002 RTEB EQU 11 TEB BEING DEACTIVATED 08650002 RUCB EQU 12 CURRENT UCB 08700002 RSAVE EQU 13 SAVE AREA FOR OPEN 08750002 RSCB1 EQU 14 TEMP SYS CB ADDRESSES 08800002 RSCB2 EQU 15 TEMP SYS CB ADDRESSES 08850002 EJECT 08900002 *********************************************************************** 08950002 * * 09000002 * EQUATES * 09050002 * * 09100002 *********************************************************************** 09150002 ACURASCB EQU 12 CURRENT ASCB ADDR LOC IN TCB TABLE 09200002 ACURTCB EQU 4 CURRENT TCB ADDR LOC IN TCB TABLE 09250002 ADR EQU 4 09300002 DCBADR EQU 0 CURRENT DCB ADDR FROM INPUT PLIST 09400002 IOBSIZE EQU 72 IOB BLOCK SIZE IN BYTES 09450002 THRTWO EQU 32 09500002 TTROFF EQU 14 09550002 WAOFF EQU 32 OFFSET OF FIRST ENTRY OF WTG TAB 09600002 WGOFF EQU 8 OFFSET OF WTG ENTRIES 09650002 SPACE 09700002 ZERO EQU 0 DECIMAL/HEX NUMBERS FOR GENERAL USE 09750002 ONE EQU 1 09800002 TWO EQU 2 09850002 THREE EQU 3 09900002 FOUR EQU 4 09950002 SIX EQU 6 10000002 SEVEN EQU 7 10050002 EIGHT EQU 8 10100002 SPACE 10150002 CCW24 EQU 24 LENGTH OF HALT+PFK CCW LD YA01258 10200002 CCW16 EQU 16 LENGTH OF HALT CCW LD YA01258 10250002 SPACE 10260002 EXCP EQU 0 SVC NUMBERS 10270002 DAR EQU 74 10280002 EJECT 10300002 *********************************************************************** 10350002 * * 10400002 * INITIALIZATION * 10450002 * * 10460002 * 1. USING STATEMENTS IDENTIFY DSECT BASE REGISTERS * 10470002 * 2. BASE ESTABLISHED FOR ADDRESSABILITY OF MODULE * 10480002 * 3. MODULE EYECATCHER ID FOR RELEASE LEVEL VERIFICATION * 10490002 * * 10500002 *********************************************************************** 10550002 SPACE 2 10600002 USING CVT,RSCB1 CVT DSECT INITZ FROM LOC 16 10650002 USING FORCORE,RCORE IECDSECS, KEY 0, REFERENCED ONLY 10700002 USING IHADCB,RDCB DCB DSECT; KEY 5: COPIED; KEY >7: USER 10750002 USING DEBBASIC,RDEB DEB DSECT, KEY 5, CREATED BY GAM OPEN 10800002 USING SAVEAREA,RSAVE SAVE/WORK AREA, KEY 5, FOR GAM CLOSE 10850002 USING TCB,RTCB STD DSECTS, KEY 0: TCB 10900002 USING TEB,RTEB TEB 10950002 USING UCB,RUCB UCB 11000002 SPACE 3 11050002 BALR RBASE,0 SET UP CSECT BASE REGISTER 11100002 USING *,RBASE DEFINE CSECT BASE REGISTER 11150002 B *+24 11200002 MODID DC C'IGG0203Y.VS2R2.75106' MODULE EYECATCHER ID 11250000 EJECT 11300002 *********************************************************************** 11350002 * * 11400002 * INITIALIZATION * 11450002 * * 11460002 * 4. SAVE/WORK AREA IS USED TO PRESERVE REENTRANT STATUS. * 11470002 * INPUT REGS ARE SAVED NOW TO EXPAND NUMBER OF WORK REGS. * 11480002 * * 11500002 *********************************************************************** 11510002 L RSIZE,SAVSPSIZ GET SAVE/WORK AREA FOR GRAPHIC OPEN 11800002 GETMAIN R,LV=(0) 11850002 LR RSAVE,RADR 11900002 CLOS0010 EQU * 11950002 STM RPAR,RWTGC,R5 SAVE INPUT/UPDATED REGS 12000002 L RDCB,ZERO(RPARC) LOAD: COPIED DCB ADDRESS 12050002 L RCORE,ADR(RWTGC) WORK AREA FOR THIS DCB 12100002 L RSCB1,DXUDCBAD USER'S DCB ADDRESS 12150002 LA RSCB1,ZERO(RSCB1) CLEAR HIGH BYTE 12200002 ST RCORE,R4 KEEP AVAIL FOR USE 12250002 ST RSCB1,DECBDCB KEEP AVAIL FOR USE 12300002 EJECT 12310002 *********************************************************************** 12320002 * * 12330002 * VALIDITY CHECKS * 12340002 * * 12340402 * 1. VALID DEVICE TYPE * 12342002 * A. ASSUME ALL UCBS OK IF FIRST OK * 12344002 * * 12346002 *********************************************************************** 12348002 DEBCHK (RSCB1),TYPE=VERIFY,AM=GAM VALIDATE DEB LB Y01021 12350002 LR RDEB,RADR INITIALIZE DEB BASE LB Y01021 12400002 LA RDEB,ZERO(RDEB) CLEAR HIGH ORDER BYTE 12450002 ST RDEB,R9 KEEP AVAIL FOR USE 12460002 L RUCB,DEBSUCBA GET FIRST UCB ADR 12500002 CLI UCBTBYT3,UCB3DISP IS DEVICE GRAPHICS TYPE LF A37402 12550002 BNE CLOS0240 IF NO, SKIP PROCESSING LI A37402 12600002 CLI UCBTBYT4,UCBT1053 IS DEVICE 1053 TYPE 12650002 BE CLOS0020 IF YES, OK TO PROCESS 12700002 CLI UCBTBYT4,UCBT2260 IS DEVICE 2260 TYPE 12750002 BE CLOS0020 IF YES, OK TO PROCESS 12800002 CLI UCBTBYT4,UCBT2250 IS DEVICE 2250 TYPE 12850002 BNE CLOS0240 IF NO, SKIP ALL PROCESSING 12900002 EJECT 12950002 *********************************************************************** 13000002 * * 13010002 * COMMON PROCESSING FOR EVERY CLOSE ENTRANCE * 13050002 * * 13060002 * 1. DELETE SPECIAL ROUTINES LOADED BY OPEN (IGG0193Y) * 13100002 * AND NOT DELETED BY SYSTEM CLOSE USING DEBSUBID * 13150002 * A. IFFCAN03 LOADED FOR 2250 BASIC ATTN HANDLING UCBS * 13200002 * 2. DECREMENT DCBS OPEN COUNT IN UCB (KEY 0) * 13250002 * * 13300002 *********************************************************************** 13350002 TM DCBGTYPE,DCBGTBAS IS THIS A BASIC SYSTEM? 13400002 BNO CLOS0020 BRANCH IF EXPRESS 13450002 DELETE EP=IFFCAN03 AOS/1 13500002 CLOS0020 EQU * 13550002 MODESET EXTKEY=ZERO LF YM4062 13600002 SR RCTR,RCTR CLEAR REG FOR UCB CT INSERT 13650002 SR REXT,REXT FOR NBR OF UCBS 13700002 SR RLOC,RLOC FOR INDEXING DEBUCBAD 13750002 IC REXT,DEBNMEXT GET NBR OF UCBS 13800002 CLOS0030 EQU * 13900002 L RUCB,DEBSUCBA(RLOC) LOAD FIRST/NEXT UCB ADDRESS 13950002 IC RCTR,UCBOPEN GET DCB OPEN COUNT 14000002 LTR RCTR,RCTR IS OPEN COUNT ALREADY ZERO 14050002 BZ CLOS0040 IF YES, GET NEXT UCB 14100002 BCTR RCTR,0 IF NO, REDUCE BY ONE 14150002 STC RCTR,UCBOPEN REPLACE NEW USECT IN UCB 14200002 LTR RCTR,RCTR IS USE CT NOW ZERO 14250002 BP CLOS0040 IF NO, SKIP BIT RESETS 14300002 NI UCBGCB,UCBGSET IF YES, RESET TO IGNORE SA32068 14350002 CLOS0040 LA RLOC,FOUR(RLOC) INCREMENT INDEX 14400002 BCT REXT,CLOS0030 BRANCH IF MORE UCBS TO SERVICE 14450002 CLI UCBTBYT4,UCBT2250 IS THIS A 2250 14500002 BNE CLOS0090 IF NO, SKIP 2250 I/O 14550002 CLI UCBOPEN,ZERO IS 2250 STILL BEING USED 14600002 BNE CLOS0090 IF YES, SKIP 2250 SHUTDOWN I/O 14650002 EJECT 14700002 *********************************************************************** 14750002 * * 14800002 * 2250 I/0 SHUTDOWN * 14850002 * * 14900002 * 1. SOUND ALARM TO NOTIFY 2250 OPERATOR OF SHUTDOWN * 14950002 * 2. HALT REGENERATION OF SCREEN * 15000002 * 3. TURN OFF PFK LIGHTS IF FEATURE INSTALLED * 15050002 * * 15110002 *********************************************************************** 15150002 L RCORE,R4 GET CURRENT WORK AREA ADDR 15210002 LM RCCW1,RCCW3,HLTCCW 15250002 L RIOB,DCBIOBAD IOB ADDR FROM COPY DCB 15300002 MODESET KEYADDR=DXUKEY,WORKREG=15 15310002 USING DXIOB,RIOB TEMP BASE FOR IOB I/O 15312002 CLOS0050 TS IOBAVAIL CHECK IF IOB AVAILABLE FOR USE 15320002 BZ CLOS0060 IF YES, USE FOR SHUTDOWN I/O 15330002 LR RSCB1,RIOB IF NO, SAVE & USE IF NO OTHER AVAIL 15332002 L RIOB,IOBNXTPT CHECK IF ANOTHER IOB ON CHAIN 15340002 LA RIOB,ZERO(RIOB) CLEAR HIGH BYTE 15342002 LTR RIOB,RIOB CHECK FOR ADDR 15344002 BNZ CLOS0050 IF YES, CHECK IF AVAILABLE 15346002 LR RIOB,RSCB1 IF NO, USE LAST IOB 15348002 CLOS0060 LA RSCB1,IOBCCW4 15348402 ST RSCB1,IOBECBPT INITZ IOB WITH ECB ADDR SM2858 15350002 TM UCBTBYT2,UCBTPFK IS PFK FEATURE INSTALLED LD YA01258 15400002 BZ CLOS0070 IF NO, SKIP PFK I/O LD YA01258 15450002 STM RCCW1,RCCW3,IOBCCW1 CCWS INTO IOB SA42814 15510002 LA RLOC,ZEROS LOAD ADDRESS OF ZEROS SA42814 15520002 STCM RLOC,SEVEN,IOBCCW3+1 PUT MASK ADR IN CCW SA42814 15550002 B CLOS0080 ISSUE EXCP FOR I/O 15650002 CLOS0070 STM RCCW1,RCCW2,IOBCCW1 CCWS INTO IOB SA42814 15750002 NI IOBCCW1+12,X'9F' TURN OFF CMD CHAIN L5 @ZA03992 15760000 CLOS0080 LR RADR,RIOB PUT IOB ADDR IN REG 1 & 15800002 SVC EXCP ISSUE EXCP 15850002 WAIT ECB=IOBCCW4 WAIT ON I/O SM2858 15950002 DROP RIOB 15952002 EJECT 15960002 *********************************************************************** 15970002 * * 15980002 * 2250 I/0 SHUTDOWN * 15990002 * * 15992002 * 4. RELEASE BUFFER IF FEATURE INSTALLED * 15994002 * * 15996002 *********************************************************************** 15998002 MODESET EXTKEY=DATAMGT 15998402 CLC UCBBTB(THREE),ZEROS DOES BUFFER TABLE EXIST 16000002 BE CLOS0090 IF NO, SKIP BFR RELEASE 16050002 L RSCB1,DXUDCBAD GET USER DCB 16150002 LA RDECB,DECBECB 16160002 RLSEBFR (RSCB1),ALL,MF=(E,(RDECB)) RELEASE BUFFER SM2858 16200002 EJECT 16250002 *********************************************************************** 16300002 * * 16350002 * ATTENTION HANDLING SHUTDOWN * 16400002 * * 16450002 * 1. DETERMINE TYPE OF ATTENTION HANDLING BEING USED * 16500002 * A. IF BASIC, RELEASE CONTROL BLOCKS * 16550002 * B. IF EXPRESS, RELEASE/COMPRESS POLLING LIST * 16600002 * * 16650002 *********************************************************************** 16700002 CLOS0090 EQU * 16750002 MODESET EXTKEY=ZERO 16760002 L RDEB,R9 GET DEB FOR LATER USE 16770002 L RSCB1,CVTPTR GET CVT ADDR FROM FIXED LOCATION 16800002 L RTCB,CVTTCBP GET ADDRS OF: TCB TABLE 16850002 L RSCB2,ACURASCB(RTCB) ASCB 16900002 ST RSCB2,ASCBADR KEEP FOR BR ENTRIES 16950002 L RTCB,ACURTCB(RTCB) CURRENT TCB 17000002 TM DCBGTYPE,DCBGTBAS IS THIS A BASIC SYSTEM? 17050002 BNO EAH0280 IF NO, DO EXPRESS PROCESSING 17100002 EJECT 17150002 *********************************************************************** 17200002 * * 17250002 * BASIC ATTENTION HANDLING SHUTDOWN * 17300002 * * 17350002 * 1. VALIDATE CORRECT TASK IS REQUESTING CLOSE * 17400002 * A. IF INCORRECT AND NOT ABENDING, ISSUE ABEND * 17450002 * * 17500002 *********************************************************************** 17550002 USING TEB,RTEB 17560002 L RTEB,UCBTEB DOES TEB EXIST 17600002 LTR RTEB,RTEB IF NO, SKIP BASIC PROCESSING & 17650002 BZ CLOS0210 CK IF OK TO PURGE IOBS 17700002 L RSCB1,TEBTCB IF YES, TEB TCB AND CUR TCB 17750002 CR RSCB1,RTCB MUST BE EQUAL OR ABENDING 17800002 BE BAH0100 IF EQUAL, OK TO PROCESS 17850002 TM TCBFLGS1,TCBFA IS ABEND IN PROGRESS LI SA45407 17900002 BO CLOS0240 IF YES, DONE PROCESSING LI SA45407 17950002 LA RADR,X'D14' LOAD ABEND CODE LC S21016 18000002 SLL RADR,12 SHIFT CODE LC S21016 18050002 ABEND (1),DUMP ABEND TASK LC S21016 18100002 EJECT 18150002 *********************************************************************** 18200002 * * 18250002 * BASIC ATTENTION HANDLING SHUTDOWN * 18300002 * * 18350002 * 2. DAR ANY REBS ASSOCIATED WITH THE DCB * 18400002 * * 18450002 *********************************************************************** 18500002 BAH0100 EQU * 18550002 USING GACB,RGACB 18600002 USING REB,RREB 18650002 L RREB,TEBREB LOAD FIRST REB 18700002 LTR RREB,RREB ANY REBS ON THIS TEB 18750002 BE BAH0130 IF NO, SKIP DAR PROCESSING 18800002 BAH0110 EQU * 18850002 L RGACB,REBGACB LOAD GACB ADDRESS 18900002 L RREB,REBL LOAD NEXT REB ADDR 18950002 L RSCB1,DECBDCB GET USER DCB 19000002 L RSCB2,GACBDCB GET DCB ADR 19050002 LA RSCB2,ZERO(RSCB2) CLEAR HIGH ORDER BYTE 19100002 L RCORE,R4 GET WORK AREA 19150002 CLR RSCB1,RSCB2 DO DCB ADRS MATCH 19200002 BNE BAH0120 IF NO, SKIP DAR & CK NEXT REB 19250002 MODESET KEYADDR=DXUKEY,WORKREG=15 19300002 OI GACBFLGS+1,GACBCLOS SET BIT FOR DAR TO CLOSE 19350002 MODESET EXTKEY=ZERO 19400002 LA RADR,DARPLGH GET ADDR OF DAR'S PLIST 19450002 LA RE,TWO LOAD LIST LENGTH 19500002 ST RGACB,DARGACB STORE GACB ADR IN PARM LIST 19550002 ST RE,DARPLGH STORE LENGTH IN PARM LIST 19600002 SVC DAR ISSUE SVC FOR DAR (IGC0007D) 19650002 BAH0120 EQU * 19700002 LTR RREB,RREB ARE THERE MORE REBS 19750002 BNZ BAH0110 IF YES, REPEAT PROCESSING 19800002 DROP RGACB 19850002 DROP RREB 19900002 EJECT 19950002 *********************************************************************** 20000002 * * 20050002 * BASIC ATTENTION HANDLING SHUTDOWN * 20100002 * * 20150002 * 3. FREE IQES ON IRB FOR CANCEL KEY * 20200002 * * 20250002 *********************************************************************** 20300002 USING RBBASIC,RIRB 20350002 BAH0130 EQU * 20400002 CLI UCBOPEN,ZERO CHECK DCB OPEN COUNT 20450002 BNE CLOS0210 IF NO, SKIP FREEMAINS 20500002 SR REXT,REXT IF YES, OK TO FREE IQES, ETC 20550002 IC REXT,DEBNMEXT GET NBR OF UCBS FROM DEB 20600002 LA RLOC,DEBSUCBA GET PTR TO FIRST UCB 20650002 LR RGMTCB,RTCB CURRENT TCB ADDR 20700002 L RASCB,ASCBADR CURRENT ASCB ADDR 20750002 LL1ON SETLOCK OBTAIN,TYPE=LOCAL,MODE=UNCOND,RELATED=(LOCAL,IGG0203Y(X20800002 LL1OFF)),REGS=SAVE 20850002 BAH0140 EQU * 20900002 L RUCB,ZERO(RLOC) LOAD UCB ADDRESS 20950002 LA RUCB,ZERO(RUCB) CLEAR HIGH ORDER BYTE 21000002 CLI UCBTBYT4,UCBT2250 IS DEVICE A 2250 21050002 BNE BAH0150 IF NO, ONLY ONE IQE TO FREE 21100002 LA RCOUNT,THREE IF YES, THREE IQES TO FREE 21150002 L RIRB,TEBCKRB LOAD CANCEL KEY IRB FROM TE 21200002 L RADR,RBNEXAV LOAD CANCEL KEY IQE ADDRESS 21250002 LTR RADR,RADR DOES CKQE EXIST 21300002 BZ BAH0160 IF NO, CHECK GAR'S IRB 21350002 MVC RBNEXAV(FOUR),ZERO(RADR) UPDATE CKIQE FLD 21400002 L RE,IQESIZE LOAD IQE BYTE REQUEST 21450002 FREEMAIN R,LV=(0),A=(1),BRANCH=YES FREE CANCEL KEY IQE 21500002 B BAH0160 NOW CHECK GAR'S IRB 21550002 EJECT 21600002 *********************************************************************** 21650002 * * 21700002 * BASIC ATTENTION HANDLING SHUTDOWN * 21750002 * * 21800002 * 4. FREE IQES ON IRB FOR GAR * 21850002 * A. IF 2250S: ONE IQE FOR CANCEL KEY'S IRB * 21900002 * THREE IQES FOR GAR'S IRB (THREE ATTN TYPES) * 21950002 * B. IF 2260S: ONE IQE FOR GAR'S IRB (ONE ATTN TYPE) * 22000002 * * 22050002 *********************************************************************** 22100002 BAH0150 EQU * 22150002 LA RCOUNT,ONE LOAD 2260 COUNT 22200002 BAH0160 EQU * 22250002 L RIRB,TEBGARB LOAD GAR'S IRB ADDRESS FROM TEB 22300002 BAH0170 EQU * 22350002 L RADR,RBNEXAV LOAD CANCEL KEY IQE ADDRESS 22400002 LTR RADR,RADR ANY MORE IQES 22450002 BZ BAH0180 NO 22500002 MVC RBNEXAV(FOUR),ZERO(RADR) UPDATE CKIQE FLD 22550002 L RE,IQESIZE LOAD IQE BYTE REQUEST 22600002 FREEMAIN R,LV=(0),A=(1),BRANCH=YES FREE IQE 22650002 BCT RCOUNT,BAH0170 BRANCH IF MORE IQES TO FREE 22700002 EJECT 22750002 *********************************************************************** 22800002 * * 22850002 * BASIC ATTENTION HANDLING SHUTDOWN * 22900002 * * 22950002 * 5. CLEAR UCBTEB FIELD * 23000002 * 6. TURN OFF UCBGCB BITS, GINIT AND GBAS * 23050002 * 7. DECREMENT TEB UCB USE COUNT * 23100002 * A. IF TEB UCB USE COUNT IS ZERO * 23150002 * 1). FREE IRBS * 23200002 * 2). FREE TEB * 23250002 * * 23300002 *********************************************************************** 23350002 BAH0180 EQU * 23400002 XC UCBTEB(FOUR),UCBTEB CLEAR UCBTE FIELD 23450002 NI UCBGCB,UCBGSET RESET TO IGNORE ATTNS SA32068 23500002 L RCOUNT,TEBUCBCT LOAD TEB UCB COUNT LG ZA00500 23550000 BCTR RCOUNT,ZERO DECREMENT USECNT (TE) LG ZA00500 23600000 ST RCOUNT,TEBUCBCT RESTORE USECNT LG ZA00500 23650000 LA RLOC,FOUR(RLOC) INCREMENT UCB PTR ADR 23700002 BCT REXT,BAH0140 BRANCH IF MORE UCBS 23750002 LL1OFF SETLOCK RELEASE,TYPE=LOCAL,RELATED=(LOCAL,IGG0203Y(LL1ON)), X23800002 REGS=SAVE 23850002 LTR RCOUNT,RCOUNT IS TEB STILL IN USE LG ZA00500 23900000 BNE CLOS0210 IF YES, DO ABEND CK & PURGE 23950002 EJECT 24000002 *********************************************************************** 24050002 * * 24100002 * BASIC ATTENTION HANDLING SHUTDOWN * 24150002 * * 24200002 * 8. FREE IRBS (INCLUDING THEIR PP SAVE AREA) AND TEB * 24250002 * * 24300002 * NOTE: IRBS THAT ARE ACTIVE CAN NOT BE FREED; THE IRB ON SM4120 * 24350002 * THE TASK RB CHAIN IS LEFT FOR ABEND TO FREE. SM4120 * 24400002 * * 24450002 *********************************************************************** 24500002 L RIRB,TEBCKRB IS THERE A CANCEL KEY IRB SM4120 24550002 LTR RIRB,RIRB SM4120 24600002 BZ BAH0190 IF NO,CK FOR A GAR IRB SM4120 24650002 TM RBSTAB2,RBFACTV IS THIS IRB ACTIVE ? SM4120 24700002 BO BAH0190 IF YES, DO NOT REMOVE SM4120 24750002 L RSIZE,REQUEST2 LOAD PPSVAREA REQUEST SM4120 24800002 L RADR,ZERO(RIRB) LOAD PPSVAREA ADDRESS SM4120 24850002 FREEMAIN R,LV=(0),A=(1) FREE PROB PROG SAVE AREA SM4120 24900002 L RSIZE,IRBSIZE LOAD IRB BYTE REQUEST 24950002 LR RADR,RIRB LOAD IRB ADDRESS TO PARM REG 25000002 FREEMAIN R,LV=(0),A=(1) FREE CANCEL KEY IRB 25050002 BAH0190 L RIRB,TEBGARB IS THERE A GAR IRB SM4120 25100002 LTR RIRB,RIRB IF NO, CK FOR A TEB SM4120 25150002 BZ BAH0200 SM4120 25200002 TM RBSTAB2,RBFACTV IS THIS IRB ACTIVE ? SM4120 25250002 BO BAH0200 IF YES, DO NOT REMOVE SM4120 25300002 L RSIZE,REQUEST2 LOAD PPSVAREA REQUEST SM4120 25350002 L RADR,ZERO(RIRB) LOAD PPSVAREA ADDRESS FROM IRB 25400002 FREEMAIN R,LV=(0),A=(1) FREE PROB PROG SAVE AREA 25450002 L RSIZE,IRBSIZE LOAD IRB BYTE REQUEST 25500002 LR RADR,RIRB LOAD IRB ADDRESS TO PARM REG 25550002 FREEMAIN R,LV=(0),A=(1) FREE GAR IRB 25600002 BAH0200 L RSIZE,TEBSIZE LOAD TE BYTE REQUEST M4120 25650002 LR RADR,RTEB LOAD TE ADDRESS IN PARM REG 25700002 FREEMAIN R,LV=(0),A=(1) FREE TE 25750002 EJECT 25800002 *********************************************************************** 25850002 * * 25900002 * COMMON PROCESSING IF NOT ABENDING * 25950002 * * 26000002 * 1. PURGE, THEN FREEMAIN, ALL IOBS * 26050002 * * 26060002 *********************************************************************** 26070002 CLOS0210 EQU * 26350002 LR RTCB,RGMTCB 26400000 TM TCBFLGS1,TCBFA ABEND IN PROGRESS 26450002 BO CLOS0240 26500002 CLOS0220 EQU * 26550002 MODESET EXTKEY=DATAMGT 26600002 L RCORE,R4 GET ADDR OF WORK AREA 26650002 ST RDEB,DXCCW6 STORE DEB ADDRESS LI SA42542 26700002 MVI DXCCW6,X'A0' PURGE OPTION LI SA42542 26750002 * PURGE OPTIONS: SPECIFIED ONLY; DON'T POST; HIO; RELATED ONLY 26800002 XC DXCCW6+4(EIGHT),DXCCW6+4 CLEAR FIELDS LI SA42542 26850002 LA RADR,DEBNMEXT GET IOB PURGE CHAINING ADDRESS FROM DEB 26900002 ST RADR,DXCCW6+8 FOR PURGE TO CHAIN IOB LI SA42542 26950002 LA RADR,DXCCW6 GET ADDRESS OF LIST 27000002 SVC 16 27050002 WAIT ECB=DXCCW6+4 WAIT ON PURGE ECB 27100002 SR RCTR,RCTR ZERO REGISTER 27150002 IC RCTR,DCBGNCP LOAD NO.OF IOBS 27200002 CLI DCBGNCP,DCBGNCPH IS GNCP EQUAL TO MAXIMUM 27250002 BE CLOS0230 IF YES, DO NOT ADJUST CTR 27300002 LA RCTR,ONE(RCTR) FOR SPARE IOB 27350002 CLOS0230 EQU * 27400002 LA RCALC,IOBSIZE LOAD IOB BLOCK SIZE 27450002 MR RSIZE,RCTR CALC SIZE TO RELEASE 27500002 LA RSIZE,EIGHT(RCALC) ADD FINAL SIZE FACTOR 27550002 O RSIZE,IOBSPOOL INDICATE IOB POOL 27600002 L RADR,DCBIOBAD LOAD IOB ADDRESS 27650002 S RADR,IOBECB LF YM7703 27700002 FREEMAIN R,LV=(0),A=(1) 27750002 EJECT 27752002 *********************************************************************** 27760002 * * 27770002 * COMMON PROCESSING IF NOT ABENDING * 27780002 * * 27790002 * 2. RESTORE DCB FIELDS TO PRE-OPEN STATUS; I. E., ZERO FIELDS: * 27792002 * A. BUFFER RELATED FIELDS: STARTING ADDRESSES AND SIZE * 27794002 * B. IOB ADDRESS * 27796002 * * 27798002 *********************************************************************** 27798402 SR RADR,RADR INITIALIZE FIELDS TO ZEROS: 27800002 STH RADR,DCBBRSA BUFFER RESTART ADDRESS 27850002 ST RADR,DCBBFRST BUFFER STARTING ADDR & SIZE 27900002 ST RADR,DCBIOBAD IOB CHAINING ADDRESS 27950002 EJECT 28000002 *********************************************************************** 28050002 * * 28100002 * CLOSE CHECK FOR ADDITIONAL DCBS TO PROCESS * 28150002 * * 28200002 *********************************************************************** 28250002 CLOS0240 EQU * 28300002 MODESET EXTKEY=DATAMGT 28350002 LM RCORE,RWTGC,R4 RESTORE INPUT REGS 28400002 XC ZERO(TWO,RWTGC),ZERO(RWTGC) CLEAR ID IND COMPLETION 28450002 CLOS0250 EQU * 28500002 LA RWTGC,WGOFF(RWTGC) STEP TO NEXT ENTRY 28550002 LA RPARC,ADR(RPARC) STEP TO NEXT ENTRY 28600002 CLC ZERO(TWO,RWTGC),GIDCNST1 CHECK FOR ID MATCH 28650002 BE CLOS0010 BRANCH IF HIT 28700002 CLC ZERO(TWO,RWTGC),CLLDB CHECK FOR ID MATCH 28750002 BL CLOS0250 BRANCH IF NO HIT 28800002 CLC ZERO(TWO,RWTGC),CLLDG CHECK FOR ID MATCH 28850002 BH CLOS0250 BACK TO LOOP IF HIGH 28900002 LR RPARC,RPAR INITIALIZE REGISTER 28950002 LA RWTGC,WAOFF(RWTG) INITIALIZE REGISTER 29000002 CLOS0260 EQU * 29050002 CLI ZERO(RWTGC),ZERO IS THIS ENTRY ZERO? 29100002 BNE CLOS0270 BRANCH IF NO 29150002 LA RWTGC,WGOFF(RWTGC) INCREMENT POINTER 29200002 LA RPARC,ADR(RPARC) INCREMENT POINTER 29250002 B CLOS0260 BRANCH UNCONDITIONALLY 29300002 CLOS0270 EQU * 29350002 LR RADR,RSAVE PRIME ADDR REG 29400002 L RSIZE,SAVSPSIZ GET SAVE/WORK AREA DESCRIPTION 29450002 FREEMAIN R,LV=(0),A=(1) 29500002 MVC SIX(TWO,RWTG),ZERO(RWTGC) SET UP ID FOR XCTL 29550002 MVC TTROFF(THREE,RWTG),TWO(RWTGC) ID TO TTR 29600002 LA RLINK,DXCCW12 POINT TO XCTL PARAMETER 29650002 XCTL DE=(RWTG),SF=(E,(RLINK)) 29700002 EJECT 29750002 *********************************************************************** 29800002 * * 29850002 * EXPRESS ATTENTION HANDLING SHUTDOWN * 29900002 * * 29950002 * ABEND CHECK: SKIP POLST PROCESSING IF TASK ABENDING SINCE * 30000002 * POLST IS NO LONGER FUNCTIONAL * 30050002 * * 30100002 * 1. FREE/COMPRESS POLLING LIST (USER KEY) * 30150002 * * 30200002 *********************************************************************** 30250002 EAH0280 TM TCBFLGS1,TCBFA IS ABEND IN PROGRESS 30300002 BO CLOS0240 IF YES, NO PROCESSING REQUIRED 30350002 L RADR,DCBPOLST GET POLL LIST ADDR FROM COPY DCB 30400002 LA RADR,ZERO(RADR) CLEAR HIGH ORDER BYTE 30450002 LTR RADR,RADR DOES A LIST EXIST 30500002 BZ CLOS0220 IF NO, CK FOR IOB PURGE 30550002 CLI ZERO(RADR),ZERO IF YES, CK IF LIST IS ACTIVE 30600002 BE CLOS0220 IF NO, SKIP PROCESSING 30650002 L RLAST,ZERO(RADR) IF YES, GET LAST ENTRY ADDR 30700002 LA RLAST,ZERO(RLAST) CLEAR FLAG BYTE 30750002 LA RLOC,FOUR(RADR) GET LOCATION FIRST ENTRY 30800002 L RCORE,R4 GET WORK AREA 31000002 L RSCB1,DECBDCB GET USER DCB FOR CHECK 31050002 MODESET KEYADDR=DXUKEY,WORKREG=7 31100002 EAH0290 EQU * 31110002 L RSCB2,ZERO(RLOC) GET DCB ADDR FROM ENTRY 31120002 LA RSCB2,ZERO(RSCB2) CLEAR INDEX BYTE 31130002 CLR RSCB1,RSCB2 CLOSING DCB MATCH THIS ENTRY 31150002 BE EAH0300 IF YES, REMOVE ENTRY 31200002 CLR RLOC,RLAST IS THIS END OF LIST 31250002 BE CLOS0220 IF YES, PROCESSING DONE 31300002 LA RLOC,FOUR(RLOC) IF NO, GET ADDR NEXT ENTRY 31350002 B EAH0290 AND REPEAT PROCESSING 31400002 EJECT 31450002 *********************************************************************** 31500002 * * 31550002 * EXPRESS ATTENTION HANDLING SHUTDOWN * 31600002 * * 31650002 * 1. DCB MATCH FOUND (CLOSING DCB & POLL LIST ENTRY) * 31700002 * * 31750002 * RLOC HAS ENTRY ADDR WITH MATCH * 31800002 * RLAST ADDR OF LAST ENTRY IN POLL LIST * 31850002 * RSCB2 ENTRY CONTENTS; I.E., DCB ADDR * 31900002 * * 31950002 *********************************************************************** 32000002 EAH0300 EQU * 32050002 SR RE,RE GET SOURCE OF ZEROS 32060002 LA RNEXT,FOUR(RLOC) GET NEXT ENTRY LOCATION 32100002 EAH0310 EQU * 32150002 CLR RNEXT,RLAST IS NEXT ENTRY LOC INSIDE LIST 32200002 BH EAH0330 IF NO, REMOVE LAST ENTRY 32250002 L RSCB2,ZERO(RNEXT) IF YES, GET NEXT ENTRY 32300002 LA RSCB2,ZERO(RSCB2) CLEAR INDEX BYTE 32350002 CLR RSCB1,RSCB2 CLOSING DCB MATCH NEXT ENTRY 32400002 BE EAH0320 IF YES, REMOVE ENTRY 32450002 MVC ZERO(FOUR,RLOC),ZERO(RNEXT) IF NO, COMPRESS ENTRY 32500002 LA RLOC,FOUR(RLOC) ADJUST LOCATION TO NEXT ENTRY 32550002 EAH0320 EQU * 32600002 LA RNEXT,FOUR(RNEXT) GET NEW NEXT ENTRY LOCATION 32650002 B EAH0310 AND REPEAT PROCESSING 32700002 * DCB MATCH FOUND 32750002 EAH0330 EQU * 32800002 LR RNEXT,RLOC GET PREVIOUS ENTRY LOCATION 32850002 EAH0340 EQU * 32900002 ST RE,ZERO(RNEXT) REMOVE ENTRY FROM LIST 32950002 LA RNEXT,ADR(RNEXT) ADJUST POINTER TO NEXT ENTRY 33000002 CLR RNEXT,RLAST IS NEXT ENTRY INSIDE LIST 33050002 BNH EAH0340 IF YES, CONTINUE TO PROCESS 33100002 S RLOC,ENTRY IF NO, BACK UP TO LAST ENTRY 33150002 CLR RADR,RLOC ANY ENTRIES IN POLL LIST 33200002 BE EAH0350 IF NO, RESET ACTIVE FLAG 33250002 STCM RLOC,SEVEN,ONE(RADR) IF YES, INSERT NEW EOL PTR 33300002 B CLOS0220 CHECK FOR IOBS TO PURGE 33350002 EAH0350 EQU * 33400002 STC RE,ZERO(RADR) RESET TO INACTIVE LIST (NO ENTRIES) 33450002 B CLOS0220 CHECK FOR IOBS TO PURGE I/O 33500002 EJECT 33550002 *********************************************************************** 33600002 * * 33650002 * CONSTANTS * 33700002 * * 33750002 *********************************************************************** 33800002 ZEROS DC F'0' MASK TO TURN OFF PFK LIGHTS SA42814 33900002 HLTCCW DC X'0700000040000002' 33950002 DC X'0B00000060000002' SA42814 34000002 PFKCCW DC X'1B00000020000004' CCW TO TURN OFF PFK'S SA42814 34050002 IOBSPOOL DC X'FA000000' SP 250 FOR IOB 34200002 IQESIZE DC X'E9000010' SP 233 16 BYTE IQE AOS/1 34300002 IRBSIZE DC X'E9000068' SP 233 104 BYTE IRB AOS/1 34400002 TEBSIZE DC X'EB000024' SP 235 36 BYTE TEB LG @ZM2360 34500000 REQUEST2 DC X'FA000048' SP 250 72 BYTE PP SAVE AREA 34600002 SAVSPSIZ DC X'E6000078' SP 230 120 BYTE WORK AREA 34700002 ENTRY DC F'4' POLL LIST ENTRY SIZE IN BYTES 34900002 IOBECB DC F'8' IOB ECB SIZE IN BYTES 34910002 GIDCNST1 DC C'3Y' 34950002 CLLDB DC C'0B' 35000002 CLLDG DC C'0G' 35050002 SPACE 5 35060002 ********************************************************************** 35070002 * * 35080002 * SPECIAL MAINTENANCE PATCH AREA FOR FIELD USE * 35090002 * * 35092002 ********************************************************************** 35094002 PATCH DC C'IGG0203Y 50 BYTE PATCH AREA.' 35096002 DC C'50 BYTE AREA ENDS HERE' 35098002 EJECT 35100002 *********************************************************************** 35150002 * * 35200002 * DSECTS * 35250002 * * 35300002 *********************************************************************** 35350002 CVT DSECT=YES 35400002 EJECT 35450002 DCBD DSORG=GS 35500002 ********************************************************************** 35550002 * * 35600002 * ADDITIONAL DCB EQUATES FOR DSECT * 35650002 * * 35700002 *********************************************************************** 35750002 DCBGNCPL EQU X'00' LOW END OF RANGE FOR CHANNEL PROGRAMS IS 1 35800002 DCBGNCPH EQU X'63' HIGH END OF RANGE FOR CHANNEL PROGRAMS IS 99 35850002 EJECT 35900002 IEZDEB 35950002 IECDSECS MAIN,EXPAND=YES 36000002 * 36050002 * ADDITIONAL IOB LABELS FOR GAM EXTENSION 36100002 * 36150002 ORG DXIOB 36200002 IOBDX DS 8F USE WORK AREA LABELS FOR STD FIELDS 36250002 * GAM EXTENSION 36300002 IOBUCBX DS 0CL1 UCB INDEX 36350002 IOBADRPT DS F ADDRESSING LIST POINTER 36400002 IOBAVAIL DS 0CL1 BIT 0: ON IF IOB NOT AVAILABLE FOR USE 36450002 IOBNXTPT DS F NEXT IOB POINTER 36500002 IOBCCW1 DS 2F MAX NBR OF CCWS FOR A GRAPHIC CHANNEL PGM IS 4 36510002 IOBCCW2 DS 2F 36520002 IOBCCW3 DS 2F 36530002 IOBCCW4 DS 2F * USED AS ECB FOR SHUTDOWN I/O * 36540002 EJECT 36550002 GACB DSECT 36600002 GACBCOM DS F ADDR OF: USER COMMUNICATION AREA FOR ATNS 36650002 GACBDCB DS F DCB FOR DEVICE WITH ATTENTIONS 36700002 GACBPFK DS F MASKS: PFK ATTENTION SOURCES PERMITTED 36750002 GACBATYP DS F ATTENTION TYPES PERMITTED 36800002 GACBEP1 DS F ADDR OF: ENTRY POINT FOR USER'S ATN RTN 36850002 GACBEP2 DS F ENTRY POINT FOR ATNQ, MODE=R 36900002 GACBSA DS F SAVE AREA FOR ATNQ 36950002 GACBPKSA DS F MASKS: SAVE AREA FOR PFK MASK 37000002 GACBATSA DS F SAVE AREA FOR ATTENTION TYPES 37050002 GACBECB DS F ECB USED FOR ATNQ, MODE=W 37100002 GACBREB DS F ADDR OF: REB FOR THIS ATTENTION ROUTINE 37150002 GACBIDX DS C INFO: INDEX VALUE TO FIND 2260 UCBS 37200002 GACBLPR DS C BUFFER RESTART LOCATION FOR LP 37250002 GACBFLGS DS H FLAGS: 37300002 GACBCLOS EQU X'01' CLOSE HAS ISSUED DAR 37350002 GACBATNQ DS F ADDR OF: ATTENTION INQUIRY RTN (IGG019OK) 37400002 GACBRES DS F RESERVED 37450002 EJECT 37500002 IHAPSA 37550002 EJECT 37600002 * ROUTINE ENTRY BLOCK (REB) 37650002 * 37700002 * 1. CREATED BY USER WITH GRAPHICS SPAR MACRO 37750002 * 2. SEE SVC MODULE, IGC0007C FOR FURTHER DETAILS 37800002 * 37850002 REB DSECT 37900002 REBL DS F ADDR OF: NEXT LOWER PRIORITY REB, OR ZEROS 37950002 REBH DS F NEXT HIGHER PRIORITY REB, OR TEB 38000002 REBUCB DS F UCB, OR LIST OF UCBS 38050002 REBGACB DS F GACB 38100002 REBGEIRB DS F GEIR'S IRB 38150002 REBFLGS DS H FLAGS: 38200002 REBPRTY DS H PRIORTY INDICATED BY USER IN SPAR 38250002 REBQ1 DS F ADDR OF: IQE TO BE PROCESSED IF EP=0 38300002 REBQ2 DS F IQE NEXT TO BE PROCESSED 38350002 REBTCB DS F TCB 38400002 REBRES DS F RESERVED 38450002 EJECT 38500002 IHARB 38550002 EJECT 38600002 IKJTCB 38650002 EJECT 38700002 TEB DSECT 38750002 TEBCKRB DS F ADDR OF: IRB FOR CANCEL KEY (IFFCAN03) 38800002 TEBREB DS F GAM ROUTINE ENTRY BLOCK 38850002 TEBTCB DS F TCB 38900002 TEBCKQE DS F LIST OF CANCEL KEY IQES 38950002 TEBUCBCT DS F USE COUNT: NBR OF UCBS USING THIS TEB 39000002 TEBFLGS DS F FLAG BYTES: 39050002 TEBFLAG EQU X'80' TEB ID FLAG 39100002 TEBGARB DS F ADDR OF: IRB FOR GAR (IGG019OE) 39150002 TEBGEIR DS F GEIR (IGG019OJ) ENTRY POINT 39200002 TEBGIOCR DS F GIOCR(IGG0190A)ENTRY POINT LG @ZM2360 39210000 EJECT 39250002 UCB DSECT 39300002 IEFUCBOB 39350002 EJECT 39400002 ********************************************************************** 39450002 * * 39500002 * ADDITIONAL UCB EQUATES FOR DSECT * 39550002 * * 39600002 *********************************************************************** 39650002 SPACE 3 39700002 * UCBTYP, BYTE 2, BIT SETTINGS 39750002 SPACE 39800002 UCBTPFK EQU X'10' UNIT TYPE BIT 3 FOR PFK FEATURE 39850002 SPACE 3 39900002 * UCBTYP, BYTE 4, BIT SETTINGS 39950002 SPACE 40000002 UCBT2250 EQU X'02' UNIT TYPE ID FOR 2250 DEVICE 40050002 UCBT2260 EQU X'03' FOR 2260 40100002 UCBT1053 EQU X'04' FOR 1053 40150002 SPACE 2 40200002 * UCBGCB, BIT SETTINGS 40250002 SPACE 40300002 UCBGINIT EQU X'40' OK TO ACCEPT ATTNS NOW A32068 40350002 UCBGBAS EQU X'08' 40400002 UCBGSET EQU X'B7' RESET ABOVE BITS TO ZERO 40450002 EJECT 40500002 *********************************************************************** 40550002 * * 40600002 * SAVE AREA DSECT * 40650002 * * 40700002 *********************************************************************** 40750002 SAVEAREA DSECT 40800002 WKSA DS 5F WORK WORDS FOR LOCAL LOCK WHEN REGS=SAV 40850002 R0 DS F REG ZERO * REGS MAP INTO * 41100002 R1 DS F REG ONE * STANDARD OS * 41150002 R2 DS F REG TWO * DISPLACEMENTS * 41200002 R3 DS F REG THREE * FOR * 41250002 R4 DS F REG FOUR * SAVE AREA * 41300002 R5 DS F REG FIVE * CHAINING * 41350002 R6 DS F REG SIX 41400002 R7 DS F REG SEVEN 41450002 R8 DS F REG EIGHT 41500002 R9 DS F REG NINE 41550002 R10 DS F REG TEN 41600002 R11 DS F REG ELEVEN 41650002 R12 DS F REG TWELVE 41700002 EPCAN03 DS F IFFCAN03 ADDRESS SAVE 41750002 EPGAR DS F GAR ADDRESS SAVE 41800002 EPGEIR DS F GEIR ADDRESS SAVE 41850002 ASCBADR DS F ADDR OF CURRENT ASCB 41900002 * THE FOLLOWING SECTION OF THE DSECT IS USED FOR THE GRAPHICS * 41950002 * SHUTDOWN I/O AND EXTERNAL LINKAGES. THE GETMAIN AREA IS USED * 42000002 * TO MAKE THE MODULE REENTRANT. * 42050002 * * 42100002 * DECB * 42150002 * * 42200002 DECBECB DS F ECB WORD 42250002 DECBTYPE DS F TYPE OF I/O OPERATION 42300002 RMICODE EQU X'08' TYPE CODE FOR RMI 42350002 DECBDCB DS F POINTER TO DCB 42400002 DECBADDR DS F I/O BUFFER-DATA TO BE 42450002 * TRANSFERRED 42500002 DECBHEX DS C ECB POSTING CODE 42550002 DECBCNT DS 3C RESIDUAL COUNT FROM CSW AFTER 42600002 * I/O COMPLETED 42650002 DECBOCBP DS F O/P CONTROL BLOCK POINTER 42700002 DECBSTRT DS F START ADDR OF CONTROL ORDERS 42750002 DECBUNIT DS C UNIT INDEX 42800002 DECBBUFF DS 3C BUFFER ADDRESS 42850002 ORG DECBECB 42900002 DARPLGH DS F LENGTH OF DAR'S PARAMETER LIST 42950002 DARGACB DS F ADDRESS OF GACB TO BE DELETED 43000002 END 43050002