* NAME 00300021 * DISATN 00600021 * 00900021 * MODLUE NAME 01200021 * IFFACA03 01500021 * 01800021 * FUNCTION 02100021 * TO CAUSE GSP TO DISREGARD SUBSEQUENT OCCURRANCE OF 02400021 * ATTENTIONS ON THE DESIGNATED SOURCE(S) WHEN THE 02700021 * ASSOCIATED ATTENTION LEVEL IS ACTIVE. 03000021 * 03300021 * ENTRY 03600021 * CSECT NAME 03900021 * 04200021 * INPUT 04500021 * REGISTER 1 CONTAINS THE ADDRESS OF A WORK/SAVE AREA. 04800021 * THE FIRST WORD CONTAINS THE ADDRESS OF A PARAMETER 05100021 * LIST CONTAINING. 05400021 * 4. ADDRESS OF A VARIABLE CONTAINING THE ADDRESS 05700021 * OF THE ATTENTION LEVEL(ATTNLEVEL). 06000021 * 2. ADDRESS OF ATTENTION SOURCE(S) TO BE DISABLED 06300021 * (ATTNSOURCE). 06600021 * 1-31 PROGRAM FUNCTION KEYS 1-31 06900021 * 32 END KEY 07200021 * 33 CANCEL KEY 07500021 * 34 LIGHT PEN 07800021 * 35 EOS 08100021 * 36 ASYNCHRONOUS ERROR 08400021 * 08700021 * TO GIVE INDIVIDUAL SOURCES, GIVE A NUMBER. 09000021 * TO GIVE SOURCES 5 TO 10, FOR EXAMPLE, 5 IS 09300021 * POSITIVE AND 10 IS NEGATIVE. 09600021 * 09900021 * OUTPUT 10200021 * RESET INDICATED ATTENTION SOURCE BIT(S) IN THE 10500021 * ATTENTION TABLE ENABLED SOURCE MASKS. 10800021 * 11100021 * EXIT 11400021 * RETURN TO CALLING ROUTINE VIA REGISTER 14. 11700021 * 12000021 * RETURN CODES 12300021 * 4,1 INVALID ATTENTION LEVEL 12600021 * 4,N INVALID SOURCE CODE 12900021 * 13200021 * ATTRIBUTES 13500021 * REENTRANT, PROBLEM PROGRAM MODE 13800021 * FLOWCHARTS 14100021 * CM, CN, CO 14400021 TITLE 'DISATN - DISABLE ATTENTIONS' 14700021 REG0 EQU 0 PARAM REG 0 15000021 REG1 EQU 1 PARAM REG 1 15300021 RLIST EQU 2 INPUT PARAM LIST 15600021 RPARAM EQU 3 USER PARAM LIST 15900021 RATL EQU 4 ATTENTION LEVEL ADDR 16200021 RGTMCB EQU 5 GTMCB ADR 16500021 RWORKD EQU 7 WORK REG 16800021 RBASE EQU 9 BASE REG 17100021 RWORKC EQU 11 WORK REG 17400021 RSAVE EQU 13 SAVE AREA REG 17700021 RWORKA EQU 14 WORK REG 18000021 RWORKB EQU 15 WORK REG 18300021 RSOURCE EQU 2 CONVERTA ATTNSOURCE ADR REG 18600021 RFIRST EQU 3 CONVERTA FIRST ARG REG 18900021 RINFO EQU 4 CONVERTA ADD INFO REG 19200021 RPFA EQU 5 CONVERTA PF REG 19500021 RANA EQU 6 CONVERTA A/N REG 19800021 RA EQU 7 CONVERTA WORK REG A 20100021 RB EQU 8 CONVERTA WORK REG B 20400021 * RBASE EQU 9 BASEREG DUMMY 20700021 RC EQU 10 CONVERTA WORK REG C 21000021 RD EQU 11 CONVERTA WORK REG D 21300021 RE EQU 12 CONVERTA WORK REG E 21600021 ADD0 EQU 0 ADD INFO 0 21900021 ADD1 EQU 1 22200021 ADD5 EQU 2 ADD INFO EQUAL 2 FOR ENATTN 22500021 AID EQU X'04' ATTN LEVEL ID 22800021 GACBPLUS EQU 8 OFFSET TO GACB ADDR 23100021 HASPFK EQU X'10' HAS PF KEYBOARD 23200021 HEX01 EQU X'01' 23400021 HEX03 EQU X'03' 23700021 IOK EQU X'7F' I/O SUCCESSFULL CODE 23800021 LAST EQU X'80' LAST PARAMETER 24000021 NEG EQU X'80' NEGATIVE VALUE 24300021 NEXT EQU 4 NEXT SOURCE 24600021 ONE EQU 1 24900021 PFK0 EQU X'80' PFK0 BIT 25200021 RCC4 EQU X'08' RETURN CODE 4 25500021 RC4 EQU 16 OFFSET TO RC4 25800021 RC5 EQU X'04' I/O ERROR 25900021 ZERO EQU 0 ZERO 26100021 IFFACA03 CSECT 26400021 *2101,513000 PTM 3051 26450021 *2101,513000 26500021 SAVE (14,12) SAVE REGISTERS 26700021 BALR RBASE,0 SET UP BASE REG 27000021 USING *,RBASE DEFINE BASE REG 27300021 LR RLIST,REG1 SAVE INPUT PARAM 27600021 USING WORKAREA,RLIST DEFINE DSECT 27900021 L RPARAM,PARAM LOAD ADDR USER PARAM LIST 28200021 USING PLIST,RPARAM DEFINE DSECT 28500021 ST RSAVE,SAVE+4 MY SAVE ARE ADDR 28800021 LA RSAVE,SAVE LOAD ADDR MY SAVE AREA 29100021 ST RSAVE,SAVE+8 SAVE USERS R13 29400021 L RWORKA,RCA LOAD RETURN CODE ARRAY ADDR 29700021 XC ZERO(20,RWORKA),ZERO(RWORKA) ZERO ARRAY 30000021 B AROUND 30300021 ERROR EQU * 30600021 * RETURN CODE MUST BE LOADED INTO REG RWORKB (15) 30900021 * ADD INFO MUST BE LOADED INTO REG RWORKC (R11) 31200021 * OFFSET MUST BE LOADED INTO REG RWORKD (R12) 31500021 * UPON ENTRY TO ERROR ROUTINE 31800021 L RWORKA,RCA LOAD RETURN CODE ARRAY ADDR 32100021 STC RWORKB,ZERO(RWORKA) STORE RETURN CODE 32400021 ST RWORKC,ZERO(RWORKD,RWORKA) STO ADD INFO AT PROPER OFFSET 32700021 OUT L RSAVE,SAVE+4 RE-ESTABLISH OLD SAVE AREA 33000021 RETURN (14,12),T RETURN TO CALLER 33300021 AROUND TM ATNLVL,LAST LAST PARAM 33600021 BC 14,REQ01 BRANCH IF NO 33900021 LA RWORKC,ADD0 LOAD ADD INFO 34200021 REQ03 LA RWORKB,RCC4 LOAD RETURN CODE 34500021 LA RWORKD,RC4 LOAD OFFSET 34800021 B ERROR 35100021 REQ01 L RATL,ATNLVL LOAD INDIRECT PTR TO ATTN LEVEL 35400021 L RATL,ZERO(RATL) LOAD ATTN LEVEL ADDR 35700021 USING ATTNLEVL,RATL DEFINE DSECT 36000021 CLI ATTNLVID+1,AID IS THIS VALID ATTN LEVEL 36300021 BNE REQ40 BRANCH IF NO ADD INFO EQUAL1 36600021 * TEST FOR ANY ATTNSOURCES SPECIFIED 36900021 L RWORKC,ATNSRCE LOAD ADDR OF DATA 37200021 LA RWORKC,ZERO(RWORKC) ZERO HI ORDER BIT 37500021 LTR RWORKC,RWORKC IS THERE AN ADDR THERE 37800021 BZ INFOADD0 NO 38100021 BAL RWORKA,CONVERTA BRANCH TO ATTNSOURCE CONVERSION 38400021 LTR RWORKB,RWORKB RC=0 38700021 BZ GOOD YES 39000021 LR RWORKC,RWORKB LOAD ADD INFO 39300021 B REQ03 39600021 REQ40 EQU * 39900021 LA RWORKC,ADD1 LOAD ADD INFO CODE OF 1 40200021 B REQ03 40500021 INFOADD0 EQU * 40800021 * NO ATTN SOURCE PARAMETER SPECIFIED 41100021 LA RWORKC,ADD5 LOAD ADD INFO CODE OF 2 41400021 B REQ03 41700021 GOOD EQU * 42000021 * SAVE PF MASK FOR LATER TEST 42300021 ST REG1,PFMASK SAVE PF MASK 42600021 * SUBTRACT A/N AND P/F MASK FROM PERM ATLV MASKS 42900021 X REG0,MASK *FLIP AN MASK 43200021 X REG1,MASK *FLIP PF MASK 43500021 ST REG0,AN1 * 43800021 ST REG1,PF1 * 44100021 NC ATTNPFEN(4),PF1 * 44400021 NC ATTNANEN(4),AN1 * 44700021 NC ATTNPFDE(4),PF1 * 45000021 NC ATTNANDE(4),AN1 * 45300021 CLC ATTNFWPT,ZERO1 *IS LEVEL ACTIVE 45600021 BNE RETCODE0 * 45900021 * PUT NEW ATLV PERM MASKS IN GACB2 AND GACB3 46200021 ST RATL,SAVE1 SAVE ATTN LVL ADDR 46500021 AGAIN CLI ATTNBPID,HEX01 ATBL BP POINT TO GTMCB 46800021 BE LBPTR YES 47100021 L RATL,ATTNBKPT LOAD BACKWARD PTR INTO BASE REG 47400021 B AGAIN 47700021 LBPTR L RGTMCB,ATTNBKPT LOAD BASE 48000021 USING GTMCB,RGTMCB DEFINE DESECT 48300021 L RATL,SAVE1 RESTORE ATTN LVL ADDR 48600021 * REPLACE AN AND PF MASKS IN ATTN LVL OF GACB 3 AND2 48900021 L RWORKA,GTMGACBA LOAD GACB ADR 49200021 LA RWORKA,GACBPLUS(RWORKA) LOAD PTR TO TRUE START OF GACB 49500021 MVC 8(4,RWORKA),ATTNPFEN * 49800021 MVC 12(4,RWORKA),ATTNANEN *NEW ANMASK INTO ML GACB PLUS 12 50100021 L RWORKA,GTMGACBA *LOAD GACB ADDR 50400021 L RWORKA,ZERO(RWORKA) *SET PTR TO START OF DE GACB %2< 50700021 LA RWORKA,GACBPLUS(RWORKA) LOAD PTR TO TRUE START OF GACB* 51000021 MVC 8(4,RWORKA),ATTNPFDE NEW PFK MASK INTO DE PTM 3051 51200021 * GACB + 8 PTM 3051 51400021 MVC 12(4,RWORKA),ATTNANDE *NEW ANMASK INTO DE GACB PLUS 12 51600021 TM GTMFEATS+1,HASPFK DOES DEVICE HAVE A PF KEYBOARD 51700021 BC 14,OUT BRANCH-NO 51800021 L RWORKB,PFMASK *LOAD PF MASK 51900021 LTR RWORKB,RWORKB *ANY PF KEYS DISABLED 52200021 BZ RETCODE0 *NO 52500021 CLI ATTNLITE,HEX03 52800021 BE TURNON 53100021 * SET PF LITES ON AS PER ENABLED KEYS 53400021 CLI ATTNLITE,HEX01 SYS DEFAULT OPTION IN GTMCB 53700021 BNE RETCODE0 54000021 CLI GTMLIGHT,HEX03 LIGHT ENABLED KEYS 54300021 BNE RETCODE0 NO 54600021 * TURN PF LIGHTS ON 54900021 TURNON EQU * 55200021 XC DECB(36),DECB CLEAR I/O AREA 55500021 L RWORKD,GTMGRDCB LOAD DCB ADDR 55800021 LA RWORKC,DATA LOAD DATA ADDR 56100021 LA REG1,DECB LOAD PARM LIST ADDR 56400021 MVC DATA(4),ATTNPFEN PUT KEY MASK INTO DATA (LIGHTS) 56700021 GCNTRL (1),IND,(7),(11),MF=E TURN LIGHTS ON 57000021 WAIT ECB=(1) 57300021 CLI DECB,IOK I/O SUCCESSFULL 57350021 BE OUT BRANCH-I/O OK 57400021 L REG1,RCA LOAD RTN CODE ARRAY ADR 57450021 OI ZERO(REG1),RC5 INDICATE I/O ERROR 57500021 B OUT RETURN TO CALLER 57550021 RETCODE0 EQU * 57900021 B OUT RETURN TO CALLER 58000021 LA RWORKC,ADD0 LOAD ADD INFO 58200021 LA RWORKB,ADD0 LOAD RETURN CODE 58500021 LA RWORKD,RC4 LOAD OFFSET 58800021 B ERROR 59100021 EJECT 59400021 CONVERTA SAVE (2,12) SAVE REGS 59700021 LA RSOURCE,ATNSRCE LOAD ADR OF 1ST ARG 60000021 LA RFIRST,NEXT INDICATE 1ST ARG 60300021 SR RPFA,RPFA CLEAR PF REG 60600021 SR RANA,RANA CLEAR A/N REG 60900021 LA RINFO,ADD5 LOAD 1ST ADD INFO CODE 61200021 B REQ18 BRANCH 61500021 REQOK SR RWORKB,RWORKB ZERO RETURN CODE 61800021 LR REG0,RANA LOAD A/N MASK 62100021 LR REG1,RPFA LOAD P/F MASK 62400021 B REQ19 BRANCH 62700021 REQERR LR RWORKB,RINFO LOAD RETURN CODE 63000021 REQ19 RETURN (2,12) RETURN 63300021 REQ18 L RC,ZERO(RSOURCE) LOAD ADR OF ARG 63600021 TM ZERO(RC),NEG ARG NEGATIVE 63900021 BC 1,REQNEG BRANCH IF NEG 64200021 L RB,ZERO(RC) LOAD VALUE OF ARG 64500021 REQ24 CL RB,MAX VALUE GREATER THAN ALLOWABLE 64800021 BC 2,REQERR BRANCH IF YES 65100021 REQ23 CL RB,ANSIZE VALUE GREATER THAN 31 65400021 BC 2,REQ20 BRANCH IF YES 65700021 L RE,PRIME PRIME REG 66000021 SRL RE,ZERO(RB) POSITION BIT 66300021 OR RPFA,RE ADD TO PF MASK 66600021 REQ26 TM ZERO(RC),NEG ARG NEG 66900021 BC 1,REQ21 BRANCH IF YES 67200021 REQ22 TM ZERO(RSOURCE),LAST MORE ARGS 67500021 BC 1,REQOK BRANCH IF NO 67800021 L RA,ZERO(RC) SAVE VALUE PRESENT ARG 68100021 LA RSOURCE,NEXT(RSOURCE) STEP TO NEXT ARG 68400021 SR RFIRST,RFIRST INDICATE NOT 1ST ARG 68700021 LA RINFO,ONE(RINFO) INCREMENT ADD INFO 69000021 B REQ18 BRANCH TO MORE ARGS 69300021 REQ21 LA RE,ONE LOAD CONSTANT 69600021 SR RB,RE DECREMENT ARG BY 1 69900021 CLR RA,RB VALUE=PREVIOUS VALUE 70200021 BE REQ22 BRANCH IF YES 70500021 B REQ23 BRANCH 70800021 REQNEG LTR RFIRST,RFIRST FIRST ARG 71100021 BC 7,REQERR BRANCH IF YES 71400021 LTR RA,RA PREV ARG NEG 71700021 BC 4,REQERR BRANCH IF YES 72000021 L RB,ZERO(RC) LOAD VALUE OF ARG 72300021 LPR RB,RB MAKE ARG POS 72600021 CLR RB,RA VALUE GREATER THAN PREV ARG 72900021 BC 2,REQ24 BRANCH IF YES 73200021 B REQERR BRANCH 73500021 REQ20 LA RD,END LOAD ADR OF CONSTANT 73800021 LA RE,ONE LOAD CONSTANT 74100021 REQ27 CL RB,ZERO(RD) COMPARE 74400021 BE REQ25 BRANCH IF YES 74700021 SLL RE,ONE SHIFT BIT 75000021 LA RD,NEXT(RD) LOAD NEXT CONSTANT ADR 75300021 B REQ27 BRANCH 75600021 REQ25 OR RANA,RE ADD BIT TO MASK 75900021 B REQ26 BRANCH 76200021 SPACE 3 76500021 * CONSTANTS 76800021 * END,LP,EOS,CANCEL,MAX,ANSIZE FIELDS MUST BE IN SEQUENCE 77100021 END DC A(32) 77400021 LP DC A(34) 77700021 EOS DC A(35) 78000021 CANCEL DC A(33) 78300021 MAX DC A(36) 78600021 ANSIZE DC A(31) 78900021 PRIME DC X'80000000' PF PRIME VALUE 79200021 ZERO1 DC 1F'0' 79500021 MASK DC X'FFFFFFFF' * 79800021 EJECT 80100021 WORKAREA DSECT 80400021 PARAM DS 1F 80700021 RCA DS 1F 81000021 ANMASK DS 1F SAVE AREA FOR ANMASK 81300021 PFMASK DS 1F SAVE AREA FOR PFMASK 81600021 SAVE DS 18F 81900021 DECB DS 8F I/O DECB 82200021 SAVE1 DS 1F 82500021 DATA DS 1F DATA AREA FOR IO 82800021 AN1 DS 1F * 83100021 PF1 DS 1F * 83400021 SPACE 3 83700021 PLIST DSECT 84000021 ATNLVL DS 1F 84300021 ATNSRCE DS 1F 84600021 ATNFLAG DS BL1 ATTNDATA SWITCH 84900021 EJECT 85200021 COPY ATTNLEVL 85500021 COPY GTMCB 85800021 COPY GDSCB 86100021 COPY GSPCB 86400021 END 86700021