SEARCH HDRFIL
COMPIL(IRP,,,,,,DUMMYFORGDSCISS)
NOTENX <
DEFINE IENS1 < INTTBL,INTMOD,ENABLE,DISABLE,INTMAP>
DEFINE IEXT1 < GOGTAB,INTRPT,X22,CORGET >
IFN APRISW <
DEFINE XJBCNI <JOBCNI>
DEFINE XJBTPC <JOBTPC>
DEFINE XJBAPR <JOBAPR>
DEFINE IEXT5 <JOBCNI,JOBTPC,JOBAPR,XJBENB,APRACS>
IFN ALWAYS <
EXTERN JOBCNI,JOBTPC,JOBAPR	;THESE ARE ALWAYS EXTERNAL
>;IFN ALWAYS
>;IFN APRISW
IFE APRISW <
DEFINE IEXT5 <XJBCNI,XJBTPC,XJBAPR,JOBINT>
IFN ALWAYS <
EXTERNAL JOBINT ;THIS FELLOW IS ALWAYS EXTERNAL
>;IFN ALWAYS
>;IFE APRISW
COMPXX(IRP,< IENS1 >,< IEXT1,IEXT5 >
		,<INTERRUPT STUFF>,,HIIFPOSSIB)
BEGIN IRPPKG
INTDBG←←0
IFE APRISW <
IFE INTDBG <
OPDEF DISMIS [ CALLI 400024]
>;IFE INTDBG
IFN INTDBG <
DEFINE DISMIS < JRST DSMMSR >
DSMMSR:
	HRLZI	P,INACS
	BLT	P,P
	JRST	@JOBTPC
INACS:	BLOCK 	20
>;IFN ITDBG
OPDEF INTORM [ CALLI 400026]
OPDEF INTACM [ CALLI 400027]
OPDEF INTENB [ CALLI 400025]
>;IFE APRISW
IFN APRISW <
OPDEF APRENB [ CALLI 16]
DEFINE DISMIS < JRST DSMSSR >
DSMSSR:	HRLZI	17,APRACS
	BLT	17,17	;BLT BACK ALL ACS
	JRST	@XJBTPC
>;IFN APRISW
HERE(INTTBL)
	MOVE	USER,GOGTAB	;
INTTB1:	MOVEI	C,=110
	ADD	C,-1(P)
	PUSHJ	P,CORGET
	ERR <NOT ENOUGH SPACE FOR INTSET>
	SKIPN	D,DISPAT(USER)	;ALREADY HABE ONE?
	JRST	INTTB2		;NO
	MOVSS	D		
	HRR	D,B		;D ← OLD,,NEW
	BLT	D,=71(B)	;COPY OLD DISPAT TABLE
	JRST	INTTB3
INTTB2:	SETZM	(B)
	HRL	A,B
	HRRI	A,1(B)
	ADDI	C,-1(B)
	BLT	A,(C)
INTTB3:	HRLI	B,10
	MOVEM	B,DISPAT(USER)
	ADDI	B,=36
	MOVEM	B,DFRINF(USER)
	ADDI	B,=36
	HRRZM	B,INTQWB(USER)
	HRRZM	B,INTQWP(USER)
	HRRZM	B,INTQRP(USER)
	ADD	B,-1(P)
	HRRZM	B,INTQWT(USER)
	HRLI	B,-20
	MOVEM	B,IPDP(USER)
	ADD	B,[XWD -10,20]
	MOVEM	B,ISPDP(USER)
	SUB	P,X22
	JRST 	@2(P)
IFN INTDBG,<
INTAPR:	MOVEM	P,INACS+17
	MOVEI	P,INACS
	BLT	P,INACS+16
>;IFN INTDBG
HERE(INTMOD)
IFN APRISW <
	MOVEM	17,APRACS+17
	MOVEI	17,APRACS
	BLT	17,APRACS+16	;SAVE THE ACS
>;IFN APRISW
	MOVE	USER,GOGTAB
	MOVE	7,XJBCNI	;PICK UP THE BITS
IFN APRISW <			
	ANDI	7,235110	;BE SURE LEGIT BITS ONLY
>;IFN APRISW
	MOVE	P,IPDP(USER)	;A PDL FOR THIS
	MOVE	SP,ISPDP(USER)	;A STRING PDL
