./ ADD SSI=00050050,NAME=IGE0010C,SOURCE=0 TE67 TITLE ' 2280,2282 STANDARD ERROR ROUTINE' TRAPCODE/2280ERR 00020000 IGE0010C START X'00' 00040000 *********************************************************************** 00060000 * 00080000 *TITLE 2280,2282 STANDARD ERROR ROUTINE 00100000 * 00120000 * 00140000 *FUNCTION 1. TO RETRY I/O OPERATIONS THAT HAVE FAILED DUE TO HARD- 00160000 * WARE ERRORS IN ORDER TO DETERMINE PERMANENCY. 00180000 * 2. TO KEEP TRACK OF RETRIES AND NOTIFY SYSTEM OPERATOR 00200000 * OF ALL PERMANENT HARDWARE ERRORS. 00220000 * 3. TO NOTIFY SYSTEM OPERATOR IF INTERVENTION IS REQUIRED 00240000 * ON THE FILM UNITS. 00260000 * 4. TO KEEP STATISTICS ON THE NUMBER OF HARDWARE FAILURES 00280000 * FOR USE BY THE CUSTOMER ENGINEER. 00300000 * 5. TO CAUSE PERMANENT ERROR CODES TO BE POSTED IN THE 00320000 * ECB FOR PERMANENT HARDWARE ERRORS AND PROGRAM ERRORS DETECTED. 00340000 * 00360000 * 00380000 *ENTRY POINT ENTRY IS MADE TO THIS ROUTINE AT IGE0010C UPON DETECTION 00400000 * OF AN ERROR BY THE I O S INTERRUPTION SUPERVISOR. 00420000 * 00440000 * 00460000 *INPUT ADDRESS OF 12 STAR ELEMENT IN GENERAL REGISTER 1. 00480000 * 00500000 * 00520000 *OUTPUT 1. MESSAGE TO SYSTEM OPERATOR (WHEN REQUIRED). 00540000 * 2. STATISTICS TO STATISTICS TABLE (WHEN REQUIRED). 00560000 * 00580000 * 00600000 *EXITS - 00620000 * NORMAL 1. EXIT TO STATISTICS UPDATE ROUTINE (CORRECT ERROR). 00640000 * 2. EXIT TO SUPERVISOR VIA SVC3 AFTER INITIATING SVC15. 00660000 * 00680000 * ERROR 1. EXIT TO WTO ROUTINE FOR PERMANENT HARDWARE ERROR. 00700000 * 2. EXIT TO STATISTICS UPDATE ROUTINE FOR ALL PERMANENT 00720000 * PROGRAM ERRORS. 00740000 * 00760000 * 00780000 *TABLES/WORK AREAS 00800000 * SEE STANDARD CONTROL BLOCK LAYOUTS DESCRIBED IN OS/360 00820000 * I O S PLM, AND INTRO TO CONTROL PROGRAM LOGIC PLM. 00840000 * 00860000 * 00880000 *ATTRIBUTES REENTRANT 00900000 * 00920000 * 00940000 *NOTES N/A 00960000 * 00980000 *********************************************************************** 01000000 * 01020000 * REGISTER DEFINITION 01040000 * 01060000 STAR12 EQU 1 12* ADDRESS REGISTER (RQE ADDR) 01080000 BASEREG EQU 15 BASE REGISTER 01100000 IOBREG EQU 10 IOB ADDRESS REGISTER 01120000 UCBREG EQU 11 UCB ADDRESS REGISTER 01140000 ERREG2 EQU 12 WORK REGISTER 01160000 ERREG3 EQU 13 WORK REGISTER 01180000 ERREG4 EQU 0 WORK REGISTER 01200000 RTNREG EQU 14 RETURN REGISTER 01220000 * 01240000 * DEFINITIONS OF FLAGS, FLAG FIELDS, AND CODES IN CONTROL BLOCKS 01260000 * 01280000 IOBFLAG1 EQU 0 FLAG1 FIELD IN IOB 01300000 IOBECI EQU X'20' ERROR CORRECTION INDICATOR BIT 01320000 IOBEXCFG EQU X'04' EXCEPTION FLAG 01340000 FLAG1ALL EQU IOBECI+IOBEXCFG TWO BIT COMBINATION 01360000 * 01380000 IOBFLAG2 EQU 1 FLAG2 FIELD IN IOB 01400000 IOBDNP EQU X'02' DEVICE END POST CODE 01420000 * 01440000 IOBFLAG3 EQU 8 FLAG3 FIELD IN IOB 01460000 IOBMSGTP EQU X'04' MESSAGE TYPE INDICATOR 01480000 SEROUTID EQU X'01' SERR LOG OUT INDICATOR 01500000 * 01520000 UCBTYPE EQU 19 DEVICE TYPE FIELD IN UCB 01540000 TYPE2280 EQU X'05' TYPE CODE ID FOR 2280 01560000 TYPE2282 EQU X'06' TYPE CODE ID FOR 2282 01580000 * 01600000 IOBSTAT1 EQU 12 FIRST STATUS BYTE IN IOB 01620000 ATENTION EQU X'80' ATTENTION 01640000 CHANLEND EQU X'08' CHANNEL END 01660000 DEVICEND EQU X'04' DEVICE END 01680000 UNITCHEK EQU X'02' UNIT CHECK 01700000 UNITEXCP EQU X'01' UNIT EXCEPTION 01720000 SNOCRST1 EQU ATENTION+UNITEXCP SHOULD NOT OCCUR BITS STATUS 1 01740000 UCUE EQU X'FF'-UNITCHEK-UNITEXCP MASK TO RESET UNIT CHECK/EXCEPT 01760000 * 01780000 IOBSTAT2 EQU 13 SECOND STATUS BYTE IN IOB 01800000 INCLEN EQU X'40' INCORRECT LENGTH 01820000 PROGCHEK EQU X'20' PROGRAM CHECK 01840000 PROTCHEK EQU X'10' PROTECTION CHECK 01860000 CHAINCK EQU X'01' CHAINING CHECK 01880000 STAT2ALL EQU INCLEN+PROGCHEK+PROTCHEK THREE BIT COMBINATION 01900000 SNOCRST2 EQU CHAINCK SHOULD NOT OCCUR BIT STATUS 2 01920000 * 01940000 IOBSENS0 EQU 2 IOB SENSE FIELD ZERO 01960000 CMDREJCT EQU X'80' COMMAND REJECT 01980000 INTVNREQ EQU X'40' INTERVENTION REQUIRED 02000000 BUSOUTCK EQU X'20' BUS OUT CHECK 02020000 EQUIPCHK EQU X'10' EQUIPMENT CHECK 02040000 DATACHEK EQU X'08' DATA CHECK 02060000 ILLGLSEQ EQU X'01' ILLEGAL SEQUENCE 02080000 SNOCUR0 EQU X'06' SHOULD NOT OCCUR SENSE DATA 0 02100000 * 02120000 IOBSENS1 EQU 3 IOB SENSE FIELD 1 02140000 READBCZ EQU X'80' READ BYTE COUNT ZERO 02160000 RECFLMLW EQU X'40' RECORDER FILM LOW 02180000 RECFORCG EQU X'20' RECORDER FORCED GAP 02200000 FILMOTLT EQU X'10' FILM MOTION LIMIT 02220000 OUTCKBUF EQU X'04' 2840 OUTPUT CHECK 02240000 INCHKBUF EQU X'02' 2840 INPUT CHECK 02260000 GRAPICHK EQU X'01' GRAPHIC CHECK 02280000 SNOCUR10 EQU X'18' 2280 SHOULD NOT OCCUR SENSE 1 02300000 SNOCUR12 EQU X'08' 2282 SHOULD NOT OCCUR SENSE 1 02320000 * 02340000 IOBRETRY EQU 30 IOB RETRY COUNT FIELD 02360000 BUSOUT1 EQU X'80' BUS OUT 1 RETRY INDICATOR 02380000 BUSOUT2 EQU X'40' BUS OUT 2 RETRY INDICATOR 02400000 DATACHK EQU X'20' DATA CHECK RETRY INDICATOR 02420000 INPIND EQU X'08' 2840 INPUT CHECK RETRY INDICATR 02440000 IOBAEA EQU X'02' ABNORMAL END APPENDAGE INDICATR 02460000 RETRYALL EQU BUSOUT1+BUSOUT2+DATACHK+INPIND FOUR BIT COMBINATION 02480000 * 02500000 * MISCELLANEOUS 02520000 * 02540000 UCBADR EQU 2 UCB ADDRESS FIELD IN 12 * 02560000 DCBADR EQU 20 DCB ADDRESS FIELD IN IOB 02580000 DCBERFLG EQU 44 DCB ERROR FLAG FIELD IN DCB 02600000 DCBPERM EQU X'C0' DCB PERMANENT ERROR FLAGS 02620000 EXCPER EQU 15 ERROR EXECUTE CHANNEL PROGRAM 02640000 EXIT EQU 3 EXIT TO SUPERVISOR SVC ID 02660000 STATAB EQU 9 STATISTICS TABLE INDEX BYTE 02680000 ERRNM1 EQU 254 POST STATISTICS IDENTIFICATION 02700000 WTO EQU 253 WRITE TO OPERATOR IDENT 02720000 COMADR EQU 16 LOCATION CONTAINING COMMUNICA- 02740000 * TIONS VECTOR TABLE ADDR (CVT) 02760000 XCLADR EQU 44 LOCATION IN CVT OF XCTL ADDR 02780000 STATADR EQU 112 LOCATION IN CVT THAT CONTAINS 02800000 * THE STARTING ADDR OF STAT TBLS 02820000 STATDISP EQU 8 STATISTIC TABLE DISPLACEMENT TO 02840000 * 'OR' SENSE DATA FROM IOB TO TBL 02860000 IOBADR EQU 4 IOB ADDRESS FIELD IN 12 * 02880000 BITRESET EQU X'7F' MASKS UNUSED BITS IN STAT TABLE 02900000 * 02920000 * 02940000 ENTRY ER2280 02960000 USING *,BASEREG DEFINE BASE REGISTER 02980000 * 03000000 * SET EXCEPTION BIT AND ERROR FLAG IN IOB 03020000 * 03040000 ER2280 L IOBREG,IOBADR(0,STAR12) LOAD IOB ADDRESS 03060000 LH UCBREG,UCBADR(0,STAR12) LOAD UCB ADDRESS 03080000 OI IOBFLAG1(IOBREG),FLAG1ALL TURN ON ERROR BITS IN IOB FLG1 03100000 * 03120000 * 03140000 * TEST CSW STATUS BITS 03160000 * 03180000 * TEST SHOULD NOT OCCUR CONDITIONS 03200000 * 03220000 TM IOBSTAT1(IOBREG),SNOCRST1 TEST SHOULD NOT OCCUR STATUS 1 03240000 BC 5,SEROUT BRANCH IF ANY/ALL PRESENT 03260000 TM IOBSTAT2(IOBREG),SNOCRST2 TEST SHOULD NOT OCCUR STATUS 2 03280000 BC 5,SEROUT BRANCH IF ANY/ALL PRESENT 03300000 * 03320000 * TEST UNIT CHECK 03340000 * 03360000 TM IOBSTAT1(IOBREG),UNITCHEK TEST FOR UNIT CHECK 03380000 BC 1,MAINER BRANCH IF PRESENT 03400000 * 03420000 * TEST PERMANENT ERROR 03440000 * 03460000 TESTST TM IOBSTAT2(IOBREG),STAT2ALL TEST FOR PROG CHECK,PROT CHECK 03480000 * AND INCORRECT LENGTH 03500000 BC 5,PERMER BRANCH IF ANY/ALL PRESENT 03520000 * 03540000 * CLEAR EXCEPTION BIT IN IOB 03560000 * 03580000 NOERR NI IOBFLAG1(IOBREG),X'FF'-FLAG1ALL CLEAR PERMANENT ERROR 03600000 * FLAGS IN IOB 03620000 NI IOBSTAT1(IOBREG),UCUE CLEAR STATUS 03640000 L ERREG2,DCBADR(ERREG4,IOBREG) LOAD DCB ADDRESS 03660000 NI DCBERFLG(ERREG2),X'FF'-DCBPERM CLEAR DCB ERROR FLAGS 03680000 NI IOBRETRY(IOBREG),X'FF'-IOBAEA RESET AEA FLAG 03700000 BC 15,RESET BRANCH 03720000 * 03740000 * SET LOG OUT BIT IN IOB 03760000 * 03780000 SEROUT OI IOBFLAG3(IOBREG),SEROUTID INDICATE LOG OUT TO SERR 03800000 * 03820000 * CLEAR ERROR FLAG IN IOB 03840000 * 03860000 PERMER NI IOBFLAG1(IOBREG),X'FF'-IOBECI INDICATE PERMANENT ERROR 03880000 RESET NI IOBRETRY(IOBREG),X'FF'-RETRYALL RESET ALL RETRY FLAGS 03900000 POST LA ERREG3,ERRNM1 LOAD POST STATISTICS ROUTINE ID 03920000 L RTNREG,COMADR LOAD ADDR OF CVT 03940000 L RTNREG,XCLADR(ERREG4,RTNREG) LOAD ADDR OF XCTL ROUTINE 03960000 BCR 15,RTNREG BRANCH TO XCTL ROUTINE 03980000 * 04000000 * TEST SENSE BITS 04020000 * 04040000 MAINER LR ERREG4,IOBREG SAVE REGISTER 04060000 L IOBREG,COMADR LOAD COMMUNICATION TABLE ADDR 04080000 L IOBREG,STATADR(ERREG4,IOBREG) LOAD STAT TABLE START ADR 04100000 SR ERREG2,ERREG2 ZERO REGISTER 04120000 IC ERREG2,STATAB(ERREG4,UCBREG) STAT TAB INDEX TO REGISTER 04140000 LA ERREG3,10 CONSTANT TO REGISTER 04160000 MR ERREG2,ERREG2 COMPUTE ABSOLUTE INDEX 04180000 AR ERREG3,IOBREG COMPUTE ABSOLUTE ADDRESS OF 04200000 * DEVICE STATISTIC TABLE 04220000 LR IOBREG,ERREG4 RESTORE REGISTER 04240000 OC STATDISP(2,ERREG3),IOBSENS0(IOBREG) SENSE DATA IS 04260000 * 'OR' INTO STATISTICS TABLE SO 04280000 * THAT DIFFERENCES DUE TO RETRY 04300000 * WILL BE COMBINED AT UPDATE TIME 04320000 NI STATDISP(ERREG3),BITRESET RESET NOT USED BIT 04340000 TM IOBSENS0(IOBREG),SNOCUR0 TEST FOR SHOULD NOT OCCUR 04360000 * SENSE BITS IN BYTE 0 04380000 BC 5,SEROUT BRANCH IF ANY/ALL PRESENT 04400000 CLI UCBTYPE(UCBREG),TYPE2280 TEST FOR 2280 04420000 BC 8,IS2280 BRANCH IF 2280 04440000 CLI UCBTYPE(UCBREG),TYPE2282 TEST FOR 2282 04460000 BC 8,IS2282 BRANCH IF 2282 04480000 BC 15,SEROUT GO TO SYSTEM ERROR RECORDING 04500000 * 04520000 * TEST SHOULD NOT OCCUR SENSE BITS IN BYTE 1 04540000 * 04560000 IS2280 TM IOBSENS1(IOBREG),SNOCUR10 TEST 2280 NOT OCCUR SENSE 1 04580000 BC 5,SEROUT BRANCH IF ANY/ALL PRESENT 04600000 BC 15,AROUND BRANCH OVER 2282 CODE 04620000 IS2282 TM IOBSENS1(IOBREG),SNOCUR12 TEST 2282 NOT OCCUR SENSE 1 04640000 BC 5,SEROUT BRANCH IF ANY/ALL PRESENT 04660000 AROUND TM IOBFLAG2(IOBREG),IOBDNP TEST FOR DEVICE END ONLY 04680000 BC 1,DEONLY BRANCH IF DEVICE END ONLY 04700000 TM IOBSTAT1(IOBREG),CHANLEND+DEVICEND TEST FOR CE AND DE 04720000 BC 1,ISCEDE BRANCH IF CE AND DE 04740000 * 04760000 * TEST ERROR CONDITIONS POSSIBLE WITH UNIT CHECK 04780000 * 04800000 TM IOBSENS0(IOBREG),BUSOUTCK TEST FOR BUS OUT CHECK 04820000 BC 1,ISBUSOT1 BRANCH IF BUS OUT PRESENT 04840000 TM IOBSENS0(IOBREG),CMDREJCT TEST FOR COMMAND REJECT 04860000 BC 1,PERMER BRANCH IF PRESENT 04880000 BC 15,TESTST BRANCH TO TEST REMAINDER OF 04900000 * STATUS BITS 04920000 ISBUSOT1 TM IOBRETRY(IOBREG),BUSOUT1 HAS ERROR BEEN RETRIED 04940000 BC 1,WTORTN BRANCH IF YES 04960000 OI IOBRETRY(IOBREG),BUSOUT1 IF NOT, SET RETRY INDICATOR 04980000 * 05000000 * ALL ERRORS TO BE RETRIED WILL EXIT HERE 05020000 * 05040000 RETRY SVC EXCPER ISSUE ERROR EXCP 05060000 SVC EXIT RETURN TO IOS 05080000 * 05100000 * 05120000 * TEST ERROR CONDITIONS POSSIBLE WITH CHANNEL END, DEVICE END, AND 05140000 * UNIT CHECK 05160000 * 05180000 ISCEDE TM IOBSENS0(IOBREG),BUSOUTCK TEST FOR BUS OUT CHECK 05200000 BC 1,ISBUSOT2 BRANCH IF PRESENT 05220000 TM IOBSENS0(IOBREG),DATACHEK TEST FOR DATA CHECK 05240000 BC 1,ISDATACK BRANCH IF PRESENT 05260000 TM IOBSENS1(IOBREG),INCHKBUF TEST FOR 2840 INPUT CHECK 05280000 BC 1,ISBFINCK BRANCH IF PRESENT 05300000 BC 15,TESTST IF NOT, BRANCH TO TEST REMAINDR 05320000 * OF STATUS BITS 05340000 ISBUSOT2 TM IOBRETRY(IOBREG),BUSOUT2 HAS ERROR BEEN RETRIED 05360000 BC 1,WTORTN BRANCH IF YES 05380000 OI IOBRETRY(IOBREG),BUSOUT2 SET RETRY INDICATOR 05400000 BC 15,RETRY BRANCH TO RETRY I/O REQUEST 05420000 ISDATACK TM IOBRETRY(IOBREG),DATACHK HAS ERROR BEEN RETRIED 05440000 BC 1,WTORTN BRANCH IF YES 05460000 OI IOBRETRY(IOBREG),DATACHK SET RETRY INDICATOR 05480000 BC 15,RETRY BRANCH TO RETRY I/O REQUEST 05500000 ISBFINCK TM IOBRETRY(IOBREG),INPIND HAS ERROR BEEN RETRIED 05520000 BC 1,WTORTN BRANCH IF YES 05540000 OI IOBRETRY(IOBREG),INPIND SET RETRY INDICATOR 05560000 BC 15,RETRY BRANCH TO RETRY I/O REQUEST 05580000 * 05600000 * TEST ERROR CONDITIONS POSSIBLE WITH DEVICE END AND UNIT CHECK 05620000 * 05640000 DEONLY TM IOBSENS0(IOBREG),EQUIPCHK TEST FOR EQUIPMENT CHECK 05660000 BC 1,PERMER BRANCH IF PRESENT 05680000 TM IOBSENS0(IOBREG),INTVNREQ TEST FOR INTERVENTION REQUIRED 05700000 BC 1,INTERVEN BRANCH IF PRESENT 05720000 TM IOBSENS0(IOBREG),DATACHEK+ILLGLSEQ TEST FOR DATA CHECK 05740000 * OR ILLEGAL SEQUENCE 05760000 BC 5,PERMER BRANCH IF EITHER/BOTH PRESENT 05780000 TM IOBSENS1(IOBREG),READBCZ+RECFORCG+FILMOTLT+GRAPICHK 05800000 * TEST FOR READ BYTE COUNT ZERO 05820000 * OR RECORDER FORCED GAP OR FILM 05840000 * MOTION LIMIT OR GRAPHIC CHECK 05860000 BC 5,PERMER BRANCH IF ANY/ALL PRESENT 05880000 BC 15,TESTST BRANCH TO TEST REMAINDER OF 05900000 * STATUS BITS 05920000 * 05940000 * ATTEMPT TO RETRY WAS NOT SUCCESSFUL 05960000 * 05980000 WTORTN OI IOBFLAG3(IOBREG),IOBMSGTP INDICATE PERMANENT ERROR MSG 06000000 NI IOBRETRY(IOBREG),X'FF'-RETRYALL RESET ALL RETRY FLAGS 06020000 WOPOST NI IOBFLAG1(IOBREG),X'FF'-IOBECI INDICATE PERM ERROR IN IOB 06040000 OI IOBFLAG3(IOBREG),SEROUTID INDICATE POSTING NEEDED 06060000 LA ERREG3,WTO LOAD WRITE TO OPERATOR ID 06080000 L RTNREG,COMADR LOAD ADDRESS OF COMM VECTOR TBL 06100000 L RTNREG,XCLADR(0,RTNREG) LOAD ADDRESS OF XCTL ROUTINE 06120000 BCR 15,RTNREG BRANCH TO XCTL ROUTINE 06140000 * 06160000 * INTERVENTION REQUIRED MESSAGE MUST BE WRITTEN TO OPERATOR 06180000 * 06200000 INTERVEN NI IOBFLAG3(IOBREG),X'FF'-IOBMSGTP INDICATE I.R. MESSAGE 06220000 BC 15,WOPOST BRANCH TO FINISH WTO INTERFACE 06240000 * 06260000 * 06280000 CNOP 0,8 06300000 * 06320000 * 06340000 END 06360000 ./ ADD SSI=21120748,NAME=IGE0010D,SOURCE=0 IGE0010D CSECT 00200000 TITLE 'IGE0010D ERROR RTN' 00300000 * TITLE: 5450 ERROR RECOVERY PROCEDURE 00400000 * 00600000 * STATUS: CHANGE LEVEL= 0 00800000 * 01000000 * FUNCTION: ANALYZE STATUS AND SENSE DATA AND ATTEMPT ERROR RECOVERY 01200000 * IF THE ERROR IS CORRECTED, PROCEED IN A NORMAL MANNER. 01400000 * IF A PERMANENT ERROR IS DETECTED, INDICATE IT TO THE 01600000 * USER BY A COMPLETION CODE IN THE ECB. 01800000 * ENTRY: IGE001OD 02000000 * 02200000 * INPUT: REQUEST ELEMENT POINTER IN REGISTER 1. 02400000 * 02600000 * OUTPUT: NONE 02800000 * 03000000 * EXITS: 1.ERREXCP EXIT TO I/O SUPERVISOR TO RE-EXECUTE THE 03200000 * CHANNEL PROGRAM IN ERROR. 03400000 * 2.SVC 3 TO RETURN CONTROL TO THE SUPERVISOR AND 03600000 * RELINQUISH CONTROL OVER THE TRANSIENT AREA 03800000 * 3.XCTL EXIT TO STATISTICS UPDATE ROUTINE TO LOG ERROR 04000000 * THIS ROUTINE WILL RETURN TO THE SUPERVISOR VIA SUC 3. 04200000 * 04400000 * NOTES: IOB EXCEPTION AND IOB ERROR FLAGS ARE INTERPRETED AS 04600000 * FOLLOWS 04800000 * IOBEX ON AND IOBERR ON, ERROR RTN. IN CONTROL. 05000000 * IOBEX ON AND IOBERR OFF, PERMANENT ERROR. 05200000 * IOBEX OFF AND IOBERR OFF, NO ERROR OR CORRECTED. 05400000 * 05600000 * TABLES: STATISTICS TABLE AND IOB 05800000 * 06000000 * OPERATION: THIS ROUTINE CHECKS THE STATUS AND SENSE BYTES STORED IN 06200000 * THE UCB AND IOB AND TAKES ACTION AS SPECIFIED IN THE 06400000 * DEVICE STANDARDS. STATISTICS ARE KEPT AS TO THE KIND AND 06600000 * FREQUENCY OF ERRORS. THESE STATISTICS ARE USED BY THE 06800000 * CE TO ISOLATE AND RECOGNIZE ERRORS. 07000000 * A COMMON INTERPRETER ROUTINE IS USED TO CHECK BOTH 07200000 * STATUS AND SENSE. ON RETURN FROM THE INTERPRETER THE 07400000 * PROPER ACTION OF RETRY OR LOG OUT AND EXIT TO STATISTICS 07460000 * UPDATE ROUTINE IS TAKEN. FOR NON-PERMANENT ERRORS, SVC 07520000 * 15(RETRY CHANNEL PROGRAM) AND SVC 3 ARE EXECUTED. FOR 07580000 * PERMANENT ERRORS, THE SENSE INFORMATION IS MOVED INTO 07640000 * BYTES 9 AND 10 OF THE STATISTICS TABLE, THEN EXIT IS 07700000 * MADE TO THE STATISTICS UPDATE ROUTINE (IGE0025D). 07760000 * ERRORS CAUSING UNIT CHECKS ARE RETRIED ONCE. NO RETRY IS 07820000 * PERFORMED FOR PROG. CHECK, PROTECT CHECK,UNIT EXCEPTION. 07880000 * FOR CHANNEL CHECK ERRORS, THE ERP TRACES BACK THROUGH 08000000 * THE CCH LINKAGE TO LOCATE THE APPROPRIATE ERP INTERFACE 08200000 * BYTE (ERPIB) FOR THE CHANNEL ERROR. THE ERPIB IS 08400000 * GENERATED BY CCH AND CONTAINS DATA WHICH AUGMENTS AND 08600000 * INFLUENCES SUBSEQUENT RECOVERY HANDLING OF THE ERROR. 08800000 * IF NO ERPIB IS FOUND FOR THE ERROR, IT WILL BE TREATED 09000000 * AS A PERMANENT ERROR. 09200000 * IF THE APPROPRIATE ERPIB IS FOUND. A RETRY IS PERFORMED 09240000 * AND THE ERPIB IS ZEROED. 09280000 * FOR CHANNEL DATA CHECKS, A BIT IS SET IN THE STATISTICS 09320000 * TABLE. ONE RETRY IS PERFORMED. 09360000 * 09400000 * IOB DEFINITION FUNCTION LENGTH 09600000 IOBFL1 EQU 0 IOB FLAG 1 1 09800000 IOBFL2 EQU 1 IOB FLAG 2 1 10000000 IOBSNS EQU 2 IOBSNS 2 10200000 IOBCOD EQU 4 ECB COMPLETION CODE 1 10400000 INTERCPT EQU X'7E' INTERCEPT CONDITION 10600000 IOBECB EQU 5 ECB ADDRESS 3 10800000 IOBFL3 EQU 8 IOB FLAG 3 - ERROR 1 11000000 IOBCSW EQU 8 LAST CSW 8 11200000 IOBSTOCC EQU 16 SIO CONDITION CODE 1 11400000 IOBSTART EQU 17 CHANNEL PROG ADDR 3 11600000 IOBDCB EQU 20 ADDRESS OF DCB 4 11800000 IOBRSTR EQU 25 IOS RESTART ADDR 3 12000000 IOBBCT EQU 28 2 12200000 IOBERCT EQU 30 ERROR RETRY COUNT 2 12400000 SPACE 2 12600000 * FLAGS IN IOB FLAG 3 12800000 IOBCRJ EQU X'80' COMMAND REJECT COUNT 13000000 IOBBOE EQU X'40' BUSOUT ERROR COUNT 13200000 IOBCECE EQU X'20' EQUIPMENT CHECK COUNT 13400000 IOBDCE EQU X'10' DATA CHECK ERROR COUNT 13600000 IOBBPC EQU X'08' BUFFER ADDR PARITY ERROR COUNT 13800000 IOBIBA EQU X'04' INVALID BUFFER ADDR ERROR COUNT 14000000 IOBLOG EQU X'01' 14200000 IOBRTCDC EQU X'40' CHANNEL DATA CHECK RETRY FLAG 14400000 CDCBIT EQU X'01' CDC BIT - TURNED ON IN STAT TABLE 14600000 * 14800000 * INPUT/OUTPUT BLOCK FORMAT 15000000 * 15200000 * ************************************ 15400000 * * * * * FLAG DEFINITIONS 15600000 * + 0 * FLAGS * FLAGS * SENSE BYTES * FLAGS 1- OFFSET 0 15800000 * * 1 * 2 * * X'20'-I/O REQUEST UNDER 16000000 * ************************************ CONTROL OF ERROR 16200000 * * * * ROUTINE 16400000 * + 4 * ECB * ECB ADDRESS * X'04'-IOB EXCEPTION 16600000 * * CODE * * LEFT ON IF ERROR 16800000 * ************************************ UNCORRECTED 17000000 * * * * X'01'-START/RESTART 17200000 * + 8 * FLAGS * * 17400000 * * 3 * CHANNEL STATUS * FLAGS 3- OFFSET 8 17600000 * ********* * RETRY FLAGS 17800000 * * WORD * X'80' - COMMAND REJECT 18000000 * * * X'40'- BUSOUT CHECK 18200000 * * * X'10'- DATA CHECK 18400000 * ************************************ X'08'- BUFFER ADDRESS 18600000 * * * * PARITY CHECK 18800000 * + 16 * SIO * START ADDRESS * X'04'- INVALID BUFFER 19000000 * * CC * * ADDRESS 19200000 * *********************************** X'01'- LOG OUT FLAG 19400000 * * * * ERROR COUNT- OFFSET 30 19600000 * + 20 * * DCB ADDRESS * X'80'- RETRY FOR INTER. 19800000 * * * * CONTROL CHECK OR 20000000 * ************************************ CHAN.CONTR CHECK 20200000 * * * * X'40'- RETRY FOR CHAN. 20400000 * + 24 * * RESTART ADDRESS * DATA CHECK 20600000 * * * * 20800000 * ************************************ 21000000 * * * * 21200000 * + 28 * * ERROR COUNT * 21400000 * * * * 21600000 * ************************************ 21800000 * TWELVE STAR DEFINITION 22000000 TSTLNK EQU 0 FORWARD 12* LINK 22200000 TSTUCB EQU 2 UCB POINTER 22400000 TSTIOB EQU 5 IOB POINTER 22600000 TSTPR EQU 8 ENTRY PRIORITY 22800000 TSTDEB EQU 9 DEB POINTER 23000000 * FLAGS IN IOB FLAG 1 23200000 IOBDTC EQU X'80' DATA CHAIN FLAG 23400000 IOBCMC EQU X'40' COMMAND CHAIN FLAG 23600000 IOBERR EQU X'20' ERROR RTN IN CONTROL FLAG 23800000 IOBMD1 EQU X'10' MOD 1 FLAG 24000000 IOBMD2 EQU X'08' MOD 2 FLAG 24200000 IOBEX EQU X'04' EXCEPT FLAG 24400000 IOBSRS EQU X'01' START/RESTART FLAG 24600000 IOBEXE EQU IOBEX+IOBERR EXCEPT AND ERROR FLAGS 24800000 IOBCXE EQU 255-IOBEXE CLEAR EXCEPT AND ERROR FLAGS 25000000 SPACE 2 25200000 * FLAGS IN IOB FLAG 2 25400000 IOBUEX EQU X'08' WRITE 25600000 SPACE 2 25800000 * UCB DEFINITION 26000000 UCBFL1 EQU 6 UCB FLAGS 26200000 UCBSTI EQU 9 STATISTICS POINTER 26400000 * UCB FLAGS 26600000 UCBNRY EQU X'40' UCB NOT READY 26800000 * STATUS INDICATORS - CSW 27000000 CSWPC EQU X'20' PROGRAM CHECK 27200000 CSWPCK EQU X'10' PROTECTION CHECK 27400000 CSWCHE EQU X'08' CHANNEL END 27600000 CSWUCK EQU X'02' UNIT CHECK 27800000 CSWCCK EQU X'01' CHAINING CHECK 28000000 CSWVEX EQU X'01' UNIT EXCEPTION 28200000 CSWCCC EQU X'04' CHANNEL CONTROL CHECK 28400000 CSWICC EQU X'02' INTERFACE CONTROL CHECK 28600000 CSWCDC EQU X'08' CHANNEL DATA CHECK 28800000 * MISCELLANEOUS DEFINITIONS 29000000 ABADVEC EQU 16 ADDRESS OF VECTOR TABLE 29200000 VECT44 EQU 44 POINTER TO XCTL ROUTINE 29400000 EXCPER EQU 15 EXCP ERROR 29600000 ERRETURN EQU 3 RETURN 29800000 IOBCC1 EQU X'10' 30000000 STATAB EQU 112 NDX TO STATISTICS TABLE 30200000 CNTLAL EQU X'0B' 30400000 VECT68 EQU 68 NDX TO INTERPRETOR ROUTINE PTR 30600000 NORCOD EQU X'7F' IOB NORMAL CODE 30800000 VECT116 EQU 116 PTR TO CHAN CHECK PTR TAB 31000000 IOBCHN EQU X'80' ICC-CCC FLAG 31200000 DCBFL EQU 44 31400000 DCBCEX EQU X'C0' 31600000 * RQE DEFINITIONS 31800000 RQEUCB EQU 0 UCB PTR 32000000 RQEIOB EQU 4 IOB POINTER 32200000 IB3037 EQU 67 32400000 IB3069 EQU 69 32600000 IB3130 EQU 130 32800000 WTORTN EQU 253 LOAD NAME TO WTO RTN 33000000 TABEND EQU X'FF' END OF ERPIB TABLE INDICATOR 33200000 N0 EQU 0 NUMBER 33400000 N1 EQU 1 NUMBER 33600000 N2 EQU 2 NUMBER 33800000 N3 EQU 3 NUMBER 34000000 N4 EQU 4 NUMBER 34200000 N5 EQU 5 NUMBER 34400000 N6 EQU 6 NUMBER 34600000 N7 EQU 7 NUMBER 34800000 N8 EQU 8 NUMBER 35000000 N9 EQU 9 NUMBER 35200000 N10 EQU 10 NUMBER 35400000 N12 EQU 12 NUMBER 35600000 N13 EQU 13 NUMBER 35800000 N14 EQU 14 NUMBER 36000000 N15 EQU 15 NUMBER 36200000 N16 EQU 16 NUMBER 36400000 N18 EQU 18 NUMBER 36600000 N255 EQU 255 NUMBR 36800000 STATUP EQU 254 DISPLACEMENT 37000000 VECTXL EQU 44 IBID. 37200000 IOCLBT EQU 0 IBID. 37400000 * REGISTER EQUATES AND USAGES 37600000 PBASE EQU 15 PROGRAM BASE REG 37800000 XCTL EQU 14 PTR TO XCTL ROUTINE 38000000 XDCB EQU 13 DCB POINTER 38200000 ERRLNK EQU 12 ERROR LINK REG 38400000 XUCB EQU 11 UCB POINTER 38600000 XIOB EQU 10 IOB POINTER 38800000 XSAV EQU 9 SAVE REGISTER 39000000 XVEC EQU 8 VECTOR TABLE POINTER 39200000 XLNK EQU 7 LINK REGISTER 39400000 XCCW EQU 6 CCW POINTER 39600000 XER5 EQU 5 WORK REG 39800000 XER4 EQU 4 WORK REG 40000000 XERP EQU 3 40200000 X2 EQU 2 40400000 XRQE EQU 1 RQE POINTER 12* 40600000 X0 EQU 0 40800000 * COMPLETION CODE SETTINGS 41000000 IOBINT EQU X'7E' IOB INTERCEPT CODE 41200000 INTCOD EQU X'44' INTERCEPT POST CODE 41400000 IOBFIN EQU X'7F' NORMAL COMPLETION CODE 41600000 * 41800000 IBFLG1 EQU 4 ERPIB BYTE 4 42000000 IBUNR EQU X'01' UNCONDITIONAL NO-RETRY BIT 42200000 IBSIB1 EQU X'C0' SIO 42400000 IBSIO1 EQU X'80' SIO BIT 42600000 IBSNS1 EQU X'04' VALID SENSE 42800000 * 43000000 IBFLG2 EQU 6 ERPIB BYTE 6 43200000 IBALL2 EQU X'1C' VALIDITY BITS 43400000 * 43600000 IBFLG3 EQU 7 ERPIB BYTE 7 - TERMINATION/RETRY 43800000 IB3001 EQU 1 44000000 IB3002 EQU 2 44200000 IB3003 EQU 3 44400000 IB3004 EQU 4 44600000 IB3005 EQU 5 44800000 * 44850000 *C622000 A48088 44900000 * 44950000 * INITIALIZATION 45000000 * 45200000 USING *,15 ESTABLISH PROGRAM BASE 45400000 ER5450 EQU * 45600000 L XIOB,RQEIOB(XRQE) GET IOB ADDR FROM RQE 45800000 OI IOBFL1(XIOB),IOBEXE INDICATE ERP IN CONTROL 46000000 L XVEC,ABADVEC GET VECTOR TABLE ADDRESS 46200000 L XCTL,VECT44(XVEC) GET XCTL RTN POINTER 46400000 L XDCB,IOBDCB(XIOB) GET DCB POINTER 46600000 LA XLNK,ERR618 SET ADDR TO SVC 15/SVC3 RETURN 46800000 LH XUCB,TSTUCB(XRQE) POINT TO UCB - PTR DEFINED AS 2 BYTE 47000000 NI IOBFL1(XIOB),N255-IOBMD1 CLEAR MODE ONE FLAG 47200000 L XER5,STATAB(XVEC) POINT TO STATISTICS TABLE 47400000 SR XER4,XER4 CLEAR REG 47600000 IC XER4,UCBSTI(XUCB) GET STATAB INDEX FROM UCB 47800000 MH XER4,ERRCN2 MULTIPLY BY TEN 48000000 AR XER5,XER4 NDX TO DEVICE ENTRY IN STATAB 48200000 * TEST CSW FOR CHANNEL CONTROL CHECK OR INTERFACE CONTROL CHECK 48400000 * BRANCH IF EITHER ON TO FIND ERPIB 48600000 CLI IOBCOD(XIOB),INTERCPT Q. INTERCEPT COND.- ASYNC ERROR 48800000 BE ERR603 YES, LOG SENSE INFO AND EXIT 49000000 TM IOBCSW+N5(XIOB),CSWCCC+CSWICC Q. ICC OR CCC ON 49200000 BC N7,ERR630 YES CHECK CHANNEL ERROR 49400000 TM IOBCSW+N5(XIOB),CSWCDC Q. CHANNEL DATA CHECK 49600000 BNO ERR600 NO, CHECK FOR UNIT CHECK 49800000 OI N1(XER5),CDCBIT TURN ON BIT IN STAT TABLE 50000000 TM IOBERCT(XIOB),IOBRTCDC Q HAS CHAN DATA C BEEN RETRIED 50200000 BO ERR603 YES, EXIT 50400000 OI IOBERCT(XIOB),IOBRTCDC TURN ON RETRY FLAG 50600000 B ERR650 GO RETRY 50800000 ERR600 EQU * 51000000 TM IOBCSW+N4(XIOB),CSWUCK Q. UNIT CHECK 51200000 BNO ERR618 NO CHECK STATUS INFO 51400000 LR XSAV,PBASE YES CHECK SENSE INFO - SAV BAS 51600000 L PBASE,VECT68(XVEC) POINT TO RESIDENT INTERPRETER RTN 51800000 ERR601 EQU * 52000000 BALR ERRLNK,PBASE LINK TO INTERPRET SENSE INFO 52200000 DC X'02' BUS OUT CHECK 52400000 DC AL1(ERR606-ERR601-N2) ADDRESS TO BRANCH TO 52600000 DC X'04' DATA CHECK 52800000 DC AL1(ERR605-ERR601-N4) ADDRESS TO BRANCH TO 53000000 DC X'07' BUFFER ADDRESS PARITY CHECK 53200000 DC AL1(ERR607-ERR601-N6) ADDRESS TO BRANCH TO 53400000 DC X'06' INVALID BUFFER ADDRESS 53600000 DC AL1(ERR608-ERR601-N8) ADDRESS TO BRANCH TO 53800000 DC X'00' COMMAND REJECT 54000000 DC AL1(ERR609-ERR601-N10) ADDRESS TO BRANCH TO 54200000 DC X'2F' TEST END - PERMANENT ERROR 54400000 DC AL1(ERR603-ERR601-N12) ADDRESS TO BRANCH TO 54600000 ERR603 EQU * PERMANENT ERROR 54800000 OI IOBFL3(XIOB),IOBLOG SET LOG OUT FLAG 55000000 NI IOBFL1(XIOB),N255-IOBERR MARK IOB AS PERM ERR 55200000 NI IOBFL3(XIOB),N255-IOBLOG TURN OFF RETRY INDICATORS 55260000 NI IOBERCT(XIOB),IOBCHN+IOBRTCDC TURN OFF CHAN RETRY INDIC 55320000 ERR625 EQU * 55400000 OC N8(N1,XER5),IOBSNS(XIOB) PUT SENSE DATA IN STATAB 55600000 LA N13,STATUP GET ADDR STATUP RTN 55800000 BR N14 XCTL TO STATISTICS UPDATE RTN 56000000 ERR606 EQU * BUSOUT CHECK 56200000 TM IOBFL3(XIOB),IOBBOE Q. BUS OUT RETRY 56400000 BO ERR603 YES CONSIDER PERM ERROR 56600000 OI IOBFL3(XIOB),IOBBOE INDICATE BUS OUT RETRY 56800000 ERR650 EQU * 57000000 SVC EXCPER ERROR EXCP 57600000 SVC ERRETURN RETURN 57800000 ERR605 EQU * DATA CHECK 58000000 TM IOBFL3(XIOB),IOBDCE Q. DATA CHECK RETRY 58200000 BO ERR603 YES PERM ERROR 58400000 OI IOBFL3(XIOB),IOBDCE NO INDICATE RETRY 58600000 B ERR650 GO RETRY 58800000 ERR607 EQU * BUFFER ADDRESS PARITY CHECK 59000000 TM IOBFL3(XIOB),IOBBPC Q. FIRST CHECK 59200000 BO ERR603 NO PERM ERROR 59400000 OI IOBFL3(XIOB),IOBBPC INDICATE RETRY 59600000 B ERR650 GO RETRY 59800000 ERR608 EQU * INVALID BUFFER ADDRESS 60000000 TM IOBFL3(XIOB),IOBIBA Q. FIRST CHECK 60200000 BO ERR603 NO PERM ERROR 60400000 OI IOBFL3(XIOB),IOBIBA INDICATE RETRY 60600000 B ERR650 GO RETRY 60800000 ERR609 EQU * COMMAND REJECT 61000000 TM IOBFL3(XIOB),IOBCRJ Q. FIRST CHECK 61200000 BO ERR603 NO PERM ERROR 61400000 OI IOBFL3(XIOB),IOBCRJ INDICATE RETRY 61600000 B ERR650 GO RETRY 61800000 ERR618 EQU * PERMANENT ERROR FOR PROG CHECK, PROTECT CHECK, UNIT 61900000 * EXCEPTION 62000000 TM IOBCSW+N5(XIOB),CSWPC+CSWPCK Q. PROTECTION OR PROG CHK 62100000 BZ ERR621 NO,THEN ENTERED FROM NORMAL END A48088 62200000 NI IOBFL1(XIOB),N255-IOBERR SET PERM ERROR 62400000 SVC EXCPER SVC 15 WILL POST PERMANENT ERROR 62600000 SVC ERRETURN AND EXIT 62800000 * ERROR CORRECTED 63000000 ERR621 EQU * 63200000 L XER4,IOBDCB(XIOB) POINT TO DCB 63400000 NI DCBFL(XER4),N255-DCBCEX RESET DCB EXCEPTION 63600000 NI IOBFL1(XIOB),IOBCXE-IOBSRS RESET IOB EX, ERROR, RESTART 63800000 MVI IOBFL3(XIOB),IOCLBT CLEAR ERROR COUNTS 64000000 NI IOBCSW+N4(XIOB),N255-CSWUCK RESET CSW UNIT CHK 64200000 ERR622 EQU * 64400000 LA N13,STATUP GET STAT UPDATE PTR 64600000 L ERRETURN,VECTXL(XVEC) GET XCTL RTN 64800000 BCR N15,ERRETURN RETURN 65000000 ERR630 EQU * 65200000 L XERP,VECT116(XVEC) POINT TO PARAM TABLE 65400000 L XERP,N0(XERP) POINT TO CCH PTR TABLE 65600000 L XERP,N0(XERP) POINT TO ERPIB TABLE 65800000 * 66000000 * SEARCH ERPIBS - WHEN UCB POINTER SAME AS 12* UCB, ERPIB 66200000 * FOUND FOR ERROR. 66400000 * FIRST ERPIB BYTE X'FF' BEFORE MATCH - NO ERPIB 66600000 * 66800000 ERR615 EQU * 67000000 TM N0(XERP),TABEND Q. END OF ERPIB TABLE 67200000 BO ERR603 YES- LOGOUT AND EXIT 67400000 L X2,N0(XERP) NO GET ERPIB UCB ADDR 67600000 LA X2,N0(X2) CLEAR HIGH BYTE 67800000 CLR X2,XUCB Q. UCB S MATCH 68000000 BE ERR670 YES-TEST ERPIB 68200000 LA XERP,N8(XERP) NEXT ERPIB 68400000 B ERR615 LOOP 68600000 * 68800000 * ERPIB FOUND - CHECK IF RETRY - IF ICC-CCC CAUSED BY ICC-CCC 69000000 * RETRY, PERMANET ERROR 69200000 * 69400000 ERR670 EQU * 69600000 TM IOBERCT(XIOB),IOBCHN Q. RETRY OF ICC-CCC 69800000 BO ERR685 YES BR 70000000 * 70200000 * TEST FOR IOB INTERCEPT 70400000 * 70600000 CLI IOBCOD(XIOB),IOBINT Q. IOB INTERCEPTED 70800000 BE ERR680 YES BR 71000000 * 71200000 * TEST FOR UNCONDITIONAL NO-RETRY 71400000 * 71600000 TM IBFLG1(XERP),IBUNR 71800000 BO ERR685 YES BR 72000000 ERR651 EQU * 72200000 OI IOBERCT(XIOB),IOBCHN SET RETRY 72400000 XC N0(N8,XERP),N0(XERP) ZERO ERPIB 72600000 B ERR650 GO ISSUE RETRY AND RETURN 72900000 ERR680 EQU * 73200000 MVI IOBCOD(XIOB),INTCOD SET INTERCEPT CODE 73400000 ERR685 EQU * 73600000 XC N0(N8,XERP),N0(XERP) CLEAR ERPIB 73800000 B ERR603 GO LOG OUT AND EXIT 74000000 * CONSTANTS 74200000 ERRCN1 DC H'08' CCW LENGTH 74400000 ERRCN2 DC H'10' MULTIPLIER 74600000 END 74800000 ./ ADD SSI=01012433,NAME=IGE0110B,SOURCE=0 IGE0110B START X'00' 01000014 *TITLE '2260/1053 STANDARD ERROR ROUTINE LOAD 2' 02000014 *FUNCTION WRITE A MESSAGE TO 2260 OPERATOR. 03000014 *ENTRY POINT ENTRY IS MADE BY LOAD 1 AT POINT IGE0110B 04000014 *INPUT ADDRESS OF 12 STAR ELEMENT IN REGISTER 1. 05000014 *NON DATA ENTRY MSG TO 2260 OPERATOR: ERR,RE-ENTER MSG. 06000014 *DATA ENTRY MSG TO 2260 OPERATOR: ERASE,RE-ENTER 07000014 *EXTERNAL ROUTINE N/A 08000014 *EXITS NORMAL EREXCP AND RETURN SVCS. 09000014 *EXITS ERROR N/A 10000014 *TABLES/WORK AREAS N/A 11000014 *ATTRIBUTES REENTRANT 12000014 *NOTES N/A 13000014 * 14000014 * 15000014 *REGISTER DEFINITION 16000014 STAR12 EQU 1 12*REGISTER 17000014 BASERG EQU 15 BASE REGISTER 18000014 IOBREG EQU 10 IOB ADDRESS REGISTER 19000014 ERREG1 EQU 11 WORK REGISTER 20000014 ERREG2 EQU 12 WORK REGISTER 21000014 * 22000014 IOBFL1 EQU 0 FLAG1 IN IOB 23000014 FL1ALL EQU X'24' ERR.CORR.IND AND EXCEPTION BIT 24000014 * 25000014 IOBCNT EQU 30 26000014 ECRTRY EQU X'10' 27000014 IOBCCW1 EQU 40 28000014 IOBCCW2 EQU 48 29000014 IOBCCW3 EQU 56 30000014 EXCPER EQU 15 31000014 DEMSK EQU X'10' 32000014 EXIT EQU 3 33000014 IOBADR EQU 4 34000014 ENTRY ER2260A 35000014 USING *,BASERG 36000014 ER2260A L IOBREG,IOBADR(0,STAR12) LOAD IOB ADDRESS 37000014 OI IOBFL1(IOBREG),FL1ALL TURN ON ERROR RTN IN CNTRL 38000014 * FLAGS IN IOB 39000014 OI IOBCNT(IOBREG),ECRTRY TURN ON ERR CHANL PROG FLAG 40000014 TM IOBCCW1(IOBREG),DEMSK CHECK FOR DATA ENTRY COMMAND 41000014 BO MVEDE 42000014 MVC IOBCCW1(32,IOBREG),ERASECCW 43000014 REGNDE LA ERREG2,IOBCCW3(0,IOBREG) LOAD MESSAGE ADR. 44000014 STH ERREG2,IOBCCW2+2(IOBREG) PARTIAL STORE 45000014 STH ERREG2,IOBCCW1+2(IOBREG) PARTIAL STORE ADR. 46000014 SRL ERREG2,16 SHIFT 47000014 STC ERREG2,IOBCCW2+1(IOBREG) COMPLETE STORE 48000014 STC ERREG2,IOBCCW1+1(IOBREG) COMPLETE ADDR STORE 49000014 SVC EXCPER 50000014 SVC EXIT 51000014 MVEDE MVC IOBCCW1(32,IOBREG),DECCW 52000014 B REGNDE 53000014 DS 0F 54000014 ERASECCW CCW 7,0,X'60',2 55000014 CCW 1,0,X'20',16 56000014 DC CL16' ERROR ON READ ' 57000014 DS 0D 58000014 DECCW CCW X'17',0,X'60',2 59000014 CCW X'11',0,X'20',16 60000014 DC CL16' ERROR ON READ ' 61000014 DS 0D 62000014 END 63000014 ./ ADD SSI=03010445,NAME=IGGIFF01,SOURCE=0 IGGIFF01 CSECT F41082 00300000 TITLE 'IGGIFF01 TEMPORARY GRAPHIC FORCE/CLOSE ROUTINE ' F41082 00600000 SPACE 3 F41082 00900000 *TITLE: IGGIFF01 - TEMPORARY GRAPHIC FORCE/CLOSE ROUTINE F41082 01200000 *A274000-275000,A502000-527000,A565000-566000,A600100-610900 LI A42288 01270000 *A651600-653400,A696300-698400 LI A42288 01340000 *D504000-531000 LI A42288 01410000 *A288400-290200,A498500-500500,A624070-626890,A653500-653920 JM A63458 01430021 *C600200-600300,C652200 A51802 01450021 SPACE 2 F41082 01500000 *FUNCTION: THIS ROUTINE WILL BE CALLED BY MVT ABEND WHEN F41082 01800000 * ABEND HAS DETERMINED THAT A CLOSE FAILURE HAS F41082 02100000 * OCCURRED. THE ROUTINE WILL BE RESPONSIBLE FOR F41082 02400000 * DETERMINING IF THE DEVICE BEING CLOSED IS A GRAPHIC F41082 02700000 * DEVICE. IF THE FAILURE IS ASSOCIATED WITH A F41082 03000000 * GRAPHIC DEVICE THIS ROUTINE MUST LOCATE THE UCB F41082 03300000 * ASSOCIATED WITH THE FAILING GRAPHIC DEVICE AND CLEAR F41082 03600000 * THE TEB POINTER, THE USE COUNT, AND THE GRAPHIC F41082 03900000 * CONTROL BYTE. IN THE CASE WHERE THE FAILURE IS F41082 04200000 * ASSOCIATED WITH A LIST OF GRAPHIC DEVICES THEN F41082 04500000 * THE FORCE/CLOSE CLEAN UP OF THIS ROUTINE MUST BE F41082 04800000 * DONE FOR ALL OF THE DEVICES. F41082 05100000 * WHEN PROCESSING IS COMPLETED THEN CONTROL MUST F41082 05400000 * BE RETURNED TO ABEND (WHO PASSED CONTROL TO THIS F41082 05700000 * ROUTINE). F41082 06000000 SPACE 2 F41082 06300000 *ENTRY POINT: IGGIFF01 F41082 06600000 SPACE 2 F41082 06900000 *INPUT: F41082 07200000 * REGISTERS F41082 07500000 * 3 -- ADDRESS OF CVT F41082 07800000 * 4 -- ADDRESS OF ABENDING TASK'S TCB F41082 08100000 * 5 -- ADDRESS OF ABENDING TASK'S ACTIVE RB F41082 08400000 SPACE 2 F41082 08700000 * CONTROL BLOCKS F41082 09000000 * THE DEB ASSOCIATED WITH THE DCB THAT CLOSE F41082 09300000 * HAS FAILED ON WILL BE THE FIRST DEB F41082 09600000 * ON THE FAILING TASK'S TCB DEB CHAIN. F41082 09900000 SPACE 2 F41082 10200000 *OUTPUT: F41082 10500000 * REGISTERS F41082 10800000 * THE CONTENTS OF REGISTERS 3, 4 AND 5 MUST BE F41082 11100000 * THE SAME AS WHEN THIS ROUTINE WAS GIVEN F41082 11400000 * CONTROL. F41082 11700000 * F41082 12000000 * 8 -- THIS REGISTER MUST BE SET TO ZERO F41082 12300000 * BEFORE CONTROL IS RETURNED TO ABEND. F41082 12600000 * F41082 12900000 * CONTROL BLOCKS F41082 13200000 * THE DEB ASSOCIATED WITH THE DCB THAT CLOSE F41082 13500000 * HAS FAILED ON MUST REMAIN AS THE FIRST F41082 13800000 * DEB ON THE FAILING TASK'S TCB DEB F41082 14100000 * CHAIN. F41082 14400000 * F41082 14700000 * IF THE FAILING DEB IS FOR GRAPHIC DEVICES F41082 15000000 * THEN THE UCBS ASSOCIATED WITH THE DEB F41082 15300000 * WILL BE RESET TO INSURE SYSTEM F41082 15600000 * INTEGRITY. F41082 15900000 SPACE 2 F41082 16200000 *EXTERNAL ROUTINES: NONE F41082 16500000 SPACE 2 F41082 16800000 *EXITS-NORMAL: RETURN CONTROL TO ABEND VIA XCTL F41082 17100000 * RELEASE 18 TO MODULE IGC0201C F41082 17400000 * RELEASE 19 TO MODULE IGC0301C F41082 17700000 SPACE 2 F41082 18000000 *EXITS-ERROR: NONE F41082 18300000 * THE ABEND INTERFACE IS NOT DESIGNED TO F41082 18600000 * HANDLE ANY RECURSIVE ABEND F41082 18900000 * CONDITIONS. F41082 19200000 SPACE 2 F41082 19500000 *TABLE/WORKAREAS: F41082 19800000 * TCB F41082 20100000 * DEB F41082 20400000 * CVT F41082 20700000 * UCB F41082 21000000 * THE FIRST WORD OF THE ACTIVE RB'S EXTENDED F41082 21300000 * SAVE AREA. F41082 21600000 SPACE 2 F41082 21900000 *ATTRIBUTES: REENTRANT, SUPERVISOR MODE F41082 22200000 EJECT F41082 22500000 * F41082 22800000 * R E G I S T E R U S A G E F41082 23100000 SPACE 3 F41082 23400000 UCBCOUNT EQU 2 COUNT OF UCBS ASSOCIATED F41082 23700000 * WITH FAILING DEB F41082 24000000 CVTR EQU 3 ADDRESS OF CVT F41082 24300000 TCBR EQU 4 ADDRESS OF FAILING F41082 24600000 * TASK'S TCB F41082 24900000 ACTRBR EQU 5 ADDRESS OF FAILING F41082 25200000 * TASK'S ACTIVE RB F41082 25500000 DEBR EQU 6 DATA EXTENT BLOCK ADDRESSF41082 25800000 DEBINDEX EQU 7 DATA EXTENT BLOCK INDEX F41082 26100000 * VALUE F41082 26400000 UCBR EQU 9 ADDRESS OF UCB F41082 26700000 RETURNR EQU 8 RETURN INTERFACE REGISTERF41082 27000000 * TO ABEND F41082 27300000 TEBR EQU 8 ADDRESS OF TEB LI A42288 27400000 TEBUSREG EQU 10 USE CNT FROM TEB LI A42288 27500000 RELASE#R EQU 10 ADDRESS OF SYSTEM RELEASEF41082 27600000 * NUMBER F41082 27900000 BASER EQU 11 BASE REGISTER F41082 28200000 PARMR EQU 15 PARAMETER REGISTER F41082 28500000 EPR EQU 15 ENTRY POINT ADDRESS F41082 28800000 * 28820021 * REGISTER EQUATES FOR ARAR 63458 CHANGES JM A63458 28840021 * 28860021 REG0 EQU 0 WORK REGISTER JM A63458 28880021 REG1 EQU 1 WORK REGISTER JM A63458 28900021 REG7 EQU 7 WORK REGISTER JM A63458 28920021 RBFTBL EQU 8 FOR ADDRESS OF BUFFER TABLE JM A63458 28940021 REGA EQU 10 WORK REGISTER JM A64458 28960021 REGC EQU 12 WORK REGISTER JM A63458 28980021 REGE EQU 14 WORK REGISTER JM A63458 29000021 REGF EQU 15 WORK REGISTER JM A63458 29020021 EJECT F41082 29100000 USING *,EPR ESTABLISH ADDRESSABILITY F41082 29400000 * FOR THIS MODULE F41082 29700000 B OB BRANCH ARROUND IF F41082 30000000 DC AL1(8) ID LENGTH F41082 30300000 DC CL8'IGGIFF01' MODULE ID F41082 30600000 DROP EPR 30900000 SPACE 3 F41082 31200000 USING IGGIFF01,BASER ESTABLISH ADDRESSABILITY F41082 31500000 OB LR BASER,EPR FOR THIS ROUTINE F41082 31800000 USING TCB,TCBR ESTABLISH ADDRESSABILITY F41082 32100000 * FOR TASK CONTROL BLOCK F41082 32400000 USING DEB,DEBR ESTABLISH ADDRESSABILITY F41082 32700000 L DEBR,TCBDEB FOR DEB F41082 33000000 EJECT F41082 33300000 * THIS SECTION IS RESPONSIBLE FOR DETERMINING IF F41082 33600000 * THE FAILING DEB IS A GRAPHIC DEB. F41082 33900000 SPACE 3 F41082 34200000 CLI DEBNMSUB,ATLEAST2 FOR A GRAPHIC DEB THE F41082 34500000 * NUMBER OF ACCESS F41082 34800000 * METHOD SUBROUTINES F41082 35100000 * MUST BE AT LEAST 2 F41082 35400000 BL RETURN IF NOT AT LEAST 2 TAKE F41082 35700000 * BRANCH F41082 36000000 CLI DEBNMEXT,ATLEAST1 FOR A GRAPHIC DEB THE F41082 36300000 * NUMBER OF EXTENTS MUST F41082 36600000 * BE ONE OR GREATER F41082 36900000 BL RETURN IF NOT AT LEAST 1 TAKE F41082 37200000 * BRANCH F41082 37500000 CLI DEBEXSCL,GAMEXSCL IS THE DEB EXTENT SCALE F41082 37800000 * THE ONE USED BY GAM F41082 38100000 BNE RETURN IF NOT TAKE BRANCH F41082 38400000 SR DEBINDEX,DEBINDEX CLEAR WORKING SPACE F41082 38700000 IC DEBINDEX,DEBNMEXT TO FIND THE SUBROUTINE F41082 39000000 SLL DEBINDEX,GAMEXSCL NAME SECTION OF THE F41082 39300000 LA DEBINDEX,BASEDEB(DEBR,DEBINDEX) DEB, THE NUMBER F41082 39600000 * OF EXTENTS MUST BE F41082 39900000 * MULTIPLIED BY THE F41082 40200000 * EXTENT SCALE AND ADDED F41082 40500000 * TO THE BASE SECTION F41082 40800000 * SIZE OF THE DEB F41082 41100000 CLC NULL(MINSUBID,DEBINDEX),GAMSUBID ARE THE F41082 41400000 * FIRST TWO SUBROUTINE F41082 41700000 * NAMES OF THE FAILING F41082 42000000 * DEB THE ID'S FOR THE F41082 42300000 * GAM ROUTINES - GIOCR F41082 42600000 * AND CE-XCE APPENDAGE - F41082 42900000 BNE RETURN IF NOT A GAM DEB TAKE F41082 43200000 * BRANCH F41082 43500000 EJECT F41082 43800000 * THIS SECTION WILL VERIFY THAT THE UCB(S) F41082 44100000 * ASSOCIATED WITH THE FAILING DEB ARE IN FACT GRAPHIC F41082 44400000 * DEVICE TYPES. IF THE UCB(S) ARE GRAPHIC (AS THEY F41082 44700000 * SHOULD BE) THEN THIS SECTION WILL PROCEED TO CLEAN F41082 45000000 * UP THE THREE UCB FIELDS THAT ARE VITAL TO THE SYSTEM F41082 45300000 * INTEGRITY. F41082 45600000 SPACE 3 F41082 45900000 SR UCBCOUNT,UCBCOUNT CLEAR COUNTER F41082 46200000 IC UCBCOUNT,DEBNMEXT GET THE NUMBER OF UCB(S) F41082 46500000 * ASSOCIATED WITH F41082 46800000 * FAILING DEB F41082 47100000 NEXTUCB LR DEBINDEX,UCBCOUNT ESTABLISH ADDRESS OF A F41082 47400000 BCTR DEBINDEX,NULL UCB TO BE RESET FROM F41082 47700000 SLL DEBINDEX,GAMEXSCL ONE OF THE UCBS F41082 48000000 L UCBR,BASEDEB(DEBINDEX,DEBR) ASSOCIATED F41082 48300000 USING UCB,UCBR WITH THE FAILING DEB F41082 48600000 SPACE 3 F41082 48900000 CLI UCBCLASS,GRAPHIC IS THIS A GRAPHIC DEVICE F41082 49200000 BNE RETURN IF NOT DO NO MORE F41082 49500000 * PROCESSING F41082 49800000 * IF DEVICE IS A 2250 RELEASE BUFFER ASSIGNED TO IT JM A63458 49850021 CLI UCBTYPE,T2250 IS THIS A 2250? JM A63458 49900021 BE RELEASE YES RELEASE ASSIGNED BUFFER JM A63458 49950021 * 50000021 CLOSE000 EQU * JM A63458 50050021 SPACE 2 F41082 50100000 L TEBR,UCBTEB GET TEB ADDRESS LI A42288 50200000 LTR TEBR,TEBR DOES TEB EXIST LI A42288 50300000 BZ NOTEB NO TEB GO CLEAR UCB LI A42288 50400000 L TEBUSREG,TEUSCNT(TEBR) GET TEB USE COUNT LI A42288 50500000 LTR TEBUSREG,TEBUSREG IS USE COUNT ZERO LI A42288 50600000 BZ NOTEB A TEB EXIST WITH NO LI A42288 50700000 * USECNT. THIS IS AN LI A42288 50800000 * ERROR SO WE WILL LI A42288 50900000 * CLEAR THE UCB WITHOUT LI A42288 51000000 * FREEING THE TEB SINCE LI A42288 51100000 * IT MAY NOT BE A VALID LI A42288 51200000 * ADDRESS LI A42288 51300000 BCTR TEBUSREG,0 DECREMENT TEB USE CNT LI A42288 51400000 LTR TEBUSREG,TEBUSREG IS USE COUNT ZERO LI A42288 51500000 BZ FREETEB YES GO FREE TEB LI A42288 51600000 NOTEB EQU * LI A42288 51700000 XC UCBUC(UCBRESET),UCBUC CLEAR UCB FIELDS LI A42288 51800000 BCT UCBCOUNT,NEXTUCB DECREMENT NO. OF UCBS LI A42288 51900000 B RETURN NO UCBS PREPARE TO LI A42288 52000000 * RETURN TO ABEND LI A42288 52100000 FREETEB EQU * LI A42288 52200000 XC UCBUC(UCBRESET),UCBUC CLEAR FLDS THIS UCB LI A42288 52300000 LR 1,TEBR LOAD TEB ADDRESS LI A42288 52400000 L 0,TELNGTH LOAD LNGTH AND SP LI A42288 52500000 FREEMAIN R,LV=(0),A=(1) FREE TEB LI A42288 52600000 BCT UCBCOUNT,NEXTUCB DECREMENT NO. UCBS LI A42288 52700000 EJECT F41082 53400000 * THIS SECTION WILL DETERMINE WHICH LOAD OF ABEND F41082 53700000 * IS TO BE GIVEN CONTROL (RELEASE DEPENDENT) AND TRANSFER F41082 54000000 * CONTROL TO IT. F41082 54300000 SPACE 3 F41082 54600000 RETURN SR RETURNR,RETURNR RESET RETURN INTERFACE F41082 54900000 * REGISTER FOR ABEND F41082 55200000 * F41082 55500000 LA RELASE#R,FOUR LOCATE THE RELEASE F41082 55800000 LNR RELASE#R,RELASE#R NUMBER OF F41082 56100000 AR RELASE#R,CVTR THIS SYSTEM F41082 56400000 CLC REL21,NULL(RELASE#R) IS THIS REL 21 SYSTEM LI A42288 56500000 BE EXIT21 BRANCH IF REL 21 LI A42288 56600000 CLC REL20,NULL(RELASE#R) RELEASE 20 SYSTEM A42288 56630021 BE EXIT20 BRANCH IF REL 20 A42288 56660021 SPACE 2 F41082 56700000 CLC REL19#,NULL(RELASE#R) CHECK THIS SYSTEM F41082 57000000 * FOR RELEASE # 19 F41082 57300000 BE EXIT19 IF RELEASE 19 BRANCH F41082 57600000 SPACE 3 F41082 57900000 USING RB,ACTRBR ESTABLISH ADDRESSABILITY F41082 58200000 * FOR ACTIVE REQUEST F41082 58500000 * BLOCK F41082 58800000 LA RELASE#R,REL18NM LOCATE NAME OF RELEASE F41082 59100000 * 18 ABEND MODULE TO F41082 59400000 * RETURN CONTROL TO F41082 59700000 B XCTL PRECEED TO TRANSFER F41082 60000000 EXIT20 EQU * A42288 60001021 CLI CVTDCB(CVTR),MFT IS THIS A MFT SYSTEM A42288 60002021 BE MFTTEST BRANCH IF YES A42288 60003021 LA RELASE#R,MVTREL20 LOCATE NAME FOR MVT,REL20 A42288 60004021 B XCTL AND RETURN TO ABEND A42288 60005021 EXIT21 EQU * LI A42288 60010000 CLI CVTDCB(CVTR),MFT IS THIS AN MFT SYSTEM A51802 60020021 BNE EXIT BRANCH IF NOT MFT A51802 60030021 NI 180(TCBR),X'7F' RESET RCR. ABEND BIT LI A42288 60040000 MFTTEST EQU * A42288 60045021 CL TCBR,JSTP(TCBR) IS THIS JOBSTEP ABEND LI A42288 60050000 BE MFTJSTP BRANCH IF JBSTP ABEND LI A42288 60060000 LA RELASE#R,SUBTSK LOCATE NAME FOR REL21 LI A42288 60070000 * SUBTASK ABEND RETURN LI A42288 60080000 B XCTL AND RETURN CONTROL LI A42288 60090000 * BACK TO ABEND LI A42288 60100000 MFTJSTP EQU * LI A42288 60110000 LA RELASE#R,JBSTP LOCATE NAME FOR REL21 LI A42288 60120000 * JOBSTEP ABEND RETURN LI A42288 60130000 B XCTL AND RETURN CONTROL LI A42288 60140000 * BACK TO ABEND LI A42288 60150000 EXIT EQU * LI A42288 60160000 LA PARMR,RBEXSAVE LOCATE RB EXTENDED LI A42288 60170000 * SAVE AREA LI A42288 60180000 SVC 3 RETURN TO MVT ABEND LI A42288 60190000 EXIT19 LA RELASE#R,REL19NM LOCATE NAME OF RELEASE F41082 60300000 * 19 ABEND MODULE TO F41082 60600000 * RETURN CONTROL TO F41082 60900000 SPACE 2 F41082 61200000 XCTL LA PARMR,RBEXSAVE LOCATE ADDRESS OF THE F41082 61500000 * PARAMETER LIST F41082 61800000 * TRANSFER F41082 62100000 XCTL EPLOC=(RELASE#R),SF=(E,(15)) CONTROL F41082 62400000 RELEASE EQU * JM A63458 62407021 L RBFTBL,UCBDI GET BUFFER TABLE ADDRESS JM A63458 62414021 LA RBFTBL,0(RBFTBL) CLEAR HI-ORDER BYTE JM A63458 62421021 LTR RBFTBL,RBFTBL IS THERE A BUFFER TABLE ADDR? JM A63458 62428021 BZ CLOSE000 IF NO THEN GET OUT JM A63458 62435021 SR REG7,REG7 CLEAR WORK REGISTER JM A63458 62442021 IC REG7,UCBDI GET DEVICE INDEX JM A63458 62449021 BCTR REG7,0 DECREMENT BY ONE JM A63458 62456021 SLL REG7,3 MULTIPLY BY EIGHT JM A63458 62463021 LA REG1,8(RBFTBL) REG1 EQ BFTBL ADDR+8 JM A63458 62470021 AR REG7,REG1 DISP TO DEV'S INFO IN BFTBL JM A63458 62477021 LH REG1,0(REG7) TASGND FOR THIS DEVICE JM A63458 62484021 LTR REG1,REG1 ANY BUFFER ASSIGNED THIS DEV JM A63458 62491021 BE CLOSE000 IF NO,GET OUT JM A63458 62498021 LH REGA,0(RBFTBL) GET LENGTH OF ZONES JM A63458 62505021 AR REGA,RBFTBL ADD START OF BUFFER TABLE JM A63458 62512021 CLI UCBCODE,MOD1 IS THIS A MOD1? JM A63458 62516021 BE EXPRESS YES,GET HEADER FOR MOD1. JM A63458 62518021 LA REGC,HEADER GET FIXED HEADER FOR 2840. JM A63458 62518421 TBLEND EQU * JM A63458 62518821 AR REGA,REGC END OF BUFFER TABLE JM A63458 62520821 AR REGC,RBFTBL ADDR FOR START OF RELEASE JM A63458 62526021 RLSEBF2 CLC UCBDI,0(REGC) ASSIGNED TO THIS DEVICE? JM A63458 62533021 BE RLSEBF3 YES,RELEASE IT JM A63458 62540021 CLR REGC,REGA END OF BUFFER TABLE?? JM A63458 62547021 BE UPDTBL YES,GO UPDATE TABLE JM A63458 62554021 LA REGC,ONE(REGC) POINT TO NEXT ENTRY JM A63458 62561021 B RLSEBF2 TEST NEXT ENTRY FOR ASSIGNED JM A63458 62568021 RLSEBF3 XC 0(1,REGC),0(REGC) ZERO THIS ENTRY JM A63458 62575021 LA REGC,ONE(REGC) POINT TO NEXT ENTRY JM A63458 62582021 BCT REG1,RLSEBF2 RELEASE ALL ASSIGNED BUFFER JM A63458 62589021 * 62596021 * UPDATE THE BUFFER TABLE JM A63458 62603021 * 62610021 UPDTBL EQU * JM A63458 62617021 LH REGA,TOTAVL(RBFTBL) GET TOTAL AVAILABLE JM A63458 62624021 LH REG1,0(REG7) GET TASGND FOR THIS DEVICE JM A63458 62631021 AR REG1,REGA NEW TOTAVAIL JM A63458 62638021 STH REG1,TOTAVL(RBFTBL) UPDATE TOTAVAIL JM A63458 62645021 XC 0(2,REG7),(REG7) UPDATE TASGND JM A63458 62652021 B CLOSE000 CONTINUE PROCESSING JM A63458 62659021 EXPRESS EQU * JM A63458 62669021 LA REGC,HEAD16 FIXED HEADER FOR 2250-1 JM A63458 62679021 B TBLEND CONTINUE RELEASE PROCESSING. JM A63458 62689021 EJECT F41082 62700000 * C O N S T A N T S F41082 63000000 SPACE 3 F41082 63300000 NULL EQU 0 NULL OR NO-OP VALUE F41082 63600000 ATLEAST1 EQU 1 NUMERIC VALUE OF 1 F41082 63900000 ATLEAST2 EQU 2 NUMERIC VALUE OF 2 F41082 64200000 FOUR EQU 4 DISPLACEMENT VALUE OF 4 F41082 64500000 GAMEXSCL EQU X'02' EXTENT SCALE VALUE FOR F41082 64800000 * GRAPHIC DEB'S F41082 65100000 TEUSCNT EQU 16 OFFSET OF TE USE CNT LI A42288 65160000 MFT EQU 32 MFT SYSTEM TYPE A51802 65220021 CVTDCB EQU 116 OFFSET OF SYSTEM TYPE LI A42288 65280000 JSTP EQU 44 OFFSET OF JOBSTEP TCB LI A42288 65340000 ONE EQU 1 CONSTANT '1' JM A63458 65350021 T2250 EQU X'02' 2250 UNIT TYPE JM A63458 65360021 TOTAVL EQU 6 DISP TO TOTAVAIL IN BFTBL JM A63458 65370021 MOD1 EQU X'31' 2250 MODEL-1 JM A63458 65380021 HEAD16 EQU 16 LENGTH OF HEADER FOR 2250-1 JM A63458 65390021 HEADER EQU 40 LENGTH OF HEADER FOR 2840 JM A63458 65392021 GAMSUBID DC C'OAOB' GAM SUBROUTINES FOR THE F41082 65400000 * FIRST TWO ROUTINES F41082 65700000 * LOADED THE GRAPHIC F41082 66000000 * ACCESS METHOD F41082 66300000 * (I.E. OA FOR GIOCR F41082 66600000 * AND OB FOR THE CE-XCE F41082 66900000 * APPENDAGE) F41082 67200000 MINSUBID EQU *-GAMSUBID THE SIZE OF THE MINIMINALF41082 67500000 * GAM SUBROUTINE ID F41082 67800000 * SECTION F41082 68100000 GRAPHIC EQU X'10' GRAPHIC DEVICE CLASS F41082 68400000 * ASSIGNMENT IN UNIT F41082 68700000 * TYPE FIELD OF UNIT F41082 69000000 * CONTROL BLOCK F41082 69300000 REL19# DC C'19' RELEASE 19 NUMBER F41082 69600000 DS 0F LI A42288 69630000 TELNGTH DC X'FF' TE SUBPOOL LI A42288 69660000 DC AL3(32) TE LENGTH LI A42288 69690000 REL20 DC C'20' RELEASE 20 NUMBER A42288 69697021 MVTREL20 DC C'IGC0401C' RETURN TO ABEND A42288 69704021 * FOR RELEASE 20 A42288 69711021 REL21 DC C'21' RELEASE 21 NUMBER LI A42288 69720000 SUBTSK DC C'IGC0E01C' RETURN TO ABEND FOR LI A42288 69750000 * MFT SUBTASK ABEND LI A42288 69780000 JBSTP DC C'IGC0701C' RETURN TO ABEND FOR LI A42288 69810000 * MFT JOBSTEP ABEND LI A42288 69840000 DS 0D F41082 69900000 REL18NM DC C'IGC0201C' LOAD OF ABEND TO RETURN F41082 70200000 * CONTROL TO IN RELEASE F41082 70500000 * 18 SYSTEM F41082 70800000 REL19NM DC C'IGC0301C' LOAD OF ABEND TO RETURN F41082 71100000 * CONTROL TO IN RELEASE F41082 71400000 * 19 SYSTEM F41082 71700000 EJECT F41082 72000000 DEB DSECT FORMAT OF DATA EXTENT F41082 72300000 * BLOCK F41082 72600000 SPACE 3 F41082 72900000 DS 0F F41082 73200000 DEBNMSUB DS 1X NUMBER OF ACCESS METHOD F41082 73500000 * SUBROUTINES LOADED F41082 73800000 DEBTCBAD DS 3X TCB ADDRESS F41082 74100000 DEBAMLNG DS 1X ACCESS METHOD SECTION F41082 74400000 * LENGTH F41082 74700000 DEBDEBAD DS 3X NEXT DEB ADDRESS F41082 75000000 DEBOFLGS DS 1X DATA SET STATUS F41082 75300000 DEBIRBAD DS 3X ADDRESS OF IRB F41082 75600000 DEBRES1 DS 1F RESERVED FIELDS F41082 75900000 DEBNMEXT DS 1X NUMBER OF EXTENTS F41082 76200000 DEBUSRPG DS 3X ADDRESS OF USER PERGE F41082 76500000 * CHAIN F41082 76800000 DEBPRIOR DS 1X PRIORITY F41082 77100000 DEBRES2 DS 3X RESERVED FIELD F41082 77400000 DEBPROTG DS 1X PROTECTION KEY F41082 77700000 DEBDCBAD DS 3X ADDRESS OF DCB F41082 78000000 DEBEXSCL DS 1X EXTENT SCALE F41082 78300000 DEBAPPAD DS 3X ADDRESS OF I/O F41082 78600000 * APPENDAGE VECTOR F41082 78900000 * TABLE F41082 79200000 BASEDEB EQU *-DEB SIZE OF BASE SECTION OF F41082 79500000 * DEB F41082 79800000 EJECT F41082 80100000 UCB DSECT FORMAT OF UNIT CONTROL F41082 80400000 * BLOCK F41082 80700000 SPACE 3 F41082 81000000 DS 0F F41082 81300000 UCBJBNR DS 1X INTERNAL JOB NUMBER F41082 81600000 UCBCHAN DS 1X CHANNEL MASK F41082 81900000 UCBID DS 1X UCB IDENTIFIER F41082 82200000 UCBSTATA DS 1X STATUS BYTE A F41082 82500000 UCBCHA DS 1X CHANNEL ADDRESS F41082 82800000 UCBUA DS 1X UNIT ADDRESS F41082 83100000 UCBFL1 DS 1X FLAG BYTE 1 F41082 83400000 UCBDTI DS 1X INDEX TO DEVICE TABLE F41082 83700000 UCBETI DS 1X ERROR ROUTINE KEY F41082 84000000 UCBSTI DS 1X STATISTICS TABLE INDEX F41082 84300000 UCBLCI DS 1X CHANNEL TABLE INDEX F41082 84600000 UCBATI DS 1X ATTENTION TABLE INDEX F41082 84900000 UCBWGT DS 1X FLAGS AND MASKS F41082 85200000 UCBNAME DS 3X UCB NAME F41082 85500000 UCBCODE DS 1X FLAGS AND MODEL CODE F41082 85800000 UCBFTR DS 1X OPTIONAL FEATURES F41082 86100000 UCBCLASS DS 1X DEVICE CLASS F41082 86400000 UCBTYPE DS 1X UNIT TYPE F41082 86700000 UCBLTS DS 1H LAST REQUEST ELEMENT F41082 87000000 UCBSNS DS 4X SENSE INFORMATION F41082 87300000 UCBUC DS 1X USE COUNT F41082 87600000 UCBGCB DS 1X GRAPHIC CONTROL BYTE F41082 87900000 UCBTEB DS 1F TASK ENTRY BLOCK ADDRESS F41082 88200000 UCBRESET EQU *-UCBUC FIELDS TO BE RESET F41082 88500000 UCBRST DS 1F RESTART ADDRESS F41082 88800000 UCBDI DS 1X DEVICE INDEX F41082 89100000 UCBBT DS 3X BUFFER TABLE ADDRESS F41082 89400000 EJECT F41082 89700000 RB DSECT FORMAT OF REQUEST BLOCK F41082 90000000 SPACE 3 F41082 90300000 DS 0D F41082 90600000 RBRESV1 DS 1F RESERVED F41082 90900000 RBABOPSW DS 1F RIGHT HALF OF USERS OLD F41082 91200000 * PSW F41082 91500000 RBWCSA DS 1X WAIT-COUNT SAVE AREA F41082 91800000 RBSIZE DS 1X SIZE IN DOUBLEWORDS F41082 92100000 RBSTAB DS 1H STATUS/ATTRIBUTE BITS F41082 92400000 RBCDFLGS DS 1X CONTENT CONTROL FLAGS F41082 92700000 RBCDE DS 3X ADDRESS OF CONTENTS F41082 93000000 * DIRECTORY ENTRY F41082 93300000 RBOPSW DS 1D OLD PSW F41082 93600000 RBZERO DS 1X ZEROS F41082 93900000 RBPGMQ DS 3X RELATED PROGRAM RB F41082 94200000 RBWCF DS 1X WAIT COUNT F41082 94500000 RBLINK DS 3X ADDRESS OF NEXT RB OR TCBF41082 94800000 RBGRSAVE DS 8D REGISTER SAVE AREA F41082 95100000 RBEXSAVE DS 6D EXTENDED SAVE AREA F41082 95400000 EJECT F41082 95700000 TCB DSECT PART OF TASK CONTROL F41082 96000000 * BLOCK FORMAT F41082 96300000 SPACE 3 F41082 96600000 TCBRBP DS 1F ADDRESS OF REQUEST BLOCK F41082 96900000 TCBPIE DS 1F ADDRESS OF PROGRAM F41082 97200000 * INTERRUPT ELEMENT F41082 97500000 TCBDEB DS 1F ADDRESS OF DATA EXTENT F41082 97800000 * BLOCK LIST F41082 98100000 END IGGIFF01 F41082 98400000 ./ ADD SSI=07053210,NAME=IGG019OA,SOURCE=0 TITLE 'GRAPHIC INPUT/OUTPUT CONTROL ROUTINE' 00100014 *********************************************************************** 00200014 * * 00300014 * GRAPHIC INPUT/OUTPUT CONTROL ROUTINE * 00400014 * * 00500014 *STATUS CHANGE LEVEL 1 00600014 * * 00700014 * FUNCTION: TAKES THE PARAMETER LIST WHICH IS BUILDED BY THE I/O * 00800014 * MACRO AND BUILDS THE APPROPIATE CHANNEL COMMAND WORDS. * 00900014 * IF REQUIRED PARAMETERS ARE MISSING, THE ROUTINE WILL * 01000014 * ABEND. IF COUNT INCORRECT, OR BUFFER * 01100014 * LIMITS EXCEEDED, A CODE IS RETURNED IN REGISTER 15 AND * 01200014 * CONTROL IS RETURNED TO PROBLEM PROGRAM. * 01300014 * * 01400014 * ENTRY POINT: IGG019OA, GIOCR VIA BALR IN I/O MACRO * 01500014 * * 01600014 * INPUT: ADDRESS OF DECB IN REGISTER 1 * 01700014 * * 01800014 * OUTPUT: RETURN CODE IN REGISTER 15-00 = NORMAL * 01900014 * 04 = BUFFER LIMITS VIOLATED * 02000014 * 08 = BYTE COUNT IMPROPER * 02100014 * 0C = 2ND DCB USE INVALID (STR) * 02200014 * * 02300014 * EXTERNAL ROUTINES - IGC084 VIA SVC 084 * 02400018 * * 02500014 * EXITS: NORMAL -'RETURN' * 02600014 * ERROR - 'ABEND' * 02700014 * * 02800014 * TABLE: OGATABLE - TABLE OF COMMAND CODES AND COUNTS ASSOCIATED WITH * 02900014 * TABLE LOOK-UP USING 1ST FIVE BITS OF TYPE CODE * 03000014 * IN MACRO. * 03100014 * * 03200014 * WORK AREA: N/A * 03300014 * * 03400014 * ATTRIBUTES: PROBLEM PROGRAM RESIDENCE, PROBLEM PROGRAM STATE AND * 03500014 * REENTRANT * 03600018 * * 03700014 * NOTES: N/A * 03800014 * * 03900014 *********************************************************************** 04000014 * 04100014 * 04200014 * REGISTER USE IN THIS ROUTINE 04300014 * 04400014 * 04500014 REG0 EQU 0 04600014 RX EQU 0 04700014 RDECB EQU 1 DECB ADDRESS REGISTER 04800014 RY EQU 1 04900014 RDCB EQU 2 DCB ADDRESS REGISTER 05000014 RZ EQU 2 05100014 RBASE EQU 3 BASE REGISTER 05200014 RIOB EQU 4 IOB ADDRESS REGISTER 05300014 RB EQU 4 05400014 REG5 EQU 5 05500014 REG6 EQU 6 05600014 REG7 EQU 7 05700014 REG8 EQU 8 05800014 RUCB EQU 8 05900014 REG9 EQU 9 06000014 RBFTBL EQU 9 06100014 REG10 EQU 10 CCW ADDRESS REGISTER 06200014 REG11 EQU 11 06300014 REG12 EQU 12 06400014 ROACB EQU 12 06500014 RA EQU 12 06600014 RSAVE EQU 13 SAVE ADDRESS REGISTER 06700014 REG14 EQU 14 06800014 REG15 EQU 15 06900014 T2250 EQU X'02' 3841 06950015 * 07000014 IGG019OA CSECT 07100014 * 090000,094050-094800,565100-565600 A33619 07140020 *2515,024000,036000,467000 07180018 ENTRY GIOCR 07200014 GIOCR SAVE (14,12),,* SAVE REGISTERS IN USER AREA 07300014 BALR RBASE,0 07400014 USING *,RBASE 07500014 * 07600014 * LOAD DCB ADDRESS IN REGISTER AND CHECK FOR LEGAL DCB 07700014 * 07800014 L RDCB,8(0,RDECB) DCB ADDRESS 07900014 LA RDCB,0(0,RDCB) STRIP HIGH ORDER BITS 08000014 C RDCB,FZERO CHECK IF DCB IN PRAM 08100014 BNE OGANO 08200014 WTO 'IFF201I GIOCR FOUND NO DCB ADDRESS IN DECB',ROUTCDE=11,X08230021 DESC=7 08260021 LA REG15,X'10' DECB DOES NOT HAVE JFCD 08300017 B OGASTR DCB ADDR--RETURN JFCD 08400017 OGANO L RIOB,28(0,RDCB) 1ST IOB ADDRESS IN DCB 08600014 L REG5,20(0,RIOB) DCB PTR IN IOB 08700014 LA REG5,0(0,REG5) DROP HIGH ORDER BITS 08800014 CR RDCB,REG5 CHECK IF LEGAL DCB 08900014 BE TESTDEB YES A33619 09000020 WTO 'IFF202I GIOCR FOUND UNEQUAL DCB ADDRESSES IN DECB AND AX09050021 SSOCIATED IOB',ROUTCDE=11,DESC=7 09100021 LA REG15,X'14' ILLEGAL DCB ADDRESS 09150021 B OGASTR IN DECB--RETURN JFCD 09200017 * 09400014 TESTDEB L REG6,DCBDEBAD(RDCB) GET DEB ADDR FROM DCB A33619 09405020 L REG7,DEBDCBAD(REG6) GET DCB ADDR FROM DEB A33619 09410020 LA REG7,ZERO(REG7) CLEAR HIGH-ORDER BYTE A33619 09415020 CR REG7,RDCB DCB ADDRESSES MATCH? A33619 09420020 BE TESTINDX YES A33619 09425020 WTO 'IFF203I GIOCR FOUND UNEQUAL DCB ADDRESSES IN DECB AND AX09426021 SSOCIATED DEB',ROUTCDE=11,DESC=7 09427021 LA REG15,X'28' INVALID DEB - DEB DOES A33619 09430020 * NOT CONTAIN CORRECT DCB A33619 09435020 * ADDRESS A33619 09440020 B OGASTR RETURN A33619 09445020 TESTINDX CLC DEBNMEXT(ONE,REG6),UNITINDX(RDECB) NUMBER IN A33619 09450020 * DEBNMEXT IN DEB MUST BE A33619 09455020 * LARGER THAN NUMBER IN A33619 09460020 * UNIT INDEX FIELD IN DEB A33619 09465020 BH OGAOCBP COMPARE VALID - CONTINUE A33619 09470020 WTO 'IFF204I GIOCR FOUND DECB UNIT INDEX EXCEEDS UNITS SPECIX09471021 FIED IN DD RECORD',ROUTCDE=11,DESC=7 09472021 LA REG15,X'2C' DECB REFERENCING UCB NOT A33619 09475020 * IN DEB A33619 09480020 B OGASTR RETURN A33619 09485020 * TEST IF OCBP USED, IF SO, LOAD ADDRESSES TO REGISTERS 09500014 * FROM OACB. IF NOT, LOAD REGISTERS FROM DECB. 09600014 * 09700014 OGAOCBP TM 4(RDECB),X'C0' IF 2260 READ/WRITE 09800014 BO OGACOMP OCBP NOT USED 09900014 TM 4(RDECB),X'70' IF 2260 ERASE 10000014 BO OGACOMP OCBP NOT USED 10100014 TM 4(RDECB),X'80' READ/WRITE 10200014 BC 12,OGACOMP OCBP NOT USED 10300014 TM 20(RDECB),X'80' TEST FOR OCBP USED 10400014 BZ OGACOMP NOT SPECIFIED 10500014 L REG7,20(0,RDECB) OCBP ADDRESS 10600014 LA REG7,0(0,REG7) STRIP HIGH ORDER BITS 10700014 C REG7,FZERO CHECK IF OCBP IN PRAM 10800014 BNE OGANO1 10900014 WTO 'IFF205I GIOCR FOUND NO OCBP ADDRESS IN DECB',ROUTCDE=11X10930021 ,DESC=7 10960021 LA REG15,X'18' DECB DOES NOT HAVE JFCD 11000017 B OGASTR OCBP PTR--RETURN JFCD 11100017 OGANO1 L REG8,0(0,REG7) LOAD OACB ADDRESS 11300014 L REG6,12(0,REG8) CRSA ADDRESS (AREA ADDRESS) 11400014 LA REG5,22(0,REG8) START ADDRESS (BUFFER ADDRESS) 11500014 L REG0,24(0,RDECB) START ADDRESS IN REGISTER 11600014 C REG0,FZERO CHECK IF START ADDRESS 11700014 BNE OGAOLP YES 11800014 LR REG0,REG5 BUFFER ADDRESS TO START REG 11900014 OGAOLP L REG8,16(0,REG8) OLP 12000014 LA REG8,0(0,REG8) STRIP HIGH ORDER BITS 12100014 LA REG6,0(0,REG6) STRIP HIGH ORDER BITS 12200014 SR REG8,REG6 LENGTH 12300014 BC 11,OGARWS NOT NEGATIVE LENGTH 12400014 WTO 'IFF206I GIOCR, USING OACB, COMPUTED NEGATIVE BYTE COUNTX12450021 FOR I/O OPERATION',ROUTCDE=11,DESC=7 12500021 LA REG15,X'08' LOAD THE RETURN CODE 12550021 B OGASTR RESTORE REGISTERS AND EXIT 12600014 * 12700014 * TEST IF TYPE CODE IN DECB, IF START ADDRESS EVEN 12800014 * 12900014 OGACOMP L REG0,24(0,RDECB) START ADDRESS IN REGISTER 13000014 L REG8,20(0,RDECB) LENGTH IN REGISTER 13100014 TM 4(RDECB),X'80' FOR TYPE CODE IN LENGTH 13200014 BZ OGAPASS 13300014 C REG8,FZERO TEST IF NEGATIVE 13400014 BC 11,OGAPASS YES S21016 13430021 WTO 'IFF207I GIOCR FOUND NEGATIVE LENGTH IN DECB',ROUTCDE=11X13460021 ,DESC=7 13490021 LA REG15,X'3C' LOAD RETURN CODE S21016 13520021 B OGASTR GO RETURN 13550000 OGAPASS L REG6,12(0,RDECB) AREA ADDRESS TO REGISTER 13600014 L REG5,28(0,RDECB) BUFFER ADDRESS TO REGISTER 13700014 LA REG5,0(0,REG5) DROP EIGHT HIGH ORDER BITS 13800014 OGARWS L REG7,4(0,RDECB) TYPE CODE 13900014 C REG7,FZERO CHECK IF TYPE IN PARM 14000014 BNE OGABUF2 YES 14100014 WTO 'IFF208I GIOCR FOUND NO TYPE CODE IN DECB',ROUTCDE=11,DEX14130021 SC=7 14160021 LA REG15,X'1C' DECB DOES NOT HAVE JFCD 14200017 B OGASTR TYPE CODE--RETURN JFCD 14300017 * 14500014 * CHECK IF BUFFER LIMIT TEST REQUIRED, IF SO, GO TO BUFFER 14600014 * TEST ROUTINE. 14700014 * 14800014 OGABUF2 TM 4(RDECB),X'C0' 2260 READ/WRITE 14900014 BC 1,OGANEXT NO BUFFER CHECK 15000014 TM 4(RDECB),X'70' 2260 ERS 15100014 BC 1,OGANEXT NO BUFFER CHECK 15200014 TM 4(RDECB),X'80' TEST FOR READ/WRITE 15300014 BC 1,OGAMAN YES 15400014 TM 4(RDECB),X'48' TEST FOR HLT/INS/STR 15500014 BC 1,OGAMAN0 YES 15600014 TM 4(RDECB),X'62' TEST FOR RMV 15700014 BC 1,OGAMAN YES 15800014 B OGANEXT 15900014 OGAMAN0 TM 4(RDECB),SRTYP SEE IF STR TYPE IN DECB. 16000014 BZ OGAMAN NO 16100014 TM 24(RDECB),DCB2 SEE IF 2ND DCB PRESENT. 16200014 BZ OGAMAN NO DCB2 SPECIFIED 16300014 L RDCB,12(0,RDECB) LOAD 2'ND DCB ADDR. 16400014 LA RDCB,0(0,RDCB) ZERO HI-ORDER BYTE. 16500014 L REG10,28(0,RDCB) IOB ADDRESS FROM DCB. 16600014 L REG10,20(0,REG10) DCB PTR FROM IOB. 16700014 LA REG10,0(0,REG10) ZERO HI-ORDER BYTE. 16800014 CR REG10,RDCB DOES IOB POINT TO DCB2. 16900014 BE CONT1 NO-INVALID DCB S21016 16930021 WTO 'IFF209I GIOCR FOUND DCB2 ADDRESS IN DECB NOT EQUAL TO DX16960021 CB ADDRESS IN IOB',ROUTCDE=11,DESC=7 16990021 LA REG15,X'38' LOAD RETURN CODE S21016 17020021 B OGASTR GO RETURN 17050000 CONT1 EQU * S21016 17070021 L REG10,44(0,RDCB) DEB ADDR FROM DCB2 17100014 L REG10,32(0,REG10) UCB ADDR IN DEB. 17200014 L REG11,8(0,RDECB) DCB1 ADDR TO REG 11. 17300014 L REG11,44(0,REG11) DEB ADDR FROM DCB1. 17400014 L REG11,32(0,REG11) UCB ADDR IN DEB 17500014 CLC BTBL(3,REG10),BTBL(REG11) ARE BUF TBL ADDR EQUAL. 17600014 BE SWITCH YES. 17700014 WTO 'IFF210I GIOCR FOUND DEVICES FOR DCB AND DCB2 ON DIFFEREX17730021 NT CONTROL UNITS',ROUTCDE=11,DESC=7 17760021 LA REG15,OGA0CR 17800014 B OGASTR 17900014 SWITCH MVC 12(4,RDECB),8(RDECB) REVERSE DCB POINTERS 18000014 ST RDCB,8(0,RDECB) IN DECB FOR BUFFER CHECK. 18100014 OGAMAN LR REG14,REG8 STORE REG. 8 18200014 LR REG11,RIOB STORE REG. 4 18300014 LR REG10,REG0 STORE REG. 0 18400014 LA REG10,0(0,REG10) CLEAR HIGH ORDER BYTE 18500014 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 18600014 * BUFFER PROTECT ROUTINE * 18700014 *FUNCTION/OPERATION: CHECK BUFFER ADDRESSES INVOLVED IN INPUT/OUTPUT * 18800014 * OPERATIONS AGAINST THE LIMITS OF THE BUFFER ASSIGNMENT TO THAT * 18900014 * DEVICE TO PROTECT BUFFER STORAGE ASSIGNED TO OTHER DEVICES. * 19000014 *ENTRY POINT: IGG019OC * 19100014 *INPUT: ADDRESS OF DECB IN REGISTER 1 * 19200014 *OUTPUT: RETURN CODE IN REGISTER 15 - 00 = PROCEED WITH I/O * 19300014 * 04 = ERROR, DO NOT PROCEED * 19400014 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 19500014 * 19600014 IGG019OC EQU * 19700014 USING DECB,RDECB 19800014 * 19900014 L RUCB,DCBAD LOAD RUCB WITH DCB ADR 20000014 L RUCB,44(RUCB) LOAD RUCB WITH DEB ADR 20100014 L RUCB,32(RUCB) LOAD RUCB WITH UCB ADR 20200014 L RBFTBL,36(RUCB) LOAD RBFTBL WITH BFR TBL ADR 20300014 * 20400014 TM OCBP,X'80' TEST OACB INDICATOR BYTE 20500014 BC 1,COMPUTE 20600014 * 20700014 TM TYPE,SRTYP CHK FOR STR TYPE 20800014 BO CHKSTR BRANCH IF START TYPE 20900014 L RA,BUFFER NO - ACCESS BFR START ADDR 21000014 LA RA,ZERO(RA) CLEAR HI BYTE S21016 21020021 LTR RA,RA IS BFR START ADDR PRESENT S21016 21040021 BZ NOBUFAD BRANCH IF BFR ADDR ZERO S21016 21060021 LH RA,0(RA) 21100014 LH RB,LENGTH ACCESS LENGTH FROM DECB 21200014 TM 4(RDECB),X'06' TEST FOR 2260 LI A44376 21209000 BNO NOT2260 BRANCH IF NOT LI A44376 21218000 CLC 4(RDECB),ERSTYPE TEST FOR 2260 GCNTRL LI A44376 21227000 BE NOLNGTH BRANCH IF YES LI A44376 21236000 B ADJUST NOT 2260 GCNTRL LI A44376 21245000 NOT2260 EQU * LI A44376 21254000 TM 4(RDECB),X'40' IS THIS 2250 GCNTRL LI A44376 21263000 BNO ADJUST NO,USE LENGTH LI A44376 21272000 NOLNGTH EQU * LI A44376 21281000 SR RB,RB ZERO LENGTH REG LI A44376 21290000 B ADJUST 21300014 CHKSTR L RA,START ACCESS BUFFER START ADDR IN DECB 21400014 LH RA,0(RA) 21500014 SR RB,RB ZERO LENGTH REG LI A44376 21600000 * 21700014 *POSITIVE CHECK FOR LEGAL ADR, I.E., WITHIN BUFFER SIZE 21800014 * 21900014 ADJUST LH RX,0(RBFTBL) LOAD TBLNGTH IN RX 22000014 SLL RX,8 MULTIPLY TBLNGTH BY 256 22100014 CLR RA,RX IS ADR LARGER THAN SIZE 22200014 BH ERROR1 YES GO TO ERROR ROUTN S21016 22300021 AR RA,RB ADD LENGTH TO START ADR FOR END ADR 22400014 CLR RA,RX IS END ADR LARGER THAN SIZE 22500014 BH ERROR2 YES GO TO ERROR ROUTN S21016 22600021 SR RA,RB OTHERWISE SET RA EQ START ADR AND GO 22700014 SRL RA,8 BUFFER ADR ROUNDED DOWN TO MULT 256 22800014 CLI 16(RUCB),X'31' SEE IF MODEL ONE 22900014 BE MOD1 YES 23000014 LA RX,HEADISP LOAD RX EQ 72 23100014 * 23200014 GOON AR RA,RX ADD HEADER LENGTH TO ADR 23300014 AR RA,RBFTBL ADD ADDR OF BFR TBL, RA EQ DISP OF 23400014 * SECTION ENTRY FOR THAT BFR ADR 23500014 * IN BFR TBL 23600014 *ADJUST LENGTH TO 256-BYTE SECTIONS 23700014 * 23800014 LA RX,MASK1 LOAD RX WITH ALL ONES 23900014 AR RB,RX ADD CONVERSION FACTOR 24000014 SRL RB,8 PUT NUMBER OF SECTIONS IN LO-ORDER 24100014 * BYTES OF RB 24200014 CL RB,FZERO CHK FOR ZERO LENGTH 24300014 BH INITRX BRANCH IF NOT ZERO 24400014 LA RB,RY 24500014 INITRX LA RX,RY SET RX EQ 1 24600014 CHECKALL CLC 0(1,RA),36(RUCB) COMPARE BFR TBL ENTRY TO DEVNDX 24700014 BNE ERROR3 NOT EQUAL GO TO ERROR ROUTN S21016 24800021 AR RA,RX INCREMENT ENTRY DISP BY 1 24900014 BCT RB,CHECKALL 25000014 B OUT 25100014 * 25200014 MOD1 LA RX,16 LOAD MOD 1 BFRTBL HEADER LNGYH 25300014 B GOON 25400014 * 25500014 COMPUTE L ROACB,OCBP LOAD ADDR OF OCBP IN ROACB 25600014 L ROACB,0(ROACB) LOAD ADDR OF OACB IN ROACB 25700014 USING OACB,ROACB SET UP OACB DSECT REGISTER 25800014 L RB,OLP LOAD RB WITH OLP ADDR 25900014 S RB,CRSA SUBTRACT CRSA TO GET LNG IN BYTES 26000014 L RA,BLP LOAD BUFFER START ADDR IN RA 26100014 B ADJUST GO TO CONVERT ROUTINE 26200014 * 26300014 ERROR1 WTO 'IFF211I GIOCR FOUND BUFFER START ADDRESS EXCEEDS BUFFERX26350021 SIZE',ROUTCDE=11,DESC=7 26400021 LA REG15,X'04' LOAD RETURN CODE S21016 26450021 B CHKRET 26500014 OUT LA 15,0(0,0) LOAD RETURN CODE. 26600014 B CHKRET BRANCH TO RETURN S21016 26610021 ERROR2 WTO 'IFF212I GIOCR FOUND BUFFER ENDING ADDRESS EXCEEDS BUFFEX26620021 R SIZE',ROUTCDE=11,DESC=7 26630021 LA REG15,X'30' LOAD RETURN CODE S21016 26640021 B CHKRET GO RESTORE REGS S21016 26650000 ERROR3 WTO 'IFF213I GIOCR FOUND I/O OPERATION VIOLATES BUFFER STORAX26660021 GE ASSIGNED',ROUTCDE=11,DESC=7 26670021 LA REG15,X'34' LOAD RETURN CODE S21016 26680021 B CHKRET BRANCH TO PD PROCESSING S21016 26690021 CHKRET EQU * 26700014 * 26800014 LR REG8,REG14 RESTORE REG. 8 26900014 LR RIOB,REG11 RESTORE REG. 4 27000014 LR REG0,REG10 RESTORE REG. 0 27100014 C REG15,FZERO TEST IF BEYOND LIMITS 27200014 BNE OGASTR BUFFER ERROR-RETURN. 27300014 OGAMAN1 TM 24(RDECB),DCB2 WAS DCB2 CHECKED BY BUF PROTECT 27400014 BZ OGAMAN2 NO. 27500014 MVC 8(4,RDECB),12(RDECB) RESTORE DCB PTRS 27600014 ST RDCB,12(0,RDECB) IN DECB. 27700014 L RDCB,8(0,RDECB) RELOAD DCB1 ADDR. 27800014 B OGANEXT 27900014 OGAMAN2 CLI 4(RDECB),X'92' TEST FOR FND 28000014 BNE OGANEXT 28100014 A REG8,FONE ONE TO LENGTH FOR FIND TYPE 28200014 * 28300014 * FIND NEXT IOB AND ASSIGN 28400014 * 28500014 OGANEXT LR REG10,RIOB FIND NEXT IOB AVAILABLE 28600014 OGALOOP TS 36(REG10) IS THIS IOB AVAILABLE 28700014 BZ OGASGN YES - ASGN 28800014 LA REG10,36(0,REG10) LOCATION OF NEXT IOB 28900014 CLC 1(3,REG10),FZERO TEST FOR ZERO 29000014 BZ OGAWAIT NON-AVAILABLE, WAIT 29100014 L REG10,0(0,REG10) LOAD NEXT IOB AVAILABLE 29200014 B OGALOOP 29300014 OGAWAIT LR REG11,RDECB STORE REGISTER 1 29400014 LR REG12,REG0 STORE REGISTER 0 29500014 LR RDECB,RIOB FIRST IOB LOCATION 29600014 S RDECB,FOUR LOCATION 29700014 MVC 0(4,RDECB),FZERO CLEAR ECB 29800014 WAIT ECB=(1) 29900014 LR REG0,REG12 RESTORE REGISTER 0 30000014 LR RDECB,REG11 RESTORE REGISTER 1 30100014 B OGANEXT FIND AVAIL IOB 30200014 OGASGN LR RIOB,REG10 IOB REG WITH NEW IOB ASGN 30300014 LA REG10,40(0,RIOB) CCW LOCATION ADDRESS 30400014 L REG9,4(0,RDECB) TYPE CODE TO REGISTER 30500014 * 30600014 * IS NON-STOP REGENERATION TYPE CODE 30700014 * 30800014 TM 4(RDECB),X'C0' 2260 READ/WRITE 30900014 BC 1,OGACCW BUILD CCW 31000014 TM 4(RDECB),X'70' 2260 ERASE 31100014 BC 1,OGACCW BUILD CCW 31200014 CLI 4(RDECB),X'4A' HLT TYPE 31300014 BE OGACCW BUILD CCW 31400014 CLI 4(RDECB),X'08' MIP TYPE 31500014 BE OGACCW BUILD CCW 31600014 CLI 4(RDECB),X'10' XYP TYPE 31700014 BE OGACCW BUILD CCW 31800014 CLI 4(RDECB),X'40' ALM TYPE 31900014 BE OGACCW BUILD CCW 32000014 CLI 4(RDECB),X'50' IND TYPE 32100014 BE OGACCW BUILD CCW 32200014 CLI 4(RDECB),X'6C' STR TYPE 32300014 BE OGACCW BUILD CCW 32400014 CLI 4(RDECB),X'A8' UNB TYPE 32500014 BE OGACCW BUILD CCW 32600014 CLI 4(RDECB),X'00' DEV TYPE 32700014 BE OGACCW BUILD CCW 32800014 CLI 4(RDECB),X'18' 'SEN' TYPE A25397 32830019 BE OGACCW IF YES GO BUILD CCW A25397 32860019 * 32900014 * BUILD - SET BUFFER ADDRESS REGISTER AND STOP - CHANNEL 33000014 * COMMAND WORD WITH CHAINING 33100014 * 33200014 OGAHALT SR REG11,REG11 CLEAR REGISTER 33300014 ST REG11,4(0,REG10) CLEAR FIELD 33400014 IC REG11,HLTCT HALT COMMAND CODE COUNT 33500014 STC REG11,7(0,REG10) COUNT IN CCW FOR HALT 33600014 C REG5,FZERO BUFFER ADDRESS IN PRAM 33700014 BNE OGANO3 33800014 NOBUFAD EQU * S21016 33820021 WTO 'IFF214I GIOCR FOUND NO BUFFER ADDRESS IN DECB',ROUTCDE=X33840021 11,DESC=7 33860021 LA REG15,X'20' DECB DOES NOT HAVE JFCD 33900017 MVI 36(RIOB),X'00' MARK IOB AS NOW A29793 33930019 * AVAILABLE A29793 33960019 B OGASTR BUFF ADR.--RETURN JFCD 34000017 OGANO3 ST REG5,0(0,REG10) BUFFER ADDRESS IN CCW 34200014 SR REG11,REG11 CLEAR REGISTER 34300014 IC REG11,HALT HALT COMMAND CODE 34400014 STC REG11,0(0,REG10) COMMAND CODE IN CCW FOR HALT 34500014 MVI 4(REG10),X'60' CCW FLAG BITS 34600014 A REG10,EIGHT UPDATE CCW POINTER 34700014 * 34800014 * BUILD APPROPIATE CHANNEL COMMAND WORD FOR I/O OPERATION. IF 34900014 * ANOTHER COMMAND FOLLOW, BRANCH BACK WITH CHAINING. IF LAST 35000014 * COMMAND, TEST FOR UNBUFFERED. 35100014 * 35200014 OGACCW LR REG12,REG8 SHIFT LENGTH TO REG12 35300014 OGACCW1 SR REG8,REG8 CLEAR REGISTER 35400014 ST REG8,4(0,REG10) CLEAR FIELD 35500014 SLDL REG8,5 TYPE CODE 5 HIGH ORDER BITS 35600014 TM 4(RDECB),X'06' FOR ONE 35700014 BC 4,OGABUF NEXT TEST 35800014 ST REG6,0(0,REG10) AREA ADDRESS TO CCW 35900014 B OGACODE COMMAND CODE AND COUNT 36000014 OGABUF TM 4(RDECB),X'02' FOR BUFFER CODE 36100014 BC 12,OGASTART START CODE 36200014 ST REG5,0(0,REG10) BUFFER ADDRESS TO CCW 36300014 B OGACODE COMMAND CODE AND COUNT 36400014 OGASTART TM 4(RDECB),X'04' FOR START CODE 36500014 BC 12,OGACODE COMMAND CODE AND COUNT 36600014 ST REG0,0(0,REG10) START ADDRESS TO CCW 36700014 OGACODE LA REG11,OGATABLE COMMAND CODE AND COUNT TABLE 36800014 L REG15,44(RDCB) DEB ADDR 36820014 L REG15,32(REG15) UCB ADDR 36840014 CLI UCBTYP(REG15),T2260 2260 36860014 BNE OGACODE1 NO 36880014 CLI 29(RDECB),X'01' 36900014 BE DATENTRY 37000014 OGACODE1 CLI 4(RDECB),X'40' FOR ALM TYPE 37100014 BE OGANCK 37200014 CLI 4(RDECB),X'70' FOR ERS TYPE 2260 37300014 BE OGANCK 37400014 L REG15,0(0,REG10) DATA ADDRESS IN CCW 37500014 C REG15,FZERO CHECK IF ADDRESS PRESENT 37600014 BNE OGANCK 37700014 MVI 36(RIOB),X'00' MARK IOB AS NOW A29793 37730019 * AVAILABLE A29793 37760019 WTO 'IFF215I GIOCR DISCOVERED AREA,BUFFER, OR START ADDRESS X37770021 MISSING',ROUTCDE=11,DESC=7 37780021 LA REG15,X'24' DECB DOES NOT HAVE JFCD 37800017 B OGASTR AREA ADR.--RETURN JFCD 37900017 DATENTRY A REG11,THRESIX 38100014 B OGANCK 38200014 OGANCK AR REG8,REG8 DOUBLE BITS IN REGISTER 38300014 LH REG11,0(REG8,REG11) COMMAND CODE AND COUNT 38400014 STC REG11,7(0,REG10) COUNT IN CCW 38500014 SRL REG11,8 SHIFT OUT COUNT 38600014 STC REG11,0(0,REG10) COMMAND CODE INTO CCW 38700014 TM 7(REG10),X'FF' IS COUNT ZERO 38800014 BC 5,OGACMD NO 38900014 ST REG12,4(0,REG10) LENGTH FROM REGISTER TO CCW 39000014 OGACMD L REG11,FZERO ZERO TO REGISTER 39100014 STH REG11,4(0,REG10) CLEAR UNUSED AREA IN CCW 39200014 TM 4(RDECB),X'92' TYPE CODE FOR FIND 39300014 BC 12,OGAREAD NO 39400014 SR REG11,REG11 CLEAR REGISTER 39500014 IC REG11,FNDB FIND FLAG BITS 39600014 STC REG11,4(0,REG10) BITS IN FLAG IN CCW FOR FIND 39700014 B OGABIT NEXT TYPE CODE 39800014 OGAREAD TM 4(RDECB),X'80' TYPE CODE FOR READ/WRITE 39900014 BC 12,OGAOTHB OTHER CODES 40000014 SR REG11,REG11 CLEAR REGISTER 40100014 CLI 4(RDECB),X'88' TEST IF CUR TYPE 40200014 BE OGABIT YES 40300014 CLI 4(RDECB),X'D8' TEST FOR SMI READ 40400014 BE OGABIT YES 40500014 CLI 4(RDECB),X'E0' TEST IF DSM READ TYPE 40600014 BE OGABIT YES 40700014 CLI 4(RDECB),X'E8' TEST IF DSB READ TYPE 40800014 BE OGABIT YES 40900014 IC REG11,RDWTB READ/WRITE FLAG BITS 41000014 STC REG11,4(0,REG10) BITS IN FLAG OF CCW FOR RD/WR 41100014 B OGABIT NEXT TYPE CODE 41200014 OGAOTHB SR REG11,REG11 CLEAR REGISTER 41300014 CLI 4(RDECB),X'4A' TEST IF HLT TYPE 41400014 BE OGABIT YES 41500014 CLI 4(RDECB),X'6C' TEST IF STR TYPE 41600014 BE OGABIT YES 41700014 CLI 4(RDECB),X'50' TEST IF IND TYPE 41800014 BE OGABIT YES 41900014 CLI 4(RDECB),X'08' TEST IF MIP TYPE 42000014 BE OGABIT YES 42100014 CLI 4(RDECB),X'10' TEST IF XYP TYPE 42200014 BE OGABIT YES 42300014 CLI 4(RDECB),X'18' TEST IF DFS TYPE 42400014 BE OGABIT YES 42500014 CLI 4(RDECB),X'00' TEST IF DEV TYPE 42600014 BNE OGASIL IF NOT, BYPASS 2280/82 SUPPORT 42700014 LA REG11,18 PLACE LENGTH INTO WORK REG 42800014 AR REG6,REG11 COMPUTE NEW AREA ADDRESS 42900014 B OGABIT GO TO ENDING 43000014 OGASIL IC REG11,FLAG BITS FOR OTHERS FLAG 43100014 STC REG11,4(0,REG10) BITS IN FLAG OF CCW FOR OTHERS 43200014 OGABIT SLDL REG8,3 SHIFT OUT LAST BITS 43300014 L REG11,4(0,RDECB) TYPE CODE 43400014 SLL REG11,8 1ST TYPE CODE 43500014 ST REG11,4(0,RDECB) TYPE CODE BACK 43600014 TM 4(RDECB),X'FF' ANOTHER TYPE CODE FOLLOWS 43700014 BC 8,OGASET NON-FOLLOW 43800014 TM 4(REG10),X'40' TEST IF COMMAND CHAINING 43900014 BC 5,OGAUPD YES 44000014 L REG11,4(0,REG10) FLAG FIELD 44100014 O REG11,BFOUR TURN ON COMMAND CHAIN FLAG 44200014 ST REG11,4(0,REG10) FLAG W/COMMAND CHAINING IN CCW 44300014 OGAUPD A REG10,EIGHT UPDATE CCW POINTER 44400014 B OGACCW1 LOOP FOR NEXT CCW 44500014 OGASET ST REG7,4(0,RDECB) RESTORE TYPE CODE IN DECB 44600014 * 44700014 * TURN OFF APPROPIATE FLAGS IN CCW AND STORE RESTART ADDRESS 44800014 * IN DCB. STORE ECB ADDRESS IN IOB AND SET ECB TO ZERO 44900014 * 45000014 TM 4(REG10),X'40' TEST IF COMMAND CHAINING 45100014 BC 8,OGAECB OFF 45200014 L REG11,4(0,REG10) FLAG OF CCW 45300014 N REG11,BNTWO TURN OFF 45400014 ST REG11,4(0,REG10) FLAG TO CCW 45500014 OGAECB LR REG11,REG0 45600014 CLI 0(REG10),X'27' WAS LAST COMMAND A START 3841 45630015 BNE OGASKIP1 NO SKIP ADDR SAVE 3841 45660015 MVC 12(2,RDCB),0(REG11) RESTART BUF ADD IN DCB 45700014 L REG5,44(0,RDCB) DEB ADDRESS FROM DCB 45800014 LR REG10,RDECB SAVE REG 1. 45900014 LH REG0,0(0,REG11) GET RESTART ADDRESS. 46000014 LH RDECB,34(0,REG5) UCB ADDR FROM DEB TO REG1. 46100014 CLI UCBTYP(RDECB),T2250 3841 46200015 BH OGASKIP 3841 46300015 SLL REG0,16 LEFT JUSTIFY IN REG0. 46400014 OR REG0,RDECB UCB AND BUFF ADDR TO REG 0. 46500014 SR RDECB,RDECB ZERO TO REG 1. 46600014 SVC 84 RESTART ADDRESS TO UCB TMGA 46700018 OGASKIP LR RDECB,REG10 RESTORE DECB ADDR IN REG1 46800014 OGASKIP1 ST RDECB,4(0,RIOB) ECB ADDR IN IOB 3841 46900015 OGAEXCP L REG11,FZERO ZERO TO REGISTER 47000014 STH REG11,30(0,RIOB) CLEAR COUNT AREA IN IOB 47100014 L REG7,28(0,RDECB) BUFFER ADDRESS 47200014 SRL REG7,24 47300014 STC REG7,32(0,RIOB) UCB INDEX INTO IOB 47400014 * 47500014 * ISSUE SVC 0 FOR EXCP AND RETURN 47600014 * 47700014 LR RDECB,RIOB IOB POINTER TO REG 1 47800014 SVC 0 EXCP 47900014 LA REG15,ZERO LOAD RETURN CODE S21016 48000021 OGASTR RETURN (14,12),RC=(15) 48100014 * 48200014 * ABEND AND DUMP ON PROPER CODE 48300014 * 48400014 DS 0D 48600014 * 48700014 * 48800014 * COMMAND CODE AND COUNT TABLE ON HALH WORD BOUNDARY USED 48900014 * FOR BUILDING CCW'S. THE FIRST BYTE IS THE COMMAND CODE 49000014 * AND THE LAST BYTE IS THE COUNT ASSOCIATED WITH EACH COMMAND 49100014 * IF APPROPIATE. THE MACRO ID REQUIRED TO HAVA A COUNT IF THE 49200014 * COUNT IS ZERO. 49300014 * 49400014 * 49500014 OGATABLE DS 0F 49600014 OGADEV DC X'1612' 0 49700014 OGAMIP DC X'0E03' 1 49800014 OGAXYP DC X'1204' 2 49900014 OGADFS DC X'0404' 3 50000014 OGADCS DC X'0404' 4 50100014 DC X'0000' 5 UNASSIGNED 50200014 DC X'0000' 6 UNASSIGNED 50300014 DC X'0000' 7 UNASSIGNED 50400014 OGAALM DC X'0B02' 8 50500014 OGASTOP DC X'0702' 9 50600014 OGAIND DC X'1B04' 10 50700014 OGAINS DC X'0F02' 11 50800014 OGARMV DC X'1F02' 12 50900014 OGASTR1 DC X'2702' 13 51000014 OGAERS DC X'0702' 14 51100014 DC X'0000' 15 UNASSIGNED 51200014 OGABUF1 DC X'0200' 16 51300014 OGACUR DC X'0600' 17 51400014 OGAFND DC X'0600' 18 51500014 DC X'0000' 19 UNASSIGNED 51600014 OGAWBUF DC X'0100' 20 51700014 OGAUNB DC X'0100' 21 51800014 DC X'0000' 22 UNASSIGNED 51900014 DC X'0000' 23 UNASSIGNED 52000014 DC X'0000' 24 UNASSIGNED 52100014 DC X'0000' 25 UNASSIGNED 52200014 DC X'0000' 26 UNASSIGNED 52300014 OGASMI DC X'0A00' 27 2260 52400014 OGADSM DC X'0200' 28 2260 52500014 OGADSB DC X'0600' 29 2260 52600014 OGAWDSB DC X'0100' 30 2260 52700014 OGALNE DC X'0500' 31 2260 52800014 OGAERSW DC X'1702' 52900014 DC 24X'00' 53000014 OGASMIW DC X'1A00' DATA ENTRY COMMANDS 53100014 OGADSMW DC X'1200' 53200014 OGADSBW DC X'1600' 53300014 OGADSBWW DC X'1100' 53400014 OGALNEW DC X'1500' 53500014 * 53600014 * 53700014 * CONSTANT 53800014 * 53900014 DS 0F 54000014 FONE DC XL4'01' 54100014 FZERO DC XL4'0' 54200014 TWO DC F'2' 54300014 FOUR DC F'4' 54400014 EIGHT DC F'8' 54500014 BFOUR DC X'40000000' 54600014 BNTWO DC X'20FFFFFF' 54700014 FLAG DC X'20' 54800014 CONCF DC C'C0' 54900014 HLTCT DC X'02' 55000014 T2260 EQU X'03' 55100014 HALT DC X'07' 55200014 FNDB DC X'30' 55300014 RDWTB DC X'20' 55400014 ERSTYPE DC X'7000' 2260 GCNTRL TYPE LI A44376 55450000 THRESIX DC F'36' 55500014 OGA4R EQU 4 55600014 OGA8R EQU 8 55700014 OGA0CR EQU 12 55800014 OGA10R EQU 16 55900014 UCBTYP EQU 19 56000014 BTBL EQU 37 56100014 HEADISP EQU 40 56200014 SRTYP EQU X'6C' 56300014 DCB2 EQU X'80' 56400014 MASK1 EQU X'FF' 56500014 DCBDEBAD EQU 44 DISP IN DCB FOR DEB ADDR A33619 56510020 DEBDCBAD EQU 24 DISP IN DEB FOR DCB ADDR A33619 56520020 DEBNMEXT EQU 16 DISP IN DEB FOR NUMBER OF A33619 56530020 * EXTENTS A33619 56540020 UNITINDX EQU 28 DISP TO UNIT INDEX IN DECBA33619 56550020 ZERO EQU 0 DISPLACEMENT A33619 56560020 ONE EQU 1 LENGTH OF UNIT INDEX ENTRYA33619 56570020 CNOP 0,8 56600014 *DUMMY SECTIONS 56700014 DECB DSECT 56800014 DS F 56900014 TYPE DS F 57000014 DCBAD DS F 57100014 AREADR DS F 57200014 DS F 57300014 OCBP DS CL2 57400014 LENGTH DS CL2 57500014 START DS F 57600014 BUFFER DS F 57700014 * 57800014 * 57900014 OACB DSECT 58000014 SLOA DS F 58100014 DS 2F 58200014 CRSA DS F 58300014 OLP DS F 58400014 BLP DS F 58500014 END 58600014 ./ ADD SSI=03052480,NAME=IGG019OB,SOURCE=0 CEAF TITLE 'GRAPHIC ACCESS METHOD CHANNEL END AND EXCEPTIONAL CHANN-00020000 EL END MODULE' 00040000 *********************************************************************** 00060000 * * 00080000 * GRAPHIC CHANNEL END AND EXCEPTIONAL CHANNE END APPENDAGE * 00100000 * * 00120000 *STATUS CHANGE LEVEL 1 00140000 * * 00160000 * FUNCTION: * 00180000 * CHANNEL END * 00200000 * 1 IF THE DEVICE IS A FILM UNIT GO TO 5, ELSE GO TO 2. * 00220000 * 2 IF GIOCR IS WAITING FOR AN IOB, POST THE SPECIAL ECB * 00240000 * AND GO TO 3. * 00260000 * 3 TURN OFF THE AVAILABILITY BIT IN THE IOB AND GO TO 4. * 00280000 * 4 NORMAL RETURN TO I/O SUPERVISOR. * 00300000 * 5 TURN OFF THE DEVICE END POST FLAG AND GO TO 2. * 00320000 * ABNORMAL END APPENDAGE * 00340000 * 1 IF GRAPHIC DEVICE PERFORMING VARIABLE LENGTH INPUT * 00360000 * COMMAND HAS CAUSED INCORRECT LENGTH STATUS, RETRIEVE * 00380000 * RESIDUAL COUNT AND GO TO 3, OTHERWISE GO TO 2. * 00400000 * 2 IF FILM UNIT WITH PERMANENT ERROR CONDITION, ESTABLISH * 00420000 * STATUS INDICATOR POINTER AND GO TO 3, ELSE GO TO 3. * 00440000 * 3 GO TO CHANNEL-END-FUNCTION-2. * 00460000 * * 00480000 * ENTRY POINT: IGG019OB, CEAPPEND VIA BALR IN IOS * 00500000 * * 00520000 * INPUT USE OF REGISTERS OF IOS 3574 00523018 * 3574 00526018 * IN REGISTER 1 TWELVE STAR ADDRESS (RQE) IF THERE 3574 00529018 * IS ONE 3574 00532018 * IN REGISTER 2 IOB ADDRESS 3574 00535018 * IN REGISTER 3 DEB ADDRESS 3574 00538018 * IN REGISTER 4 DCB ADDRESS 3574 00541018 * IN REGISTER 6 UNIT ADDRESS 3574 00544018 * IN REGISTER 7 UCB ADDRESS 3574 00547018 * IN REGISTER 14 RETURN ADDRESS TO IOS 3574 00550018 * IN REGISTER 15 ENTRY POINT ADDRESS OF APPENDAGE 3574 00553018 * * 00560000 * OUTPUT: N/A * 00580000 * * 00600000 * EXTERNAL ROUTINES: N/A * 00620000 * * 00640000 * EXITS NORMAL RETURN TO IOS 3574 00660018 * * 00680000 * TABLE: N/A * 00700000 * * 00720000 * WORK AREA: N/A * 00740000 * * 00760000 * ATTRIBUTES: PROBLEM PROGRAM RESIDENCE, SUPERVISOR ENTERED * 00780000 * * 00800000 * NOTES: N/A * 00820000 * * 00840000 *2928,005400,006600,014800,015200-016400,017600-020800, 3574 00845018 * 022000-022400,024800-027200,029400,031000-033600, 3574 00850018 * 039000-039200,039800-040000 3574 00855018 * 00856018 *1933,010660,010720 PTM 2173 00857018 *********************************************************************** 00860000 * 00880000 * 00900000 * THESE ARE THE SYMBOLIC REGISTERS 00920000 * 00940000 REG0 EQU 0 00960000 REG1 EQU 1 00980000 RIOB EQU 2 01000000 RDEB EQU 3 01020000 RDCB EQU 4 01040000 RUCB EQU 7 01060000 REG9 EQU 9 01080000 REG10 EQU 10 01100000 REG11 EQU 11 01120000 REG12 EQU 12 01140000 RCCW EQU 12 CHANNEL COMMAND WORD PTM 2173 01146018 * REGISTER PTM 2173 01152018 RBASE EQU 13 01160000 RRETRN EQU 14 01180000 * 01200000 * 3574 01200218 * 3574 01200418 * IOB DISPLACEMENTS 3574 01200618 * 3574 01200818 * 3574 01201018 SENSE2 EQU 3 SECOND SENSE BYTE 3574 01201218 ECBCODE EQU 4 EVENT CONTROL BLOCK POST 3574 01201418 * CODE 3574 01201618 STATUS EQU 12 FIRST BYTE OF CHANNEL 3574 01201818 * STATUS WORK 3574 01202018 STATUS2 EQU 13 SECOND BYTE OF CHANNEL 3574 01202218 * STATUS WORK 3574 01202418 CSWCOUNT EQU 14 BYTE COUNT FIELD OF CHANNEL 3574 01202618 * STATUS WORK 3574 01202818 CCWSTAD EQU 16 CHANNEL COMMAND START 3574 01203018 * ADDRESS AT TOP OF THE 3574 01203218 * CHAIN 3574 01203418 IOBCOUNT EQU 30 ERROR RECOVERY FIELD USED 3574 01203618 * FOR COMMUNICATION BETWEEN 3574 01203818 * THE ABNORMAL END APPENDAGE 3574 01204018 * AND THE ERROR RECOVERY 3574 01204218 * PROGRAM 3574 01204418 * 3574 01204618 * 3574 01204818 * CHANNEL COMMAND WORD FIELDS AND FLAGS 3574 01205018 * 3574 01205218 COMMCODE EQU 0 CHANNEL COMMAND WORD 3574 01205418 * COMMAND CODE DISPLACEMENT 3574 01205618 CCWFLAGS EQU 4 CHANNEL COMMAND WORD FLAG 3574 01205818 * FIELD DISPLACEMENT 3574 01206018 CMDCHAIN EQU X'40' COMMAND CHAINING BIT OF 3574 01206218 * CHANNEL COMMAND WORD 3574 01206418 * 3574 01206618 * UNIT CONTROL BLOCK DISPLACEMENTS 3574 01206818 * 3574 01207018 UNITTYPE EQU 19 UNIT TYPE FIELD 3574 01207218 * UNIT TYPE MASKS 3574 01207418 A2250 EQU X'02' 2250 TYPE CODE 3574 01207618 A2260 EQU X'03' 2260 TYPE CODE 3574 01207818 * 3574 01208018 * 3574 01208218 * DATA EVENT CONTROL BLOCK DISPLACEMENTS 3574 01208418 * 3574 01208618 STATUSPT EQU 16 STATUS INDICATOR POINTER 3574 01208818 * (IOB) 3574 01209018 * 3574 01209218 IOSERFG EQU 44 IOS ERROR FLAGS 3574 01209418 * FLAG MEANING 3574 01209618 ERRCRT EQU X'40' ERROR CORRECTION IN 3574 01209818 * PROGRESS 3574 01210018 PECOND EQU X'80' PERMANENT ERROR CONDITION 3574 01210218 * EXISTS 3574 01210418 * 3574 01210618 * CHANNEL STATUS WORD STATUS MASKS 3574 01210818 * 3574 01211018 ATTN EQU X'80' ATTENTION 3574 01211218 INCLNGTH EQU X'40' INCORRECT LENGTH 3574 01211418 UNITCK EQU X'02' UNIT CHECK 3574 01211618 ATTNUC EQU ATTN+UNITCK ATTENTION PLUS UNIT CHECK 3574 01211818 ICC EQU X'02' INTERFACE CONTROL CHECK 3574 01212018 * CSW INDICATOR 3574 01212218 CCC EQU X'04' CHANNEL CONTROL CHECK 3574 01212418 * CSW INDICATOR 3574 01212618 CDC EQU X'08' CHANNEL DATD CHECK 3574 01212818 * CSW INDICATOR 3574 01213018 CHNLERR EQU ICC+CCC+CDC CHANNEL ERROR CONDITIONS 3574 01213218 * STATUS INDICATORS 3574 01213418 * 3574 01213618 * OTHER MASKS 3574 01213818 FULLMASK EQU X'FF' ALL ONES BYTE MASK 3574 01214018 ZEROMASK EQU X'00' ALL ZEROS BYTE MASK 3574 01214218 ZERO EQU 0 A VALUE OF ZERO 3574 01214418 ANEIGHT EQU 8 DISPLACEMENT VALUE OF 8 3574 01214618 PRMERR EQU X'02' PERMANENT ERROR FLAG IN 3574 01214818 * IOB ERROR COUNT FIELD 3574 01215018 ERPENTRY EQU X'01' ERP HAS BEEN ENTERED 3574 01215218 * INDICATOR 3574 01215418 PRMERRCD EQU X'41' PERMANNNT I/O ERROR CODE 3574 01215618 * TO BE PLACED IN ECB CODE 3574 01215818 * FIELD 3574 01216018 NOERRORS EQU X'7F' SUCCESSFUL COMPLETION OF 3574 01216218 * I/O 3574 01216418 * READ COMMAND 3574 01216618 READCUR EQU X'06' GREAD COMMAND CODE FOR 3574 01216818 * READ TO CORSOR TYPE ON 3574 01217018 * 2250 3574 01217218 EJECT 3574 01217418 IGG019OB CSECT 01220000 ENTRY CEAPPEND 01240000 CNOP 2,4 01260000 CEAPPEND BALR RBASE,0 01280000 USING *,RBASE 01300000 * 01320000 * IF ABNORMAL CHANNEL END, TEST FOR INCORRECT LENGTH AND 01340000 * TURN ON OR OFF APPROPIATE BITS FOR THE ERROR ROUTINE RETRY 01360000 * CHECKING FOR 2250 AND 2260 ERROR CONDITIONS 01380000 * 01400000 TM 0(RIOB),X'04' TEST IOB EXCEPTION BIT 01420000 BZ OHAFUI GO TO FILM UNIT INTERFACE 01440000 TM 30(RIOB),X'02' TEST FOR ABNORMAL END APPEND. 01460000 BO OHAFUI YES TAKE BRANCH PERMANENT 3574 01470018 * ERROR INDICATED BY ERP 3574 01480018 OI 30(RIOB),X'02' TURN ON AEA BIT 01500000 TM STATUS2(RIOB),CHNLERR WAS THERE AN ERROR IN THE 3574 01506018 * CHANNEL 3574 01512018 BZ CKUNITCK IF NOT TAKE BRANCH 3574 01518018 CLI UNITTYPE(RUCB),OHA80 IS DEVICE A 2280 3574 01524018 BE OHAFUCE YES TAKE BRANCH 3574 01530018 CLI UNITTYPE(RUCB),OHA82 IS DEVICE A 2282 3574 01536018 BE OHAFUCE YES TAKE BRANCH 3574 01542018 B OHARTN ELSE GO TO ERP 3574 01548018 CKUNITCK TM STATUS(RIOB),UNITCK WAS THE ERROR IN THE UNIT 3574 01554018 BZ ZEROSNSE NO TAKE BRANCH 3574 01560018 TM SENSE2(RIOB),FULLMASK DID SENSE FAIL 3574 01566018 BNO TST2260 IF DID NOT FAIL TAKE BRANCH 3574 01572018 ZEROSNSE NI SENSE2(RIOB),ZEROMASK ZERO OUT SECOND SENSE 3574 01578018 * BYTE 3574 01584018 TST2260 CLI UNITTYPE(RUCB),A2260 IS DEVICE A 2260 3574 01590018 BNE OHALPD IF NOT TAKE BRANCH 3574 01596018 TM STATUS(RIOB),UNITCK WAS THE ERROR IN THE UNIT 3574 01602018 BO OHARTN YES TAKE BRANCH 3574 01608018 CLI STATUS2(RIOB),INCLNGTH WAS ERROR INCORRECT 6574 01614018 * LENGTH ONLY 3574 01620018 BNE OHARTN IF NOT TAKE BRANCH 3574 01626018 STORECSW LH REG10,CSWCOUNT(RIOB) COUNT FROM IOB CSW 3574 01632018 L REG11,4(0,RIOB) ECB ADDRESS FROM IOB 01660000 LA REG11,0(0,REG11) DROP HIGH ORDER BYTE 01680000 ST REG10,16(0,REG11) COUNT IN DECB 01700000 MVI 16(REG11),X'43' INCORRECT LENGTH CODE TO DECB 01720000 NI 0(RIOB),X'FF'-X'04' TURN OFF IOB EXEC BIT 01740000 MVI ECBCODE(RIOB),NOERRORS SET IOB ECB 3574 01750018 * CODE TO INDICATE SUCCESSFUL 3574 01760018 * OPERATION 3574 01770018 B CLRDCBFG GO SET NO ERROR CONDITION 3574 01780018 OHALPD CLI UNITTYPE(RUCB),A2250 IS DEVICE A 2250 3574 01790018 BNE OHARTN IF NOT TAKE BRANCH 3574 01800018 CLI STATUS(RIOB),ATTNUC IS STATUS ATTENTION PLUS 3574 01810018 * UNIT CHECK 3574 01820018 BE OHAOFF IF YES TAKE BRANCH 3574 01830018 TM STATUS(RIOB),UNITCK WAS THE ERROR IN THE UNIT 3574 01840018 BO OHARTN IF YES TAKE BRANCH 3574 01850018 CLI STATUS2(RIOB),INCLNGTH WAS ERROR INCORRECT 3574 01860018 * LENGTH ONLY 3574 01870018 BNE OHARTN IF NOT TAKE BRANCH 3574 01880018 L RCCW,CCWSTAD(RIOB) GET CCW START ADDRESS 3574 01890018 TM CCWFLAGS(RCCW),CMDCHAIN IS FIRST COMMAND 3574 01900018 * CHAINED TO THE SECOND 3574 01910018 BZ OHARTN IF NOT TAKE BRANCH 3574 01920018 LA RCCW,ANEIGHT(RCCW) GET NEXT CCW ADDRESS 3574 01930018 CLI COMMCODE(RCCW),READCUR WAS COMMAND READ 3574 01940018 * TO CURSOR 3574 01950018 BNE OHARTN IF NOT TAKE BRANCH 3574 01960018 B STORECSW GO STORE COUNT INTO DECB 3574 01970018 OHAOFF TM 3(RIOB),X'80' LIGHT PEN 02100000 BC 8,OHARTN 02120000 NI 0(RIOB),X'FF'-X'04' TURN OFF IOB EXEC BIT 02160000 B OHAIOB RELEASE IOB 02180000 * 02260000 * FILM UNIT ERROR ROUTINE INTERFACE REQUIRES THE STATUS INDICATOR 02280000 * POINTER (ALIAS IOB) TO BE PLACED INTO THE DECB FOR ALL PERMANENT 02300000 * I/O ERRORS. 02320000 * 02340000 IOBFLAG2 EQU 1 FLAG2 FIELD IN IOB 02360000 IOBDNP EQU X'02' DEVICE END POST FLAG 02380000 UCBTBYT4 EQU 19 DISPLACEMENT UCB DEVICE CODE 02400000 OHA80 EQU 5 UCB TYPE CODE FOR 2280 DEVICE 02420000 OHA82 EQU 6 UCB TYPE CODE FOR 2282 DEVICE 02440000 * 02460000 * 02740000 * FILM UNIT INTERFACE FOR NORMAL CHANNEL END WITH DEVICE END IS 02760000 * IDENTICAL TO OTHER GRAPHIC DEVICES. FILM UNIT INTERFACE FOR 02780000 * CHANNEL END SEPERATED FROM DEVICE END WILL TURN OFF THE DEVICE 02800000 * END POST FLAG AND THEN CONTINUE NORMAL PROCESSING SIMILAR TO 02820000 * OTHER GRAPHIC DEVICES. 02840000 * 02860000 * 02880000 * 02900000 OHAFUI CLI UCBTBYT4(RUCB),OHA80 FOR 2280 02920000 BE OHAFUE GO TO STORE STATUS POINTER 3574 02940018 CLI UCBTBYT4(RUCB),OHA82 FOR 2282 02960000 BNE OHAIOB GO TO NORMAL CHANNEL END FOR 02980000 * ALL OTHER GRAPHIC DEVICES 03000000 * 3574 03001018 * 3574 03002018 * FILM UNIT ERRORS 3574 03003018 * 3574 03004018 OHAFUE TM IOBCOUNT(RIOB),PRMERR IS PERMANENT ERROR 3574 03005018 * FLAG ON 3574 03006018 BZ OHADNP IF NOT TAKE BRANCH 3574 03007018 OHAFUCE LA REG10,ZERO(RIOB) ZERO OUT HIGH BYTE 3574 03008018 L REG11,ECBCODE(ZERO,RIOB) GET ECB ADDRESS 3574 03009018 LA REG11,ZERO(ZERO,REG11) CLEAR OUT HIGH BYTE 3574 03010018 ST REG10,STATUSPT(ZERO,REG11) STORE STATUS INDICATOR3574 03011018 * POINTER 3574 03012018 MVI ECBCODE(RIOB),PRMERRCD SET ECB CODE TO 3574 03013018 * INDICATE PERMANENT ERROR 3574 03014018 NI IOBFLAG2(RIOB),FULLMASK-IOBDNP TURN OFF POST 3574 03015018 * FLAG 3574 03016018 B CLRDCBFG GO CLEAR DCB ERROR FLAGS 3574 03017018 * TURN OFF DEVICE END POST FLAG 03020000 * 03040000 OHADNP NI IOBFLAG2(RIOB),X'FF'-IOBDNP TURN OFF DE POST FLAG 03060000 B OHAIOB GO TO NORMAL CHANNEL END LOGIC 03080000 CLRDCBFG NI IOSERFG(RDCB),FULLMASK-ERRCRT-PECOND 3574 03150018 * TURN OFF IOS ERROR FLAGS 3574 03220018 * IN DCB 3574 03290018 * * 03380000 * NORMAL CHANNEL END FOR RELEASE OF IOB AND POSTING COMPLETE 03400000 * IF GIOCR WAITING FOR AN AVAILABLE IOB 03420000 * 03440000 * TEST IF GIOCR WAITING FOR IOB TO BECOME AVAILABLE * 03460000 * * 03480000 OHAIOB L REG11,28(0,RDCB) FIRST IOB ADDRESS 03500000 S REG11,FOUR ECB ADDRESS 03520000 TM 0(REG11),X'80' TEST IF WAITING IN GIOCR 03540000 BZ OHANEXT 03560000 * * 03580000 * POST WAITING ECB BY GIOCR COMPLETE * 03600000 * * 03620000 SR REG10,REG10 SET COMPLETION CODE TO ZERO 03640000 L REG12,0(RDEB) PLACE TCB ADDRESS 03660000 L 15,16(0,REG10) CVT ADDRESS 03680000 L 15,152(0,15) POST ROUTINE 03700000 LR RIOB,RRETRN SAVE RETURN ADDRESS 03720000 BALR 14,15 POST ROUTINE 03740000 LR RRETRN,RIOB RESTORE RETURN ADDR 03760000 L RIOB,4(0,REG1) RESTORE RIOB REG 03780000 * * 03800000 * TURN OFF NON-AVAILABLE BIT IN IOB WHICH WILL MAKE THIS * 03820000 * IOB NOW AVAILABLE * 03840000 * * 03860000 OHANEXT NI 36(RIOB),X'00' TURN OFF NON AVAIL BIT IN IOB 03880000 * TURN OFF PERMENT ERROR 3574 03881018 * FLAG AND ERP ENTRY FLAG IN 3574 03882018 * IOB ERROR COUNT FIRLD 3574 03883018 NI IOBCOUNT(RIOB),FULLMASK-PRMERR-ERPENTRY 3574 03884018 * 3574 03885018 * ALL OTHER FLAGS IN THE IOB ERROR COUNT FIRLD THE 3574 03886018 * ERP HAS THE RESPONCABILITY OF TURNING OFF. 3574 03887018 * 3574 03888018 * 3574 03889018 * 3574 03890018 * THE APPENDAGE WILL BE ENTERED TWICE FOR AN ERROR 3574 03891018 * RECOVERY PROCESS ONCE AT IOS FINDING THE ERROR 3574 03892018 * CONDITION AND THE SECOND JUST BEFORE IOS GOES TO 3574 03893018 * POST THE PROBLEM PROGRAM ON COMPLETION OF I/O. 3574 03894018 * THE APPEMDAGE HAS THE RESPONCABILITY OF FINKING O1T 3574 03895018 * IF THE INCORRECT LENGTH ON A READ OPERATION IS A 3574 03896018 * VALID ERROR OR EXPECTED. 3574 03897018 * A PROBLEN ARRISES WITH THE ERP ABILITY TO RECOVER 3574 03898018 * FROM CHANNEL ERRORS BUT STILL HAVE INCORRECT LENGTH.3574 03899018 * THE ERP MUST LET THE APPENDAGE KSOW THAT THERE IS AN3574 03900018 * ERROR CONDITION THAT MIGHT BE EXPECTED. 3574 03901018 * 3574 03902018 * SO THE ERP HAS BEEN MODIFIED TO TREAT THE 3574 03903018 * INCORRECT LENGRH AS A PERMENT ERROR BUT TO LET TH) 3574 03904018 * APPENDAGE HAVE THE LAST TRY AT CHECKING THE ERROR 3574 03905018 * OVER AND INDICATING THAT THERE IS NOT AN ERROR 3574 03906018 * CONDITION. 3574 03907018 * THIS IS DONE BY THE ERP BIT SETTINGS SWITCHES IN 3574 03908018 * THE IOB ERROR COUNT FIELD IN THE FIRST BYTE , THE 3574 03909018 * LAST TWO BITS AND THE IOB FLAGS 2 FIELD 3574 03910018 * THE MAIN ENTREST IS SO THAT THE APPENDAGE WILL 3574 03911018 * KNOW THAT THE ERP HAS CHECKED OVER THE ERROR 3574 03912018 * CONDITION SO WHEN THE APPENDAGE RETURNS TO IOS THE 3574 03913018 * ERROR RECOVERY IS OVER AND THE IOB MUST BE PLACED 3574 03914018 * BACK ON TO THE FREE LIST TO KEEP FROM BEING LOST OR 3574 03915018 * HAVING GAM IN THE WAIT STATE WAITING ON THE IOB. 3574 03916018 * 3574 03917018 * THE BIT SETTINGS AND THERE MEANING ARE 3574 03918018 * IOB ERROR COUNT FIELD IN HEX 3574 03919018 * 3574 03920018 * '00' NORMAL CHANNEL END NO ERROR 3574 03921018 * RECOVERY DONE 3574 03922018 * '03' PERMANENT ERROR FORUN BY ERP 3574 03923018 * IOB EXECPTION BIT WILL BE ON ALSO 3574 03924018 * '01' ERP HAS BEEN ENTERED SO IOB NUST BE 3574 03925018 * FREED 3574 03926018 * WITH IOB ECCEPTION BIT ON THERE COULD 3574 03927018 * BE AN ERROR CONDITOON 3574 03928018 * WITH IOB EXECPTION BIT OFF 3574 03929018 * ERROR RECOVERY SUCCESSFUL 3574 03930018 OHARTN TM IOBCOUNT(RIOB),ERPENTRY HAS ERP BEEN ENTERED 3574 03931018 BO OHAIOB YES GO FREE IOB 3574 03932018 BR RRETRN RETURN TO IOS 3574 03933018 * 03940000 FOUR DC F'4' 03960000 * 04020000 CNOP 0,8 04040000 END 04060000 ./ ADD SSI=05052789,NAME=IGG019OE,SOURCE=0 *TITLE 'GRAPHIC ATTENTION ROUTING ROUTINE' 00020000 *STATUS:CHANGE LEVEL 0 00040000 *FUNCTION:SECOND LEVEL GRAPHIC ATTENTION HANDLING MODULE. 00060000 * 1.DECODE ATTENTION TYPE. 00080000 * 2.PROVIDE MI DATA ON 2250 KEYBOARD(A/N OR PF)ATTENTIONS. 00100000 * 3.PROVIDE XY BEAN POSITION REGISTER READOUT ON LP ATTENTIONS. 00120000 * 4.PROVIDE BUFFER RESTART ON LP ATTENTION IF USER REQUESTS IT. 00140000 * 5.QUEUE DATA ON ATTENTION ROUTINE THAT IS: 00160000 * A.ACTIVE FOR THAT DEVICE.(ROUTINE MAY BE IN WAIT STATE.IF THE 00180000 * ROUTINE DESIRES A PARTICULAR ATTENTION IT WILL BE POSTED.) 00200000 * B.WILL BECOME ACTIVE SOONEST FOR THAT DEVICE IF:ALREADY HAS 00220000 * DATA ON ITS INTERNAL QUEUE WAITING TO BE DISPATCHED. 00240000 * C.DESIRES THE ATTENTION TYPE. 00260000 * D.IF THE ATTENTION IS UNABLE TO SATISFY A,B OR C IT IS 00280000 * DISCARDED. 00300000 * 6.SCHEDULE THIRD LEVEL GRAPHIC CONTROL PROGRAM. 00320000 *ENTRY POINT:SCHEDULED BY PRIMARY GRAPHIC CONTROL PROGRAM VIA AN 00340000 * IQE TO AEE STAGE II. 00360000 *INPUT:1.GR#0=IQE ADDRESS 00380000 * 2.GR#1=UCB ADDRESS AND STATUS BITS 32-39. 00400000 * 3.GR#S13,14,15 AS PER CONVENTIONS. 00420000 *OUTPUT:IQE TO AEE STAGE II TO SCHEDULE THIRD LEVEL CONTROL PROGRAM. 00440000 * IQE CONTAINS THE DATA THAT WILL BE PLACED IN USER COMAREA. 00460000 *EXTERNAL ROUTINES:ASYNCHRONOUS EXIT EFFECTOR(AEE)STAGE TWO AND IOS. 00480000 *EXIT:VIA RETURN MACRO 00500000 *TABLES/WORK AREAS:N/A 00520000 *ATTRIBUTES:1.SUPERVISOR STATE 00540000 * 2.PRIVILEDGED 00560000 * 3.RE-ENTRANT 00580000 * 4.OPERATES IN BOTH ENABLED AND DISABLED MODES. 00600000 *NOTES:N/A 00620000 EJECT 00630019 PAR0 EQU 0 PARAM REG 0 00640000 PAR1 EQU 1 PARAM REG 1 00660000 BASERG EQU 2 BASE REG 00680000 MAINREG EQU 3 REG FOR WORK AREA DSECT 00700000 RIQE EQU 4 IQE ADR REG 00720000 RUCB EQU 5 UCB ADR REG 00740000 REBRG EQU 6 REB ADR REG 00760000 R7 EQU 7 WORK REG 00780000 R8 EQU 8 WORK REG 00800000 R9 EQU 9 WORK REG 00820000 R10 EQU 10 WORK REG 00840000 R11 EQU 11 WORK REG 00860000 R12 EQU 12 WORK REG 00880000 SAVEREG EQU 13 SAVE AREA REG 00900000 R14 EQU 14 RTN REG 00920000 R15 EQU 15 RTN CODE REG 00940000 EJECT 00950019 * 00960000 * GACB CONSTRUCTION 00980000 * 01000000 COMAREA EQU 0 OFFSET TO COMAREA ADR 01020000 DCBADR EQU 4 OFFSET TO DCB ADR 01040000 PFKMSK EQU 8 OFFSET TO PFK MASK 01060000 ATNTYP EQU 15 OFFSET TO ATTENTION TYPE 01080000 EP1 EQU 16 OFFSET TO ENTRY POINT ONE ADR 01100000 EP2 EQU 20 OFFSET TO ENTRY POINT TWO ADR 01120000 SAVE13 EQU 24 REG 13 SAVE AREA FOR R MODE 01140000 PFKEY EQU 28 FUNCTION KEY SAVE AREA 01160000 SAVETYP EQU 32 ATTN TYPE SAVE AREA 01180000 ECB EQU 36 EVENT CONTROL BLOCK FOR MODE W 01200000 REBADR EQU 40 ROUTINE ENTRY BLOCK ADR 01220000 GACBRSVD EQU 44 RESERVED AREA 01240000 * 01260000 * COMAREA CONTRUCTION 01280000 * 01300000 COMRSVD1 EQU 0 RESERVED 01320000 COMOVCOD EQU 1 OVERLAY CODE 01340000 COMKEY EQU 2 PF KEY NUMBER 01360000 COMTYPE EQU 3 ATTENTION TYPE 01380000 SENSE EQU 4 SENSE AREA 01400000 COMMI EQU 4 MANUAL INPUT AREA 01420000 XYPOS EQU 8 XY POSITION REGISTERS 01440000 COMRSVD3 EQU 12 RESERVED 01460000 * 01480000 * COMAREA TYPE FIELD 01500000 * 01520000 ENDORANK EQU X'01' END OR A/N KEYBOARD ATTENTION 01540000 PFKB EQU X'02' PF KEYBOARD ATTENTION 01560000 LP EQU X'03' LIGHT PEN ATTENTION 01580000 EOS EQU X'04' END ORDER SEQUENCE ATTENTION 01600000 CANCEL EQU X'05' CANCEL KEY ATTENTION 01620000 AE EQU X'06' ASYNCHRONOUS ERROR ATTENTION 01640000 A2260 EQU X'07' 2260 ATTENTION 01660000 HEX82 EQU X'82' CSW STATUS BITS INDICATING A LIGHT 01663020 * PEN ATTENTION 01666020 EJECT 01670019 * 01680000 * GACB ATTNTYP FIELD 01700000 * 01720000 GENAN EQU X'01' END OR A/N KEYBOARD ATTENTION 01740000 GLP EQU X'02' LIGHT PEN ATTENTION 01760000 GEOS EQU X'04' END ORDER SEQUENCE ATTENTION 01780000 GCANCEL EQU X'08' CANCEL KEY ATTENTION 01800000 GAE EQU X'10' ASYNCHRONOUS ERROR ATTENTION 01820000 T2260 EQU X'20' 2260 KEYBOARD ATTENTION 01840000 * 01860000 * 01880000 ANKBD EQU X'80' A/N BIT 01900000 AT2260 EQU X'03' TYPE=2260 01920000 CANCELD EQU X'10' CANCEL KEY BIT 01940000 COMPLETE EQU X'7F' POST CODE 01960000 CVTADR EQU 16 CVT ADR 01980000 ENDD EQU X'20' END KEY BIT 02000000 EOSDET EQU X'40' END ORDER SEQUENCE BIT 02020000 FLAGS EQU X'40' TE PTR FLAG 02040000 GACBADR EQU 12 GACB ADR 02060000 IQELNK EQU 0 LINK FLD 02080000 IQEPAR EQU 4 PARAM FLD 02100000 IQEIRB EQU 8 IRD ADR FLD 02120000 IQETCB EQU 12 TCB ADR FLD 02140000 IQEDATA EQU 16 DATA FLD 02160000 LPDET EQU X'80' LIGHT PEN BIT 02180000 NEXAVL EQU 96 NEXT AVAILABLE IQE PTR 02200000 ONE EQU 1 ONE 02220000 PFKBD EQU X'40' PF BIT 02240000 RBIQE EQU 24 ADR OF FIRST INPUT IQE 02260000 RTNB EQU 4 HIGHER REB PTR 02280000 RTNF EQU 0 PTR TO NEXT REB 02300000 RTNFLG EQU 20 FLAG FLD 02320000 RTNGACB EQU 12 GACB ADR 02340000 RTNIRB EQU 16 IRB ADR 02360000 RTNQ1 EQU 24 EP=0 QUEUE FIELD 2575 02370014 RTNQ2 EQU 28 Q2 LIST PTR 02380000 REBTCB EQU 33 OFFSET TO TCB ADR IN REB 02400000 RTNUCB EQU 8 UCB PTR 02420000 STAGE2 EQU 4 STAGE 2 ADR 02440000 TEREB EQU 4 REB PTR 02460000 TETCB EQU 8 TE TCB ADR FLD 02480000 TWO EQU 2 TWO 02500000 TYPE4 EQU 19 UCB TYPE FLD 02520000 UCBSEN EQU 22 START OF UCB SENSE FIELD 02540000 UCBTE EQU 28 USER TE ADR 02560000 WAITST EQU X'80' WAIT BIT 02580000 ZERO EQU 0 ZERO 02600000 MULTI EQU X'20' INDICATES MULTIPLE 2260 02620000 NEXT EQU 4 CONSTANTS TO STEP ADR SEARCH 02640000 ALL EQU X'FF' ACCEPT ANY 2260 02660000 RSTRT EQU 45 GACB LP RESTART FLAG 02680000 RESTART EQU X'01' AUTO RESTART BIT IN GFLGS 02700000 TCBDEB EQU 8 DEB IN TCB RSTD 02701016 DEBDEB EQU 4 DEB CHAIN IN DEB RSTD 02702016 DEBDCB EQU 24 DCB IN DEB RSTD 02703016 DEBUCB EQU 32 UCB IN DEB RSTD 02704016 CAN EQU 12 CANCEL KEY RTN ADDR/SW RSTD 02705016 T2250 EQU X'02' 2250 BIT IN UCB TYPE FIELD RSTD 02706016 GCB EQU 27 RSTD 02707016 GJPBIT EQU X'80' RSTD 02708016 WODMP EQU X'00' RSTD 02709016 RTNCD EQU X'40' RSTD 02710016 ABND EQU X'80' RSTD 02711016 ATTNERR EQU X'41' F40815 02711500 FOUR EQU 4 02712019 FIVE EQU 5 02713019 SIX EQU 6 02714019 ECBLN EQU 32 02714519 SIXTN EQU 16 02715019 INDGAR EQU X'04' 02716019 REBUCB EQU 8 UCB ADDR 02717019 DQCKQE EQU X'02' DEQUEUE CKQE 02718019 EIGHT EQU 8 DISPLACEMENT 02718619 EJECT 02719219 IGG019OE CSECT 02720000 *A51700 JLM A54244 02727021 *1708,065600-066000,084800,088000,089000-0892000 0803 02735017 *1190,084700 PTM 2173 02737018 * 087404 A27773 02738019 *A16630-16660,A29710-30510,A65490-65510,A92810-92900 A34795 02738400 *C88000 A34795 02738800 *D29695-30400 A34795 02739200 *C91900,C92100-92300 A35022 02739600 *A29400 A35022 02739700 *A27115,A61060-61120,A64260-64320,A64630-64750,A75500,A89660 LI F40815 02739800 *C48000-48400,C52000,C61060,C64260 LI A42794 02739900 SAVE (14,12) 02740000 BALR BASERG,PAR0 SET UP BASE REG 02760000 USING *,BASERG DEFINE BASE REG 02780000 USING WORKAREA,MAINREG DEFINE CSECT REG 02800000 LR RIQE,PAR0 SAVE PARAMETER 02820000 LR RUCB,PAR1 SAVE PARAMETER 02840000 L PAR0,REQUEST LOAD BYTE REQUEST 02860000 GETMAIN R,LV=(0) 02880000 ST PAR1,EIGHT(SAVEREG) BACK CHAIN SAVE AREAS 02890019 LR MAINREG,PAR1 LOAD DSECT REG 02900000 XC RSVD(120),RSVD CLEAR CORE 02920000 ST SAVEREG,CHAIN CHAIN SAVE AREA 02940000 LA SAVEREG,SAVE ESTABLISH NEW SAVE AREA 02960000 L R11,UCBTE(ZERO,RUCB) LOAD TE ADDRESS FROM UCB 02960519 L R10,CAN(R11) LOAD CKQE POINTER 02961019 DEQLOOP LA R10,ZERO(R10) CLEAR HIGH ORDER BYTE 02961519 LTR R10,R10 CKQE POINTER ZERO 02962019 BZ GASBACK YES TEST FOR ABEND 02962519 USING CKQE,R10 BASE REG FOR CKQE DSECT 02963019 TM CKQEFLGA,CKQEDEQ SHOULD CKQE BE DEQUEUED 02963519 BZ CKCHECK NO 02964019 * YES REBUILD CHAIN 02964519 SSM DISABLE DISABLE INTERRUPTS 02965019 L R12,CKQENEXT GET NEXT CKQE ADDRESS 02965519 ST R12,CAN(R11) STORE NEW CKQE ADDRESS IN TE 02966019 LR PAR1,R10 LOAD CKQE ADDRESS FOR FREEMAIN 02967019 L PAR0,CKQECORE LOAD SUBPOOL AND BYTE REQUEST 02967519 FREEMAIN R,LV=(0),A=(1) FREE CKQE 02968019 LR R10,R12 PUT NEW CKQE PTR IN REG 10 AND 02968519 B DEQLOOP TEST FOR DEQUEUE NECESSARY 02969019 CKCHECK ST RUCB,IOSTAT SAVE IO STATUS CAN 02971020 LA RUCB,ZERO(RUCB) CLEAR HIGH ORDER BYTE CAN01 02973020 LH R12,CKQEUCB GET UCB ADDR FROM CKQE 02975020 CR RUCB,R12 COMPARE UCB ADDRS 02977020 BE CHKATTN MATCH FOUND-CAN KEY IN CONTROL 02979020 L R10,ZERO(R10) GET NEXT CKQE 02981020 B DEQLOOP CHECK FOR MORE CKQE'S 02983020 CHKATTN TM CKQEFLGA,CKQEATTN IS ATTN EXPECTED FROM 2250 02985020 BZ GASNEXT NO 02987020 TM IOSTAT,HEX82 IS IT A LIGHT PEN ATTENTION CAN01 02989020 BNO GASRMI BRANCH TO UNLOCK KYBD "AN01 02991020 L PAR1,UCBTE(RUCB) GET TEB ADDRESS CAN01 02993020 MVC SENSED(FOUR),UCBSEN(RUCB) MOVE SENSE DATA TO WORKAREA 02995020 TM SENSED+ONE,LPDET TEST FOR LIGHT PEN DETECT 02997020 BZ GASRMI NOT LP - FREE KEYBOARD 02999020 OI FIVE(R10),INDGAR IND ENTRY FROM GAR W/LP ATTN 03001020 B GAS60 PLACE CKQE ON TEB CKQE LIST 03003020 GASRMI L REBRG,TEREB(PAR1) LOAD REB ADDRESS 03005020 REBLOOPA LA REBRG,ZERO(REBRG) CLEAR HIGH ORDER BYTE 03007020 LTR REBRG,REBRG DOES REB EXIST 03009020 BNZ REBGOOD BRANCH IF REB ADDR IS GOOD 03011020 L R8,CKQEDCB GET DCB ADDRESS 03013020 B NOREBRMI BRANCH IF REB IS NOT FOUND 03015020 DROP R10 03017020 REBGOOD L R10,REBUCB(REBRG) GET UCB FROM REB 03019020 CR R10,R12 RIGHT REB 03021020 BE DCBRMI YES 03023020 L REBRG,ZERO(REBRG) NO TRY ANOTHER 03025020 B REBLOOPA REB 03027020 DCBRMI L R8,GACBADR(REBRG) GET GACB ADDRESS 03029020 L R8,DCBADR(R8) GET DCB ADDRESS 03031020 LA R8,ZERO(R8) CLEAR HIGH ORDER BYTE 03033020 NOREBRMI XC IOREQ(ECBLN),IOREQ CLEAR ECB 03035020 LA PAR1,IOREQ LOAD DECB ADDRESS 03037020 LA R9,MI INPUT AREA ADDRESS 03039020 BAL R7,COMNREAD GO EXECUTE GREADR FOR RMI 03041020 B GASHSKP 03043020 GASBACK L R11,UCBTE(0,RUCB) LOAD TE ADR FROM UCB 03045020 L REBRG,TEREB(0,R11) LOAD PTR TO FIRST REB 03047020 LR R10,RUCB PARAM TO WORK REG(UCB ADR) 03049020 LA R10,0(0,R10) ZERO HI ORDER BYTE 03051020 GAS02 LTR REBRG,REBRG PTR 0 03060000 BC 8,GASCHAIN BRANCH IF YES RSTD 03080016 TM RTNFLG(REBRG),MULTI REB POINT TO A LIST OF 03100000 * UCB ADRS 03120000 BC 14,GAS24 BRANCH IF NO 03140000 SR R15,R15 CLEAR REG 03160000 IC R15,RTNFLG+1(REBRG) LOAD NO OF UCB ADRS 03180000 L R14,RTNUCB(REBRG) LOAD PTR TO LIST 03200000 GAS25 L R12,ZERO(0,R14) LOAD UCB ADR 03220000 LA R12,ZERO(0,R12) ZERO HI ORDER BYTE 03240000 CLR R10,R12 UCB ADRS EQUAL 03260000 BC 8,GAS01 BRANCH IF YES 03280000 LA R14,NEXT(0,R14) UPDATE PTR 03300000 BCT R15,GAS25 BRANCH IF MORE UCB ADRS 03320000 B GAS05 BRANCH 03340000 GAS24 L R12,RTNUCB(0,REBRG) LOAD REB UCB ADR 03360000 CLR R10,R12 ADDRESSES COMPARE 03380000 BC 8,GAS01 BRANCH IF YES 03400000 GAS05 L REBRG,RTNF(0,REBRG) LOAD PTR TO NEXT REB 03420000 B GAS02 03440000 GAS01 L R12,CODETYP LOAD MASK 03460000 NR R12,RUCB LOAD R12 WITH ATN TYPE 03480000 LTR R12,R12 TEST FOR KYBD ATTN 03500000 BC 8,GAS03 BRANCH IF KYBD ATTN 03520000 MVC SENSED(4),UCBSEN(RUCB) SENSE DATA TO WORK AREA 03540000 TM SENSED+1,LPDET TEST FOR LIGHT PEN 03560000 BC 14,GAS04 BRANCH IF NOT LP 03580000 LA R10,LP LOAD LP CODE 03600000 L R8,GACBADR(0,REBRG) LOAD GACB ADR 03620000 L R8,DCBADR(0,R8) LOAD DCB ADR 03640000 LA R8,ZERO(0,R8) ZERO HI ORDER BYTE 03660000 LTR R8,R8 DCB ADR=0 03680000 BC 8,GAS05 BRANCH IF YES 03700000 XC IOREQ(32),IOREQ CLEAR ECB AHD6 03710018 LA PAR1,IOREQ LOAD DECB ADR 03720000 LA R9,XYP LOAD XYP ADR 03740000 GREADR (1),XYP,(8),(9),MF=E 03760000 BAL R7,COMNWAIT TEST FOR GOOD I/O AND WAIT 03780019 B TRANSLAT BRANCH 03800000 GAS04 TM SENSED+1,EOSDET TEST FOR END ORDER SEQUENCE 03820000 BC 14,GAS06 BRANCH IF NOT EOS 03840000 LA R10,EOS LOAD EOS CODE 03860000 B TRANSLAT BRANCH 03880000 GAS06 LA R10,AE LOAD AE CODE 03900000 B TRANSLAT BRANCH 03920000 GAS03 CLI TYPE4(RUCB),AT2260 IS THIS A 2260 03940000 BC 7,GAS08 BRANCH IF NO 03960000 LA R10,A2260 LOAD 2260 CODE 03980000 B TRANSLAT BRANCH 04000000 GAS08 L R8,GACBADR(0,REBRG) LOAD GACB ADR 04020000 L R8,DCBADR(0,R8) LOAD DCB ADR 04040000 LA R8,ZERO(0,R8) ZERO HI ORDER BYTE 04060000 LTR R8,R8 DCB ADR=0 04080000 BC 8,GAS05 BRANCH IF YES TO TRY FOR 04100000 * ANOTHER UCB ADR MATCH 04120000 XC IOREQ(32),IOREQ CLEAR ECB AHD6 04130018 LA PAR1,IOREQ LOAD DECB ADR 04140000 LA R9,MI LOAD INPUT AREA ADR 04160000 BAL R7,COMNREAD GO EXECUTE GREADR FOR RMI 04190019 TM MI,PFKBD TEST FOR PF KYBD ATTN 04220000 BC 1,GASPF BRANCH IF YES 04240000 GAS10 TM MI,CANCELD TEST FOR CANCEL KEY 04260000 BC 14,GAS22 BRANCH IF NOT 04280000 TM GCB(RUCB),GJPBIT GJP IN AND ACTIVE RSTD 04290016 BC 8,GAS132 NO SYSTEM GETS CANCEL RSTD 04300016 LA R10,CANCEL ROUTE CANCEL TO GJP RSTD 04310016 B TRANSLAT RSTD 04320016 GAS22 TM MI,ANKBD+ENDD TEST FOR AN OR END KEY ATTENTIOM 04340000 BC 10,GASNEXT BRANCH IF NOT A/N OR END 04360000 LA R10,ENDORANK LOAD END OR A/N CODE 04380000 TRANSLAT STC R10,TYPE PUT TYPE IN DATA AREA 04400000 LA R7,ONE LOAD TYPE MASK 04420000 LA R8,ZERO ZERO PF MASK 04440000 CLI TYPE,ENDORANK TEST FOR END OR A/N 04460000 BC 8,SEARCH 04480000 LA R9,TWO LOAD CONSTANT 04500000 SR R10,R9 DETERMINE SHIFT COUNT 04520000 SLL R7,ZERO(R10) DETERMINE SEARCH ARGUMENT 04540000 B SEARCH BRANCH 04560000 GASPF MVC KEY(1),MI+1 KEY NUMBER TO WORH AREA 04580000 MVC OV(1),MI+2 OVERLAY COSE TO WORK AREA 04600000 MVI TYPE,X'02' PF CODE TO TYPE FIELD 04620000 SR R10,R10 CLEAR REG 04640000 IC R10,KEY INSERT KEY NUMBER 04660000 LA R7,ZERO ZERO TYPE REG 04680000 L R8,PFKCODE LOAD PF MASK 04700000 SRL R8,ZERO(R10) DETERMINE PF SEARCH ARGUMENT 04720000 SEARCH L REBRG,UCBTE(0,RUCB) LOAD TE ADR FROM UCB 04740000 L REBRG,TEREB(0,REBRG) LOAD PTR TO FIRST REB 04760000 LA RUCB,ZERO(0,RUCB) ZERO HIGH ORDER BYTE 04780000 GAS28 SR R15,R15 CLEAR REG LI A42794 04800000 TM RTNFLG(REBRG),MULTI REB POINT TO MULTI UCBS LI A42794 04820000 BC 14,GAS12 BRANCH IF NO LI A42794 04840000 IC R15,RTNFLG+1(REBRG) LOAD # OF UCB ADRS 04860000 L R14,RTNUCB(0,REBRG) LOAD PTR 04880000 GAS27 L R9,ZERO(0,R14) LOAD UCB ADR 04900000 LA R9,ZERO(0,R9) ZERO HI ORDER BYTE 04920000 CLR R9,RUCB UCB ADRS COMPARE 04940000 BC 8,GAS26 BRANCH IF YES 04960000 LA R14,NEXT(0,R14) LOAD PTR TO NEXT UCB ADR 04980000 BCT R15,GAS27 BRANCH IF MORE 05000000 B GAS13 BRANCH 05020000 GAS26 SR R14,R14 CLEAR REG 05040000 IC R14,RTNFLG+1(REBRG) INSERT # OF EXTENTS 05060000 LA R14,ONE(0,R14) INCREMENT COUNT BY ONE 05080000 SR R14,R15 DETERMINE OFFSET TO UCB ADR 05100000 STC R14,RSVD 2260 OFFSET TO DATA AREA 05120000 B GAS11 BRANCH 05140000 GAS12 L R9,RTNUCB(0,REBRG) LOAD UCB ADR 05160000 LA R15,ONE(R15) INCR. INDEX JLM A54244 05170021 CLR R9,RUCB ADRS COMPARE 05180000 BC 8,GAS26 BRANCH IF YES LI A42794 05200000 GAS13 L REBRG,RTNF(0,REBRG) LOAD NEXT REB PTR 05220000 LTR REBRG,REBRG PTR = 0 05240000 BC 7,GAS28 BRANCH IF PTR NOT 0 05260000 L REBRG,UCBTE(0,RUCB) LOAD TE ADR 05280000 L REBRG,TEREB(0,REBRG) LOAD PTR TO FIRST REB 05300000 LA RUCB,0(0,RUCB) ZERO HI ORDER BYTE 05320000 GAS56 TM RTNFLG(REBRG),MULTI REB POINT TO LIST OF UCB ADRS 05340000 BC 14,GAS53 BRANCH IF NO 05360000 SR R9,R9 CLEAR REG 05380000 IC R9,RTNFLG+1(REBRG) LOAD # OF UCB ADRS 05400000 L R11,RTNUCB(REBRG) LOAD PTR TO LIST 05420000 GAS55 L R12,ZERO(0,R11) LOAD UCB ADR 05440000 LA R12,ZERO(0,R12) ZERO HI ORDER BYTE 05460000 CLR RUCB,R12 UCB ADRS COMPARE 05480000 BC 7,GAS54 BRANCH IF NO 05500000 LA R12,GASNEXT LOAD RETURN ADR 05520000 CLI TYPE,LP IS THIS A LP ATTN 05540000 BCR 7,R12 BRANCH IF NO 05560000 L R9,RTNGACB(0,REBRG) LOAD GACB ADRESS 05580000 B LPSTART1 BRANCH 05600000 GAS54 LA R11,4(0,R11) INCREMENT PTR 05620000 BCT R9,GAS55 BRANCH IF MORE UCBS 05640000 GAS57 L REBRG,RTNF(0,REBRG) LOAD NEXT REB PTR 05660000 LA REBRG,ZERO(0,REBRG) ZERO HI ORDER BYTE 05680000 LTR REBRG,REBRG PTR=0 05700000 BC 8,GASNEXT BRANCH IF YES 05720000 B GAS56 BRANCH 05740000 GAS53 L R12,RTNUCB(0,REBRG) LOAD UCB ADR 05760000 LA R12,ZERO(0,R12) ZERO HI ORDER BYTE 05780000 CLR R12,RUCB UCB ADRS COMPARE 05800000 BC 7,GAS57 BRANCH IF NO 05820000 LA R12,GASNEXT LOAD RETURN ADR 05840000 CLI TYPE,LP IS THIS A LP ATTN 05860000 BCR 7,R12 BRANCH IF NO 05880000 L R9,RTNGACB(0,REBRG) LOAD GACB ADRESS 05900000 B LPSTART1 BRANCH 05920000 GAS11 L R10,RTNIRB(0,REBRG) LOAD IRB ADR 05940000 L R9,RBIQE(0,R10) LOAD RB IQE PTR 05960000 LA R9,ZERO(0,R9) ZERO HI ORDER BYTE 05980000 LTR R9,R9 PTR=0 06000000 BC 7,GAS14 BRANCH IF NOT 0 06020000 L R9,RTNGACB(0,REBRG) LOAD GACB ADR 06040000 LA R9,ZERO(0,R9) ZERO HIGH ORDER BYTE 06060000 LTR R9,R9 GACB ADR=0 06080000 BC 8,GAS58 BRANCH IF YES 06100000 CLC ECB(FOUR,R9),INIT WAS ECB INITALIZED LI A42794 06106000 BE POSTERR YES, BRANCH F40815 06112000 TM ECB(R9),X'80' ECB=WAIT 06120000 BC 1,GAS16 BRANCH IF YES 06140000 GAS58 L R9,RTNQ2(0,REBRG) LOAD QZ PTR 06160000 LTR R9,R9 PTR=0 06180000 BC 7,GAS15 BRANCH IF NO 06200000 L R9,RTNGACB(0,REBRG) LOAD GACB ADR 06220000 L R11,PFKMSK(0,R9) LOAD PFKMSK MASK FROM GACB 06240000 L R12,PFKMSK+4(0,R9) LOAD ATTNTYP MASK FROM GACB 06260000 NR R12,R7 DETERMINE IF MATCH 06280000 NR R11,R8 DETERMINE IF MATCH 06300000 LTR R12,R12 REG=0 06320000 BC 7,GAS15 NOT 0-ATTN TYP MATCH 06340000 LTR R11,R11 REG=0 06360000 BC 7,GAS15 NOT 0-PF KEY MATCH 06380000 B GAS13 BRANCH 06400000 GAS14 L R9,RTNGACB(0,REBRG) LOAD GACB ADR 06420000 CLC ECB(FOUR,R9),INIT WAS ECB INITALIZED LI A42794 06426000 BE POSTERR YES, BRANCH F40815 06432000 TM ECB(R9),WAITST ROUTINE IN WAIT STATE 06440000 BC 1,GAS16 BRANCH IF YES 06460000 B GAS15 NO, BRANCH TO LP RESTART F40815 06463000 POSTERR LA PAR0,ATTNERR LOAD ERR CODE F40815 06466000 SLL PAR0,24 SHIFT TO HIGH ORDER BYTE F40815 06469000 LA PAR1,ECB(R9) LOAD ECB ADDR F40815 06472000 POST (1),(0) POST ECB WITH ERROR F40815 06475000 GAS15 BAL R12,LPSTART BRANCH TO LP RESTART CYCLE 06480000 GAS15A L R9,NEXAVL(0,R10) LOAD NEXT AVAIL IQE FLD 06500000 LTR R9,R9 PTR=0 06520000 BC 7,GAS17 BRANCH IF NO 06540000 LA R9,GMAINADR SET UP RE-ENTRANT ADR LOC 0803 06547017 LA PAR1,GMAINLST POINT TO LIST A34795 06549020 GETMAIN EC,LV=32,A=(9),SP=254,MF=(E,(1)) A34795 06551020 LTR R15,R15 IS CORE AVAILABLE 0803 06561017 BZ GAS15B IF YES, CONTINUE PROCESSING 0803 06568017 BNZ GASHSKP 06588019 GAS15B L R9,GMAINADR CLEAR IQE 0803 06610017 XC ZERO(32,R9),ZERO(R9) CLEAR CORE 06620000 ST R10,IQEIRB(0,R9) IRB ADR TO IQE 06640000 L PAR1,UCBTE(0,RUCB) LOAD TE ADR 06660000 MVC IQETCB+1(3,R9),REBTCB(REBRG) SPAR TCB ADR TO IQE 06680000 GAS17 MVC NEXAVL(4,R10),IQELNK(R9) LINK ADR TO IRB NEXAVL FLD 06700000 L R11,RTNGACB(0,REBRG) LOAD GACB ADR 06720000 ST R11,IQEPAR(R9) GACB ADR TO IQE 06740000 MVC IQEDATA(12,R9),RSVD DATA TO IQE 06760000 * 06780000 *DISABLE 06800000 MVC IQELNK(4,R9),RTNQ2(REBRG) QZ PTR TO IQE LNK FIELD 06820000 ST R9,RTNQ2(REBRG) IQE ADR TO Q2 PTR FLD 06840000 GASNEXT SSM DISABLE DISABLE 06860000 L R10,IQELNK(0,RIQE) LOAD GAS IQE LINK FLD 06880000 LTR R10,R10 PTR=0 06900000 BC 8,GAS18 BRANCH IF YES 06920000 L R11,IQEIRB(0,R10) LOAD GAS IRB PTR 06940000 ST R10,RBIQE(R11) STORE PTR IN RB IQE FLD 06960000 MVC IQELNK(4,RIQE),NEXAVL(R11) 06980000 ST RIQE,NEXAVL(R11) IQE ADR TO NEXAVL FLD 07000000 LR RIQE,R10 DUMMY REG 07020000 L RUCB,IQEPAR(0,RIQE) DUMMY REG 07040000 XC RSVD(40),RSVD CLEAR WORKAREA 07060000 SSM ENABLE ENABLE 07080000 B GASBACK BRANCH 07100000 GAS16 L R12,RTNGACB(0,REBRG) LOAD GACB ADR 07120000 L R11,PFKMSK(0,R12) LOAD PFKMSK 07140000 L R14,PFKMSK+4(0,R12) LOAD ATTNTYP MASK 07160000 NR R11,R8 DETERMINE IF MATCH 07180000 NR R14,R7 DETERMINE IF MATCH 07200000 LTR R11,R11 REG=0 07220000 BC 7,GAS19 BRANCH NOT 0-HAD A MATCH 07240000 LTR R14,R14 REG=0 07260000 BZ GAS15 07290019 GAS19 BAL R12,LPSTART BRANCH TO LP RESTART CYCLE 07320000 L R12,RTNGACB(0,REBRG) LOAD GACB ADR 07340000 CLI TYPE,A2260 IS THIS A 2260 ATTN 07360000 BC 7,GAS19A BRANCH IF NOT 2260 07380000 CLI GACBRSVD(R12),ALL ACCEPT ANY 2260 ATN 07400000 BC 8,GAS19A BRANCH IF YES 07420000 CLC GACBRSVD(1,R12),RSVD IS THIS THE 2260 RTN WAITING FOR 07440000 BNZ GAS15A NO 07470019 GAS19A L R11,COMAREA(0,R12) LOAD COMAREA ADR 07500000 MVC ZERO(12,R11),RSVD DATA TO COMAREA 07520000 LA PAR0,COMPLETE LOAD POST CODE 07540000 SLL PAR0,24 SHIFT TO HIGH ORDER BYTE F40815 07550000 LA PAR1,ECB(0,R12) LOAD ECB ADR 07560000 POST (1),(0) 07580000 B GASNEXT BRANCH 07600000 GAS18 L REBRG,UCBTE(0,RUCB) LOAD TE ADDRESS 07680019 L REBRG,TEREB(0,REBRG) LOAD PTR TO FIRST REB 07760000 LA REBRG,0(0,REBRG) ZERO HI ORDER BYTE 07780000 LTR REBRG,REBRG 07800000 BC 8,GASHSKP BRANCH IF YES 07820000 GAS23 L R7,RTNF(0,REBRG) LOAD PTR TO NEXT REB 07840000 LTR R7,R7 REG 0 07860000 BC 8,GAS20 BRANCH IF YES 07880000 LR REBRG,R7 SAVE ADR 07900000 B GAS23 BRANCH 07920000 * REBR6 CONTAINS ADR OF LOWEST PRIORITY REB 2575 07927014 * R7,R8 AND PAR1 REGS AVAILABLE AS WORK REGS 2575 07934014 GAS20 SSM DISABLE DISABLE INTERRUPTS 2575 07941014 GAS103 L R7,RTNGACB(REBRG) LOAD GACB ADR FROM REB 2575 07948014 CLC ZERO1(4),EP1(R7) ENTRY POINT=0 2575 07955014 BE GAS100 BRANCH-EP=0 2575 07962014 GAS110 CLC ZERO1(4),RTNQ1(REBRG) ANY IQES ON Q1 FIELD 2575 07969014 BNE GAS101 BRANCH-Q1 HAS IQES 2575 07976014 GAS104 CLC ZERO1(4),RTNQ2(REBRG) ANY IQES ON Q2 FIELD 2575 07983014 BNE GAS102 BRANCH-Q2 HAS IQES 2575 07990014 GAS113 TM RTNFLG(REBRG),FLAGS REB POINT TO A TE 2575 07997014 BO GASHSKP BRANCH-REB POINTS TO A TE 2575 08004014 L REBRG,RTNB(REBRG) LOAD NEXT REB POINTER 2575 08011014 B GAS103 BRANCH TO CHECK NEXT REB 2575 08018014 GAS102 L R7,RTNQ2(REBRG) LOAD IQE ADR 2575 08025014 MVC RTNQ2(4,REBRG),IQELNK(R7) UPDATE CHAIN 2575 08032014 LNR PAR1,R7 COMPLEMENT IQE ADR TO PARAM 2575 08039014 L R15,CVTADR GET CVT TABLE ADR 2575 08046014 L R15,STAGE2(R15) GET ADR OF AEE STAGE 2 2575 08053014 BALR R14,R15 LINK TO AEE STAGE 2 2575 08060014 B GAS104 BRANCH TO TEST FOR MORE IQE 2575 08067014 GAS101 L PAR1,RTNQ1(REBRG) LOAD ADR OF FIR0T IQE 2575 08074014 SR R7,R7 ZERO PREVIOUS IQE REG 2575 08081014 GAS106 CLC IQELNK(4,PAR1),ZERO1 LAST IQE ON CHAIN 2575 08088014 BE GAS105 BRANCH-LAST IQE ON CHAIN 2575 08095014 LR R7,PAR1 SAVE ADR THIS IQE 2575 08102014 L PAR1,IQELNK(PAR1) LOAD NEXT IQE ADR ONCHAIN 2575 08109014 B GAS106 BRANCH TO TEST FOR END OF C 2575 08116014 GAS105 LTR R7,R7 PREVIOUS IQE REG = 0 2575 08123014 BC 8,GAS107 BRANCH-YES 2575 08130014 MVC IQELNK(4,R7),IQELNK(PAR1) REMOVE IQE FROM END OF 01 2575 08137014 B GAS108 BRANCH 2575 08144014 GAS107 MVC RTNQ1(4,REBRG),IQELNK(PAR1) UPDATE 01 CHAIN 2575 08151014 GAS108 XC IQELNK(4,PAR1),IQELNK(PAR1) ZERO IQE LINK FIELD 2575 08158014 CLC ZERO1(4),RTNQ2(REBRG) 02 FIE TO ZERO 2575 08165014 BNE GAS109 BRANCH-02 NOT ZERO 2575 08172014 ST PAR1,RTNQ2(REBRG) ADD IQE TO Q2 FIELD 2575 08179014 B GAS110 BRANCH TO TEST 01 FIELD 2575 08186014 GAS109 L R7,RTNQ2(REBRG) LOAD 1ST IQE ADR 2575 08193014 GAS112 CLC ZERO1(4),IQELNK(R7) LAST IQE ON CHAIN 2575 08200014 BE GAS111 BRANCH-LAST IQE ON CHAIN 2575 08207014 L R7,IQELNK(R7) LOAD ADR OF NEXT IQE 2575 08214014 B GAS112 BRANCH TO FIND END OF Q2 CH 2575 08221014 GAS111 ST PAR1,IQELNK(R7) ADD IQE TO END OF CHAIN 2575 08228014 B GAS110 BRANCH TO TEST Q1 FIELD 2575 08235014 GAS100 CLC ZERO1(4),RTNQ2(REBRG) ANU IQES ON Q2 FIELD 2575 08242014 BE GAS113 BRANCH-NO IQES ON Q2 FIELD 2575 08249014 L PAR1,RTNQ2(REBRG) LOAD ADR OF FIRST IQE 2575 08256014 SR R7,R7 ZERO PREVIOUS IQE REG 2575 08263014 GAS114 CLC ZERO1(4),IQELNK(PAR1) LAST IQE ON CHAIN 2575 08270014 BE GAS115 BRANCH LAST IQE ON CH 2575 08277014 LR R7,PAR1 SAVE ADR THIS IQE 2575 08284014 L PAR1,IQELNK(PAR1) LOAD NEXT IQE ADR ON CHAIN 2575 08291014 B GAS114 BRANCH TO TEST FOR END OF 2575 08298014 GAS115 LTR R7,R7 PREVIOUS IQE REG= 0 2575 08305014 BC 8,GAS116 BRANCH-YES 2575 08312014 MVC IQELNK(4,R7),IQELNK(PAR1) REMOVE IQE FROM END OF Q 2575 08319014 B GAS117 BRANCH 2575 08326014 GAS116 MVC RTNQ2(4,REBRG),IQELNK(PAR1) UPDATE Q2 CHAIN 2575 08333014 GAS117 XC IQELNK(4,PAR1),IQELNK(PAR1) ZERO IQE LINK FIELD 2575 08340014 CLC ZERO1(4),RTNQ1(REBRG) Q1 FIELD ZERO 2575 08347014 BNE GAS118 BRANCH-Q1 NOT ZERO 2575 08354014 ST PAR1,RTNQ1(REBRG) ADD IQE TO Q1 FIELD 2575 08361014 B GAS100 BRANCH TO TEST 02 FIELD 2575 08368014 GAS118 L R7,RTNQ1(REBRG) LOAD 1SR IQE ADR 2575 08375014 GAS119 CLC ZERO1(4),IQELNK(R7) LAST IQE ON CHAIN 2575 08382014 BE GAS120 BRANCH LAST IQE ON CHAI 2575 08389014 L R7,IQELNK(R7) LOAD ADR OF NEXT IQE 2575 08396014 B GAS119 BRANCH TO FIND END OF CHA 2575 08403014 GAS120 ST PAR1,IQELNK(R7) ADD IQE TO END OF CHAIN 2575 08410014 B GAS100 BRANCH 2575 08417014 GASHSKP L SAVEREG,CHAIN RESTORE SAVE AREA POINTER 08427019 LR PAR1,MAINREG LOAD ADDRESS TO FREE 08437019 L PAR0,REQUEST LOAD BYTE COUNT 08447019 FREEMAIN R,LV=(0),A=(1) FREE SAVE AREA 08457019 GASHSKP1 RETURN (14,12) RSTD 08512016 EJECT 08516019 LPSTART CLI TYPE,LP IS THIS A LP ATTN 08520000 BCR 7,R12 BRANCH IF NOT LP 08540000 L R9,RTNGACB(0,REBRG) LOAD GACB ADR 08560000 TM RSTRT(R9),RESTART AUTO RESTART REQUESTED 08580000 BCR 14,R12 BRANCH IF NO 08600000 LPSTART1 L R11,DCBADR(0,R9) LOAD DCB ADDRESS 08620000 LA R9,SENSED+TWO LOAD RESTART ADR 08640000 XC IOREQ(32),IOREQ CLEAR DECB 08660000 LA PAR1,IOREQ LOAD DECB ADR 08680000 GCNTRL (1),STR,(11),(9),MF=E 08700000 WAIT ECB=(1) 08720000 CLI IOREQ,COMPLETE I/O COMPLETED AHD6 08726018 BNE GAS06 BRANCH IF NO AHD6 08732018 BR R12 08740000 GASCHAIN CLI TYPE4(RUCB),T2250 IS THIS A 2250 A27773 08740419 BNE GASNEXT NO 08740819 TM GCB(RUCB),GJPBIT TEST GJP NO SPAR RSTD 08741216 BO GASNEXT RSTD 08741616 L R12,CODETYP LOAD MASK RSTD 08742016 NR R12,RUCB RSTD 08742416 LTR R12,R12 RSTD 08742816 BC 7,GASNEXT IS THIS A KEYBOARD ATTN RSTD 08743216 L REBRG,TETCB(R11) LOAD TCB ADDR FIELD RSTD 08743616 L REBRG,TCBDEB(REBRG) LOAD DEB QUEUE RSTD 08744016 GAS130 LTR REBRG,REBRG ANOTHER DEB RSTD 08744416 BZ GASNEXT NO- IGNORE ATTN RSTD 08744816 L R15,DEBUCB(REBRG) LOAD UCB RSTD 08745216 LA R15,0(R15) ZERO HI ORDER BYTE RSTD 08745616 CR R10,R15 SAME UCB RSTD 08746016 BE GAS131 YES RSTD 08746416 L REBRG,DEBDEB(REBRG) LOAD NEXT DECB RSTD 08746816 LA REBRG,0(REBRG) ZERO HI ORDER BYTE RSTD 08747216 B GAS130 CONTINUE SEARCH RSTD 08747616 GAS131 L R8,DEBDCB(REBRG) 08748016 LA R8,0(R8) ZERO HI ORDER BYTE RSTD 08748416 XC IOREQ(32),IOREQ CLEAR ECB AHD6 08748618 LA PAR1,IOREQ LOAD DECB ADDR RSTD 08748816 LA R9,MI INPUT AREA ADDR RSTD 08749216 BAL R7,COMNREAD GO TO EXECUTE GREADR 08749419 TM MI,CANCELD TEST FOR CANCEL KEY RSTD 08749619 BC 14,GASNEXT NO RETURN RSTD 08749819 GAS132 L PAR0,CKQECORE LOAD REQUEST FOR GETMAIN 08750019 GETMAIN R,LV=(0) GET CORE FOR CKQE 08750219 LR R10,PAR1 LOAD ADDR OF CORE FOR CKQE 08750419 XC ZERO(SIXTN,R10),ZERO(R10) ZERO CKQE 08750619 STH RUCB,SIX(R10) PUT UCB PTR IN CKQE 08750819 SSM DISABLE 08751019 L PAR1,UCBTE(RUCB) LOAD TE ADDRESS 08751219 ST R8,CAN(R10) STORE DCB ADDR IN CKQE 08751419 MVC ZERO(FOUR,R10),CAN(PAR1) ADD NEW CKQE TO TOP OF 08751619 ST R10,CAN(PAR1) TE CKQE LIST 08751819 GAS60 L R9,ZERO(PAR1) LOAD CANCEL KEY IRB ADDR 08752019 L R7,NEXAVL(R9) GET NEXT AVAILABLE CKIQE 08752219 LA R7,ZERO(R7) CLEAR HIGH ORDER BYTE 08752419 LTR R7,R7 CKIQE AVAILABLE 08752619 BNE UPDATE 08752819 OI FOUR(R10),DQCKQE CKQE NO LONGER NEEDED 08753019 B GASHSKP 08753219 UPDATE MVC NEXAVL(FOUR,R9),ZERO(R7) UPDATE NEXT AVAIL CKIQE PTR 08753519 ST R10,FOUR(R7) PUT CKQE PTR IN CKIQE 08753819 LNR PAR1,R7 COMPLEMENT IQE ADDR TO PARM LIST 08754119 L R15,CVTADR GET CVT TABLE ADDRESS 08754519 L R15,STAGE2(R15) GET ADDR OF AEE STAGE 2 08754619 BALR R14,R15 LINK TO AEE STAGE 2 08754719 B GASNEXT 08754819 EJECT 08756819 *** 08758819 * 08760819 * COMMON GREADR FOR READ MANUAL INPUT 08762819 * 08764819 *** 08766819 COMNREAD GREADR (1),MIP,(8),(9),MF=E 08768819 COMNWAIT LTR R15,R15 I/O STARTED 08770819 BNZ GASHSKP NO -- LEAVE 08772819 LA PAR1,IOREQ 08774819 WAIT ECB=(1) 08776819 CLI IOREQ,COMPLETE I/O GOOD 08778819 BNE GAS06 NO -- BRANCH 08780819 BR R7 RETURN 08782819 EJECT 08784819 ZERO1 DC 1F'0' ZERO 2575 08790014 REQUEST DC A(140) WORK AREA DSECT SPACE A34795 08800020 CODETYP DC X'02' 08820000 DC AL3(0) 08840000 PFKCODE DC X'80' 08860000 DC AL3(0) 08880000 DISABLE DC X'00' 08940000 ENABLE DC X'FF' 08960000 DS 0F 08964019 INIT DC X'00FFFFFF' F40815 08966000 CKQECORE DC X'FD' SUBPOOL 253 08968019 DC AL3(26) LENGTH OF CKQE LI A39419 08972000 HOLDREG0 DC F'0' 08976019 DS 0F 08980000 CNOP 0,8 09000000 WORKAREA DSECT 09020000 ORG WORKAREA+0 09040000 RSVD DS BL1 09060000 OV DS BL1 09080000 KEY DS BL1 09100000 TYPE DS BL1 09120000 MI DS 0BL3 09140000 SENSED DS F 09160000 XYP DS F 09180000 ORG WORKAREA+16 A35022 09190020 IOREQ DS 4D 09200020 ORG WORKAREA+48 A35022 09210020 SAVE DS F A35022 09220020 CHAIN DS F A35022 09230020 DS 16F A35022 09240020 ORG WORKAREA+120 0803 09268020 GMAINADR DS F CORE ADR FOR IQE 0803 09272020 ORG WORKAREA+124 A34795 09276020 GMAINLST DS F LENGTH FOR E-TYPE GETMAIN A34795 09280020 DS F ADDR OF ADDR LIST A34795 09284020 DS C EC MODE GETMAIN A34795 09288020 DS C SUB POOL VALUE A34795 09292020 ORG WORKAREA+136 09296020 IOSTAT DS F 09300020 CKQE DSECT 09312319 CKQENEXT DS F CHAIN POINTER TO NEXT CKQE 09312619 CKQEFLGA DS XL1 TWO BYTE SWITCHES USED TO 09312919 CKQEGJP EQU X'80' CALLER IS GJP 09313219 CKQEDUMP EQU X'40' CORE DUMP REQUESTED BY USER 09313519 CKQEATTN EQU X'20' SYS CAN KEY RTN EXPECTING ATTN 09313819 CKQECKPT EQU X'10' CKCB POINTER VALID 09314119 CKQERESV EQU X'08' RESERVED 09314419 CKQEGJPE EQU X'04' GJP ECB ADDR VALID-GJP WAITING 09314719 CKQEDEQ EQU X'02' DEQUEUE CKQE 09315019 CKQEBUF EQU X'01' 2250 BUFFER RUNNING 09315319 CKQEFLGB DS XL1 COMMUNICATE WITH GAR,GJP ABEND 09315619 * HOOK,IFFCAN01 AND IFFCAN02. 09315919 CKQEGETA EQU X'80' GETMAIN FOR USER BUFFER 09316219 CKQERLOT EQU X'40' USER BUFFER FOLLED OUT 09316519 CKQEGETB EQU X'20' GETMAIN 2250 I/P BUFFER AND DECB 09316819 CKQEGETC EQU X'10' GETMAIN OPCB,DECB AND O/P LINES 09317119 CKQESBD EQU X'08' SYSBFDMP O/P DCB IS OPEN 09317419 CKQEGAR EQU X'04' ENTRY FROM GAR WITH LP ATTN 09317719 CKQEUCB DS H POINTER TO ASSOCIATED UCB 09318019 CKQECKCB DS F POINTER TO CAN KEY CONTROL BLOCK 09318319 CKQEDCB DS F DCB ADDR FOR ASSOCIATED DEVICE 09318619 END 09320000 ./ ADD SSI=00050050,NAME=IGG019OJ,SOURCE=0 *TITLE 'GRAPHIC ENTRY INTERFACE ROUTINE' 00020000 *STATUS:CHANGE LEVEL 0 00040000 *FUNCTION:THIRD LEVEL GRAPHIC CONTROL PROGRAM THAT GIVES CONTROL TO 00060000 * USER SPECIFIED ATTENTION ROUTINE AND PLACES ATTENTION DATA 00080000 * IN USERS COMAREA. 00100000 * 1.DETERMINE IF USER ROUTINE DESIRES THE ATTENTION TYPE BEING 00120000 * SERVICES.IF NOT,THE DATA IS DISCARDED. 00140000 * 2.DETERMINE WHERE TO GIVE USER CONTROL IE:VIA EP2 OR EP IN 00160000 * GACB. 00180000 * 3.PLACE DATA IN COMAREA. 00200000 *ENTRY POINT:SCHEDULED BY SECOND LEVEL GRAPHIC CONTROL PROGRAM VIA AEE 00220000 * STAGE 2. 00240000 *INPUT:1.GR#0=IQE ADDRESS. 00260000 * 2.GR#1=GACB ADDRESS. 00280000 * 3.GR'S 13,14,15 AS PER CONVENTIONS. 00300000 *OUTPUT:DATA TO USER'S COMAREA. 00320000 *EXTERNAL ROUTINES:1.USER ATTENTION ROUTINE. 00340000 * 2.SVC 3 (EXIT SVC) 00360000 *EXITS:1.TO USER VIA GR#15 ON ACCEPTED ATTENTIONS. 00380000 * 2.TO IOS VIA SVC 3 ON USER REJECTED ATTENTIONS. 00400000 *TABLES/WORKAREAS:1.USER COMAREA 00420000 * 2.USER GACB 00440000 *ATTRIBUTES:1.RESIDENT WITH GRAPHIC JOB(LOADED AT OPEN TIME). 00460000 * 2.RE-ENTRANT 00480000 *NOTES:N/A 00500000 * 00520000 * REGISTER DEFINITION 00540000 * 00560000 R0 EQU 0 00580000 R1 EQU 1 00600000 R2 EQU 2 00620000 RBASE EQU 3 00640000 RPFK EQU 4 00660000 RTYP EQU 5 00680000 R6 EQU 6 00700000 R7 EQU 7 00720000 R8 EQU 8 00740000 R9 EQU 9 00760000 R10 EQU 10 00780000 RIQE EQU 11 00800000 RGACB EQU 12 00820000 RSAVE EQU 13 00840000 RTNRG EQU 14 00860000 ENTRG EQU 15 00880000 * 00900000 * GACB TYPE VALUES 00920000 * 00940000 ENDAN EQU X'01' END KEY OR A/N ATTN 00960000 PFKB EQU X'02' 00980000 * 01000000 * 01020000 * 01040000 ONE EQU 1 ONE 01060000 TWO EQU 2 TWO 01080000 ZERO EQU 0 ZERO 01100000 IGG019OJ CSECT 01120000 SAVE (14,12) 01140000 BALR RBASE,R0 SET UP BASE REG 01160000 USING *,RBASE DEFINE BASE REG 01180000 LR RGACB,R1 SAVE PARAM 01200000 LR RIQE,R0 SAVE PARM 01220000 USING IQEFLDS,RIQE 01240000 USING GACBFLDS,RGACB 01260000 LA RPFK,ZERO ZERO REG 01280000 L RTYP,SEARCH LOAD ATNTYP SEARCH MASK 01300000 CLI TYPE,ENDAN END KEY 01320000 BC 8,GEIR01 BRANCH IF YES 01340000 CLI TYPE,PFKB PF KEY ATTN 01360000 BC 8,GEIR02 BRANCH IF YES 01380000 SR R2,R2 CLEAR REG 01400000 IC R2,TYPE INSERT TYPE FIELD 01420000 LA R6,TWO LOAD CONSTANT 01440000 SR R2,R6 DETERMINE SHIFT COUNT 01460000 SLL RTYP,ZERO(R2) DETERMINE SEARCH ARGUMENT 01480000 B GEIR01 BRANCH TO SEARCH 01500000 GEIR02 LA RTYP,ZERO ZERO REG 01520000 SR R6,R6 ZERO REG 01540000 IC R6,KEY INSERT KEY NO. 01560000 L RPFK,PFKSRCH LOAD PFK SEARCH ARGUMENT 01580000 SRL RPFK,ZERO(R6) DETERMINE PF SEARCH ARGUMENT 01600000 GEIR01 L R6,PFKMSK LOAD ARGUMENT 01620000 L R7,ATNTYP LOAD ARGUMENT 01640000 NR R6,RPFK SEE IF MATCH 01660000 NR R7,RTYP SEE IF MATCH 01680000 LTR R6,R6 WAS THERE A MATCH 01700000 BC 7,GEIR07 BRANCH IF YES 01720000 LTR R7,R7 WAS THERE AMATCH 01740000 BC 7,GEIR07 BRANCH IF YES 01760000 GEIROUT SVC 3 RETURN TO SUPV 01780000 GEIR07 L R7,EP2 LOAD ADR 01800000 LTR R7,R7 EP2=0 01820000 BC 7,GEIR08 BRANCH IF NO 01840000 L R7,EP1 EP1=0 01860000 LTR R7,R7 EP1=0 01880000 BC 8,GEIROUT BRANCH IF YES 01900000 LR ENTRG,R7 ENTRY ADR TO REG 01920000 L R10,COMARA LOAD COMAREA ADR 01940000 MVC ZERO(12,R10),RSVD DATA TO COMAREA 01960000 LM 0,12,20(13) RESTORE REGS 01980000 BR ENTRG TO USER ATTENTION ROUTINE 02000000 GEIR08 LR ENTRG,R7 ADR TO ENTRY REG 02020000 LA R7,ZERO ZERO REG 02040000 ST R7,EP2 ZERO EP2 02060000 L R10,COMARA LOAD COMAREA ADR 02080000 MVC ZERO(12,R10),RSVD MOVE DATA TO COMAREA 02100000 L RSAVE,REG13 LOAD REG 13 02120000 LM 0,12,20(13) RESTORE REGS 02140000 BR ENTRG TO USER ATTENTION ROUTINE 02160000 DS 0F 02180000 PFKSRCH DC X'80' 02200000 DC AL3(0) 02220000 SEARCH DC AL3(0) 02240000 DC X'01' 02260000 IQEFLDS DSECT 02280000 IQELNK DS 1F 02300000 IQEPARM DS 1F 02320000 IQEIRB DS 1F 02340000 IQETCB DS 1F 02360000 RSVD DS BL1 02380000 OV DS BL1 02400000 KEY DS BL1 02420000 TYPE DS BL1 02440000 SENSEMI DS 1F 02460000 GACBFLDS DSECT 02480000 COMARA DS 1F 02500000 DCB DS 1F 02520000 PFKMSK DS 1F 02540000 ATNTYP DS 1F 02560000 EP1 DS 1F 02580000 EP2 DS 1F 02600000 REG13 DS 1F 02620000 PFKEY DS 1F 02640000 ATNTYPS DS 1F 02660000 ECB DS 1F 02680000 Q2 DS 1F 02700000 RESERVED DS 1F 02720000 END 02740000 ./ ADD SSI=02053169,NAME=IGG019OK,SOURCE=0 *TITLE 'ATTENTION INQUIRY ROUTINE' 00300000 *STATUS:CHANGE LEVEL 0 00600000 *FUNCTION:MODE DEPENDENT 00900000 * 1.MODE=R-RELINQUISH CONTROL FOR USER ATTENTION ROUTINE IF EP 01200000 * IN GACB NOT EQUAL TO ZERO. WHEN USER GAINS CONTROL IT WILL 01500000 * BE GIVEN AT NSI AFTER MODE=R.IF EP IN GACB=0 R IS TREATED AS 01800000 * MODE=W. 02100000 * 2.MODE=W-IF REQUESTED DATA NOT AVAILABLE IT WILL PLACE ISSUING 02400000 * ROUTINE IN WAIT STATE.IF DATA IS AVAILABLE,MOVES DATA TO 02700000 * USER COMAREA AND RETURNS CONTROL TO NSI AFTER MODE=W. 03000000 * 3.MODE=C-IF DATA DESIRED IS AVAILABLE IT IS SELECTIVELY 03300000 * DEQUEUED AND PLACED IN COMAREA;CONTROL RETURNED VIA BRANCH 03600000 * ADDRESS.IF DATA NOT AVAILABLE CONTROL RETURNED TO NSI 03900000 * AFTER MODE=C. 04200000 * 4.MODE=CLEAR-REMOVES ALL DATA FROM USER INPUT QUEUE(MUST LEAVE 04500000 * ONE IQE ON USER IRB RBIQE FIELD FOR SYSTEM TO REMOVE)AND 04800000 * RETURNS CONTROL TO THE ROUTINE THAT WAS INTERRUPTED TO GIVE 05100000 * ATTENTION ROUTINE CONTROL. 05400000 *ENTRY POINT:VIA BALR 14,15 FROM ISSUING ROUTINE. 05700000 *INPUT:GR#1 POINTS TO PARAMETER LIST;GRS#13,14,15 AS PER CONVENTIONS. 06000000 *OUTPUT:MODE DEPENDENT;SEE FUNCTION. 06300000 *EXTERNAL ROUTINES:DEQUEUE(SVC 72) 06600000 *EXITS:VIA RETURN MACRO OR SVC 3. 06900000 *TABLES/WORK AREAS:N/A 07200000 *ATTRIBUTES:1.RESIDENT WITH GRAPHIC JOB 07500000 * 2.RE-ENTRANT 07800000 * 3.PROBLEM PROGRAM STATE 08100000 *NOTES:N/A 08400000 * 08700000 * REGISTER DEFINITION 09000000 * 09300000 PAR0 EQU 0 PARAM REG 0 09600000 PAR1 EQU 1 PARAM REG 1 09900000 BASERG EQU 2 BASE REG 10200000 RGACB EQU 3 GACB ADR REG 10500000 REBRG EQU 4 ROUTINE ENTRY BLOCK ADR REG 10800000 RLIST EQU 5 LIST DSECT REG 11100000 RPFK EQU 6 SAVE REG FOR PFK MASK 11400000 RSAVE EQU 7 SAVE REG FOR GACB MASK ATTNTYP 11700000 R8 EQU 8 WORK REG 12000000 R9 EQU 9 WORK REG 12300000 R10 EQU 10 WORK REG 12600000 R11 EQU 11 WORK REG 12900000 R12 EQU 12 WORK REG 13200000 SAVRG EQU 13 SAVE AREA PTR 13500000 RTNRG EQU 14 RETURN REG 13800000 RCODE EQU 15 RETURN CODE REG 14100000 * 14400000 * 14700000 FOUR EQU 4 FOUR 15000000 ZERO EQU 0 ZERO 15300000 REL EQU X'01' RELINQUISH MODE 15600000 WAIT EQU X'02' WAIT MODE 15900000 COND EQU X'04' CONDITIONAL MODE 16200000 CLEAR EQU X'08' CLEAR MODE 16500000 ANY EQU X'00' TYPE ANY(USE GACB MASK) 16800000 END EQU X'01' END OR A/N TYPE 17100000 LP EQU X'02' LIGAT PEN TYPE 17400000 EOS EQU X'03' END ORDER SEQUENCE TYPE 17700000 CANCEL EQU X'04' CANCEL TYPE 18000000 AE EQU X'05' ASYNCHRONOUS ERROR 18300000 A2260 EQU X'06' 2260 TYPE 18600000 IRB EQU 16 IRB ADR IN REB 18900000 CVTADR EQU 16 ADR OF CVT TABLE 19200000 TCBP EQU 0 TABLE OF TCB ADRS 19500000 TCBCUR EQU 4 CURRENT TCB ADR 19800000 TCBIRB EQU 0 CURRENT(ACTIVE)RB 20100000 EXIT EQU 3 EXIT FROM ROUTINE SVC NO. 20400000 DEQUEUE EQU 75 DEQUEUE RTN SVC NO. 20700000 WAITST EQU X'80' WAIT BIT 21000000 RTN EQU 12 OFF SET TO RTN REG IN SAVE AREA 21300000 RTNIRB EQU 16 IRB ADR 21600000 RTNTCB EQU 32 OFFSET FOR REB TCB ADR 21900000 SIX EQU 6 SIX 22200000 EIGHT EQU 8 EIGHT 22500000 ONE EQU 1 ONE 22800000 RBIQE EQU 24 NEXT IQE OFF IRB 23100000 ATTNERR EQU X'41' F40815 23200000 IGG019OK CSECT 23400000 * 465000-470000,516000 A31230 23800020 *A232000,A442000-445000,A541000-542000,A697000 LI F40815 24000000 SAVE (14,12) 24300000 BALR BASERG,PAR0 SET UP BASE REG 24600000 USING *,BASERG DEFINE BASE REG 24900000 USING PARLIST,RLIST DEFINE DSECT REG 25200000 USING GACB,RGACB DEFINE DSECT REG 25500000 LR RLIST,PAR1 LOAD PARAM LIST REG 25800000 L RGACB,GACBADR LOAD GACB ADDRESS 26100000 LA RGACB,ZERO(0,RGACB) ZERO HIGH ORDER BYTE 26400000 LTR RGACB,RGACB REG=0 26700000 BC 7,AT01 BRANCH IF NO 27000000 WTO 'IFF321I ATTNINQ FOUND NO GACB ADDRESS IN PARAMETER LISTX27100021 ',ROUTCDE=11,DESC=7 S21016 27200021 LA RCODE,X'10' NO GACB ADDR IN JFCC 27300000 B RTNUSCD PARAM LIST--RETURN JFCC 27600000 AT01 L R8,EP2 LOAD EP2 ADR 27900000 LA R8,ZERO(0,R8) ZERO HI ORDER BYTE 28200000 LTR R8,R8 EP2=0 28500000 BC 8,AT02 BRANCH IF YES 28800000 WTO 'IFF322I ATTNINQ FOUND NON-ZERO VALUE IN WORD SIX OF GACX28900021 B',ROUTCDE=11,DESC=7 S21016 29000021 LA RCODE,X'14' EP2 CONTAINS ERRONEOUS JFCC 29100000 B RTNUSCD DATA--RETURN JFCC 29400000 AT02 L REBRG,REBADR LOAD REB ADR FROM GACB 29700000 LA REBRG,ZERO(0,REBRG) ZERO HI ORDER BYTE 30000000 LTR REBRG,REBRG ADDRESS EQUAL ZERO 30300000 BC 7,AT00 BRANCH IF NOT ZERO 30600000 WTO 'IFF323I ATTNINQ FOUND GACB NOT INITIALIZED BY SPAR MACRX30700021 O',ROUTCDE=11,DESC=7 S21016 30800021 LA RCODE,X'18' GACB NOT SPARED JFCC 30900000 B RTNUSCD RETURN JFCC 31200000 * 31500000 * GET CURRENT TCB ADDRESS 31800000 * 32100000 AT00 L R8,CVTADR LOAD CVT ADR 32400000 L R8,TCBP(R8) LOAD OLD/NEW TCB 32700000 L R8,TCBCUR(R8) LOAD CURRENT TCB ADR 33000000 LA R8,ZERO(R8) CLEAR HI-ORDER BYTE 33300000 L R9,RTNTCB(REBRG) LOAD REB TCB ADR 33600000 LA R9,ZERO(R9) CLEAR HI-ORDER BYTE 33900000 CR R8,R9 DOES CURRENT TCB ADR = REBTCB 34200000 BE AT14 BRANCH IF WQUAL 34500000 WTO 'IFF324I ATTNINQ NOT ISSUED IN SAME TASK AS SPAR MACRO FX34600021 OR GACB',ROUTCDE=11,DESC=7 S21016 34700021 LA RCODE,X'1C' ATTNINQ ISSUED FROM OTHER JFCC 34800000 B RTNUSCD THAN SPARED TASK--RETURN JFCC 35100000 * 35400000 AT14 CLI MODE,REL MODE=R 35700000 BC 7,AT03 BRANCH IF NO 36000000 L R8,EP1 LOAD EP1 ADR FROM GACB 36300000 LA R8,ZERO(0,R8) ZERO HI ORDER BYTE 36600000 LTR R8,R8 EP1=0 36900000 BC 8,AT04 BRANCH IF YES 37200000 L R8,IRB(0,REBRG) LOAD ROUTINE IRB ADR 37500000 LA R8,ZERO(0,R8) ZERO HIGH ORDER BYTE 37800000 L R9,CVTADR LOAD CVT TABLE ADR 38100000 L R9,TCBP(0,R9) LOAD OLD/NEW TCBS 38400000 L R9,TCBCUR(0,R9) LOAD CURRENT TCB ADR 38700000 L R9,TCBIRB(0,R9) LOAD CURRENT IRB ADR 39000000 LA R9,ZERO(0,R9) ZERO HI ORDER BYTE 39300000 CLR R8,R9 IRB ADRS COMPARE 39600000 BC 7,AT04 BRANCH IF NO 39900000 ST RTNRG,EP2 STORE IN LINE RETURN ADR OF 40200000 * CALLING ROUTINE IN EP2 FIELD 40500000 * OF GACB 40800000 ST SAVRG,REG13 STORE CALLING ROUTINES SAVE 41100000 * AREA PTR IN GACB 41400000 SVC EXIT RETURN TO IOS 41700000 AT03 CLI MODE,CLEAR MODE=CLEAR 42000000 BC 8,ATCLEAR BRANCH IF YES 42300000 CLI MODE,COND MODE=C 42600000 BC 8,ATCOND BRANCH IF YES 42900000 CLI MODE,WAIT MODE=W 43200000 BC 8,AT04 BRANCH IF YES 43500000 WTO 'IFF325I ATTNINQ FOUND INVALID MODE FIELD IN PARAMETER LX43600021 IST',ROUTCDE=11,DESC=7 S21016 43700021 LA RCODE,X'20' INVALID MODE IN PARAM JFCC 43800000 B RTNUSCD LIST--RETURN JFCC 44100000 AT04 TM ECB,WAITST ALREADY IN WAIT F40815 44200000 BO AT04A YES, BRANCH F40815 44300000 MVC ECB(FOUR),INIT INITALIZE ECB F40815 44400000 AT04A LR PAR1,RGACB GACB ADDRESS IN REG 1 F40815 44500000 LA PAR0,ZERO ZERO PAR REG0 44700000 IC R10,RSVD INSERT OFFSET 45000000 SLL R10,24 POSITION OFFSET 45300000 OR PAR1,R10 ADD OFF SET TO PARAM 45600000 SVC DEQUEUE CALL DEQUEUE ROUTINE 45900000 CLI MODE,COND MODE=C 46200000 BNE AT06 BRANCH IF NO A31230 46600020 CLI TYPE,ANY ATTNINQ TYPE=ANY? A31230 47000020 BC 7,AT05 BRANCH IF NO TO RESTORE GACB 47400000 * MASKS 47700000 AT06 LA R8,ZERO LOAD ZERO 48000000 CLR RCODE,R8 RETURN CODE=0 48300000 BC 8,AT07 BRANCH IF YES 48600000 LA R8,FOUR LOAD FOUR 48900000 CLR RCODE,R8 RETURN CODE=4 49200000 BC 8,AT08 BRANCH IF YES 49500000 WTO 'IFF326I ATTNINQ UNSUCCESSFUL DUE TO INTERNAL DEQUEUE ERX49600021 ROR',ROUTCDE=11,DESC=7 S21016 49700021 LA RCODE,X'24' RTN CODE FROM DEQUEUE JFCC 49800000 B RTNUSCD NOT ZERO--RETURN JFCC 50100000 AT07 CLI MODE,WAIT MODE=W 50400000 BC 8,AT09 BRANCH IF YES 50700000 CLI MODE,REL MODE=R 51000000 BC 8,AT09 BRANCH IF YES 51300000 RTNUSER SR RCODE,RCODE SET RC=0 - OK A31230 51600020 RTNUSCD RETURN (14,12),RC=(15) 51900000 AT09 TM ECB,WAITST RTN ALREADY IN WAIT STATE 52200000 BC 1,AT10 BRANCH IF YES 52500000 ST R8,ECB ZERO ECB 52800000 SRL R10,24 POSITION OFFSET 53100000 STC R10,RESERVED STORE OFFSET IN GACB 53400000 LA PAR1,ECB LOAD ECB ADR 53700000 WAIT ECB=(1) 54000000 CLI ECB,ATTNERR COMP. CODE=X'41' F40815 54100000 BE AT04A YES, RETRY F40815 54200000 B RTNUSER BRANCH 54300000 AT10 EQU * 54400021 WTO 'IFF327I ATTNINQ FOR MODE=R OR W FOUND ATTENTION ROUTINEX54500021 ALREADY WAITING',ROUTCDE=11,DESC=7 S21016 54600021 LA RCODE,X'28' ROUTINE ALREADY IN JFCC 54700021 B RTNUSCD WAIT STATE--RETURN JFCC 54900000 AT05 ST RPFK,PFKMSK RESTORE PF MASK IN GACB 55200000 ST RSAVE,ATNTYP RESTORE ATTNTYP MASK IN GACB 55500000 B AT06 BRANCH 55800000 AT08 CLI MODE,WAIT MODE=W 56100000 BC 8,RTNUSER RETURN IN LINE TO CALLER 56400000 CLI MODE,REL MODE=R 56700000 BC 8,RTNUSER BRANCH IF YES 57000000 L R8,BRADR LOAD BRANCH ADR 57300000 LA R8,ZERO(0,R8) ZERO HIGH ORDER BYTE 57600000 LTR R8,R8 BRANCH ADR=0 57900000 BC 8,AT11 BRANCH IF YES 58200000 ST R8,RTN(SAVRG) REPLACE IN LINE ADR WITH 58500000 * BRANCH ADR 58800000 B RTNUSER BRANCH 59100000 AT11 EQU * 59200021 WTO 'IFF328I ATTNINQ FOR MODE=C FOUND NO BRANCH ADDRESS IN PX59300021 ARAMETER LIST',ROUTCDE=11,DESC=7 S21016 59400021 LA RCODE,X'2C' MODE 'C' BR ADDR JFCC 59500021 B RTNUSCD EQUAL ZERO--RETURN JFCC 59700000 ATCOND CLI TYPE,ANY ATTNINQ TYPE=ANY 60000000 BC 8,AT04 BRANCH IF YES 60300000 L RPFK,PFKMSK SAVE PFK MASK FROM GACB 60600000 L RSAVE,ATNTYP SAVE ATNTYP MASK FROM GACB 60900000 SR R8,R8 CLEAR REGISTER 61200000 IC R8,TYPE INSERT TYPE FIELD 61500000 LA R9,SIX LOAD CONSTANT 61800000 CLR R8,R9 COMPARE 62100000 BC 2,AT13 BRANCH IF TYPE GREATER THAN SIX 62400000 LA R9,ONE LOAD CONSTANT 62700000 SR R8,R9 SUBTRACT ONE FROM TYPE 63000000 SLL R9,0(R8) DETERMINE SEARCH ARGUMENT 63300000 ST R9,ATNTYP PUT NEW TYPE IN GACB 63600000 LA R9,ZERO LOAD ZERO 63900000 ST R9,PFKMSK PUT NEW TYPE IN GACB 64200000 B AT04 BRANCH 64500000 AT13 LA R9,EIGHT LOAD CONSTANT 64800000 SR R8,R9 DETERMINE KEY NUMBER 65100000 L R9,PFKCODE LOAD MASK 65400000 SRL R9,ZERO(R8) DETERMINE PF KEY ARGUMENT 65700000 ST R9,PFKMSK STORE NEW PF MASK IN GACB 66000000 LA R9,ZERO ZERO REG 66300000 ST R9,ATNTYP STORE NEW ATNTYP MASK IN GACB 66600000 B AT04 BRANCH 66900000 ATCLEAR LR PAR1,RGACB GACB ADR TO PARAM REG 67200000 L R8,RTNIRB(0,REBRG) LOAD IRB ADR 67500000 LA R8,RBIQE(0,R8) LOAD RBIQE ADR 67800000 LR PAR0,R8 ADR TO PARAM REG 68100000 SVC DEQUEUE CALL DEQUEUE ROUTINE 68400000 B RTNUSER RETURN TO USER ATTN RTN 68700000 DS 0F 69000000 PFKCODE DC X'80' 69300000 DC AL3(0) 69600000 INIT DC X'00FFFFFF' F40815 69700000 CNOP 0,8 69900000 PARLIST DSECT 70200000 GACBADR DS 1F 70500000 MODE DS BL1 70800000 RSVD DS BL1 71100000 TYPE1 DS BL1 71400000 TYPE DS BL1 71700000 BRADR DS 1F 72000000 GACB DSECT 72300000 COMARA DS 1F 72600000 DCB DS 1F 72900000 PFKMSK DS 1F 73200000 ATNTYP DS 1F 73500000 EP1 DS 1F 73800000 EP2 DS 1F 74100000 REG13 DS 1F 74400000 PFKEY DS 1F 74700000 ATNTYPS DS 1F 75000000 ECB DS 1F 75300000 REBADR DS 1F 75600000 RESERVED DS 1F 75900000 END 76200000 ./ ADD SSI=03010100,NAME=IGG0193L,SOURCE=0 TITLE 'IGG0193L - LOAD 3 BASIC GRAPHICS OPEN EXECUTOR' 00100019 IGG0193L CSECT 00200019 * 170440-170760,361200-361600,370300-370600 A25381 00230019 *A228300-228600,A370700 A35615 00240000 * C212000 A38909 00250021 * A228700,A228800 A38909 00252021 * D170100-171000,D261000 A40756 00254000 * A170300-171500, A226300-226600, A2665000 A40756 00256000 * A103100-103500,A389300-389600 A40953 00258000 *A171600-171700,332500 A55318 00259021 *A111500 JLM A57385 00259521 EJECT 00260019 *********************************************************************** 00300019 * * 00400019 * TITLE - IGG0193L - LOAD 3 BASIC GRAPHICS OPEN EXECUTOR * 00500019 * * 00600019 * FUNCTION - 1. LOADS * 00700019 * A.BUFFER PROTECTION(2250 ONLY) **************** * 00800019 * B.GAS * * * 00900019 * C.GEIR * BASIC ONLY * * 01000019 * D.TE * * * 01100019 * I.IFFCAN03 **************** * 01200019 * * 01300019 * ENTRY POINT - ENTERED BY GRAPHICS OPEN EXECUTOR LOAD 2 AT IGG0193L * 01400019 * * 01500019 * INPUT - PARAMETER LIST ADDRESS IN REGISTER 7 * 01600019 * * 01700019 * OUTPUT - 1. IRB'S FOR- * 01800019 * A.GAS * 01900019 * B.IFFCAN03 * 02000019 * 2.IQE'S FOR- * 02100019 * A.GAS * 02200019 * B.IFFCAN03 * 02300019 * C.TE * 02400019 * * 02500019 * EXTERNAL * 02600019 * REFERENCES - 1.GETMAIN * 02700019 * 2.FREEMAIN * 02800019 * 3.CIRB * 02900019 * 4.LOAD * 03000019 * 5.XCTL * 03100019 * * 03200019 * EXITS - 1.NORMAL - OS/360 OPEN * 03300019 * 2.ABNORMAL - ABEND SVC * 03400019 * * 03500019 * RETURN CODES - N/A * 03600019 * * 03700019 * TABLES/WORK AREAS - DSECTS DESCRIBED IN LISTING * 03800019 * * 03900019 * ATTRIBUTES - 1.REENTRANT * 04000019 * 2.ENABLED * 04100019 * 3.PRIVILEDGED * 04200019 * * 04300019 * NOTES - ALL NOTES CONTAINED IN LISTING * 04400019 * * 04500019 EJECT 04600019 *********************************************************************** 04700019 * REGISTER EQUATES * 04800019 * * 04900019 *********************************************************************** 05000019 RE EQU 0 WORK/PARAMETER REGISTER 05100019 RF EQU 1 WORK/PARAMETER REGISTER 05200019 RDCB EQU 2 DCB ADDRESS REGISTER 05300019 RTE EQU 2 TE ADDRESS 05400019 RBASE EQU 3 BASE REGISTER 05500019 RIRB EQU 4 GAR IRB ADDRESS 05600019 RPAR EQU 5 PARAMETER LIST REGISTER 05700019 RWTG EQU 6 WHERE-TO-GO TABLE 05800019 RPARC EQU 7 CURRENT PARAMETER LIST ENTRY 05900019 RWTGC EQU 8 CURRENT WTG TABLE ENTRY 06000019 TCBREG EQU 9 TCB ADDRESS 06100019 RCOUNT EQU 10 LOOP COUNTER REG 06200019 RUCB EQU 10 CURRENT UCB ADDRESS 06300019 RDEB EQU 11 DEB ADDRESS 06400019 RC EQU 12 WORK REG 06500019 SAVER EQU 13 BASE REG FOR SAVE 06600019 RD EQU 14 WORK/PARAMETER REG 06700019 RJ EQU 15 WORK/PARAMETER REG 06800019 EJECT 06900019 *********************************************************************** 07000019 * * 07100019 * INITIALIZATION * 07200019 * * 07300019 *********************************************************************** 07400019 USING IHADCB,RDCB BASE REG FOR DCB DSECT 07500019 USING IECTDEB,RDEB BASE REG FOR DEB DSECT 07600019 BALR RBASE,ZERO SET UP 07700019 USING *,RBASE BASE REGISTER 07800019 *********************************************************************** 07900019 * * 08000019 * GETMAIN FOR SAVE AREA TO BE USED BY GIOCR WHEN THE READ MANUAL * 08100019 * INPUT IS ISSUED TO UNLOCK THE KEYBOARD. THE SAVE AREA WILL ALSO BE * 08200019 * USED TO TEMPORARILY STORE THE USER'S DECB * 08300019 * * 08400019 *********************************************************************** 08500019 GETMAIN R,LV=116,SP=253 08600019 LR SAVER,RF SET UP BASE REG TO 08700019 USING SAVEAREA,SAVER SAVE AREA 08800019 L RDCB,ZERO(RPARC,ZERO) INITIALIZE DCB BASE REG 08900019 *********************************************************************** 09000019 * * 09100019 * SAVE DCB POINTER INTO DECB * 09200019 * * 09300019 *********************************************************************** 09400019 ST RDCB,DECBDCB SAVE DCB ADDRESS 09500019 L RDEB,DCBDEBAD INITIALIZE DEB BASE REG 09600019 LA RDEB,ZERO(ZERO,RDEB) CLEAR HIGH ORDER BYTE 09700019 S RDEB,DISPDEB GET CORRECT DEB BASE 09800019 *********************************************************************** 09900019 * * 10000019 * IF DCBGTYPE=BASIC PROCEED-IF NOT DO RMI AND XCTL * 10100019 * * 10200019 *********************************************************************** 10300019 L RD,DEBUCBAD UCB ADDRESS A40953 10310000 CLC 18(2,RD),DEV2280 2280 ? A40953 10320000 BE OAM210 YES-XCTL OUT A40953 10330000 CLC 18(2,RD),DEV2282 2282 ? A40953 10340000 BE OAM210 YES-XCTL OUT A40953 10350000 TM DCBGTYPE,BASIC IS THIS A BASIC SYSTEM 10400019 BZ OAM210 NO -- XCTL OUT 10500019 SR RD,RD CLEAR SUB ID REGISTER 10600019 LA RUCB,DEBUCBAD SUB ID SECTION FOLLOWS UCBS 10700019 IC RD,DEBNMEXT GET NUMBER OF UCBS 10800019 SLL RD,TWO ACCESS ACTUAL SIZE OF UCBS 10900019 AR RUCB,RD PTR TO SUB ID SECTION 11000019 SR RD,RD CLEAR SUB COUNT REGISTER 11100019 IC RD,DEBNMSUB # ROUTINES ALREADY LOADED JLM A57385 11150021 MVI N22(RWTG),ATBL SET REENTRANT ATTRIBUTE 11200019 OAM218 L RF,CVTADPTR GET ADDRESS OF CVT 11300019 L TCBREG,CVTTCBP(RF) GET ADDRESS OF NEW/OLD TCBS 11400019 L TCBREG,TCBLST(TCBREG) GET ADDRESS OF OLD TCB 11500019 EJECT 11600019 *********************************************************************** 11700019 * * 11800019 * LOAD GAS * 11900019 * * 12000019 *********************************************************************** 12100019 L RF,COMVECPT(ZERO,ZERO) GET POINTER TO CVT 12200019 L RF,DCBOFF(ZERO,RF) GET SVC DCB ADDRESS 12300019 LOAD EP=IGG019OE,DCB=(1) 12400019 ST RE,GARSVE SAVE GAR ADDRESS 12500019 LA RF,GAS GET GAS ID ADDRESS 12600019 LA RUCB,FOUR(RUCB) POINT TO DEB SUB ID SECTION 12650019 MVC ZERO(TWO,RUCB),ZERO(RF) MOVE ID TO DEB 12700019 LA RUCB,TWO(ZERO,RUCB) POINT TO NEXT DEB SUBID SECTION 12800019 LA RD,ONE(ZERO,RD) INCREMENT ROUTINES LOADED COUNT 12900019 STC RD,DEBNMSUB STORE COUNT IN DEB 13000019 *********************************************************************** 13100019 * * 13200019 * LOAD GEIR * 13300019 * * 13400019 *********************************************************************** 13500019 L RF,COMVECPT GET POINTER TO CVT 13600019 L RF,DCBOFF(ZERO,RF) GET SVC DCB ADDRESS 13700019 LOAD EP=IGG019OJ,DCB=(1) 13800019 ST RE,GEIRSVE SAVE GEIR ADDRESS 13900019 LA RF,GIR LOAD GEIR ID ADDRESS 14000019 MVC ZERO(TWO,RUCB),ZERO(RF) MOVE ID TO DEB 14100019 LA RUCB,TWO(RUCB) POINT TO NEXT SUB ID SECTION 14150019 LA RD,ONE(ZERO,RD) INCREMENT ROUTINE LOADED COUNT 14200019 STC RD,DEBNMSUB STORE COUNT IN DEB 14300019 L RF,DEBUCBAD GET UCB ADDRESS FROM DEB M4218 14320019 LH RJ,EIGHTEEN(RF) LOAD DEVICE AND UNIT TYPE M4218 14340019 CH RJ,DEV2250 IS THIS A 2250 ? M4218 14360019 BNE NOCAN03 NO - DO NOT LOAD IFFCAN03 M4218 14380019 *********************************************************************** 14400019 * * 14500019 * LOAD IFFCAN03 * 14600019 * * 14700019 *********************************************************************** 14800019 LOAD EP=IFFCAN03 14900019 ST RE,CAN03SVE SAVE IFFCAN03 ADDRESS 15000019 LA RF,CAN03 LOAD IFFCAN03 ID ADDRESS 15100019 MVC ZERO(TWO,RUCB),ZERO(RF) MOVE ID TO DEB 15200019 LA RD,ONE(ZERO,RD) INCREMENT ROUTINES LOADED COUNT 15300019 STC RD,DEBNMSUB STORE COUNT IN DEB 15400019 NOCAN03 L RTE,DEBUCBAD LOAD FIRST UCB POINTER M4218 15500019 SSM DISABLE 15600019 EJECT 15700019 *********************************************************************** 15800019 * * 15900019 * DOES TE EXIST FOR TASK - CHECK OTHER DEBS * 16000019 * IN TASK * 16100019 * * 16200019 *********************************************************************** 16300019 L RTE,USERTE(RTE) LOAD UCB TE FIELD 16400019 LA RTE,ZERO(RTE) CLEAR HIGH-ORDER BYTE 16500019 LTR RTE,RTE DOES TE ADDRESS EXIST IN UCB 16600019 BP SETSSM BRANCH IF YES 16700019 L RD,EIGHT(TCBREG) LOAD FIRST DEB IN TCBDEB CHAIN 16800019 LA RD,ZERO(RD) CLEAR HIGH ORDER BYTE 16900019 OAM200 EQU * 16910019 SPACE 3 16920019 *** TEST FOR A DUMMY DEB OR A DEB WITHOUT A25381 16930019 * ANY EXTENTS. A25381 16940019 * A25381 16950019 * THE DEB WILL BE SCANNED FOR EXTENTS. FOR A25381 16960019 * GRAPHICS THERE WILL BE AT LEAST ONE EXTENT A25381 16970019 * A25381 16980019 TM EXTNUMB(RD),FULLMASK ARE THERE ANY EXTENTS A25381 16990019 BZ NEXTDEB IF NOT TAKE BRANCH A25381 17000019 LA RF,UCBADR(RD) PTR TO FIRST UCB ADDR A40756 17030000 UCBA L RUCB,ZERO(RF) LOAD FIRST UCB ADDRESS A40756 17060000 LA RF,FOUR(RF) POINT TO NEXT UCB ADDRESS A40756 17090000 LTR RUCB,RUCB UCB ADDRESS=0 A40756 17120000 BZ UCBA YES, CHECK NEXT UCB A40756 17150000 TM UCBID(RUCB),FULLMASK IS THIS A VALID UCB? A55318 17160021 BZ UCBA BRANCH IF NO. A55318 17170021 LH RF,EIGHTEEN(RUCB) LOAD DEVICE AND UNIT TYPE 17200019 CH RF,DEV2250 IS THIS A 2250 - CODE 1002 17300019 BE OAM201 YES 17400019 CH RF,DEV2260 IS THIS A 2260 - CODE 1003 17500019 BE OAM201 YES 17600019 CH RF,DEV1053 IS THIS A 1053 - CODE 1004 17700019 BE OAM201 YES 17800019 NEXTDEB L RD,FOUR(RD) LOAD DEB LINK FIELD 17900019 LA RD,ZERO(RD) CLEAR HIGH ORDER BYTE 18000019 C RD,ZERO1 IS LINK FIELD 0 18100019 BE OAM202 YES 18200019 B OAM200 TEST DEVICE AND TYPE AGAIN 18300019 OAM201 L RTE,USERTE(RUCB) LOAD TE FIELD FROM UCB 18400019 LA RTE,ZERO(RTE) CLEAR HIGH ORDER BYTE 18500019 LTR RTE,RTE IS TE FIRLD 0 18600019 BZ NEXTDEB YES 18700019 B OAM203 OTHERWISE BRANCH TO BUILD IQES 18800019 EJECT 18900019 *********************************************************************** 19000019 * * 19100019 * ISSUE GETMAIN FOR TE * 19200019 * * 19300019 *********************************************************************** 19400019 OAM202 L RE,TE LOAD TE BYTE REQUEST 19500019 GETMAIN R,LV=(0) 19600019 XC ZERO(WAOFF,RF),ZERO(RF) CLEAR TE CORE TO ZERO 19700019 LR RTE,RF SAVE TE ADDRESS 19800019 *********************************************************************** 19900019 * * 20000019 * CREATE IRBS FOR GAR AND IFFCAN03 * 20100019 * * 20200019 *********************************************************************** 20300019 L RE,GARSVE LOAD GAR ADDRESS 20400019 CIRB EP=(0),SVAREA=YES,WKAREA=1,MODE=SUPR,KEY=SUPR 20500019 ST RF,TEGARIRB(RTE) STORE GAR IRB ADDRESS IN TE 20600019 ST TCBREG,TETCB(RTE) STORE CURRENT TCB ADDRESS IN TE 20700019 MVC TEGIR(FOUR,RTE),GEIRSVE STORE GEIR ADDRESS IN TE 20800019 OI TEFLG(RTE),TEFLAG INDICATE THIS IS A TE 20900019 XC NEXT(FOUR,RF),NEXT(RF) CLEAR NEXTAVAIL FIELD IN IRB 21000019 * 21100019 L RUCB,DEBUCBAD GET UCB ADDRESS FROM DEB M4218 21110019 LH RJ,EIGHTEEN(RUCB) LOAD DEVICE AND UNIT TYPE M4218 21120019 CH RJ,DEV2250 IS THIS A 2250 ? M4218 21130019 BNE OAM203 NO - DO NOT CREATE CAW03 M4218 21140019 * IRB M4218 21150019 CAN03IRB L RE,CAN03SVE LOAD IFFCAN03 ADDRESS A38909 21200021 CIRB EP=(0),SVAREA=YES,WKAREA=1,MODE=SUPR,KEY=SUPR 21300019 ST RF,ZERO(RTE) STORE IFFCAN03 IRB ADDR IN TE 21400019 XC NEXT(FOUR,RF),NEXT(RF) CLEAR NEXT AVAIL FIELD IN IRB 21500019 EJECT 21600019 *********************************************************************** 21700019 * * 21800019 * PREPARE FOR GAR/IFFCAN03 IQES * 21900019 * * 22000019 *********************************************************************** 22100019 OAM203 SR RD,RD CLEAR REGISTER 22200019 L RIRB,TEGARIRB(RTE) LOAD GAR IRB ADDRESS FROM TE 22300019 IC RD,DEBNMEXT LOAD NUMBER OF UCB EXTENTS 22400019 LA RC,DEBUCBAD LOAD PTR TO FIRST UCB ADDR 22500019 OAM204 L RUCB,ZERO(RC) LOAD UCB ADDR 22600019 LTR RUCB,RUCB UCB ADDRESS=0 A40756 22630000 BZ NEXTUCB YES, CHECK NEXT UCB A40756 22660000 CLI TYPE(RUCB),T2260 IS DEVICE A 2260 22700019 BE ONEIQE YES - GET ONE IQE 22800019 CLI TYPE(RUCB),T1053 IS DEVICE A 1053 A35615 22830020 BE ONEIQE YES - GET ONE IQE A35615 22860020 CLC ZERO(FOUR,RTE),ZERO1 DOES IFFCAN03 IRB EXIST A38909 22870021 BE CAN03IRB NO, CREATE ONE A38909 22880021 LA RCOUNT,THREE LOAD LOOP COUNT FOR 2250 22900019 *********************************************************************** 23000019 * * 23100019 * ISSUE GETMAIN FOR IFFCAN03 IQE * 23200019 * * 23300019 *********************************************************************** 23400019 L RE,IQE LOAD BYTE REQUEST FOR CAN03 IQES 23500019 GETMAIN R,LV=(0) 23600019 L RIRB,ZERO(RTE) GET CAN03 IRB ADDRESS 23700019 ST RIRB,EIGHT(RF) STORE CAN03 IRB ADDR IN CAN03IQE 23800019 MVC ZERO(FOUR,RF),NEXT(RIRB) MOVE ADDR TO IQE LINK FIELD 23900019 ST RF,NEXT(RIRB) STORE IQE ADDR IN IRB NEXTAVAIL 24000019 XC FOUR(FOUR,RF),FOUR(RF) ZERO PARM FIELD IN IQE 24100019 ST TCBREG,IQETCB(RF) STORE TCB ADDR TO IQE 24200019 B GARIQES GET IQE/S FOR GAR 24400019 ONEIQE LA RCOUNT,ONE LOAD LOOP COUNT FOR 2260 24500019 EJECT 24600019 *********************************************************************** 24700019 * * 24800019 * ISSUE GETMAIN FOR GAR IQE/S * 24900019 * * 25000019 *********************************************************************** 25100019 GARIQES L RIRB,TEGARIRB(RTE) REINITIALIZE GAR'S IRB M4218 25140019 * ADDRESS 25180019 L RE,IQE LOAD BYTE REQUEST FOR M4218 25220019 * GAR IQE'S M4218 25260019 GETMAIN R,LV=(0) 25300019 ST RIRB,EIGHT(RF) STORE GAR IRB ADDR IN IQE 25400019 MVC ZERO(FOUR,RF),NEXT(RIRB) MOVE ADDR TO IQE LINK FIELD 25500019 ST RF,NEXT(RIRB) STORE IQE ADDR IN IRB NEXTAVAIL 25600019 XC FOUR(FOUR,RF),FOUR(RF) ZERO PARM FIELD IN IQE 25700019 ST TCBREG,IQETCB(RF) STORE TCB ADDR IN IQE 25800019 BCT RCOUNT,GARIQES BRANCH IF MORE IQES FOR DEVICE 25900019 L RUCB,ZERO(RC) RELOAD UCB ADDRESS 26000019 ST RTE,USERTE(RUCB) STORE TE ADDRESS IN UCB 26200019 OI GCB(RUCB),BASIC1 INDICATE BASIC UCB 26300019 OI GCB(RUCB),PROATTN BIT TURNED ON TO INDICATE A32068 26320020 * THAT ATTENTIONS WILL BE A32068 26340020 * ACCEPTED FROM THIS DEVICE A32068 26360020 L RF,TEUSECT(RTE) LOAD TE USE COUNT 26400019 LA RF,ONE(RF) INCREMENT USE COUNT BY ONE 26500019 ST RF,TEUSECT(RTE) STORE UPDATED COUNT 26600019 NEXTUCB LA RC,FOUR(RC) POINT TO NEXT UCB ADDRESS A40756 26650000 BCT RD,OAM204 BRANCH IF MORE UCBS TO SERVICE 26700019 SETSSM SSM ENABLE 26800019 OAM210 L RC,FOUR(RWTGC) GET WORK AREA ADDRESS 26900019 MVC N22(SEVEN,RWTG),CONTAB RESTORE WTG 27000019 XC ZERO(TWO,RWTGC),ZERO(RWTGC) CLEAR ID IND COMPLETION 27100019 RELOOP EQU * 27200019 LA RWTGC,WGOFF(RWTGC) BUMP CURRENT WTG REGISTER 27300019 LA RPARC,PLOFF(RPARC) BUMP CUR PARM REG TO NEXT ENTRY 27400019 CLC ZERO(TWO,RWTGC),GIDCNST1 CHECK NEXT WTG ENTRY 27500019 BCR EIGHT,RBASE YES START AGAIN 27600019 CLC ZERO(TWO,RWTGC),OPIDCNST NO TEST FOR END OF TABLE 27700019 BNE RELOOP NOT EQUAL CHECK NEXT ENTRY 27800019 LR RPARC,RPAR RESET CURRENT WTG REG 27900019 LA RWTGC,WAOFF(RWTG) RESET CURRENT PARM REG 28000019 ZCHECK EQU * 28100019 CLI ZERO(RWTGC),ZEROENT TEST FOR ZERO ENTRY 28200019 BNE RMI NOT - XCTL 28300019 LA RWTGC,WGOFF(RWTGC) ZERO - GET NEXT ENTRY AND 28400019 LA RPARC,PLOFF(RPARC) RETURN TO ZCHECK 28500019 B ZCHECK RETURN 28600019 EJECT 28700019 *********************************************************************** 28800019 * * 28900019 * TRANSFER CONTROL ROUTINE * 29000019 * * 29100019 *********************************************************************** 29200019 RMI CLI TYPE(RUCB),T2250 IS DEVICE A 2250 29300019 BNE FREESAVE NO 29400019 SPACE 1 29500019 * 29600019 * THE FOLLOWING CODE IS A SIMULATED MACRO EXPANTION FOR A GRAPHIC 29700019 * READ MANUAL INPUT. 29800019 * 29900019 SPACE 1 30000019 L RDCB,DECBDCB GET POINTER TO DCB 30100019 XC DECBECB(DECBLN),DECBECB CLEAR DECB 30200019 ST RDCB,DECBDCB RESTORE POINTER TO DCB 30300019 MVI DECBTYPE,RMICODE SET RMI AS TYPE OF READ 30400019 LA RF,RMIAREA PUT POINTER TO INPUT 30500019 ST RF,DECBADDR AREA INTO DECB 30600019 LA RF,DECBECB LOAD PARM LIST FOR GIOCR 30700019 L RJ,GIOCRAD(RDCB) GET GIOCR'S ENTRY ADDRESS 30800019 BALR RD,RJ BRANCH TO GIOCR 30900019 LTR RJ,RJ WAS READ STARTED 31000019 BNE FREESAVE NO 31100019 WAIT ECB=DECBECB 31200019 *********************************************************************** 31300019 * * 31400019 * ISSUE FREEMAIN FOR SAVE AREA AND XCTL * 31500019 * * 31600019 *********************************************************************** 31700019 FREESAVE FREEMAIN R,LV=116,A=(13),SP=253 31800019 * 31900019 MVC SIX(TWO,RWTG),ZERO(RWTGC) MOVE ID TO NAME 32000019 MVC TTROFF(THREE,RWTG),TWO(RWTGC) MOVE TO TTR ROUTINE 32100019 LA RJ,DXCCW12(RC) GET ADDRESS OF NEW NAME FOR XCTL 32200019 XCTL DE=(RWTG),SF=(E,(RJ)) 32300019 EJECT 32400019 *********************************************************************** 32500019 * * 32600019 * EQUATES * 32700019 * * 32800019 *********************************************************************** 32900019 CVTTCBP EQU 0 33000019 ONE EQU 1 33100019 TWO EQU 2 33200019 UCBID EQU 2 OFFSET OF UCBID FIELD A55318 33250021 THREE EQU 3 33300019 PLOFF EQU 4 33400019 TCBLST EQU 4 33500019 SIX EQU 6 33600019 SEVEN EQU 7 33700019 EIGHT EQU 8 33800019 TETCB EQU 8 33900019 WGOFF EQU 8 34000019 FOUR EQU 4 34100019 ZERO EQU 0 34200019 GIOCRAD EQU 48 34300019 DECBLN EQU 32 34400019 GCB EQU 27 34500019 UCBADR EQU 32 34600019 TEUSECT EQU 16 34700019 TEFLG EQU 20 34800019 TEGARIRB EQU 24 34900019 TEGIR EQU 28 35000019 NEXT EQU 96 35100019 TYPE EQU 19 35200019 IQETCB EQU 12 35300019 USERTE EQU 28 35400019 DCBOFF EQU 84 35500019 COMVECPT EQU 16 35600019 WAOFF EQU 32 35700019 TTROFF EQU 14 35800019 N22 EQU 22 35900019 EIGHTEEN EQU 18 36000019 CVTADPTR EQU 16 36100019 EXTNUMB EQU 16 DISP INTO DEB FOR EXTENTS A25381 36150019 * 36200019 T2250 EQU X'02' 36300019 BASIC1 EQU X'08' 36400019 PROATTN EQU X'40' GCB FLAG INDICATES THAT A32068 36420020 * ATTNS WILL BE ACCEPTED A32068 36440020 * FROM THIS DEVICE A32068 36460020 BASIC EQU X'01' 36500019 ZEROENT EQU X'00' 36600019 TEFLAG EQU X'80' 36700019 T2260 EQU X'03' 36800019 DXCCW12 EQU X'1C8' 36900019 ATBL EQU X'CA' 37000019 FULLMASK EQU X'FF' MASK OF ALL ONES A25381 37050019 T1053 EQU X'04' 1053 DEVICE TYPE A35615 37070020 EJECT 37100019 *********************************************************************** 37200019 * * 37300019 * CONSTANTS * 37400019 * * 37500019 *********************************************************************** 37600019 SPACE 1 37700019 DS 0F 37800019 RMIAREA DC F'0' RMI DATA AREA 37900019 ZERO1 DC F'0' 38000019 IQE DC X'FD' SUBPOOL 253 38100019 DC AL3(16) BYTE REQUEST (IQES) 38200019 TE DC X'FF' SUBPOOL 255 38300019 DC AL3(32) TE BYTE REQUEST 38400019 DISPDEB DC A(DEBNMSUB-DEBEOEA) 38500019 OPIDCNST DC C'0S' END OF TABLE M4216 38600019 GIDCNST1 DC C'3Z' 38700019 DEV2250 DC XL2'1002' 38800019 DEV2260 DC XL2'1003' 38900019 DEV2280 DC XL2'1005' A40953 38930000 DEV2282 DC XL2'1006' A40953 38960000 DEV1053 DC XL2'1004' 39000019 GAS DC C'OE' 39100019 CAN03 DC C'03' 39200019 GIR DC C'OJ' 39300019 CONTAB DC X'C3780004000400' 39400019 DISABLE DC X'00' 39500019 ENABLE DC X'FF' 39600019 ORG IGG0193L+984 39700019 XCTLEND DC X'0000' 39800019 ORG IGG0193L+1020 39900019 DC C'019' 40000019 DC X'7B' 40100019 EJECT 40200019 *********************************************************************** 40300019 * * 40400019 * DSECTS * 40500019 * * 40600019 *********************************************************************** 40700019 SPACE 3 40800019 * 40900019 SPACE 3 41000019 *********************************************************************** 41100019 * * 41200019 * GRAPHIC DEB DUMMY SECTION * 41300019 * * 41400019 *********************************************************************** 41500019 SPACE 1 41600019 IECTDEB DSECT 41700019 DEBEOEA DS CL4 END OF EXTENT APP ROUTINE PTR 41800019 DEBSIOA DS CL4 START I/O APP ROUTINE PTR 41900019 DEBPCIA DS CL4 PROG CONTROL APP ROUTINE PTR 42000019 DEBCEA DS CL4 CHANNEL END APP ROUTINE PTR 42100019 DEBXCEA DS CL4 EX CHANNEL END APP ROUTINE PTR 42200019 DEBWKARA DS CL1 I/O SUPPORT WORK AREA 42300019 DEBDSCBA DS CL7 I/O SUPPORT DSCB AREA 42400019 DEBDCBMK DS CL4 I/O DCB MODIFICATION MASK 42500019 DEBLNGTH DS CL4 DEB LENGTH IN DOUBLE WORDS 42600019 DEBNMSUB DS CL1 NO. SUBROUTINES LOADED BY OPEN 42700019 DEBTCBAD DS CL3 TCB ADDR OF THIS DEB 42800019 DEBAMLNG DS CL1 NO. BYTES IN ACCESS METHOD SECT 42900019 DEBDEBAD DS CL3 NEXT DEB PTR IN THIS TASK 43000019 DEBOFLGS DS CL1 DATA SET STATUS FLAG 43100019 DEBIRBAD DS CL3 IRB ADDR FOR ERROR EXIT 43200019 DEBOPATB DS CL1 FILE TYPES 43300019 DEBSYSPG DS CL3 SYSTEM PURGE CHAIN 43400019 DEBNMEXT DS CL1 NO. OF EXTENTS BUILT FOR DSCB'S 43500019 DEBUSRPG DS CL3 USER PURGE CHAIN 43600019 DEBPRIOR DS CL1 TCB PRIORITY-IOS CH QUEING IOB 43700019 DEBECBAD DS CL3 IOS INTERNAL ECB ADDR 43800019 DEBPROTG DS CL1 TASK PROTECTION TAG 43900019 DEBDCBAD DS CL3 DCB ADDR 44000019 DEBEXSCL DS CL1 EXTENT SCALE 44100019 DEBAPPAD DS CL3 I/O APP BLOCK PTR 44200019 DEBUCBAD DS CL4 UCB PTR FOR GIVEN DATA EXTENT 44300019 EJECT 44400019 *********************************************************************** 44500019 * * 44600019 * DCB DSECT * 44700019 * * 44800019 *********************************************************************** 44900019 SPACE 1 45000019 DCBD DSORG=GS 45100019 EJECT 45200019 *********************************************************************** 45300019 * * 45400019 * SAVE AREA DSECT * 45500019 * * 45600019 *********************************************************************** 45700019 SPACE 1 45800019 SAVEAREA DSECT 45900019 WD1 DS F WORK WORD 46000019 HSA DS F HEAD SAVE AREA 46100019 LSA DS F LAST SAVE AREA 46200019 RET DS F RETURN ADDRESS 46300019 EPA DS F CALLING PROG ENTRY POINT 46400019 R0 DS F REG ZERO 46500019 R1 DS F REG ONE 46600019 R2 DS F REG TWO 46700019 R3 DS F REG THREE 46800019 R4 DS F REG FOUR 46900019 R5 DS F REG FIVE 47000019 R6 DS F REG SIX 47100019 R7 DS F REG SEVEN 47200019 R8 DS F REG EIGHT 47300019 R9 DS F REG NINE 47400019 R10 DS F REG TEN 47500019 R11 DS F REG ELEVEN 47600019 R12 DS F REG TWELVE 47700019 CAN03SVE DS F IFFCAN03 ADDRESS SAVE 47800019 GARSVE DS F GAR ADDRESS SAVE 47900019 GEIRSVE DS F GEIR ADDRESS SAVE 48000019 * * 48100019 * THE FOLLOWING SECTION OF THE DSECT IS USED FOR THE READ * 48200019 * MANUAL INPUT FROM THE 2250 AT OPEN TIME TO UNLOCK THE * 48300019 * KEYBOARD. THE GETMAIN AREA IS USED FOR THE DECB TO MAKE * 48400019 * THE MODULE REENTRANT. * 48500019 * * 48600019 * DECB * 48700019 * * 48800019 DECBECB DS F ECB WORD 48900019 DECBTYPE DS F TYPE OF I/O OPERATION 49000019 RMICODE EQU X'08' TYPE CODE FOR RMI 49100019 DECBDCB DS F POINTER TO DCB 49200019 DECBADDR DS F I/O BUFFER-DATA TO BE 49300019 * TRANSFERRED 49400019 DECBHEX DS C ECB POSTING CODE 49500019 DECBCNT DS 3C RESIDUAL COUNT FROM CSW AFTER 49600019 * I/O COMPLETED 49700019 DECBOCBP DS F O/P CONTROL BLOCK POINTER 49800019 DECBSTRT DS F START ADDR OF CONTROL ORDERS 49900019 DECBUNIT DS C UNIT INDEX 50000019 DECBBUFF DS 3C BUFFER ADDRESS 50100019 END 50200019 ./ ADD SSI=21120751,NAME=IGG0193Y,SOURCE=0 * TITLE- BASIC SUPPORT GRAPHIC OPEN EXECUTOR - IGG0193Y LOAD 1 00020000 * 00040000 *STATUS CHANGE LEVEL 1 00060000 * 00080000 * FUNCTION- PERFORMS GRAPHIC OPEN FUNCTIONS --- 00100000 * 1. BUILDS AND INITIALIZES DEB - GETMAIN 00120000 * 2. BUILDS AND INITIALIZES IOB(S) - GETMAIN 00140000 * 3.ASSIGNS BUFFER TO 2250(EXPRESS ONLY) 00160000 * 00180000 * ENTRY POINT- ENTERED BY OS OPEN LOAD 5 AT IGG0193Y 00200000 * 00220000 * INPUT- PARAMETER LIST ADDR IN REG 7 00240000 * 00260000 * OUTPUT- 1. DEB 00280000 * 2. IOB(S) 00300000 * 00320000 * EXTERNAL 00340000 * DEPENDENCY- IOS 00360000 * 00380000 * EXITS- 1. NORMAL - GR OPEN EXECUTOR LOAD 2 VIA XCTL 00400000 * 2. ABNORMAL - ABEND MACRO 00420000 * 00440000 * RETURN 00460000 * CODES- ABNORMAL END ONLY - REG 1 00480000 * 1.D13-INVALID DEVICE 00500000 * 2.E13-INVALID DCB GNCP PARAMETER 00520000 * 00540000 * TABLES 00560000 * WORK AREAS- DSECTS DESCRIBED IN LISTING 00580000 * 00600000 * ATTRIBUTES- 1. NONREENTRANT 00620000 * 2. ENABLED 00640000 * 3. PRIVILEDGED 00660000 * 00680000 * NOTES- ALL NOTES CONTAINED IN LISTING 00700000 * 00720000 * 00740000 * 00760000 * STANDARD SYSTEM REGISTERS --- 00780000 * 00800000 RE EQU 0 WORK/PARAMETER REGISTER 00820000 RF EQU 1 WORK/PARAMETER REGISTER 00840000 RDCB EQU 2 DCB ADDRESS REGISTER 00860000 RBASE EQU 3 BASE REGISTER 00880000 RCORE EQU 4 IOB ADDRESS REGISTER 00900000 RPAR EQU 5 PARAMETER LIST REGISTER 00920000 RWTG EQU 6 WTG REGISTER 00940000 RPARC EQU 7 CURRENT PARAMETER LIST ENTRY 00960000 RWTGC EQU 8 CURRENT WGT TABLE ENTRY 00980000 RTIOT EQU 9 TIOT ADDRESS REGISTER 01000000 RUCB EQU 10 CURRENT UCB ADDRESS REGISTER 01020000 RDEB EQU 11 DEB ADDRESS REGISTER 01040000 RB EQU 12 WORK REGISTER 01060000 RC EQU 13 WORK REGISTER 01080000 RD EQU 14 WORK/PARAMETER REGISTER 01100000 RJ EQU 15 WORK/PARAMETER REGISTER 01120000 * 01140000 * INITIALIZATION --- 01160000 * 01180000 IGG0193Y CSECT 01200000 *0166,075600 1831 01210014 *1337,030900,031600 PTM 3010 01215018 * 012400,018600-019000,022200-022600,024800-025200,080200-081400 S21016 01217021 *C32800 A48599 01217500 USING IHADCB,RDCB 01220000 USING FORCORE,RCORE BASE REG FOR FORCORE S21016 01240021 USING IECTDEB,RDEB 01260000 BALR RBASE,0 01280000 USING *,RBASE SET UP BASE REGISTER 01300000 L RDCB,0(RPARC,0) ACCESS POINTER TO DCB 01320000 * 01340000 * LOCATE DDNAME --- 01360000 * 01380000 L RC,COMVECPT(0,0) ACCESS POINTER TO CV TABLE 01400000 L RC,CVTTCBPT(0,RC) ACCESS POINTER TO TCB TABLE 01420000 L RC,CURNTTCB(0,RC) POINT TO CURRENT TCB 01440000 L RTIOT,TIOTPT(0,RC) LOAD PTR TO FIRST TIO TABLE 01460000 AH RTIOT,DCBTIOT ADD UCB OFFSET TO TIOT POINTER 01480000 LR RD,RTIOT LOAD TIOT LENGTH POSITION 01500000 * 01520000 * VERIFY DEVICE --- 01540000 * 01560000 CHECKGID EQU * 01580000 L RB,16(0,RTIOT) GET UCB ADDR 01600000 LA RB,0(0,RB) CLEAR HIGH ORDER BYTE 01620000 LH RF,18(RB) GET DEVICE AND UNIT TYPE 01640000 CH RF,TPUNIT50 CHECK FOR 2250 - CODE 1002 01660000 BE DEVOPN CORRECT CODE - CONTINUE 01680000 CH RF,TPUNIT60 CHECK FOR 2260 - CODE 1003 01700000 BE DEVOPN CORRECT CODE - CONTINUE 01720000 CH RF,TPUNIT53 CHECK FOR 1053 - CODE 1004 01740000 BE DEVOPN VALID - CONTINUE 01760000 CH RF,TPUNIT80 CHECK FOR 2280 - CODE 1005 01780000 BE DEVOPN VALID - CONTINUE 01800000 CH RF,TPUNIT82 CHECK FOR 2282 - CODE 1006 01820000 BE DEVOPN VALID - CONTINUE 01840000 DMABCOND 92,PDLOAD,RES=NO,REGSAVE=YES S21016 01850021 B RELOOP NOW GO GIVE CONTROL TO S21016 01860021 * O/C/EOV PROBLEM S21016 01870021 * DETERMINATION S21016 01880021 * ROUTINE S21016 01890021 * 01920000 * OPTION 4 CHECK - DEVICE OPENED BY SAME TASK 01940000 * 01960000 DEVOPN L RF,UCBTE(RB) LOAD ADR OF TE FROM UCB 01980000 LA RF,ZERO(RF) CLEAR HI-ORDER BYTE 02000000 SSM DISABLE DISABLE INTERRUPTS 02020000 CLI USECNT(RB),X'00' USECNT = ZERO 02040000 BE VERGNCP VALID - CONTINUE 02060000 LTR RF,RF DOES TE EXIST? 02080000 BC 8,VERGNCP BRANCH IF NO - CONTINUE 02100000 L RUCB,TETCB(RF) LOAD TE TCB ADR 02120000 LA RUCB,ZERO(RUCB) CLEAR HI-ORDER BYTE 02140000 CR RC,RUCB CURRENT TCB = TETCB 02160000 BE VERGNCP BRANCH IF YES - CONTINUE 02180000 SSM ENABLE 02200000 DMABCOND 91,PDLOAD,RES=NO,REGSAVE=YES S21016 02210021 B RELOOP NOW GO GIVE CONTROL TO S21016 02220021 * O/C/EOV PROBLEM S21016 02230021 * DETERMINATION S21016 02240021 * ROUTINE S21016 02250021 * 02280000 * VERIFY GNCP - NO OF IOB(S) --- 02300000 * 02320000 VERGNCP EQU * 02340000 CLI DCBGNCP,MAXGNCP CHECK GNCP GREATER THAN 99 02360000 BC 2,GRABEND GREATER THAN 99 - ABEND 02380000 CLI DCBGNCP,MINGNCP CHECK GNCP LESS OR EQUAL TO 0 02400000 BC 2,CONSTDEB GREATER THAN ZERO-CONTINUE 02420000 GRABEND EQU * 02440000 SSM ENABLE 02460000 DMABCOND 93,PDLOAD,RES=NO,REGSAVE=YES S21016 02470021 B RELOOP NOW GO GIVE CONTROL TO S21016 02480021 * O/C/EOV PROBLEM S21016 02490021 * DETERMINATION S21016 02500021 * ROUTINE S21016 02510021 * 02540000 * CONSTRUCT DEB --- 02560000 * 02580000 CONSTDEB EQU * 02600000 DROP RCORE DROP RCORE S21016 02606021 USING IECTIOB,RCORE BASE FOR IOB DSEDT S21016 02612021 SR RCORE,RCORE CLEAR DDNAME COUNT REGISTER 02620000 SR RB,RB CLEAR EXTENT NUMBER REGISTER 02640000 SR RF,RF CLEAR LENGTH REGISTER 02660000 * 02680000 * CALCULATE TOTAL DEB SIZE --- 02700000 * 02720000 DDBLKLP EQU * 02740000 LA RCORE,ONE(0,RCORE) BUMP FOR EACH CONCAT DDNAME 02760000 IC RF,ZERO(RD,0) PICK UP LENGTH OF TIOT 02780000 AR RD,RF ADD LENGTH FOR NEXT TIOT 02800000 SH RF,SIXTEEN L-16 IS AMOUNT OF UCB S 02820000 AR RB,RF ACCUMULATE UCB S-NO OF EXTENTS 02840000 NC ZERO(4,RD),ZERO(RD) ZERO TEST ON START OF TIOT 02860000 BZ EOTTABLE ZERO - BRANCH 02880000 CLI 4(RD),X'40' TEST FOR BLANK DDNAME 02900000 BE DDBLKLP GET TOTAL UCB S FOR GETMAIN 02920000 EOTTABLE EQU * 02940000 LA RE,MINSIZE(0,RB) LOAD TOTAL SIZE 02960000 * 02980000 * DEB GETMAIN --- 03000000 * 03020000 LR RD,RE NO OF DOUBLE WORDS INTO WKREG 03040000 A RD,SEVEN 1831 03050014 SRL RD,3 SHIFT OUT 7-ADDED FOR DD WD BD 03060000 O RE,DEBSPOOL SUBPOOL NO INTO HIGH ORDER BYTE 03080000 SR RF,RF CLEAR GETMAIN RETURN REGISTER 03100000 GETMAIN R,LV=(0) DEB SIZE IN REGISTER 0 03120000 LR RDEB,RF DEB SIZE = 52 + 20 + 7 + UCB S 03140000 LR RJ,RD DEB SIZE TRANSFERED 3010 03150018 SLL RJ,THREE MULTIPLY DEB SIZE IN DOUBLE3010 03160018 * WORDS TO SIZE IN BYTES. 3010 03170018 * 03180000 * CLEAR DEB --- 03200000 * 03220000 CLEARL EQU * 03240000 CH RJ,HWC256 DEB SIZE LESS THAN 256 BYTES 03260000 BNH EXMODIFY YES - RRANCH A48599 03280000 LA RDCB,255(0,0) LENGTH IN RDCB FOR EX INSTR 03300000 SH RJ,HWC256 SUBTRACT FOR SIZE TEST 03320000 EX RDCB,CLEARDEB EXECUTE CLEAR DEB INSTRUCTION 03340000 AH RDEB,HWC256 INCREMENT DEB PTR BY 256 03360000 B CLEARL BRANCH TO SIZE TEST 03380000 * 03400000 * INITIALIZE DEB --- 03420000 * 03440000 EXMODIFY EQU * 03460000 SH RJ,NUMONE DECREMENT BY 1 FOR EX INSTR 03480000 EX RJ,CLEARDEB LAST DEB SIZE CLEARED 03500000 LR RDEB,RF REINITIALIZE DEB POSITION 03520000 L RDCB,0(RPARC,0) REINITIALIZE DCB POSITION 03540000 SRL RB,2 DEVIDE UCB S BY 4 03560000 ST RF,DEBEXSCL STORE DEB APPENDAGE TABLE ADDR 03580000 MVI DEBEXSCL,X'02' MOVE IN 2 FOR NON-DIR ACC DEV 03600000 STC RB,DEBNMEXT MOVE NO OF EXTENTS INTO DEB 03620000 ST RC,DEBNMSUB DEBTCBAD OVERLAYS DEBNMSUB 03640000 L RF,8(RC) GET FIRST DEB ADDR 03660000 ST RF,DEBAMLNG STORE INTO DEB 03680000 MVI DEBAMLNG,X'00' CLEAR HIGH ORDER BYTE 03700000 LA RF,DEBNMSUB ACCESS ADDR OF BASIC DEB 03720000 ST RF,8(RC) STORE DEB ADDR INTO TASK 03740000 IC RB,DCBIFLGS SAVE DCBIFLGS 03760000 ST RF,DCBIFLGS DEB ADDRESS TO DCBDEBAD 03780000 STC RB,DCBIFLGS RESTORE DCBIFLGS 03800000 ST RDCB,DEBPROTG DCB ADDRESS TO DEBDCBAD 03820000 MVC DEBPROTG,28(RC) STORAGE KEY TO DEB 03840000 OI DEBPROTG,X'0F' PROTECTION TAG FOR DEB ID 03860000 STC RD,DEBLNGTH MOVE IN DOUBLE WORDS OF DEB 03880000 LA RJ,DEBUCBAD ACCESS DEBUCB ADDRESS 03900000 * 03920000 * ATTACH UCB ADDR(S) TO DEB --- 03940000 * 03960000 DEBMOVE1 EQU * 03980000 SR RF,RF CLEAR LENGTH REGISTER 04000000 IC RF,ZERO(0,RTIOT) LOCATE STARTING TIOT 04020000 SH RF,SEVNTEEN UCB S PLUS 1 FOR EX INSTR 04040000 EX RF,UCBMOVE MOVE UCB S FROM TIOT TO DEB 04060000 LA RJ,ONE(RJ,RF) INCREMENT DEB POS BY LENGTH 04080000 LA RTIOT,TIOTOFF(RTIOT,RF) INCREMENT TO PT TO NEXT TIOT 04100000 BCT RCORE,DEBMOVE1 GO GET NEXT UCB, IF ANY MORE 04120000 * 04140000 * SET UP IOS APPENDAGE TABLE --- 04160000 * 04180000 L RC,COMVECPT(0,0) ACCESS PTR TO CVT 04200000 L RC,CVTAPP(RC) LOAD IOS APPANDAGE TABLE ADDR 04220000 L RC,ZERO(RC) LOAD IOS RETURN ADDR 04240000 ST RC,DEBEOEA STORE INTO DEB APPENDAGE TABLE 04260000 ST RC,DEBSIOA STORE INTO DEB APPENDAGE TABLE 04280000 ST RC,DEBPCIA STORE INTO DEB APPENDAGE TABLE 04300000 * 04320000 * CALCULATE TOTAL IOB CORE NEEDED --- 04340000 * 04360000 SR RB,RB CLEAR REGISTER 04380000 SR RD,RD CLEAR MULTIPLIER REG 04400000 IC RD,DCBGNCP GET GNCP INTO MULTIPLIER REG 04420000 CLI DCBGNCP,X'63' IS GNCP EQUAL TO MAXIMUM 04440000 BE OAM3 BRANCH IF YES 04460000 LA RD,1(0,RD) ADD ONE FOR EXTRA IOB 04480000 OAM3 EQU * 04500000 SR RC,RC CLEAR SIZE REG 04520000 IC RC,BASICSZ GET BASIC IOB SIZE 04540000 MR RB,RD MULTIPLY IOB SIZE BY GNCP 04560000 LA RE,0(RC) TOTAL IOB CORE INTO REG 0 04580000 SR RC,RC CLEAR REGISTER 04600000 IC RC,BASICSZ GET BASIC IOB SIZE 04620000 AH RE,EIGHT ADD 8-1ST AVAIL IOB PT,DD WD BD 04640000 * 04660000 * IOB GETMAIN --- 04680000 * 04700000 O RE,IOBSPOOL SUBPOOL NO INTO HIGH ORDER BYTE 04720000 GETMAIN R,LV=(0) GET CORE FOR IOB S 04740000 LA RCORE,0(RF) GET ADDR OF IOB(S) 04760000 XC 0(8,RCORE),0(RCORE) CLEAR 1ST IOB -8 04780000 AH RCORE,EIGHT POINT PAST 1ST AVAIL PTR 04800000 ST RCORE,DCBIOBAD STORE IOB ADDR INTO DCB 04820000 * 04840000 * CLEAR AND INITIALIZE IOB(S) --- 04860000 * 04880000 SR RTIOT,RTIOT CLEAR COUNT REGISTER 04900000 SH RC,NUMONE SUBTRACT FOR IOB LENGTH 04920000 STARTCLP EQU * 04940000 EX RC,CLEAR CLEAR 1 IOB 04960000 MVI SOBCSW+4,X'0F' IND CHANNEL OPERATION COMP S21016 04980021 MVI SOBFLAG1,X'C2' SET BITS 0, 1, AND 6 S21016 05000021 CH RD,NUMONE 1 OR MORE IOBS 05020000 BC 2,NXTIOB MORE THAN 1 IOB - GET LINK ADDR 05040000 BC 15,NONXTIOB JUST 1 - NO NEXT IOB LINK ADDR 05060000 NXTIOB EQU * 05080000 LA RB,IOBOFF(0,RCORE) GET NEXT IOB LINK ADDR 05100000 ST RB,SOBNXTPT STORE NEXT IOB LINK ADDR S21016 05120021 NONXTIOB EQU * 05140000 LA RB,CCWOFF(0,RCORE) GET CCW START ADDR 05160000 ST RB,SOBSTART START ADDRESS IN IOB S21016 05180021 STC RTIOT,SOBUCBX INDEX ZERO FOR FIRST UCB S21016 05200021 AH RTIOT,NUMONE INCREMENT UCB INDEX COUNT 05220000 ST RDCB,SOBWGHT STORE DCB ADDRESS S21016 05240021 MVI SOBWGHT,X'00' CLEAR HIGH ORDER BYTE S21016 05260021 LA RCORE,ONE(RCORE,RC) BUMP FOR NEXT IOB CLEAR 05280000 BCT RD,STARTCLP CLEAR NEXT IOB, IF ANY 05300000 B XPRESSCK BRANCH 05320000 * 05340000 * END GRAPHIC OPEN EXECUTOR LOAD 1 --- 05360000 * 05380000 BACK L RJ,4(RWTGC) GET WORK AREA ADR 05400000 MVC 0(5,RWTGC),GAMLOAD2 SET UP GR OPEN LOAD 2 ID 05420000 RELOOP EQU * 05440000 LA RWTGC,WGOFF(0,RWTGC) BUMP CURRENT WTG REGISTER 05460000 LA RPARC,PLOFF(0,RPARC) BUMP CUR PARM REG TO NEXT ENTRY 05480000 CLC 0(2,RWTGC),GIDCNST1 CHECK NEXT WTG ENTRY 05500000 BCR 8,RBASE YES 05520000 CLC ZERO(2,RWTGC),OPIDCNST NO - TEST FOR END OF TABLE 05540000 BNE RELOOP NOT - CHECK NEXT ENTRY 05560000 LR RPARC,RPAR REINITIALIZE CURRENT WTG REG 05580000 LA RWTGC,WAOFF(0,RWTG) REINITIALIZE CURR PARM REG 05600000 ZCHECK EQU * 05620000 CLI 0(RWTGC),X'00' TEST FOR ZERO ENTRY 05640000 BNE XCTLRTNE NOT - GO TO TRANSFER CONTROL 05660000 LA RWTGC,WGOFF(0,RWTGC) ZERO - GET NEXT ENTRY AND 05680000 LA RPARC,PLOFF(0,RPARC) RETURN TO ZCHECK 05700000 B ZCHECK RETURN. 05720000 * 05740000 * TRANSFER CONTROL ROUTINE --- 05760000 * 05780000 XCTLRTNE EQU * 05800000 LA RJ,HEX1C8(RJ) ADDR OF NEW NAME FOR XCTL S21016 05820021 MVC 6(2,RWTG),0(RWTGC) MOVE ID FROM CURR WGT TO NAME 05840000 MVC TTROFF(3,RWTG),2(RWTGC) MOVE TO TTR ROUTINE 05860000 XCTL DE=(RWTG),SF=(E,(15)) TRANSFER CONTROL 05880000 XPRESSCK SR RB,RB CLEAR REG 05900000 LA RC,ZERO ZERO REG 05920000 L RDEB,DCBDEBAD LOAD DEB ADRESS 05940000 IC RB,16(RDEB) INSERT NO. OF UCBS 05960000 OAM1 L RUCB,UCBADR(RC,RDEB) LOAD UCB ADDR. 05980000 SR RD,RD CLEAR REG 06000000 IC RD,USECNT(RUCB) INSERT USE COUNT 06020000 LA RD,ONE(0,RD) INCREMENT USE COUNT 06040000 STC RD,USECNT(RUCB) STORE NEW USE COUNT 06060000 CLI USECNT(RUCB),X'01' USE COUNT = 1 06080000 BC 7,OAM2 BRANCH IF NO 06100000 NI GCB(RUCB),X'FC' TURN OFF BITS 6&7 IN GCB 06120000 OAM2 LA RC,FOURA(0,RC) INCREMENT INDEX 06140000 BCT RB,OAM1 BRANCH IF MORE UCBS TO SERVICE 06160000 SSM ENABLE ENABLE INTERRUPTS 06180000 TM DCBGTYPE,BASIC IS THIS A BASIC SYSTEM 06200000 BC 1,BACK BRANCH IF YES 06220000 L RC,DCBDEBAD LOAD DEB ADR 06240000 L RUCB,UCBADR(0,RC) LOAD UCB ADDRESS 06260000 CLI TYPE(RUCB),T2250 IS THIS A 2250 06280000 BNE BACK BRANCH IF NO 06300000 L RB,BFRTAB(0,RUCB) LOAD BFR TABLE ADR 06320000 LA RB,0(0,RB) ZERO HIGH ORDRR BYTE 06340000 LTR RB,RB BUFFER TABLE EXIST 06360000 BC 8,BACK BRANCH IF NO 06380000 CLI 16(RUCB),X'31' IS IT A MODEL 1 06400000 BE FILLIN BRANCH IF YES TO AUTO ASGN 06420000 LA RB,XPRBUF(0,RB) LOAD ADR OF EXPRESS BUFFER SIZE 06440000 LA RE,ATE LOAD CORE SIZE 06460000 GETMAIN R,LV=(0) 06480000 IC RUCB,DCBOFLGS SAVE OFLGS 06500000 MVI DCBOFLGS,X'12' MOVE IN DUMMY FLGS 06520000 ASGNBFR (2),(12),MF=(E,(1)) 06540000 STC RUCB,DCBOFLGS RESTORE OFLGS 06560000 LA RE,ATE LOAD CORE SIZE 06580000 FREEMAIN R,LV=(0),A=(1) 06600000 B BACK BRANCH 06620000 FILLIN MVC 8(2,RB),0(RB) PUT TBLNGTH IN TASGND FLD 06640000 XC 6(2,RB),6(RB) CLEAR TOTAVAIL FLD 06660000 IC RJ,36(RUCB) PICK UP DEVNDX 06680000 STC RJ,16(RB) PUT IN 1ST SLOT OF BFRTBL 06700000 LH RJ,0(RB) PICK UP TBLNGTH 06720000 SH RJ,NUMTWO 06740000 EX RJ,XPRASG 06760000 XC DCBBFRST(2),DCBBFRST CLEAR BFRST FLD 06780000 MVC DCBBFRSZ(2),4(RB) FILL IN BFRSZ FLD WITH EXPBFR 06800000 B BACK BRANCH 06820000 * 06840000 * CONSTANTS AND CODES --- 06860000 * 06880000 T2250 EQU X'02' 06900000 TYPE EQU 19 06920000 ATE EQU 16 06940000 XPRBUF EQU 4 06960000 BFRTAB EQU 36 06980000 UCBADR EQU 32 07000000 BASIC EQU X'01' 07020000 FOURA EQU 4 FOUR 07040000 THREE EQU 3 A SHIFT FACTOR OF THREE 3010 07045018 * TO MULTIPLYING BY 8 3010 07050018 * BITS WHICH IS EQUIVALENT 3010 07055018 GCB EQU 27 GRAPHIC CONTROL BYTE 07060000 USECNT EQU 26 USE COUNT FIELD IN UCB 07080000 DCBOFF EQU 84 07100000 TIOTPT EQU 12 07120000 CURNTTCB EQU 4 07140000 CVTTCBPT EQU 0 07160000 COMVECPT EQU 16 07180000 ONE EQU 1 07200000 ZERO EQU 0 07220000 MINSIZE EQU 79 07240000 CVTAPP EQU 20 07260000 IOBOFF EQU 72 07280000 CCWOFF EQU 40 07300000 PLOFF EQU 4 07320000 WGOFF EQU 8 07340000 WAOFF EQU 32 07360000 TTROFF EQU 14 07380000 TIOTOFF EQU 17 07400000 HEX1C8 EQU X'1C8' DISP FOR NEW XCTL S21016 07420021 DCBVMASK EQU X'80' 07440000 MINGNCP EQU X'00' 07460000 MAXGNCP EQU X'63' 07480000 TETCB EQU 8 OFFSET OF TCB FLD IN TE 07500000 UCBTE EQU 28 OFFSET OF TE FLD IN UCB 07520000 DS 0F 07540000 SEVEN DC F'7' 1831 07560014 DEBSPOOL DC X'FE000000' 07580000 IOBSPOOL DC X'FA000000' 07600000 NUMONE DC H'01' 07620000 NUMTWO DC H'02' 07640000 SIXTEEN DC H'16' 07660000 HWC256 DC H'256' 07680000 SEVNTEEN DC H'17' 07700000 EIGHT DC H'08' 07720000 TPUNIT50 DC XL2'1002' 07740000 TPUNIT60 DC XL2'1003' 07760000 TPUNIT53 DC XL2'1004' 07780000 TPUNIT80 DC XL2'1005' 07800000 TPUNIT82 DC XL2'1006' 07820000 OPIDCNST DC C'0S' 07840000 GIDCNST1 DC C'3Y' 07860000 BASICSZ DC HL1'72' 07880000 ENABLE DC X'FF' 07900000 DISABLE DC X'00' 07920000 CLEAR XC 0(1,RCORE),0(RCORE) 07940000 UCBMOVE MVC 0(1,RJ),16(RTIOT) 07960000 CLEARDEB XC 0(1,RDEB),0(RDEB) 07980000 XPRASG MVC 17(1,RB),16(RB) AUTOMATIC ASSIGN FOR EXPRESS 08000000 XCTLTABL ID=(GAMLOAD2,3Z,PDLOAD,6M),SVC=019 S21016 08030021 EJECT S21016 08060021 IECDSECS MAIN,EXPAND=YES S21016 08090021 EJECT S21016 08120021 * 08160000 * GRAPHIC IOB DUMMY SECTION --- 08180000 * 08200000 IECTIOB DSECT 08220000 SOBFLAG1 DS C IOS CHANNEL PROG DESCRIPTION S21016 08240021 SOBFLAG2 DS C INTERNAL IOS FLAG S21016 08260021 SOBSENSE DS H IOS ERROR INFORMATION S21016 08280021 SOBECBPT DS F ECB PTR S21016 08300021 SOBCSW DS 2F CSW STORED AT CE TIME S21016 08320021 SOBSIOCC DS 0CL1 START I/O COND CODE S21016 08340021 SOBSTART DS F START CHANNEL PROG PTR S21016 08360021 SOBWGHT DS 0CL1 CHANNEL WEIGHT (IN POUNDS) S21016 08380021 SOBDCBPT DS F DCB POINTER S21016 08400021 SOBRESTR DS F RESTART CHAN PROGRAM PTR S21016 08420021 SOBINCAM DS H IOS INCREMENT TO BLOCK COUNT S21016 08440021 SOBERRCT DS H ERROR COUNT S21016 08460021 SOBUCBX DS 0CL1 UCB INDEX S21016 08480021 SOBADRPT DS F ADDRESSING LIST POINTER S21016 08500021 SOBNXTPT DS F NEXT IOB POINTER S21016 08520021 SOBCCW DS 8F GRAPHIC CHANNEL PROGRAM S21016 08540021 * 08560000 * GRAPHIC DEB DUMMY SECTION --- 08580000 * 08600000 IECTDEB DSECT 08620000 DEBEOEA DS CL4 END OFEXTENT APP ROUTINE PTR 08640000 DEBSIOA DS CL4 START I/O APP ROUTINE PTR 08660000 DEBPCIA DS CL4 PROG CONTROL APP ROUTINE PTR 08680000 DEBCEA DS CL4 CHANNEL END APP ROUTINE PTR 08700000 DEBXCEA DS CL4 EX CHANNEL END APP ROUTINE PTR 08720000 DEBWKARA DS CL1 I/O SUPPORT WORK AREA 08740000 DEBDSCBA DS CL7 I/O SUPPORT DSCB AREA 08760000 DEBDCBMK DS CL4 I/O DCB MODIFICATION MASK 08780000 DEBLNGTH DS CL4 DEB LENGTH IN DOUBLE WORDS 08800000 DEBNMSUB DS CL1 NO SUBROUTINES LOADED BY OPEN 08820000 DEBTCBAD DS CL3 TCB ADDRESS OF THIS DEB 08840000 DEBAMLNG DS CL1 NO BYTES IN ACCESS METHOD SECT 08860000 DEBDEBAD DS CL3 NEXT DEB PTR IN THIS TASK 08880000 DEBOFLGS DS CL1 DATA SET STATUS FLAG 08900000 DEBIRBAD DS CL3 IRB ADDR FOR ERROR EXIT 08920000 DEBOPATB DS CL1 FILE TYPES 08940000 DEBSYSPG DS CL3 SYSTEM PURGE CHAIN 08960000 DEBNMEXT DS CL1 NO EXTENTS CONSTRUCTED - DSCB S 08980000 DEBUSRPG DS CL3 USER PURGE CHAIN 09000000 DEBPRIOR DS CL1 TCB PRIORITY-IOS CH QUEING IOB 09020000 DEBECBAD DS CL3 IOS INTERNAL ECB ADDR 09040000 DEBPROTG DS CL1 TASK PROTECTION TAG 09060000 DEBDCBAD DS CL3 DCB ADDR 09080000 DEBEXSCL DS CL1 EXTENT SCALE 09100000 DEBAPPAD DS CL3 I/O APPENDAGE BLOCK PTR 09120000 DEBUCBAD DS CL4 UCB PTR FOR GIVEN DATA EXTENT 09140000 DCBD DSORG=GS 09160000 END 09180000 ./ ADD SSI=02051365,NAME=IGG0193Z,SOURCE=0 TITLE ' IGG0193Z - LOAD 2 BASIC GRAPHICS OPEN EXECUTOR ' 00300019 IGG0193Z CSECT 00600019 * 216000 M2961 00700019 * TITLE - IGG0193Z LOAD 2 BASIC GRAPHICS OPEN EXECUTOR 00900019 * STATUS - CHANGE LEVEL 1 01200019 * FUNCTION - 1. LOADS GIOCR AND CHANNEL END APPENDAGE 01500019 * 2. EXPANDS/CREATES POLST(EXPRESS ONLY) 01800019 * 02100019 * ENTRY POINT - ENTERED BY OS/360 OPEN AT IGG0193Z 02400019 * 02700019 * INPUT - PARAMETER LIST ADDRESS IN REGISTER 7 03000019 * 03300019 * OUTPUT - POLST(EXPRESS ONLY) 03600019 * EXTERNAL 03900019 * REFERENCES - LOAD 04200019 * XCTL 04500019 * 04800019 * EXITS - 1. NORMAL- GRAPHIC OPEN EXECUTOR LOAD 3 IGG0193L 05100019 * 2. ABNORMAL- ABEND SVC 05400019 * 05700019 * RETURN CODES - N/A 06000019 * 06300019 * TABLES 06600019 * WORK AREAS - DSECTS DESCRIBED IN LISTING 06900019 * 07200019 * ATTRIBUTES - 1. REENTRANT 07500019 * 2. ENABLED 07800019 * 3. PRIVILEDGED 08100019 * 08400019 * NOTES - ALL NOTES CONTAINED IN LISTING 08700019 * 09000019 EJECT 09300019 *********************************************************************** 09600019 * * 09900019 * REGISTER EQUATES * 10200019 * * 10500019 *********************************************************************** 10800019 RE EQU 0 WORK/PARAMETER REGISTER 11100019 RF EQU 1 WORK/PARAMETER REGISTER 11400019 RDCB EQU 2 DCB ADDRESS REGISTER 11700019 RBASE EQU 3 BASE REGISTER 12000019 RCORE EQU 4 IOB ADDRESS REGISTER 12300019 RPAR EQU 5 PARAMETER LIST REGISTER 12600019 RWTG EQU 6 WTG REGISTER 12900019 RPARC EQU 7 CURRENT PARAMETER LIST ENTRY 13200019 RWTGC EQU 8 CURRENT WGT TABLE ENTRY 13500019 RUCB EQU 10 CURRENT UCB ADDRESS REGISTER 13800019 RDEB EQU 11 DEB ADDRESS REGISTER 14100019 RC EQU 12 WORK REGISTER 14400019 RD EQU 14 WORK/PARAMETER REGISTER 14700019 RJ EQU 15 WORK/PARAMETER REGISTER 15000019 *********************************************************************** 15300019 * * 15600019 * INITIALIZATION * 15900019 * * 16200019 *********************************************************************** 16500019 USING IHADCB,RDCB 16800019 USING IECTDEB,RDEB 17100019 BALR RBASE,0 17400019 USING *,RBASE SET UP BASE REGISTER 17700019 L RDCB,ZERO(RPARC) INIT DCB BASE REG 17800019 L RDEB,DCBDEBAD INITIALIZE DEB BASE REG 18000019 LA RDEB,0(0,RDEB) CLEAR HIGH ORDER BYTE 18300019 S RDEB,DISPDEB GET CORRECT DEB BASE 18600019 * 18900019 * LOAD ROUTINE FUNCTIONS --- 19200019 * 19500019 SR RD,RD CLEAR SUB ID REGISTER 19800019 LA RUCB,DEBUCBAD SUB ID SECTION FOLLOWS UCB S 20100019 IC RD,DEBNMEXT GET NO OF UCB S 20400019 SLL RD,2 ACCESS ACTUAL SIZE OF UCB S 20700019 AR RUCB,RD PTR TO SUB ID SECTION 21000019 SR RD,RD CLEAR SUB COUNT REGISTER 21300019 * 21900019 * LOAD GIOCR --- 22200019 * 22500019 L RF,COMVECPT(0,0) GET PTR TO CVT 22800019 L RF,DCBOFF(0,RF) GET SVC DCB PTR 23100019 LOAD EP=IGG019OA,DCB=(1) 23400019 LA RC,GIOCR LOAD GIOCR ID ADDRESS 23700019 MVC ZERO(TWO,RUCB),ZERO(RC) MOVE ID TO DEB 24000019 LA RUCB,2(0,RUCB) POINT TO NEXT DEB SUB ID SECTION 24300019 LA RD,ONE(0,RD) INCREMENT ROUTINES LOADED COUNT 24600019 STC RD,DEBNMSUB STORE COUNT IN DEB 24900019 IC RC,DCBOFLGS SAVE FLAGS 25200019 ST RE,DCBGIOCR PLACE GIOCR ADDRESS IN DCB 25500019 STC RC,DCBOFLGS RESTORE FLAGS 25800019 * 26100019 * LOAD CH END APP --- 26400019 * 26700019 L RF,COMVECPT(0,0) GET PTR TO CVT 27000019 L RF,DCBOFF(0,RF) GET SVC DCB PTR 27300019 LOAD EP=IGG019OB,DCB=(1) 27600019 LA RC,CHEAPP LOAD CH END APP ID ADDRESS 27900019 MVC ZERO(TWO,RUCB),ZERO(RC) MOVE ID TO DEB 28200019 LA RUCB,2(0,RUCB) POINT TO NEXT DEB SUB ID SECTION 28500019 LA RD,ONE(0,RD) INCREMENT ROUTINES LOADED COUNT 28800019 STC RD,DEBNMSUB STORE COUNT IN DEB 29100019 ST RE,DEBCEA STORE ADDRESS 29400019 ST RE,DEBXCEA STORE ADDRESS 29700019 L RF,DEBUCBAD LOAD UCB ADR 30000019 CLC 18(2,RF),TPUNIT80 2280 30300019 BC 8,AM210 YES 30600019 CLC 18(2,RF),TPUNIT82 2282 30900019 BC 8,AM210 YES 31200019 B OAM217 BRANCH 31500019 * 31800019 * END GR OPEN EXECUTOR ROUTINE --- 32100019 * 32400019 OAM217 TM DCBGTYPE,BASIC IS THIS A BASIC SYSTEM 32700019 BO AM210 BRANCH IF YES 33000019 L RC,DCBPOLST GET POLST ADR 33300019 LA RC,0(0,RC) CLEAR HI ORDER BYTE 33600019 C RC,ZERO1 POLST ADR=0 33900019 BE AM210 BRANCH IF YES 34200019 TM ZERO(RC),VERPOLST CHECK FOR EXISTING POLST 34500019 BO POLSTADD BRANCH IF EXIST 34800019 ST RC,ZERO(RC) STORE PTR INTO FIRST LOC OF POLS 35100019 POLSTADD EQU * 35400019 SR RCORE,RCORE CLEAR REG 35700019 IC RCORE,DEBNMEXT INSERT NO. OF UCBS 36000019 SR RD,RD CLEAR REG 36300019 POLSTBMP EQU * 36600019 L RJ,ZERO(RC) GET POLST PTR 36900019 LA RJ,FOUR(ZERO,RJ) BUMP LAST DCB PTR TO NEXT ENTRY 37200019 ST RJ,ZERO(RC) STORE UPDATED PTR IN POLST 37500019 ST RDCB,ZERO(RJ) DCB ADDRESS TO POLST 37800019 STC RD,ZERO(RJ) INDEX TO POLST 38100019 LA RD,ONE(0,RD) BUMP INDEX CNTR 38400019 BCT RCORE,POLSTBMP BRANCH IF MULTIPLE DEVICES 38700019 OI ZERO(RC),VERPOLST POLST CODE TO HI ORDER BYTE 39000019 AM210 L RC,FOUR(RWTGC) GET WORK AREA ADDRESS 39300019 MVC ZERO(FIVE,RWTGC),GAMLOAD3 SET UP GRAPHIC OPEN LD 3 39600019 RELOOP EQU * 39900019 LA RWTGC,WGOFF(0,RWTGC) BUMP CURRENT WTG REGISTER 40200019 LA RPARC,PLOFF(0,RPARC) BUMP CUR PARM REG TO NEXT ENTRY 40500019 CLC 0(2,RWTGC),GIDCNST1 CHECK NEXT WTG ENTRY 40800019 BCR 8,RBASE YES 41100019 CLC ZERO(2,RWTGC),OPIDCNST NO - TEST FOR END OF TABLE 41400019 BNE RELOOP NOT - CHECK NEXT ENTRY 41700019 LR RPARC,RPAR REINITIALIZE CURRENT WTG REG 42000019 LA RWTGC,WAOFF(0,RWTG) REINITIALIZE CURR PARM REG 42300019 ZCHECK EQU * 42600019 CLI 0(RWTGC),X'00' TEST FOR ZERO ENTRY 42900019 BNE XCTLRTNE NOT - GO TO TRANSFER CONTROL 43200019 LA RWTGC,WGOFF(0,RWTGC) ZERO - GET NEXT ENTRY AND 43500019 LA RPARC,PLOFF(0,RPARC) RETURN TO ZCHECK 43800019 B ZCHECK RETURN. 44100019 *********************************************************************** 44400019 * * 44700019 * XCTL ROUTINE TO LOAD 3 * 45000019 * * 45300019 *********************************************************************** 45600019 XCTLRTNE EQU * 45900019 MVC SIX(TWO,RWTG),ZERO(RWTGC) MOVE ID TO NAME 46200019 MVC TTROFF(THREE,RWTG),TWO(RWTGC) MOVE TO TTR ROUTINE 46500019 LA RJ,DXCCW12(RC) GET ADDRESS OF NEW NAME FOR XCTL 46800019 XCTL DE=(RWTG),SF=(E,(RJ)) 47100019 * 47400019 * CONSTANTS AND CODES --- 47700019 * 48000019 TWO EQU 2 9907 48300019 SIX EQU 6 9907 48600019 FIVE EQU 5 48900019 BASIC EQU X'01' 49200019 VERPOLST EQU X'FF' 49500019 THREE EQU 3 49800019 FOUR EQU 4 50100019 DCBOFF EQU 84 50400019 COMVECPT EQU 16 50700019 ONE EQU 1 51000019 ZERO EQU 0 51300019 PLOFF EQU 4 51600019 WGOFF EQU 8 51900019 WAOFF EQU 32 52200019 TTROFF EQU 14 52500019 DXCCW12 EQU X'1C8' 52800019 ATBL EQU X'CA' 53100019 DS 0F 53400019 ZERO1 DC 1F'0' 53700019 DISPDEB DC A(DEBNMSUB-DEBEOEA) 54000019 OPIDCNST DC C'0S' 54300019 GIDCNST1 DC C'3Z' 54600019 TPUNIT80 DC XL2'1005' 54900019 TPUNIT82 DC XL2'1006' 55200019 * 55500019 ORG IGG0193Z+984 55800019 XCTLTABL EQU * 56100019 GIOCR DC C'OA' 56400019 DC XL4'00' 56700019 CHEAPP DC C'OB' 57000019 DC XL4'00' 57300019 GAMLOAD3 DC C'3L' 57600019 DC XL4'00' 57900019 XCTLEND DC X'0000' 58200019 ORG IGG0193Z+1020 58500019 DC C'019' 58800019 DC X'7B' 59100019 * 59400019 * GRAPHIC DEB DUMMY SECTION --- 59700019 * 60000019 IECTDEB DSECT 60300019 DEBEOEA DS CL4 END OFEXTENT APP ROUTINE PTR 60600019 DEBSIOA DS CL4 START I/O APP ROUTINE PTR 60900019 DEBPCIA DS CL4 PROG CONTROL APP ROUTINE PTR 61200019 DEBCEA DS CL4 CHANNEL END APP ROUTINE PTR 61500019 DEBXCEA DS CL4 EX CHANNEL END APP ROUTINE PTR 61800019 DEBWKARA DS CL1 I/O SUPPORT WORK AREA 62100019 DEBDSCBA DS CL7 I/O SUPPORT DSCB AREA 62400019 DEBDCBMK DS CL4 I/O DCB MODIFICATION MASK 62700019 DEBLNGTH DS CL4 DEB LENGTH IN DOUBLE WORDS 63000019 DEBNMSUB DS CL1 NO SUBROUTINES LOADED BY OPEN 63300019 DEBTCBAD DS CL3 TCB ADDRESS OF THIS DEB 63600019 DEBAMLNG DS CL1 NO BYTES IN ACCESS METHOD SECT 63900019 DEBDEBAD DS CL3 NEXT DEB PTR IN THIS TASK 64200019 DEBOFLGS DS CL1 DATA SET STATUS FLAG 64500019 DEBIRBAD DS CL3 IRB ADDR FOR ERROR EXIT 64800019 DEBOPATB DS CL1 FILE TYPES 65100019 DEBSYSPG DS CL3 SYSTEM PURGE CHAIN 65400019 DEBNMEXT DS CL1 NO EXTENTS CONSTRUCTED - DSCB S 65700019 DEBUSRPG DS CL3 USER PURGE CHAIN 66000019 DEBPRIOR DS CL1 TCB PRIORITY-IOS CH QUEING IOB 66300019 DEBECBAD DS CL3 IOS INTERNAL ECB ADDR 66600019 DEBPROTG DS CL1 TASK PROTECTION TAG 66900019 DEBDCBAD DS CL3 DCB ADDR 67200019 DEBEXSCL DS CL1 EXTENT SCALE 67500019 DEBAPPAD DS CL3 I/O APPENDAGE BLOCK PTR 67800019 DEBUCBAD DS CL4 UCB PTR FOR GIVEN DATA EXTENT 68100019 * 68400019 DCBD DSORG=GS 68700019 * 69000019 * 9907 69300019 * 9907 69600019 * SAVE AREA DSECT 9907 69900019 * 9907 70200019 SAVEAREA DSECT 9907 70500019 WD1 DS F WORK WORD 9907 70800019 HSA DS F HEAD SAVE AREA 9907 71100019 LSA DS F LAST SAVE AREA 9907 71400019 RET DS F RETURN ADDRESS 9907 71700019 EPA DS F CALLING PROGRAM ENTRY POINT9907 72000019 R0 DS F GENERAL REGISTER ZERO 9907 72300019 R1 DS F GENERAL REGISTER ONE 9907 72600019 R2 DS F GENERAL REGISTER TWO 9907 72900019 R3 DS F GENERAL REGISTER THREE 9907 73200019 R4 DS F GENERAL REGISTER FOUR 9907 73500019 R5 DS F GENERAL REGISTER FIVE 9907 73800019 R6 DS F GENERAL REGISTER SIX 9907 74100019 R7 DS F GENERAL REGISTER SEVEN 9907 74400019 R8 DS F GENERAL REGISTER EIGHT 9907 74700019 R9 DS F GENERAL REGISTER NINE 9907 75000019 R10 DS F GENERAL REGISTER TEN 9907 75300019 R11 DS F GENERAL REGISTER ELEVEN 9907 75600019 R12 DS F GENERAL REGISTER TWELVE 9907 75900019 REGSVE DS F REGISTER SAVE WORD 9907 76200019 GARSVE DS F GAR ADDRESS SAVE 9907 76500019 GEIRSVE DS F GEIR ADDRESS SAVE 9907 76800019 * THE FOLLOWING DSECT IS USED FOR THE READ 9907 77100019 * MANUAL INPUT FROM THE 2250 AT OPEN TIME TO 9907 77400019 * UNLOCK THE KEYBOARD. THE GETMAIN AREA IS USED 9907 77700019 * FOR THE DATA EVENT CONTROL BLOCK TO MAKE THE 9907 78000019 * MODULE REENTRENT. 9907 78300019 * 9907 78600019 * 9907 78900019 * DATA EVENT CONTROL BLOCK 9907 79200019 * 9907 79500019 * 9907 79800019 * 9907 80100019 DECBECB DS F EVENT CONTROL BLOCK WORD 9907 80400019 DECBTYPE DS F TYPE OF I / O OPERATION 9907 80700019 RMICODE EQU X'08' TYPE CODE FOR READ MI 9907 81000019 DECBDCB DS F POINTER TO DATA CONTROL 9907 81300019 * BLOCK 9907 81600019 DECBADDR DS F INPUT / OUTPUT BUFFER FOR 9907 81900019 * DATA TO BE TRANSFERED 9907 82200019 DECBHEX DS C EVENT CONTROL BLOCK POSTING9907 82500019 * CODE 9907 82800019 DECBCNT DS 3C RESIDUAL COUNT FROM CSW 9907 83100019 * AFTER I/O COMPLETED 9907 83400019 DECBOCBP DS F OUTPUT CONTROL BLOCK 9907 83700019 * POINTER 9907 84000019 DECBSTRT DS F START ADDRESS OF CONTROL 9907 84300019 * ORDERS 9907 84600019 DECBUNIT DS C UNIT INDEX 9907 84900019 DECBBUFF DS 3C BUFFER ADDRESS 9907 85200019 END 85500019 ./ ADD SSI=03010561,NAME=IGG0203X,SOURCE=0 TITLE ' IGG0203X - BASIC GRAPHICS CLOSE EXECUTOR - LOAD 2' 00200019 IGG0203X CSECT 00400019 * 608000,614000-618000,634000 M4120 00500019 *A37500 A32068 00550000 *C298000,C302000 A37923 00560000 *C288000,C298000 A42281 00570000 *C328000-330000,C340000,C344000 LI A42542 00580000 *D346000,D66000-664000,D684000-688000 LI A42542 00590000 *A244400-245200,300400-301600 A54346 00595021 *A296600-297200,693200 A49199 00597021 *D244800,245200,300800,301200 LG SA63458 00599021 *********************************************************************** 00600019 * * 00800019 * TITLE - GRAPHICS CLOSE EXECUTOR LOAD 2 * 01000019 * * 01200019 * FUNCTION - PERFORM GRAPHIC CLOSE FUNCTIONS * 01400019 * 1.FREE IOB CORE * 01600019 * 2.FREE BASIC CONTROL BLOCKS * 01800019 * 3.INITIALIZE DCB * 02000019 * * 02200019 * ENTRY POINT - IGG0203X FROM GRAPHICS CLOSE LOAD ONE * 02400019 * * 02600019 * INPUT - PARAMETER LIST ADDRESS IN REGISTER 7 * 02800019 * * 03000019 * OUTPUT - SEE 'FUNCTION' * 03200019 * * 03400019 * EXTERNAL * 03600019 * REFERENCES - 1.PURGE * 03800019 * 2.FREEMAIN * 04000019 * 3.XCTL * 04200019 * * 04400019 * EXIT - TO SYSTEM CLOSE VIA XCTL * 04600019 * * 04800019 * TABLES/WORK AREAS - WHERE-TO-GO TABLE * 05000019 * * 05200019 * ATTRIBUTES - 1.NON-REENTRANT * 05400019 * 2.ENABLED * 05600019 * 3.PRIVILEDGED * 05800019 * * 06000019 * NOTES - NA * 06200019 * * 06400019 * * 06600019 EJECT 06800019 *********************************************************************** 07000019 * * 07200019 * REGISTER EQUATES * 07400019 * * 07600019 *********************************************************************** 07800019 SPACE 1 08000019 RE EQU 0 WORK/PARAMETER REGISTER 08200019 RF EQU 1 WORK/PARAMETER REGISTER 08400019 RDCB EQU 2 ADDR OF USERS DCB 08600019 RIRB EQU 2 08800019 RBASE EQU 3 BASE REGISTER 09000019 RCORE EQU 4 ADDR OF CLOSE WORK AREA 09200019 RTCB EQU 4 CURRENT TCB ADR 09400019 RPAR EQU 5 PARAMETER LIST 09600019 RWTG EQU 6 START OF WTG 09800019 RPARC EQU 7 CURRENT ENTRY IN PARAMETER LIST 10000019 RWTGC EQU 8 CURRENT ENTRY IN WTG TABLE 10200019 RTIOT EQU 9 TIOT ADDRESS 10400019 RTE EQU 9 10600019 RUCB EQU 10 UCB ADDRESS 10800019 RDEB EQU 11 DEB ADDRESS 11000019 RB EQU 12 WORK REGISTER 11200019 RC EQU 13 WORK REGISTER 11400019 RD EQU 14 WORK/PARAMETER REGISTER 11600019 RJ EQU 15 WORK/PARAMETER REGISTER 11800019 *********************************************************************** 12000019 * * 12200019 * EQUATES * 12400019 * * 12600019 *********************************************************************** 12800019 SPACE 1 13000019 BASIC1 EQU X'08' BASIC/EXPRESS SWITCH 13200019 WAOFF EQU 32 OFFSET OF FIRST ENTRY OF WTG TAB 13400019 IOBSIZE EQU 72 IOB BLOCK SIZE IN BYTES 13600019 UCBTYP EQU 19 BYTE OF 4 UCB TYPE FIELD 13800019 THRTWO EQU 32 14000019 T2260 EQU X'03' 2260 ID IN BYTE 4 OF UCB TYP FLD 14200019 T1053 EQU X'04' 1053 ID UCBTYPE FIELD M4142 14300019 GCB EQU 27 GRAPHIC CONTROL BYTE DISP. 14400019 ABEND EQU 13 SVC NO. TO ABNORMAL END 14600019 WGOFF EQU 8 OFFSET OF WTG ENTRIES 14800019 PLOFF EQU 4 OFFSET OF DCB ENTRIES 15000019 COMTABLE EQU 16 CVT TABLE ADDRESS LOCATION 15200019 CURNTCB EQU 4 CURRENT TCB DISPLACEMENT 15400019 INITCB EQU 0 POINTER TO I WORD TCB ADDRESS 15600019 ABENTON EQU X'80' ABEND BIT 15800019 ABENDISP EQU 29 DISPLACEMENT TO ABEND BIT 16000019 DEADR EQU 28 DE CONTOL NLOCK ADDRESS DISP. 16200019 UCBADR EQU 32 UCB ADR DISP. 16400019 SEFLAG EQU 0 SUB ENTRY FLAG 16600019 DCBADR EQU 4 DCB ADDRESS 16800019 SEADR EQU 4 SUB ENTRY ADDRESS 17000019 DARSVC EQU 74 DELETE ATTENTION ROUTINE SVC NO. 17200019 DEFLAG EQU 0 DEVICE ENTRY FLAG 17400019 TCBADR EQU 12 TCB ADDRESS 17600019 TETCB EQU 8 TCB ADR 17800019 TECNT EQU 16 TE USECNT 18000019 TE EQU 28 OFFSET TO TE 18200019 RTNF EQU 0 NEXT REB ADR 18400019 REBADR EQU 4 OFFSET TO REB ADR 18600019 RTNGACB EQU 12 OFFSET TO GACB 18800019 DCBAD EQU 4 OFFSET TO DCB ADR 19000019 USECNT EQU 26 USE COUNT 19200019 RBSTAB2 EQU 11 OFFSET OF STATUS BYTE 2 M4120 19220019 * OF REQUEST BLOCK M4120 19240019 IRBACTIV EQU X'40' FLAG BYTE TO INDICATING M4120 19260019 * THE INTERRUPT M4120 19280019 * REQUEST BLOCK IS M4120 19300019 * ACTIVE M4120 19320019 BASIC EQU X'01' 19400019 ZEROO EQU 0 ZERO 19600019 ONE EQU 1 19800019 TWO EQU 2 TWO 20000019 THREE EQU 3 20200019 FOUR EQU 4 FOUR 20400019 EIGHT EQU 8 DECIMAL EIGHT 20600019 CLODAR EQU 47 CLOSE ISSUED DAR IN GACB BIT 20800019 IRBADR EQU 24 TE IRB ADR OFFSET 21000019 SIXTN EQU 16 21200019 FIVE EQU 5 21400019 CANIRB EQU 0 21600019 EIGHTEEN EQU 18 21800019 TWOFOUR EQU 24 22000019 NINESIX EQU 96 DISPLACEMENT WITHIN TE 22100019 EJECT 22200019 *********************************************************************** 22400019 * * 22600019 * INITIALIZATION * 22800019 * * 23000019 *********************************************************************** 23200019 USING IHADCB,RDCB DEFINE BASE REG FOR DCB DSECT 23400019 USING IECTDEB,RDEB DEFINE BASE REG FOR DCB DSECT 23600019 USING FORCORE,RCORE DEFINE BASE REG FOR GOTTEN CORE 23800019 BALR RBASE,0 SET UP CSECT BASE REGISTER 24000019 USING *,RBASE DEFINE CSECT BASE REGISTER 24200019 CL8004 EQU * 24400019 L RDCB,ZEROO(RPARC) LOAD DCB ADDRESS 24600019 LA RDCB,ZEROO(RDCB) CLEAR HIGH ORDER BYTE 24800019 L RDEB,DCBDEBAD LOAD DEB ADDRESS 25000019 LA RDEB,ZEROO(RDEB) CLEAR HIGH ORDER BYTE 25200019 L RTCB,COMTABLE LOAD PTR TO CVT 25400019 L RTCB,INITCB(RTCB) LOAD NEW/OLD PTR 25600019 L RTCB,CURNTCB(RTCB) LOAD CURRENT TCB ADR 25800019 LA RTCB,ZEROO(RTCB) CLEAR HIGH ORDER BYTE 26000019 L RUCB,UCBADR(RDEB) LOAD FIRST UCB ADDRESS 26200019 L RTE,TE(RUCB) GET TE ADDRESS 26300019 *********************************************************************** 26400019 * * 26600019 * TEST FOR - ABEND,DEVICE EQUAL 2280/82,BASIC SYSTEM,USECNT=0 * 26800019 * * 27000019 *********************************************************************** 27200019 CL8019 EQU * 27400019 TM ABENDISP(RTCB),ABENTON TEST FOR ABEND IN PROGRESS 27600019 BO CL8020 YES-CHECK USECNT 27800019 SR RB,RB CLEAR REGISTER 28000019 IC RB,DEBNMEXT LOAD # OF UCB ADRS. 28200019 SR RC,RC INITIALIZE REGISTER 28400019 SR RD,RD INITIALIZE REGISTER 28600019 CL8020 EQU * A42281 28800000 CLC EIGHTEEN(TWO,RUCB),TPUNIT80 IS DEVICE A 2280 29000019 BE CL8034 YES PURGE/FREE IOBS 29200019 CLC EIGHTEEN(TWO,RUCB),TPUNIT82 IS DEVICE A 2282 29400019 BE CL8034 YES PURGE/FREE IOBS 29600019 TM DCBGTYPE,BASIC IS THIS A BASIC SYSTEM A42281 29800000 BZ CL8034 NO PURGE/FREE IOBS 30000019 * DELETE ROUTINES LOADED ONLY FOR BASIC SYSTEM A54346 30040021 DELETE EP=IFFCAN03 A54346 30160021 CLI USECNT(RUCB),X'00' USECNT EQUAL ZERO A37923 30200000 BE BASCLOSE YES FREE IQES 30400019 CL8013 EQU * 30600019 TM ABENDISP(RTCB),ABENTON TEST FOR ABEND IN PROGRESS 30800019 BO BASCLOSE YES CLEAN UP 31000019 EJECT 31200019 *********************************************************************** 31400019 * * 31600019 * PURGE ALL IOBS * 31800019 * * 32000019 *********************************************************************** 32200019 CL8034 EQU * 32400019 L RCORE,FOUR(RWTGC) LOAD ADDR OF DCBS GOTTEN CORE 32600019 ST RDEB,DXCCW6 STORE DEB ADR LI A42542 32800000 MVI DXCCW6,X'A0' PURGE OPTION LI A42542 33000000 * 1.SPECIFIED ONLY 33200019 * 2.DON'T POST 33400019 * 3.HIO 33600019 * 4.RELATED ONLY 33800019 XC DXCCW6+4(8),DXCCW6+4 CLEAR FIELDS LI A42542 34000000 LA RB,16(RDEB) GET CHAINING ADDRESS FROM DEB 34200019 ST RB,DXCCW6+8 STR TO CHAIN IOBS LI A42542 34400000 LA RF,DXCCW6 GET ADDRESS OF LIST 34800019 SVC 16 35000019 LA RF,DXCCW6+4 GET ADDRESS OF PURGE ECB 35200019 WAIT ECB=(1) 35400019 *********************************************************************** 35600019 * * 35800019 * FREE MAIN IOBS * 36000019 * * 36200019 *********************************************************************** 36400019 L RF,DCBIOBAD LOAD IOB ADDRESS 36600019 LA RTIOT,EIGHT LOAD EIGHT FOR COMPLEMENTATION 36800019 LNR RTIOT,RTIOT OBTAIN NEGATIVE DISPLACEMENT 37000019 LA RF,0(RTIOT,RF) LOAD GRAPHIC IOB STARTING ADDR. 37200019 SR RB,RB ZERO REGISTER 37400019 IC RB,DCBGNCP LOAD NO.OF IOBS 37600019 CLI DCBGNCP,X'63' IS GNCP EQUAL TO MAXIMUM 37800019 BE CL8033 BRANCH IF YES 38000019 LA RB,1(0,RB) ADD ONE FOR EXTRA IOB 38200019 CL8033 EQU * 38400019 LA RC,IOBSIZE LOAD IOB BLOCK SIZE 38600019 MR RB,RB START CALCULATING CORE SIZE TO 38800019 * RELEASE. 39000019 LA RC,8(0,RC) ADD FINAL SIZE FACTOR 39200019 O RC,IOBPOOL INDICATE IOB POOL 39400019 LR RE,RC PUT PARAMETER IN PARAM REG 39600019 FREEMAIN R,LV=(0),A=(1) 39800019 EJECT 40000019 *********************************************************************** 40200019 * * 40400019 * INITIALIZE DCB FIELDS * 40600019 * * 40800019 *********************************************************************** 41000019 CL8014 EQU * 41200019 SR RE,RE INITIALIZE FIELD 41400019 STH RE,DCBBRSA INITIALIZE FIELD 41600019 ST RE,DCBBFRST INITIALIZE FIELD 41800019 ST RE,DCBIOBAD INITIALIZE FIELD 42000019 *********************************************************************** 42200019 * * 42400019 * XCTL SCAN * 42600019 * * 42800019 *********************************************************************** 43000019 CL8015 EQU * 43200019 SR RB,RB LOAD ZERO 43400019 L RCORE,4(RWTGC) LOAD ADR OF GOTTEM CORE FOR DSCT 43600019 STC RB,0(0,RWTGC) CLEAR ID 43800019 CL8016 EQU * 44000019 LA RWTGC,WGOFF(RWTGC) STEP TO NEXT ENTRY 44200019 LA RPARC,PLOFF(0,RPARC) STEP TO NEXT ENTRY 44400019 CLC ZEROO(2,RWTGC),AMIDCNST CHECK FOR ID MATCH 44600019 BE CL8004 BRANCH IF HIT 44800019 CLC ZEROO(2,RWTGC),CLLDB CHECK FOR ID MATCH 45000019 BL CL8016 BRANCH IF NO HIT 45200019 CLC ZEROO(2,RWTGC),CLLDG CHECK FOR ID MATCH 45400019 BH CL8016 BACK TO LOOP IF HIGH 45600019 LR RPARC,RPAR INITIALIZE REGISTER 45800019 LA RWTGC,WAOFF(0,RWTG) INITIALIZE REGISTER 46000019 CL8017 EQU * 46200019 CLI ZEROO(RWTGC),X'00' IS THIS ENTRY ZERO? 46400019 BNE CL8018 BRANCH IF NO 46600019 LA RWTGC,WGOFF(0,RWTGC) INCREMENT POINTER 46800019 LA RPARC,PLOFF(0,RPARC) INCREMENT POINTER 47000019 B CL8017 BRANCH UNCONDITIONALLY 47200019 CL8018 EQU * 47400019 MVC 6(2,RWTG),ZEROO(RWTGC) SET UP ID FOR XCTL 47600019 MVC 14(3,RWTG),2(RWTGC) ID TO TTR 47800019 LA RB,DXCCW12 POINT TO XCTL PARAMETER 48000019 XCTL DE=(RWTG),SF=(E,(RB)) 48200019 EJECT 48400019 *********************************************************************** 48600019 * * 48800019 * BASIC CLOSE -- DO MVT CHECKS * 49000019 * FREE GAR IQES,DECREMENT TEUSECNT,CLEAR UCBTE FLD, * 49200019 * TURN OFF GCB BITS * 49400019 * * 49600019 *********************************************************************** 49800019 *** FREE GAR IQES 50000019 BASCLOSE EQU * 50200019 SR RB,RB CLEAR REG 50400019 IC RB,DEBNMEXT LOAD NO. UCBS - EXTENTS 50600019 LA RC,DEBUCBAD LOAD PTR TO 1ST UCB 50800019 MOREUCBS EQU * 51000019 L RUCB,ZEROO(RC) LOAD UCB ADDRESS 51200019 LA RUCB,ZEROO(RUCB) CLEAR HIGH ORDER BYTE 51400019 CLI UCBTYP(RUCB),T2260 DEVICE A 2260 51600019 BE ONEIQE BRANCH IF YES 51800019 CLI UCBTYP(RUCB),T1053 DEVICE 1053 ? M4142 51860019 BE ONEIQE YES M4142 51920019 LA RD,THREE LOAD 2250 COUNT 52000019 L RIRB,CANIRB(RTE) LOAD CANCEL KEY IRB FROM TE 52200019 SSM ZERO DISABLE INTERRUPTS 52400019 L RF,NINESIX(RIRB) LOAD CANCEL KEY IQE ADDRESS 52500019 LTR RF,RF DOES CKIQE EXIST 52660019 BZ FREEIQE GO TO FREEMAIN 52730019 MVC NINESIX(FOUR,RIRB),ZEROO(RF) UPDATE CKIQE FLD 52830019 SSM ENABLE ALLOW INTERRUPTS 53000019 L RE,IQE LOAD IQE BYTE REQUEST 53200019 FREEMAIN R,LV=(0),A=(1) FREE CANCEL KEY IQE 53400019 B FREEIQE BRANCH TO FREE 53600019 ONEIQE EQU * 53800019 LA RD,ONE LOAD 2260 COUNT 54000019 FREEIQE EQU * 54200019 L RIRB,IRBADR(RTE) LOAD IRB ADDRESS FROM TE 54400019 MOREIQES EQU * 54600019 SSM ZERO DISABLE INTERRUPTS 54800019 L RF,96(RIRB) LOAD IQE ADR FROM IRB NEXAVAIL 55000019 LTR RF,RF ANY MORE IQES 55200019 BZ IQEOUT NO 55400019 MVC 96(4,RIRB),0(RF) UPDATE NEXAVAIL FLD WITH IQE LNK 55600019 SSM ENABLE ENABLE 55800019 L RE,IQE LOAD IQE BYTE REQUEST 56000019 FREEMAIN R,LV=(0),A=(1) FREE IQE 56200019 * 56400019 BCT RD,MOREIQES BRANCH IF MORE IQES TO FREE 56600019 *** CLEAR TE, DEC TEUSECNT,ETC. 5-INSTR INSERT HERE 56800019 IQEOUT EQU * 57000019 SSM ENABLE ENABLE INTERRUPTS 57200019 XC TE(4,RUCB),TE(RUCB) CLEAR UCBTE FIELD 57400019 NI GCB(RUCB),X'B7' TURN OFF BASIC EXP AND A32068 57500020 * PROATTN SWITCHES IN GCB A32068 57600020 L RD,TECNT(RTE) LOAD TE USECNT 57800019 BCTR RD,0 DECREMENT USECNT (TE) 58000019 ST RD,TECNT(RTE) RESTORE USECNT 58200019 LA RC,FOUR(RC) INCREMENT UCB PTR ADR 58400019 BCT RB,MOREUCBS BRANCH IF MORE UCBS 58600019 * 58800019 L RDCB,0(RPARC) RE-INIT DCB REG 59000019 LA RDCB,ZEROO(RDCB) CLEAR HIGH ORDER BYTE 59200019 L RD,TECNT(RTE) LOAD TEUSECNT 59400019 LTR RD,RD TEUSECNT EQ TO ZERO 59600019 BNE CL8015 BRANCH IF NO 59800019 * * 60000019 * FREEMAIN TASK ENTRY BLOCK,GAR IRB,PP SVAREA * 60200019 * * 60400019 SPACE 2 M4120 60410019 * FOR EACH IRB THAT IS ACTIVE WE CAN NOT FREE M4120 60420019 * IT WITHOUT ENDANGERING THE SYSTEM SO WILL LEAVE M4120 60430019 * THE IRB ON THE TASK RB CHAIN AND LET THE LAST LOAD M4120 60440019 * OF ABEND FREE THE RB FOR US. M4120 60450019 SPACE 3 M4120 60460019 * IS THERE AN IRB ? M4120 60470019 OC CANIRB+ONE(THREE,RTE),CANIRB+ONE(RTE) M4120 60480019 BZ GARIRB IF NOT TAKE BRANCH M4120 60490019 L RD,CANIRB(RTE) LOAD CANCEL KEY IRB ADDR. M4120 60500019 TM RBSTAB2(RD),IRBACTIV IS THIS IRB ACTIVE ? M4120 60510019 BO GARIRB IF YES TAKE BRANCH M4120 60520019 L RE,REQUEST2 LOAD PPSVAREA REQUEST M4120 60530019 L RF,ZEROO(RD) LOAD PPSVAREA ADDRESS M4120 60540019 * FROM IRB M4120 60550019 FREEMAIN R,LV=(0),A=(1) FREE PROB PROG SAVE AREA M4120 60560019 L RE,IRB LOAD IRB BYTE REQUEST 60600019 LR RF,RD LOAD IRB ADDRESS TO PARM REG 61000019 FREEMAIN R,LV=(0),A=(1) FREE CANCEL KEY IRB 61200019 * IS THERE AN IRB ? M4120 61300019 GARIRB OC IRBADR+ONE(THREE,RTE),IRBADR+ONE(RTE) M4120 61400019 BZ TEBFREE IF NOT TAKE BRANCH M4120 61500019 L RD,IRBADR(RTE) LOAD GAR'S IRB ADDRESS M4120 61600019 TM RBSTAB2(RD),IRBACTIV IS THIS IRB ACTIVE ? M4120 61700019 BO TEBFREE IF YES TAKE BRANCH M4120 61800019 L RE,REQUEST2 LOAD PPSVAREA REQUEST M4120 61900019 L RF,ZEROO(RD) LOAD PPSVAREA ADDRESS FROM IRB 62000019 FREEMAIN R,LV=(0),A=(1) FREE PROB PROG SAVE AREA 62200019 * 62400019 L RE,IRB LOAD IRB BYTE REQUEST 62600019 LR RF,RD LOAD IRB ADDRESS TO PARM REG 62800019 FREEMAIN R,LV=(0),A=(1) FREE GAR IRB 63000019 * 63200019 TEBFREE L RE,TEBYTE LOAD TE BYTE REQUEST M4120 63400019 LR RF,RTE LOAD TE ADDRESS IN PARM REG 63600019 FREEMAIN R,LV=(0),A=(1) FREE TE 63800019 TM ABENDISP(RTCB),ABENTON ABEND IN PROGRESS 64000019 BO CL8015 64200019 B CL8034 BRANCH TO CLEAR IOB,DCB,XCTL 64400019 EJECT 64600019 *********************************************************************** 64800019 * * 65000019 * DEFINES * 65200019 * * 65400019 *********************************************************************** 65600019 DS 0F 65800019 IQE DC X'FD' SUBPOOL 253 FOR GAR IQES 66600019 DC AL3(16) 66800019 IRB DC X'FD' 67000019 DC AL3(104) 67200019 TEBYTE DC X'FF' TE BYTE REQUEST SUBPOOL 255 67600019 DC AL3(32) 67800019 REQUEST2 DC X'FA' SUBPOOL 250 68000019 DC AL3(72) PP SVAREA LENGTH 68200019 IOBPOOL DC X'FA00' 69000019 ZERO DC 4XL1'00' HEX ZERO 69200019 ENABLE DC X'FF' MASK TO ENABLE LB AOS/1 69250000 TPUNIT53 DC XL2'1004' 1053 DEVICE TYPE A49199 69320021 TPUNIT80 DC XL2'1005' 69400019 TPUNIT82 DC XL2'1006' 69600019 AMIDCNST DC C'3X' GRAPHIC CLOSE ID LIAD 2 M4142 69800019 CLLDB DC C'0B' 70000019 CLLDG DC C'0G' 70200019 ORG IGG0203X+1008 70400019 XCTLEND DC X'0000' 70600019 ORG IGG0203X+1020 70800019 DC C'020' 71000019 DC X'7E' 71200019 EJECT 71400019 *********************************************************************** 71600019 * * 71800019 * DSECTS * 72000019 * * 72200019 *********************************************************************** 72400019 DCBD DSORG=GS 72600019 FORCORE DSECT 72800019 DS CL368 73000019 DXCCW1 DS D 73200019 DXCCW2 DS D 73400019 DXCCW3 DS D 73600019 DXCCW4 DS D 73800019 DXCCW5 DS D 74000019 DXCCW6 DS D 74200019 DXCCW7 DS D 74400019 DXCCW8 DS D 74600019 DXCCW9 DS D 74800019 DXCCW10 DS D 75000019 DXCCW11 DS D 75200019 DXCCW12 DS D 75400019 IECTDEB DSECT 75600019 DEBNMSUB DS 0CL1 +0 75800019 DEBTCBAD DS CL4 76000019 DEBAMLNG DS 0CL1 +4 76200019 DEBDEBAD DS CL4 76400019 DEBOFLGS DS 0CL1 +8 76600019 DEBIRBAD DS CL4 76800019 DEBOPATB DS 0CL1 +12 77000019 DEBSYSPG DS CL4 77200019 DEBNMEXT DS 0CL1 +16 77400019 DEBUSRPG DS CL4 77600019 DEBPRIOR DS 0CL1 +20 77800019 DEBECBAD DS CL4 78000019 DEBPROTG DS 0CL1 +24 78200019 DEBDEBID DS 0CL1 78400019 DEBDCBAD DS CL4 78600019 DEBEXSCL DS 0CL1 +28 78800019 DEBAPPAD DS CL4 79000019 DEBDVMOD DS 0CL1 +32 79200019 DEBUCBAD DS CL4 79400019 END 79600019 ./ ADD SSI=06012862,NAME=IGG0203Y,SOURCE=0 TITLE 'IGG0203Y - BASIC GRAPHICS CLOSE EXECUTOR LOAD ONE' 00080019 IGG0203Y CSECT 00160019 * 284000-285000,488000 M4143 00180019 * 021000,133000,447000-448000,452000,454500,455000-456000,458000 M2858 00200019 * 459000,469000,480000-481000, M2858 00220019 * A446200-446600,A466500,A467600-469400 A42814 00226000 * C450000 A42814 00232000 * 016000-017600,326000-328000,489000-493000,501000-514000 S21016 00236021 * A85300-85600,A120300-1206,A210400-211600,A308300-308600 LI A37402 00238000 *A313300-313600 LI A45407 00238400 *D319000-325000 LI A45407 00238800 *A85680-85920,446050-446150,446700-446800,C450000,A465500 JLM A57420 00239421 * TITLE - GRAPHIC CLOSE EXECUTOR 00240019 * 00320019 * STATUS CHANGE LEVEL - 3 00400019 * 00480019 * FUNCTION - PERFORM GRAPHIC CLOSE FUNCTIONS 00560019 * 1.RELEASE BUFFER(2250 ONLY) 00640019 * 2.FREE/COMPRESS POLST(EXPRESS ONLY) 00720019 * 00800019 * ENTRY - FROM OS/360 SYSTEM CLOSE AT IGG0203Y 00880019 *INPUT:PARAMETER LIST ADDRESS IN GR#7. 01000018 *OUTPUT:SEE FUNCTION 01100018 *EXTERNAL ROUTINES: 01200018 * 1.DAR 01280019 * 2.GETMAIN 01360019 * 3.FREEMAIN 01440019 * 4.RELEASE BUFFER(SVC71) 01520019 * 5. WAIT LC S21016 01560000 * 6.ABEND LC S21016 01600000 * LC S21016 01640000 * EXIT-NORMAL - TO IGG0203Y GRAPHICS CLOSE EXECUTOR LOAD 2 LC S21016 01680000 * LC S21016 01720000 * EXIT-ERROR - TO ABEND LC S21016 01760000 * 01840019 *TABLES/WORKAREAS:WHERE TO GO TABLE(WTG) 02000018 * 02050019 *ATTRIBUTES 1.REENTRANT M2858 02120019 * 2.ENABLED 02200018 * 3.PRIVILEDGED 02300018 *NOTES:N/A 02400018 * 02410019 EJECT 02420019 *********************************************************************** 02430019 * * 02440019 * REGISTER EQUATES * 02450019 * * 02460019 *********************************************************************** 02470019 SPACE 1 02480019 RE EQU 0 WORK/PARAMETER REGISTER 02500018 RF EQU 1 WORK/PARAMETER REGISTER 02600018 RDCB EQU 2 ADDR OF USERS DCB 02700018 RIRB EQU 2 02800018 RBASE EQU 3 BASE REGISTER 02900018 RCORE EQU 4 ADDR OF CLOSE WORK AREA 03000018 RTCB EQU 4 CURRENT TCB ADR 03100018 RPAR EQU 5 PARAMETER LIST 03200018 RWTG EQU 6 START OF WTG 03300018 RPARC EQU 7 CURRENT ENTRY IN PARAMETER LIST 03400018 RWTGC EQU 8 CURRENT ENTRY IN WTG TABLE 03500018 RTIOT EQU 9 TIOT ADDRESS 03600018 RTE EQU 9 03700018 RUCB EQU 10 UCB ADDRESS 03800018 RDEB EQU 11 DEB ADDRESS 03900018 RB EQU 12 WORK REGISTER 04000018 RC EQU 13 WORK REGISTER 04100018 RD EQU 14 WORK/PARAMETER REGISTER 04200018 RJ EQU 15 WORK/PARAMETER REGISTER 04300018 EJECT 04320019 *********************************************************************** 04340019 * * 04360019 * EQUATES * 04380019 * * 04400019 *********************************************************************** 04420019 FIVE EQU 5 04440019 BASIC1 EQU X'08' BASIC/EXPRESS SWITCH 04500018 WAOFF EQU 32 OFFSET OF FIRST ENTRY OF WTG TAB 04600018 IOBSIZE EQU 72 IOB BLOCK SIZE IN BYTES 04700018 UCBTYP EQU 19 BYTE OF 4 UCB TYPE FIELD 04800018 THRTWO EQU 32 04900018 T2260 EQU X'03' 2260 ID IN BYTE 4 OF UCB TYP FLD 05000018 GCB EQU 27 GRAPHIC CONTROL BYTE DISP. 05100018 ABEND EQU 13 SVC NO. TO ABNORMAL END 05200018 WGOFF EQU 8 OFFSET OF WTG ENTRIES 05300018 PLOFF EQU 4 OFFSET OF DCB ENTRIES 05400018 COMTABLE EQU 16 CVT TABLE ADDRESS LOCATION 05500018 CURNTCB EQU 4 CURRENT TCB DISPLACEMENT 05600018 INITCB EQU 0 POINTER TO I WORD TCB ADDRESS 05700018 ABENTON EQU X'80' ABEND BIT 05800018 ABENDISP EQU 29 DISPLACEMENT TO ABEND BIT 05900018 DEADR EQU 28 DE CONTOL NLOCK ADDRESS DISP. 06000018 UCBADR EQU 32 UCB ADR DISP. 06100018 SEFLAG EQU 0 SUB ENTRY FLAG 06200018 DCBADR EQU 4 DCB ADDRESS 06300018 SEADR EQU 4 SUB ENTRY ADDRESS 06400018 DARSVC EQU 74 DELETE ATTENTION ROUTINE SVC NO. 06500018 DEFLAG EQU 0 DEVICE ENTRY FLAG 06600018 TCBADR EQU 12 TCB ADDRESS 06700018 TETCB EQU 8 TCB ADR 06800018 TECNT EQU 16 TE USECNT 06900018 TE EQU 28 OFFSET TO TE 07000018 RTNF EQU 0 NEXT REB ADR 07100018 REBADR EQU 4 OFFSET TO REB ADR 07200018 RTNGACB EQU 12 OFFSET TO GACB 07300018 DCBAD EQU 4 OFFSET TO DCB ADR 07400018 USECNT EQU 26 USE COUNT 07500018 BASIC EQU X'01' 07600018 ZEROO EQU 0 ZERO 07700018 ONE EQU 1 07800018 TWO EQU 2 TWO 07900018 THREE EQU 3 08000018 FOUR EQU 4 FOUR 08100018 EIGHT EQU 8 DECIMAL EIGHT 08200018 CLODAR EQU 47 CLOSE ISSUED DAR IN GACB BIT 08300018 IRBADR EQU 24 TE IRB ADR OFFSET 08400018 SIXTN EQU 16 08500018 GRATYPE EQU 18 BYTE 3 UCB TYPE FIELD LI A37402 08530000 GRADEV EQU X'10' GRAPHICS DEVICE TYPE LI A37402 08560000 OPTFEATS EQU 17 OPTIONAL FEATURES OF UCB JLM A57420 08568021 PFK EQU X'10' BIT FOR PFK FEATURES JLM A57420 08576021 HALTPFK EQU 24 LENGTH OF HALT+PFK CCW JLM A57420 08584021 HALT EQU 16 LENGTH OF HALT CCW JLM A57420 08592021 EJECT 08600018 *********************************************************************** 08700018 * * 08800018 * INITIALIZATION * 08900018 * * 09000018 *********************************************************************** 09100018 USING IHADCB,RDCB DEFINE BASE REG FOR DCB DSECT 09200018 USING IECTDEB,RDEB DEFINE BASE REG FOR DCB DSECT 09300018 USING FORCORE,RCORE DEFINE BASE REG FOR GOTTEN CORE 09400018 BALR RBASE,0 SET UP CSECT BASE REGISTER 09800018 USING *,RBASE DEFINE CSECT BASE REGISTER 09900018 CL8004 EQU * 10000018 L RDCB,ZEROO(RPARC) LOAD DCB ADDRESS 10100018 LA RDCB,ZEROO(RDCB) CLEAR HIGH ORDER BYTE 10200018 L RDEB,DCBDEBAD LOAD DEB ADDRESS 10300018 LA RDEB,ZEROO(RDEB) CLEAR HIGH ORDER BYTE 10400018 L RTCB,COMTABLE LOAD PTR TO CVT 10500018 L RTCB,INITCB(RTCB) LOAD NEW/OLD PTR 10600018 L RTCB,CURNTCB(RTCB) LOAD CURRENT TCB ADR 10700018 LA RTCB,ZEROO(RTCB) CLEAR HIGH ORDER BYTE 10800018 *********************************************************************** 10900018 * * 11000018 * DECREMENT USE COUNT * 11100018 * * 11200018 *********************************************************************** 11300018 CL8019 EQU * 11400018 SR RB,RB CLEAR REGISTER 11500018 IC RB,DEBNMEXT LOAD # OF UCB ADRS. 11600018 SR RC,RC INITIALIZE REGISTER 11700018 SR RD,RD INITIALIZE REGISTER 11800018 CL8032 EQU * 11900018 L RUCB,UCBADR(RC,RDEB) LOAD UCB ADDRESS 12000018 CLI GRATYPE(RUCB),GRADEV IS IT A GRAPHICS DEVICE LI A37402 12030000 BNE CL8015A NO RETURN TO SYSTEM CLOSE LI A37402 12060000 IC RD,USECNT(RUCB) INSERT USE COUNT 12100018 BCTR RD,0 DECREMENT USE COUNT 12200018 STC RD,USECNT(RUCB) STORE DECREMENTED USE COUNT 12300018 LA RC,FOUR(0,RC) INCREMENT INDEX 12400018 BCT RB,CL8032 BRANCH IF MORE UCBS TO SERVICE 12500018 L RUCB,UCBADR(RDEB) RE-UNIT RUCB TO 1ST UCB ADR 12600018 CLI UCBTYP(RUCB),T2260 IS THIS A 2260 12700018 BE CL8002 BRANCH IF YES TO BASIC CHECK 12800018 CLI USECNT(RUCB),X'00' USE COUNT=0 12900018 BNE CL8001 BRANCH IF NO TO 2280/82 CHECK 13000018 CLC 37(3,RUCB),ZERO BUFFER TABLE ADDRESS EXISTS 13100018 BE CL8001 BRANCH IF NO TO 2280/82 CHECK 13200018 B RELEASE GO TO RELEASE BUFFER, M2858 13250019 * STOP REGENERATION, M2858 13300019 * AND SOUND ALARM M2858 13350019 *** 2280/82 AND BASIC CHK 13400018 CL8001 EQU * 13500018 CLC 18(2,RUCB),TPUNIT80 IS DEVICE A 2280? 13600018 BE CL8015 IF YES XCTL TO LOAD 2 IGG0203X 13700019 CLC 18(2,RUCB),TPUNIT82 13800018 BE CL8015 IF YES XCTLTO LOAD 2 IGG0203X 13900019 CL8002 EQU * 14000018 TM DCBGTYPE,BASIC IS THIS A BASIC SYSTEM? 14100018 BO BASCLOSE BRANCH IF BASIC 14200018 * * 14300018 * EXPRESS CLOSE * 14400018 * * 14500018 *** ABEND CHECK 14600018 TM ABENDISP(RTCB),ABENTON TEST FOR ABEND IN PROGRESS 14700018 BO CL8015 BRANCH IF YES TO XCTL 14800018 EJECT 14900018 *********************************************************************** 15000018 * * 15100018 * FREE/COMPRESS POLST * 15200018 * * 15300018 *********************************************************************** 15400018 CL8002B EQU * 15500018 CLC DCBPOLST+1(3),ZERO POLST EXIST? 15600018 BE CL8031 BRANCH IF YES 15700018 L RCORE,DCBPOLST LOAD POLST ADR 15800018 LA RCORE,ZEROO(RCORE) CLEAR HIGH ORDER BYTE 15900018 CLI ZEROO(RCORE),X'00' ZERO IN HIGH ORDER BYTE? 16000018 BE CL8031 BRANCH IF YES 16100018 L RUCB,ZEROO(0,RCORE) LOAD END OF LIST PTR 16200018 LA RUCB,ZEROO(RUCB) CLEAR HIGH ORDER BYTE 16300018 LA RC,DCBADR(0,RCORE) INITIALIZE ZERO PTR 16400018 CL8023 EQU * 16500018 L RTIOT,ZEROO(RC) LOAD ENTRY 16600018 LA RTIOT,ZEROO(RTIOT) CLEAR HIGH ORDER BYTE 16700018 CLR RDCB,RTIOT THIS ENTRY= CLOSE DCB ADR. 16800018 BE CL8024 BRANCH IF YES 16900018 CLR RC,RUCB END OF LIST 17000018 BE CL8031 BRANCH IF YES 17100018 LA RC,FOUR(0,RC) ADD FOUR TO ZERO PTR 17200018 B CL8023 BRANCH 17300018 CL8024 EQU * 17400018 LA RD,FOUR(RC) SET NOT ZERO PTR=ZERO PTR+4 17500018 CL8025 EQU * 17600018 CLR RD,RUCB NOT ZERO PTR GREATER THAN 17700018 * END O6 LIST PTR 17800018 BH CL8027 BRANCH IF YES 17900018 L RTIOT,ZEROO(0,RD) LOAD ENTRY 18000018 LA RTIOT,ZEROO(RTIOT) CLEAR HIGH ORDER BYTE 18100018 CLR RDCB,RTIOT THIS ENTRY=CLOSE DCB ADR. 18200018 BE CL8026 BRANCH IF YES 18300018 MVC ZEROO(4,RC),ZEROO(RD) MOVE DATA TO NEW LOCATION 18400018 LA RC,FOUR(0,RC) UPDATE PTR 18500018 CL8026 EQU * 18600018 LA RD,FOUR(RD) UPDATE POINTER 18700018 B CL8025 BRANCH 18800018 CL8027 EQU * 18900018 LR RD,RC LOAD POINTER 19000018 CL8028 EQU * 19100018 MVC ZEROO(4,RD),ZERO ZERO LOCATION 19200018 LA RD,FOUR(0,RD) UPDATE PTR 19300018 CLR RD,RUCB CTR GREATER THAN END OF LIST CTR 19400018 BNH CL8028 BRANCH IF NO TO CONTINUE LOOP 19500018 CL8029 EQU * 19600018 LA RTIOT,FOUR LOAD FOUR FOR COMPLEMENTATION 19700018 LNR RTIOT,RTIOT OBTAIN NEGATIVE DISPLACEMENT 19800018 LA RUCB,ZEROO(RTIOT,RC) LOAD ZERO PTR MINUS FOUR 19900018 CLR RCORE,RUCB END OF LIST=POLST ADR 20000018 BE CL8030 BRANCH IF YES 20100018 STH RUCB,2(0,RCORE) STORE PARTIAL ADR 20200018 SRL RUCB,16 SHIFT 20300018 STC RUCB,1(0,RCORE) STORE REMAINDER OF ADR 20400018 B CL8031 BRANCH 20500018 CL8030 EQU * 20600018 SR RUCB,RUCB CLEAR REGISTER 20700018 STC RUCB,ZEROO(0,RCORE) ZERO HI ORDER BYTE 20800018 CL8031 EQU * 20900018 B CL8015 XCTL TO LOAD 2 IGG0203X M4143 21000019 CL8015A SR RB,RB CLEAR REG LI A37402 21040000 L RCORE,4(RWTGC) LOAD ADDRESS OF GOTTEN CORE LI A37402 21080000 STC RB,0(0,RWTGC) CLEAR ID LI A37402 21120000 B CL8016 BRANCH TO XCTL OUT LI A37402 21160000 CL8013 EQU * 21200018 TM ABENDISP(RTCB),ABENTON TEST FOR ABEND IN PROGRESS 21300018 BO CL8015 BRANCH IF YES TO XCTL 21400018 EJECT 21500018 *********************************************************************** 27000018 * * 27100018 * XCTL SCAN * 27200018 * * 27300018 *********************************************************************** 27400018 CL8015 EQU * 27500018 L RCORE,4(RWTGC) LOAD ADR OF GOTTEM CORE FOR DSCT 27700018 MVC ZEROO(FIVE,RWTGC),GAMLOAD2 SET GR CLOSE LOAD 2 ID 27800019 CL8016 EQU * 27900018 LA RWTGC,WGOFF(RWTGC) STEP TO NEXT ENTRY 28000018 LA RPARC,PLOFF(0,RPARC) STEP TO NEXT ENTRY 28100018 CLC ZEROO(2,RWTGC),AMIDCNST CHECK FOR ID MATCH 28200018 BE CL8004 BRANCH IF HIT 28300018 CLC ZEROO(TWO,RWTGC),CLLDB TEST FOR END OF TABLE M4143 28400019 BL CL8016 BRANCH IF NOT M4143 28500019 CLC ZEROO(TWO,RWTGC),CLLDG TEST FOR END OF TABLE M4143 28600019 BH CL8016 BRANCH IF NOT M4143 28700019 LR RPARC,RPAR INITIALIZE REGISTER 28800018 LA RWTGC,WAOFF(0,RWTG) INITIALIZE REGISTER 28900018 CL8017 EQU * 29000018 CLI ZEROO(RWTGC),X'00' IS THIS ENTRY ZERO? 29100018 BNE CL8018 BRANCH IF NO 29200018 LA RWTGC,WGOFF(0,RWTGC) INCREMENT POINTER 29300018 LA RPARC,PLOFF(0,RPARC) INCREMENT POINTER 29400018 B CL8017 BRANCH UNCONDITIONALLY 29500018 CL8018 EQU * 29600018 MVC 6(2,RWTG),ZEROO(RWTGC) SET UP ID FOR XCTL 29700018 MVC 14(3,RWTG),2(RWTGC) ID TO TTR 29800018 LA RB,DXCCW12 GET ADDR OF NAME TO XCTL M4143 29900019 XCTL DE=(RWTG),SF=(E,(RB)) 30000018 *********************************************************************** 30100018 * * 30200018 * BASIC CLOSE -- DO MVT CHECKS * 30300018 * * 30400018 *********************************************************************** 30500018 BASCLOSE EQU * 30600018 SR RTE,RTE INITIALIZE TE REG **CHANGED*** 30700018 L RF,TE(RUCB) LOAD TE ADDR FROM UCB ******* 30800018 LTR RF,RF IS THERE A TE ADDRESS LI A37402 30830000 BZ CL8015A NO GO TO SYSTEM CLOSE LI A37402 30860000 LR RTE,RF INITIALIZE PTR REG ******** 30900018 L RF,TETCB(RF) LOAD TE TCB ADDRESS ********** 31000018 LA RF,ZEROO(RF) CLEAR HIGH ORDER BYTE 31100018 CR RTCB,RF IS CURRENT TCB = TETCB 31200018 BE CLB001 BRANCH IF YES 31300018 TM ABENDISP(RTCB),ABENTON ABEND IN PROCESS LI A45407 31330000 BO CL8015 BRANCH IF YES TO XCTL LI A45407 31360000 SR RF,RF CLEAR REG 31400018 IC RF,USECNT(RUCB) INSERT USECNT 31500018 LA RF,1(RF) 31600018 STC RF,USECNT(RUCB) INCREMENT USECNT -- BAD CLOSE 31700018 EJECT 31800018 LA RF,X'D14' LOAD ABEND CODE LC S21016 32600000 SLL RF,12 SHIFT CODE LC S21016 32700000 ABEND (1),DUMP ABEND TASK LC S21016 32800000 *********************************************************************** 32900018 * * 33000018 * DAR ANY REBS ASSOCIATED WITH THE DCB * 33100018 * * 33200018 *********************************************************************** 33300018 CLB001 EQU * 33400018 CLC REBADR+1(3,RTE),ZERO ANY REBS ON THIS TE 33500018 BE CL8015 XCTL TO LOAD 2 IGG0203X 33600019 L RB,REBADR(RTE) LOAD 1ST REB 33700018 CLB002 EQU * 33800018 L RC,RTNGACB(RB) LOAD GACB ADDRESS 33900018 L RD,DCBAD(RC) LOAD DCB ADR 34000018 LA RD,ZEROO(RD) CLEAR HIGH ORDER BYTE 34100018 CLR RDCB,RD DCB ADRS MATCH 34200018 BNE CLB003 34300018 * 34400018 L RB,RTNF(RB) LOAD NEXT REB ADR 34500018 OI CLODAR(RC),X'01' SET BIT IN GACB+47 FOR CLOSE DAR 34600018 L RE,DARPARM LOAD REQUEST FOR DAR PARAM LIST 34700018 GETMAIN R,LV=(0) GET CORE 34800018 * 34900018 ST RC,FOUR(RF) STORE GACB ADR IN PARM LIST 35000018 LA RE,TWO LOAD LIST LNGTH 35100018 ST RE,ZEROO(RF) STORE LNG IN PARM LIST 35200018 LR RC,RF SAVE LIST ADR 35300018 SVC DARSVC CALL DAR 35400018 LR RF,RC LOAD LIST ADR 35500018 L RE,DARPARM LOAD REQUEST TO FREE PARM LIST 35600018 FREEMAIN R,LV=(0),A=(1) FREE CORE 35700018 * 35800018 B CLB005 BRANCH 35900018 CLB003 EQU * 36000018 L RB,RTNF(RB) LOAD PTR TO NEXT REB 36100018 CLB005 EQU * 36200018 LTR RB,RB CHECK FOR MORE REBS 36300018 BNE CLB002 BRANCH IF YES 36400018 B CL8015 XCTL TO LOAD 2 IGG0203X 36450019 EJECT 43800018 *********************************************************************** 43900018 * * 44000018 * RELEASE BUFFER * 44100018 * * 44200018 *********************************************************************** 44300018 RELEASE EQU * 44400018 LA RE,THRTWO GETMAIN REQUEST TO REG0 44500018 GETMAIN R,LV=(0) 44600018 LA RD,HALT GET LEN OF HALT CCW JLM A57420 44605021 TM OPTFEATS(RUCB),PFK ARE THERE ANY PFK'S? JLM A57420 44610021 BZ CLB006 BRANCH IF NO JLM A57420 44615021 LA RB,ZEROS LOAD ADDRESS OF ZEROS A42814 44620000 ST RB,PFKCCW CCW TO TURN OFF PFK'S A42814 44640000 MVI PFKCCW,X'1B' RESTORE COMMAND CODE IN CCW A42814 44660000 LA RD,HALTPFK GET LENGTH OF CCW'S JLM A57420 44670021 CLB006 EQU * JLM A57420 44680021 LR RB,RF SAVE LIST AREA ADDRESS M2858 44700019 XC ZEROO(THRTWO,RF),ZEROO(RF) CLEAR LIST AREA M2858 44800019 L RF,DCBIOBAD LOAD IOB ADDRESS 44900018 EX RD,MOVECCW MOVE CCW'S JLM A57420 45000021 * TO THE IOB 45100018 ST RB,FOUR(RF) STORE ECB ADDR. IN IOB M2858 45200019 SVC 0 ISSUE EXCP TO HALT REGENERATION 45300018 * AND SOUND THE INAUDIBLE ALARM 45400018 WAIT 1,ECB=(12) WAIT ON I/O M2858 45450019 RLSEBFR (2),ALL,MF=(E,(12)) RELEASE BUFFER SPACE M2858 45550019 LA RE,THRTWO 45700018 FREEMAIN R,LV=(0),A=(12) FREE LIST AREA M2858 45800019 B CL8001 RETURN TO CONTINUE CLOSE M2858 45900019 EJECT 46000018 *********************************************************************** 46100018 * * 46200018 * DEFINES * 46300018 * * 46400018 *********************************************************************** 46500018 DS 0H JLM A57420 46530021 MOVECCW MVC 40(0,RF),HLTCCW MOVE CCW'S TO IOB JLM A57420 46560021 DS 0F 46600018 ZEROS DC F'0' MASK TO TURN OFF PFKS A42814 46650000 HLTCCW DC XL8'0700000040000002' 46700018 DC XL8'0B00000060000002' A42814 46760000 PFKCCW DC X'1B' CCW TO TURN OFF PFK'S A42814 46820000 DC X'000000' A42814 46880000 DC X'20000004' A42814 46940000 IQE DC X'FD' SUBPOOL 253 FOR GAR IQES 47000018 DC AL3(16) 47100018 IRB DC X'FD' 47200018 DC AL3(104) 47300018 ENABLE EQU * 47400018 TEBYTE DC X'FF' TE BYTE REQUEST SUBPOOL 255 47500018 DC AL3(32) 47600018 REQUEST2 DC X'FA' SUBPOOL 250 47700018 DC AL3(72) PP SVAREA LENGTH 47800018 DARPARM DC A(8) 47900018 IOBPOOL DC X'FA00' 48200018 ZERO DC 4XL1'00' HEX ZERO 48300018 TPUNIT80 DC XL2'1005' 48400018 TPUNIT82 DC XL2'1006' 48500018 AMIDCNST DC C'3Y' GRAPHIC CLOSE ID 48600018 CLLDB DC C'0B' 48700018 CLLDG DC C'0G' END OF TABLE M4143 48800019 XCTLTABL ID=(GAMLOAD2,3X,PDLOAD,6M),SVC=020 S21016 49100021 EJECT 49400018 *********************************************************************** 49500018 * * 49600018 * DSECTS * 49700018 * * 49800018 *********************************************************************** 49900018 DCBD DSORG=GS 50000018 IECDSECS MAIN,EXPAND=YES S21016 50700021 IECTDEB DSECT 51500018 DEBNMSUB DS 0CL1 +0 51600018 DEBTCBAD DS CL4 51700018 DEBAMLNG DS 0CL1 +4 51800018 DEBDEBAD DS CL4 51900018 DEBOFLGS DS 0CL1 +8 52000018 DEBIRBAD DS CL4 52100018 DEBOPATB DS 0CL1 +12 52200018 DEBSYSPG DS CL4 52300018 DEBNMEXT DS 0CL1 +16 52400018 DEBUSRPG DS CL4 52500018 DEBPRIOR DS 0CL1 +20 52600018 DEBECBAD DS CL4 52700018 DEBPROTG DS 0CL1 +24 52800018 DEBDEBID DS 0CL1 52900018 DEBDCBAD DS CL4 53000018 DEBEXSCL DS 0CL1 +28 53100018 DEBAPPAD DS CL4 53200018 DEBDVMOD DS 0CL1 +32 53300018 DEBUCBAD DS CL4 53400018 END 53500018