DSPIT:	JFFO	7,DODISP	;DISPATCH INDEX
	ERR	<DRYROT: INTMOD>
DODISP:
	SKIPN	7,@DISPAT(USER)	;GO DISPATCH
	DISMIS			;DISMISS
	PUSHJ	P,(7)		;
	DISMIS
IFE APRISW <
HERE(ENABLE)
	SKIPA	B,[ INTORM A, ]
HERE(DISABLE)
	MOVE	B,[ INTACM A, ]
	MOVN	C,-1(P)
	HRLZI	A,400000
	LSH	A,(C)
	XCT	B
	SUB	P,X22
	JRST	@2(P)
>;IFE APRISW
IFN APRISW <
HERE(ENABLE)
	SKIPA	B,[OR A,XJBENB]
HERE(DISABLE)
	MOVE	B,[ANDCA A,XJBENB]
	MOVN	C,-1(P)		;
	HRLZI	A,400000
	LSH	A,(C)		;THE BIT
EXPO <
	TRO	A,400000	;REPETITIVE ENABLE (THIS MIGHT GET YOU
>;EXPO
	XCT	B
	MOVEM	A,XJBENB	;REMEMBER
	APRENB	A,
	SUB	P,X22
	JRST	@2(P)
>;IFN APRISW
HERE(INTMAP)
IFE APRISW <
	MOVEI	A,XJBCNI
	MOVEM	A,JOBINT
>;IFE APRISW
IFE INTDBG,<
	MOVEI	A,INTMOD
>;IFE INTDBG
IFN INTDBG,<
	MOVEI	A,INTAPR
>;IFN INTDBG
	MOVEM	A,XJBAPR
	MOVE	USER,GOGTAB
	SKIPE	DISPAT(USER)
	JRST	.+3
	PUSH	P,[=128]
	PUSHJ	P,INTTB1	;GET MINIMAL TABLES
	MOVE	10,-3(P)	;GET INDEX
	POP	P,-3(P)		;RET ADR
	POP	P,@DFRINF(USER)
	POP	P,@DISPAT(USER)
	POPJ	P,
HERE(IRPSP1)
HERE(IRPSP2)
HERE(IRPSP3)
BEND IRPPKG
>;NOTENX
TENX<
DEFINE IENS1 < INTTBL,PSIL1,PSIL2,PSIL3,ENABLE,DISABLE >
DEFINE IENS2 < ATI,DTI,RTIW,STIW,GTRPW,PSIMAP,INTMAP,PSIDISMS,PSIRUNTM,KPSITIME >
DEFINE IEXT1 < GOGTAB,INTRPT,JMPCHN,PS1CAS,PS2ACS,PS3ACS >
DEFINE IEXT2 < XJBCNI,XJBTPC,X22,X33,X44,CORGET,JOBUUO >
COMPXX(IRP,<IENS1,IENS2>
		,<IEXT1,IEXT2>,<INTERRUPT STUFF FOR TENEX>,,HIIFPOSSIB)
BEGIN IRPPKG
HERE(INTTBL)
	MOVE	USER,GOGTAB	;
INTTB1:	MOVEI	C,=194
	ADD	C,-1(P)
	PUSHJ	P,CORGET
	  ERR <NOT ENOUGH SPACE FOR INTSET>
	SKIPN	D,DISPAT(USER)	;ALREADY HABE ONE?
	JRST	INTTB2		;NO
	MOVSS	D		
	HRR	D,B		;D ← OLD,,NEW
	BLT	D,=71(B)	;COPY OLD DISPAT TABLE
	JRST	INTTB3
INTTB2:	SETZM	(B)
	HRL	A,B
	HRRI	A,1(B)
	ADDI	C,-1(B)
	BLT	A,(C)
INTTB3:	HRLI	B,10
	MOVEM	B,DISPAT(USER)
	ADDI	B,=36
	MOVEM	B,DFRINF(USER)
	ADDI	B,=36
	MOVEM	B,TIMFRK(USER)
	ADDI	B,=36
	HRRZM	B,INTQWB(USER)
	HRRZM	B,INTQWP(USER)
	HRRZM	B,INTQRP(USER)
	ADD	B,-1(P)
	HRRZM	B,INTQWT(USER)
DEFINE XXX $ (LEV) <
	MOVEI	C,(B)
	HRLI	C,-20
	MOVEM	C,IPDP$LEV(USER)
	ADDI	B,20
	MOVEI	C,(B)	
	HRLI	C,-10
	MOVEM	C,ISPDP$LEV(USER)
>
	XXX(1)
	XXX(2)
	XXX(3)
	SUB	P,X22
	JRST 	@2(P)
DEFINE XXX $ (LEV) <
HERE(PSIL$LEV)
	MOVEM	16,PS$LEV$ACS+16	;SAVE ACS
	MOVEI	16,PS$LEV$ACS
	BLT	16,PS$LEV$ACS+15
	HRRZI	10,-JMPCHN-1(17)	;CHANNEL NUMBER INTO 10
	MOVE	USER,GOGTAB
	MOVE	P,IPDP$LEV(USER)
	MOVE	SP,ISPDP$LEV(USER)
	SKIPN	7,@DISPAT(USER)
	  JRST	DIS$LEV
	MOVSI	A,400000
	MOVNI	B,(10)
	LSH	A,(B)
	PUSH	P,A			;THE CHANNEL AS A BIT
	MOVEI	1,400000		;THIS FORK
	JSYS	RIR			;READ LEVTAB,CHNTAB
	HLRZ	2,2			;LEVTAB
	PUSH	P,@LEV-1(2)		;PC WORD FOR THIS LEVEL
	PUSH	P,JOBUUO		;SAVE JOBUUO
	PUSHJ	P,(7)
	POP	P,JOBUUO		;RESTORE JOBUUO
	SUB	P,X22			;POINTLESS ACTUALLY
DIS$LEV:HRLZI	17,PS$LEV$ACS
	BLT	17,17
	JSYS	DEBRK
>;END OF MACRO DEFINITION
XXX(1)
XXX(2)
XXX(3)
HERE(ENABLE)
	SKIPA	C,AIC1
HERE(DISABLE)
	MOVE	C,DIC1
	MOVN	A,-1(P)			;NEGATED PSI CHAN
	HRLZI	B,400000
	LSH	B,(A)			;GET THE RIGHT BIT
	HRRZI	A,400000		
	XCT	C
	SUB	P,X22
	JRST	@2(P)
AIC1:	JSYS	AIC			;AVOID A LITERAL
DIC1:	JSYS	DIC
HERE(ATI)
	HRRZ	B,-1(P)			;GET THE CODE
	JUMPL	B,.+2			;IF NOT (0 LEQ CODE LEQ =35) THEN ERR
	 CAILE	B,=35
	 ERR	<ATI:  Terminal code not in range 0 thru 35>
	MOVE	A,-2(P)			;PSI CHANNEL
	JUMPL	A,BADCHN
	CAILE	A,=35
	  JRST	BADCHN
	CAIGE	A,=24
	  CAIG	A,=5
	JRST	.+2
BADCHN:	ERR	<ATI:  Terminal interrupt channel not 0-5 or 24-35>
	HRL	A,B
	JSYS	ATI
	SUB	P,X33
	JRST	@3(P)
HERE(DTI)
	HRRZ	A,-1(P)			;TERMINAL CODE
	JUMPL	A,DTIERR
	CAILE	A,=35
DTIERR:	ERR	<DTI:  Terminal interrupt code not in range>
	JSYS	DTI
	SUB	P,X22
	JRST	@2(P)
HERE(RTIW)
	MOVE	1,-3(P)
	JSYS	RTIW
	MOVEM	2,@-2(P)
	MOVEM	3,@-1(P)
	SUB	P,X44
	JRST	@4(P)	
HERE(STIW)
	MOVE	1,-3(P)
	MOVE	2,-2(P)
	MOVE	3,-1(P)
	JSYS	STIW
	SUB	P,X44
	JRST	@4(P)
HERE(GTRPW)
	MOVE	1,-2(P)
	JSYS	GTRPW	
	MOVEM	2,@-1(P)
	SUB	P,X33
	JRST	@3(P)				;CONTENTS OF 1 OK
HERE(PSIMAP)
	MOVE	USER,GOGTAB
	SKIPE	DISPAT(USER)		;ARE TABLES SET UP?
	  JRST	.+3
	PUSH	P,[=128]
	PUSHJ	P,INTTB1		;SO SET UP
	MOVEI	A,400000		;THIS FORK
	JSYS	RIR			;READ ADDRESS
	JUMPN	2,.+2
	  ERR	<PSIMAP: DRYROT>
	JSYS	EIR			;TURN ON PSI SYSTEM
	SKIPL	10,-4(P)		;CHANNEL
	CAILE	10,=35			;CHECK RANGE
	  ERR	<PSIMAP:  Channel number not between 0 and 35>
	POP	P,-4(P)			;RETURN ADDRESS
	POP	P,D			;LEVEL
	CAIL	D,1
	CAILE	D,3
	  ERR	<PSIMAP:  Level not between 1 and 3>
	POP	P,@DFRINF(USER)		;INFORMATION ABOUT DEFERRED INTERRUPT -- CHANNEL IN 10
 	POP	P,@DISPAT(USER)		;DISPATCH ADDRESS -- CHANNEL IN 10
	ADDI	2,(10)			;POSITION IN TENEX CHNTBL
	ADDI	10,JMPCHN		;ADDRESS TO JMP TO FROM CHNTAB
	HRLI	A,(D)			;XWD LEVEL, ADDRESS
	HRRI	A,(10)
	MOVEM	A,(2)			;PUT INTO TENEX CHNTAB
	MOVE	A,LEVJMP-1(D)		;JUMP TO CORRECT LEVEL
	MOVEM	A,(10)
	POPJ	P,			;RETURN -- STACK IS OK
LEVJMP:	JSA	17,PS1ACS+17
	JSA	17,PS2ACS+17
	JSA	17,PS3ACS+17
HERE(INTMAP)
	PUSH	P,(P)			;RETURN ADDR
	MOVEI	A,3			;LEVEL 3
	MOVEM	A,-1(P)			;MAKE ANOTHER ARGUMENT
	JRST	PSIMAP			;AND CALL PSIMAP
HERE(PSIDISMS)
	BEGIN PSIDISMS
	MOVE	USER,GOGTAB
	SKIPE	DISPAT(USER)		;TABLES SET UP?
	  JRST	.+3
	PUSH	P,[=128]		;DEFAULT DI BUFFER SIZE
	PUSHJ	P,INTTBL		;INITIALIZE
	MOVE	10,-2(P)		;INTERRUPT CHANNEL	
	SKIPE	1,@TIMFRK(USER)		;GET FORK
	  JSYS	KFORK			;KILL OLD ONE
	MOVNI	1,(10)			;CHANNEL NEGATED
	MOVSI	2,400000	
	LSH	2,(1)			;BIT MASK FOR CHANNEL IN 2
	MOVE	3,-1(P)			;TIME TO DISMISS
	ADD	P,[XWD 20,20]	
	TLNN	P,400000		;OVERFLOW?
	  ERR	<PSITIME:  PDL overflow>
	HRLI	4,PSTACS		;ADDRESS OF ACS
	HRRI	4,-17(P)		;STACK ADDRESS
	BLT	4,(P)			;ONTO STACK
	MOVEM	3,-5(P)			;TIME	
	MOVEM	2,-6(P)			;CHANNEL MASK
	MOVE	1,[XWD 260000,3]	;SET ACS, START FORK AT LOCATION 3
	MOVEI	2,-17(P)		;POINTER TO ACS
	JSYS	CFORK			;CREATE FORK
	  ERR	<PSITIME:  Cannot CFORK>
	MOVEM	1,@TIMFRK(USER)		;SAVE HANDLE
	SUB	P,[XWD 23,23]		;ADJUST STACK, INCLUDING ARGS
	JRST	@3(P)			;RETURN
PSTACS:	0				;0
	0				;1
	0				;2
	MOVE	1,12			;3
	JSYS	DISMS			;4
	MOVEI	1,-1			;HANDLE TO SUPERIOR FORK
	MOVE	2,11			;CHANNEL MASK
	JSYS	IIC			;CAUSE AN INTERRUPT
	JRST	3			;LOOP
	0				;11 --- CHANNEL MASK GOES HERE
	0				;12 -- TIME TO DISMISS GOES HERE
	BLOCK 5				;ACS 13-17 HERE
	BEND PSIDISMS
HERE(PSIRUNTM)
	BEGIN PSIRUNTM
	MOVE	USER,GOGTAB
	SKIPE	DISPAT(USER)		;TABLES SET UP?
	  JRST	.+3
	PUSH	P,[=128]		;DEFAULT DI BUFFER SIZE
	PUSHJ	P,INTTBL		;INITIALIZE
	MOVE	10,-2(P)		;INTERRUPT CHANNEL	
	SKIPE	1,@TIMFRK(USER)		;GET FORK
	  JSYS	KFORK			;KILL OLD ONE
	MOVNI	1,(10)			;CHANNEL NEGATED
	MOVSI	2,400000	
	LSH	2,(1)			;BIT MASK FOR CHANNEL IN 2
	CAIG	2,777777		;IN LEFT HALF
	   JRST	[HLL 2,[HRRZI 2,]
		 JRST GOTMSK]
	HLR	2,2			;MOVE MASK TO RIGHT HALF
	HLL	2,[HRLZI 2,]
GOTMSK:	MOVE	3,-1(P)			;TIME TO DISMISS
	CAILE	3,777777		;MAXIMUM IS 777777 MS
	  MOVEI	3,777777		;FORCE TO MAXIMUM
	ADD	P,[XWD 20,20]	
	TLNN	P,400000		;OVERFLOW?
	  ERR	<PSITIME:  PDL overflow>
	HRLI	4,PSTACS		;ADDRESS OF ACS
	HRRI	4,-17(P)		;STACK ADDRESS
	BLT	4,(P)			;ONTO STACK
	HRRM	3,-5(P)			;TIME INTERVAL INTO AC 12
	HRRM	3,-13(P)		;TIME INTERVAL INTO AC 4
	MOVEM	2,-2(P)			;CHANNEL MASK INTO AC 15
	PUSH	P,3			;SAVE TIME INTERVAL
	MOVEI	1,400000		;THIS FORK
	JSYS	RUNTM
	POP	P,3			;RESTORE INTERVAL
	ADD	1,3			;NEXT TIME TO INTERRUPT
	MOVEM	1,-17(P)		;STORE IN AC 0
	MOVE	1,[XWD 260000,4]	;SET ACS, START FORK AT LOCATION 4
	MOVEI	2,-17(P)		;POINTER TO ACS
	JSYS	CFORK			;CREATE FORK
	  ERR	<PSITIME:  Cannot CFORK>
	MOVEM	1,@TIMFRK(USER)		;SAVE HANDLE
	SUB	P,[XWD 23,23]		;ADJUST STACK, INCLUDING ARGS
	JRST	@3(P)			;RETURN
PSTACS:	0				;0 NEXT RUNTM TO INTERRUPT
	0				;1
	0				;2
	0				;3
	MOVEI	1,0			;4 TIME INTERVAL IN THE RIGHT HALF
	JSYS	DISMS			;5 DISMISS FOR THIS LONG
	MOVEI	1,-1			;6 HANDLE TO SUPERIOR FORK
	JSYS	RUNTM			;7 GET RUNTIME IN AC 1
	CAMGE	1,0			;10 IS IT BEYOND THE INTERVAL?
	   JRST	4			;11 NO DISMISS AGAIN
	ADDI	1,0			;12 NEXT PERIOD -- INTERVAL IN RIGHT HALF
	MOVEM	1,0			;13 AND SAVE IT
	MOVEI	1,-1			;14 HANDLE TO SUPERIOR FORK
	HRRZ	2,0			;15 CHANNEL MASK -- EITHER A HRRZ OR HRLZ INSTRUCTION, MODIFIED
	JSYS	IIC			;16 CAUSE AN INTERRUPT
	JRST	4			;17 AND CONTINUE
	BEND PSIRUNTM
HERE(KPSITIME)
	MOVE	USER,GOGTAB
	SKIPN	TIMFRK(USER)		;CHECK SET UP
	  JRST	KPSIRET			;NOT SET UP -- RETURN
	MOVE	10,-1(P)		;CHANNEL NUMBER
	SKIPE	1,@TIMFRK(USER)
	  JSYS	KFORK			;KILL FORK
	SETZM	@TIMFRK(USER)		;REMEMBER NO FORK
KPSIRET:SUB	P,X22
	JRST	@2(P)			;RETURN
HERE(IRPSP1)
HERE(IRPSP2)
HERE(IRPSP3)
BEND IRPPKG
>;TENX
ENDCOM(IRP)
END