+
+TITLE INTERRUPT HANDLER FOR MUDDLE
+
+RELOCATABLE
+
+.SYMTAB 3337.
+
+;C. REEVE APRIL 1971
+
+.INSRT MUDDLE >
+
+SYSQ
+XJRST=JRST 5,
+
+F==PVP
+G==TVP
+
+IF1,[
+IFE ITS,.INSRT STENEX >
+]
+
+PDLGRO==10000 ;AMOUNT TO GROW A PDL THAT LOSES
+NINT==72. ;MAXIMUM NUMBER OF INTERRUPTS POSSIBLE
+
+IFN ITS,[
+;SET UP LOCATION 42 TO POINT TO TSINT
+
+RMT [
+
+ZZZ==$. ;SAVE CURRENT LOCATION
+
+LOC 42
+
+ JSR MTSINT ;GO TO HANDLER
+
+LOC ZZZ
+]
+]
+
+; GLOBALS NEEDED BY INTERRUPT HANDLER
+
+.GLOBAL ONINT ; FUDGE INS EXECUTED IF NON ZERO AT START OF INTERRUPT
+.GLOBAL INTBCK ; "PC-LOSER HACK "
+.GLOBA GCFLG ;TELLS WHETHER OR NOT GARBAGE COLLECTOR IS RUNNING
+.GLOBAL GCFLCH ; FLUSH CHARS IMMEDIATE SO GC CAN SEE THEM
+.GLOBAL CORTOP ; TOP OF CORE
+.GLOBA GCINT ;TELLS GARBAGE COLLECTOR TO SIMULATE AN INTERRUPT
+.GLOBAL INTNUM,INTVEC ;TV ENTRIES CONCERNING INTERRUPTS
+.GLOBAL AGC ;CALL THE GARBAGE COLLECTOR
+.GLOBAL VECNEW,PARNEW,GETNUM ;GC PSEUDO ARGS
+.GLOBAL GCPDL ;GARBAGE COLLECTORS PDL
+.GLOBAL VECTOP,VECBOT ;DELIMIT VECTOR SPACE
+.GLOBAL PURTOP,CISTNG,SAGC
+.GLOBAL PDLBUF ;AMOUNT OF PDL GROWTH
+.GLOBAL PGROW ;POINTS TO DOPE WORD OF NEXT PDL TO GROW
+.GLOBAL TPGROW ;POINTS TO NEXT MUDDLE PDL TO GROW
+.GLOBAL TOPLEV,ERROR%,N.CHNS,CHNL1
+.GLOBAL BUFRIN,CHNL0,SYSCHR ;CHANNEL GLOBALS
+.GLOBAL IFALSE,TPOVFL,1STEPR,INTOBL,INCHAR,CURPRI,RDEVIC,RDIREC,GFALS,STATUS
+.GLOBAL PSTAT,NOTRES,IOIN2,INAME,INTFCN,CHNCNT,CHANNO,GIBLOK,ICONS,INCONS
+.GLOBAL IEVECT,INSRTX,ILOOKC,IPUT,IREMAS,IGET,CSTAK,EMERGE,CHFSWP
+.GLOBAL MTSINT ;BEGINNING OF INTERRUPT HANDLER
+.GLOBAL INTINT ;CALLED BY INITIALIZER TO TAKE CARE OF INT PCS
+.GLOBAL FRMSTK,APPLY,CHUNW,TGFALS
+.GLOBAL IPCGOT,DIRQ ;HANDLE BRANCHING OFF TO IPC KLUDGERY
+.GLOBAL MULTSG
+
+; GLOBALS FOR GC
+.GLOBAL GCTIM,GCCAUS,GCCALL,GPDLOV
+
+; GLOBALS FOR MONITOR ROUTINES
+
+.GLOBAL MONCH,MONCH0,RMONCH,RMONC0,LOCQ,SMON,BAPT,APLQ,MAKACT,NAPT
+.GLOBAL PURERR,BUFRIN,INSTAT,REALTV,DSTORE
+
+MONITOR
+
+.GLOBAL MSGTYP,MTYI,UPLO,IFLUSH,OCLOS,ERRET,MASK1,MASK2 ;SUBROUTINES USED
+.GLOBAL ERROR,LISTEN,ECHO,RRESET,MTYO,GCHAPN,P.CORE,P.TOP,QUEUES,NOTTY,TTYOP2,TTICHN
+.GLOBAL INTHLD,BNDV,SPECBE,DEMFLG,PLODR
+
+; GLOBALS FOR PRE-AGC INTERRUPT
+
+.GLOBAL FRETOP,GCSTOP,FREMIN,CORTOP,P.CORE,PURBOT,GETNUM,GCKNUM,GCHPN,INTAGC
+.GLOBAL SPECBIND,SSPEC1,ILVAL
+
+
+; GLOBALS FOR COPY/WRITE HACK FOR GCDUMP AND PURIFY
+
+.GLOBAL GCDFLG,%CWINF,BUFGC,WNDBOT,WIND,WNDP,%SHWND,GPURFL,%FDBUF,PURMNG,RPURBT
+.GLOBAL NPWRIT,PVSTOR,SPSTOR,OPSYS
+
+
+
+;BEGINNING OF ACTUAL INTERRUPT HANDLER (MUST BE IMPURE)
+
+
+;***** TEMP FUDGE *******
+
+QUEUES==INTVEC
+
+\f
+; DECLARATIONS ASSOCIATED WITH INTERRUPT HANDERS AND HEADERS
+
+; SPECIAL TABLES
+
+SPECIN: IRP A,,[CHAR,CLOCK,MPV,ILOPR,WRITE,READ,IOC,PURE,SYSDOWN,INFERIOR,RUNT,REALT
+PARITY]
+ MQUOTE A,[A]INTRUP
+ TERMIN
+SPECLN==.-SPECIN
+
+; TABLE OF SPECIAL FINDING ROUTINES
+
+FNDTBL: IRP A,,[GETCHN,0,0,0,LOCGET,LOCGET,0,0,0,0,0,0,0]
+ A
+ TERMIN
+
+; TABLE OF SPECIAL SETUP ROUTINES
+
+INTBL: IRP A,,[S.CHAR,S.CLOK,S.MPV,S.ILOP,S.WMON,S.RMON,S.IOC,S.PURE,S.DOWN,S.INF
+S.RUNT,S.REAL,S.PAR]
+ A
+ S!A==.IRPCNT
+ TERMIN
+
+IFN ITS,[
+
+; EXTERNAL INTERRUPT TABLE
+
+EXTINT: REPEAT NINT-36.,0
+ REPEAT 16.,HCHAR
+ 0
+ 0
+ REPEAT 8.,HINF
+ REPEAT NINT-62.,0
+EXTIND:
+
+IRP A,,[[HCLOCK,13.],[HMPV,14.],[HILOPR,6],[HIOC,9],[HPURE,26.],[HDOWN,7],[HREAL,35.]
+[HRUNT,34.],[HPAR,28.]]
+ IRP B,C,[A]
+ LOC EXTINT+C
+ B
+ .ISTOP
+ TERMIN
+TERMIN
+
+
+LOC EXTIND
+]
+\f
+IFE ITS,[
+
+; TABLES FOR TENEX INTERRUPT SYSTEM
+
+LEVTAB: P1 ; POINTS TO INT PC HOLDERS FOR LEVS 1,2 AND 3
+ P2
+ P3
+
+CHNMSK==700000,,7 ; WILL BE MASK WORD FOR INT SET UP
+MFORK==400000
+NNETS==7 ; ALLOW 7 NETWRK INTERRUPTS
+UINTS==4
+NETCHN==36.-NNETS-UINTS-1
+NCHRS==6
+RLCHN==36.-NNETS-UINTS
+
+RMT [
+IMPURE ; IMPURE BECAUSE IT CHANGES IN MULTI-SECTION MODE
+CHNTAB: ; LOCATION OF INT ROUTINES FOR VARIOUS "CHANNELS"
+
+REPEAT NCHRS, 1,,INTCHR+3*.RPCNT
+ BLOCK 36.-NNETS-NCHRS-UINTS-1 ; THERE ARE 36. TENEX INT CHANNELS
+
+REPEAT NNETS+UINTS, 1,,INTNET+3*.RPCNT
+
+IRP A,,[[9.,TNXPDL],[17.,PWRIT],[10.,TNXEOF],[11.,TNXIOC],[12.,TNXFUL]
+[RLCHN,TNXRLT],[19.,TNXINF]]
+ IRP B,C,[A]
+ LOC CHNTAB+B
+ 1,,C
+ CHNMSK==CHNMSK+<1_<35.-B>>
+ .ISTOP
+ TERMIN
+TERMIN
+LOC CHNTAB+36.
+PURE
+]
+EXTINT:
+BLOCK 36.
+REPEAT NCHRS,SETZ HCHAR
+BLOCK NINT-NNETS-NCHRS-UINTS-36.-1
+REPEAT NNETS,SETZ HNET
+REPEAT UINTS,SETZ USRINT
+LOC EXTINT+NINT-11.
+REPEAT 3,SETZ HIOC
+LOC EXTINT+NINT-RLCHN-1
+SETZ HREAL
+LOC EXTINT+NINT-19.-1
+SETZ HINF
+LOC EXTINT+NINT
+]
+
+
+; HANDLER/HEADER PARAMETERS
+
+; HEADER BLOCKS
+
+IHDRLN==4 ; LENGTH OF HEADER BLOCK
+
+INAME==0 ; NAME OF INTERRUPT
+ISTATE==2 ; CURRENT STATE
+IHNDLR==4 ; POINTS TO LIST OF HANDLERS
+INTPRI==6 ; CONTAINS PRIORITY OF INTERRUPT
+
+IHANDL==4 ; LENGTH OF A HANDLER BLOCK
+
+INXT==0 ; POINTS TO NEXTIN CHAIN
+IPREV==2 ; POINTS TO PREV IN CHAIN
+INTFCN==4 ; FUNCTION ASSOCIATED WITH THIS HANDLER
+INTPRO==6 ; PROCESS TO RUN INT IN
+
+IFN ITS,[
+RMT [
+IMPURE
+TSINT:
+MTSINT: 0 ;INTERRUPT BITS GET STORED HERE
+TSINTR: 0 ;INTERRUPT PC WORD STORED HERE
+ JRST TSINTP ;GO TO PURE CODE
+
+; SOFTWARE INTERNAL INTERRUPTS JSR TO HERE
+
+LCKINT: 0
+ JRST DOINT
+
+PURE
+]
+]
+IFE ITS,[
+RMT [
+; JSR HERE FOR SOFTWARE INTERNAL INTERRUPTS
+
+IMPURE
+LCKINT: 0
+ JRST DOINT
+PURE
+]
+]
+\f
+
+IFN ITS,[
+
+;THE REST OF THIS CODE IS PURE
+
+TSINTP: SOSGE INTFLG ; SKIP IF ENABLED
+ SETOM INTFLG ;DONT GET LESS THAN -1
+
+ SKIPE INTBCK ; ANY INT HACKS?
+ JRST PCLOSR ; DO A PC-LOSR ON THE PROGRAM
+ MOVEM A,TSAVA ;SAVE TWO ACS
+ MOVEM B,TSAVB
+ MOVE A,TSINT ;PICK UP INT BIT PATTERN
+ JUMPL A,2NDWORD ;DONT CHECK FOR PDL OVERFLOW ETC. IF SIGN BIT ON
+
+ TRZE A,200000 ;IS THIS A PDL OVERFLOW?
+ JRST IPDLOV ;YES, GO HANDLE IT FIRST
+
+IMPCH: MOVEI B,0
+ TRNE A,20000 ;IS IT A MEMORY PROTECTION VIOLATION?
+ MOVEI B,1 ; FLAG SAME
+
+ TRNE A,40 ;ILLEGAL OP CODE?
+ MOVEI B,2 ; ALSO FLAG
+ TRNN A,400 ; IOC?
+ JRST .+3
+ SOS TSINTR
+ MOVEI B,3
+ TLNE A,200 ; PURE?
+ JRST GCPWRT ; CHECK FOR PURE WRITE FOR POSSIBLE C/W
+NOPUGC: SOJGE B,DO.NOW ; CANT WAIT AROUND
+
+;DECODE THE REST OF THE INTERRUPTS USING A TABLE
+
+2NDWORD:
+ JUMPL A,GC2 ;2ND WORD?
+ IORM A,PIRQ ;NO, INTO WORD 1
+ JRST GCQUIT ;AND DISMISS INT
+
+GC2: TLZ A,400000 ;TURN OFF SIGN BIT
+ IORM A,PIRQ2
+ TRNE A,177777 ;CHECK FOR CHANNELS
+ JRST CHNACT ;GO IF CHANNEL ACTIVITY
+]
+GCQUIT: SKIPGE INTFLG ;SKIP IF INTERRUPTS ENABLED
+ JRST INTDON ;NO, DEFER REAL HANDLING UNTIL LATER
+
+ MOVE A,TSINTR ;PICKUP RETURN WORD
+IFE ITS,[
+ SKIPE MULTSG
+ JRST MLTEX
+ TLON A,10000 ; EXEC PC?
+ SOJA A,MLTEX1 ; YES FIXUP PC
+MLTEX: TLON A,10000
+ SOS TSINTR+1
+ MOVEM A,TSINTR
+ MOVE A,TSINTR+1
+]
+MLTEX1: MOVEM A,LCKINT ;STORE ELSEWHERE
+ MOVEI A,DOINTE ;CAUSE DISMISS TO HANDLER
+IFN ITS, HRRM A,TSINTR ;STORE IN INT RETURN
+IFE ITS,[
+ SKIPE MULTSG
+ HRRM A,TSINTR+1
+ SKIPN MULTSG
+ HRRM A,TSINTR
+]
+ PUSH P,INTFLG ;SAVE INT FLAG
+ SETOM INTFLG ;AND DISABLE
+
+
+INTDON: MOVE A,TSAVA ;RESTORE ACS
+ MOVE B,TSAVB
+IFN ITS, .DISMISS TSINTR ;AND DISMISS THE INTERRUPT
+IFE ITS, DEBRK
+
+IFN ITS,[
+PCLOSR: MOVEM A,TSAVA
+ HRRZ A,TSINTR ; WHERE FROM
+ CAIG A,INTBCK
+ CAILE A,INTBEN ; AVOID TIMING ERRORS
+ JRST .+2
+ JRST INTDON
+
+ SOS A,INTBCK
+ MOVEM A,TSINTR
+ SETZM INTBCK
+ SETZM INTFLG
+ AOS INTFLG
+ MOVE TP,TPSAV(TB)
+ MOVE P,PSAV(TB)
+ MOVE A,TSAVA
+ JRST TSINTP
+]
+DO.NOW: SKIPN GPURFL
+ SKIPE GCFLG
+ JRST DLOSER ; HANDLE FATAL GC ERRORS
+ MOVSI B,1
+ SKIPGE INTFLG ; IF NOT ENABLED
+ MOVEM B,INTFLG ; PRETEND IT IS
+IFN ITS, JRST 2NDWORD
+IFE ITS, JRST GCQUIT
+
+IFE ITS,[
+
+; HERE FOR TENEX PDL OVER FLOW INTERRUPT
+
+TNXPDL: SOSGE INTFLG
+ SETOM INTFLG
+ MOVEM A,TSAVA
+ MOVEM B,TSAVB
+ JRST IPDLOV ; GO TO COMMON HANDLER
+
+; HERE FOR REAL TIMER
+
+TNXRLT: MOVEM A,TSAVA
+IFG <RLCHN-18.>, MOVEI A,<1_<35.-<RLCHN>>>
+IFLE <RLCHN-18.> MOVSI A,(<1_<35.-<RLCHN>>>)
+
+ JRST CNTSG
+
+; HERE FOR TENEX ^G AND ^S INTERRUPTS
+
+INTCHR:
+REPEAT NCHRS,[
+ MOVEM A,TSAVA
+ MOVEI A,<1_<.RPCNT>>
+ JRST CNTSG
+]
+CNTSG: MOVEM B,TSAVB
+ IORM A,PIRQ2 ; SAY FOR MUDDLE LEVEL
+ SOSGE INTFLG
+ SETOM INTFLG
+ JRST GCQUIT
+INTNET:
+REPEAT NNETS+UINTS,[
+ MOVEM A,TSAVA
+ MOVE A,[1_<.RPCNT+NETCHN>]
+ JRST CNTSG
+]
+TNXINF: MOVEM A,TSAVA
+ MOVEI A,<1_<35.-19.>>
+ JRST TNXCHN
+
+; LOW LEVEL HANDLERS FOR 10X IOC INTERRUPTS
+
+TNXEOF: MOVEM A,TSAVA
+ MOVSI A,(1_<35.-10.>)
+ JRST TNXCHN
+
+TNXIOC: MOVEM A,TSAVA
+ MOVSI A,(1_<35.-11.>)
+ JRST TNXCHN
+
+TNXFUL: MOVEM A,TSAVA
+ SKIPN PLODR
+ JRST TNXFU1
+ FATAL DISK FULL IN PURE FIXUP, CONTINUE TO RETRY
+ JRST INTDON
+
+TNXFU1: MOVSI A,(1_<35.-12.>)
+
+TNXCHN: IORM A,PIRQ2
+ MOVEM B,TSAVB
+ HRRZ A,TSAVA ; ASSUME JFN IS IN A (PRETTY FLAKEY BUT ...)
+ MOVEM A,IOCLOS
+ JRST DO.NOW
+]
+\f
+; HERE TO PROCESS INTERRUPTS
+
+DOINT: SKIPE INTHLD ; GLOBAL LOCK ON INTS
+ JRST @LCKINT
+ SETOM INTHLD ; DONT LET IT HAPPEN AGAIN
+ PUSH P,INTFLG
+DOINTE: SKIPE ONINT ; ANY FUDGE?
+ XCT ONINT ; YEAH, TRY ONE
+ PUSH P,ONINT
+ SETZM ONINT
+ EXCH 0,LCKINT ; RELATIVIZE PC IF FROM RSUBR
+IFE ITS, TLZ 0,777740 ; KILL EXCESS BITS
+ PUSH P,0 ; AND SAVE
+ ANDI 0,-1
+ CAMG 0,PURTOP
+ CAMGE 0,VECBOT
+ JRST DONREL
+ SUBI 0,(M) ; M IS BASE REG
+IFN ITS, TLO 0,400000+M ; INDEX IT OFF M
+IFE ITS,[
+ TLO 0,400000+M
+ SKIPN MULTSG
+ JRST .+3
+ HLL 0,(P)
+ TLO 0,400000
+]
+ EXCH 0,(P) ; AND RESTORE TO STACK
+DONREL: EXCH 0,LCKINT ; GET BACK SAVED 0
+ SETZM INTFLG ;DISABLE
+ AOS -2(P) ;INCR SAVED FLAG
+
+;NOW SAVE WORKING ACS
+
+ PUSHJ P,SAVACS
+ HLRZ A,-2(P) ; HACK FUNNYNESS FOR MPV/ILOPR
+ SKIPE A
+ SETZM -2(P) ; REALLY DISABLED
+
+DIRQ: MOVE A,PIRQ ;NOW SATRT PROCESSING
+ JFFO A,FIRQ ;COUNT BITS AND GO
+ MOVE A,PIRQ2 ;1ST DONE, LOOK AT 2ND
+ JFFO A,FIRQ2
+
+INTDN1: SKIPN GCHAPN ; SKIP IF MUST DO GC INT
+ JRST .+3
+ SETZM GCHAPN
+ PUSHJ P,INTOGC ; AND INTERRUPT
+
+ PUSHJ P,RESTAC
+
+IFN ITS,[
+ .SUSET [.SPICLR,,[0]] ; DISABLE INTS
+]
+ POP P,LCKINT
+ POP P,ONINT
+ POP P,INTFLG
+ SETZM INTHLD ; RE-ENABLE THE WORLD
+IFN ITS,[
+ EXCH 0,LCKINT
+ HRRI 0,@0 ; EFFECTIVIZE THE ADDRESS
+ TLZ 0,37 ; KILL IND AND INDEX
+ EXCH 0,LCKINT
+ .DISMIS LCKINT
+]
+IFE ITS,[
+ SKIPN MULTSG
+ JRST @LCKINT
+ XJRST .+1 ; MAKE SURE OUT OF SECTION 0
+ 0
+ FSEG,,.+1
+ EXCH 0,LCKINT
+ TLZE 0,400000
+ ADDI 0,(M)
+ EXCH 0,LCKINT
+ JRST @LCKINT
+]
+FIRQ: PUSHJ P,GETBIT ;SET UP THE BIT TO CLOBBER IN PIRQ
+ ANDCAM A,PIRQ ;CLOBBER IT
+ ADDI B,36. ;OFSET INTO TABLE
+ JRST XIRQ ;GO EXECUTE
+
+FIRQ2: PUSHJ P,GETBIT ;PREPARE TO CLOBBER BIT
+ ANDCAM A,PIRQ2 ;CLOBBER IT
+ ADDI B,71. ;AGAIN OFFSET INTO TABLE
+XIRQ:
+ CAIE B,21 ;PDL OVERFLOW?
+ JRST FHAND ;YES, HACK APPROPRIATELY
+
+PDL2: JSP E,PDL3
+ JRST DIRQ
+
+PDL3: SKIPN A,PGROW
+ SKIPE A,TPGROW
+ JRST .+2
+ JRST (E) ; NOTHING GROWING, FALSE ALARM
+ MOVEI B,PDLGRO_-6 ;GET GROWTH SPEC
+ DPB B,[111100,,-1(A)] ;STORE GROWTH SPEC
+REAGC: MOVE C,[10.,,1] ; INDICATOR FOR AGC
+ SKIPE PGROW ; P IS GROWING
+ ADDI C,6
+ SKIPE TPGROW ; TP IS GROWING
+ ADDI C,1
+ PUSHJ P,AGC ;COLLECT GARBAGE
+ SETZM PGROW
+ SETZM TPGROW
+ AOJL A,REAGC ; IF NO CORE, RETRY
+ JRST (E)
+
+SAVACS:
+ PUSH P,PVP
+ MOVE PVP,PVSTOR+1
+IRP A,,[0,A,B,C,D,E,TVP,SP]
+ PUSH TP,A!STO(PVP)
+ SETZM A!STO(PVP) ;NOW ZERO TYPE
+ PUSH TP,A
+ TERMIN
+ PUSH TP,$TLOSE
+ PUSH TP,DSTORE
+ MOVE D,PVP
+ POP P,PVP
+ PUSH TP,PVPSTO(D)
+ PUSH TP,PVP
+ SKIPE D,DSTORE
+ MOVEM D,-13(TP) ; USE AS DSTO
+ SETZM DSTORE
+ POPJ P,
+
+RESTAC: POP TP,PVP
+ PUSH P,PVP
+ MOVE PVP,PVSTOR+1
+ POP TP,PVPSTO(PVP)
+ POP TP,DSTORE
+ SUB TP,[1,,1]
+IRP A,,[SP,TVP,E,D,C,B,A,0]
+ POP TP,A
+ POP TP,A!STO(PVP)
+ TERMIN
+ SKIPE DSTORE
+ SETZM DSTO(PVP)
+ POP P,PVP
+ POPJ P,
+
+; HERE TO DO GC INTERRUPT AND CLOSE ANY DEAD CHANNELS
+
+INTOGC: PUSH P,[N.CHNS-1]
+ MOVE PVP,PVSTOR+1
+ MOVE TVP,REALTV+1(PVP)
+ MOVEI A,CHNL1
+ SUBI A,(TVP)
+ HRLS A
+ ADD A,TVP
+ PUSH TP,$TVEC
+ PUSH TP,A
+
+INTGC1: MOVE A,(TP) ; GET POINTER
+ SKIPN B,1(A) ; ANY CHANNEL?
+ JRST INTGC2
+ HRRE 0,(A) ; INDICATOR
+ JUMPGE 0,INTGC2
+ PUSH TP,$TCHAN
+ PUSH TP,B
+ MCALL 1,FCLOSE
+
+ MOVE A,(TP)
+
+INTGC2: HLLZS (A)
+ ADD A,[2,,2]
+ MOVEM A,(TP)
+ SOSE (P)
+ JRST INTGC1
+
+ SUB P,[1,,1]
+ SUB TP,[2,,2]
+ PUSH TP,$TCHSTR
+ PUSH TP,CHQUOTE GC
+ PUSH TP,$TFLOAT ; PUSH ON TIME ARGUMENT
+ PUSH TP,GCTIM
+ PUSH TP,$TFIX ; PUSH ON THE CAUSE ARGUMENT
+ PUSH TP,GCCAUS
+ PUSH TP,$TATOM ; PUSH ON THE CALL ARGUMENT
+ MOVE A,GCCALL
+ PUSH TP,@GCALLR(A)
+ MCALL 4,INTERR
+ POPJ P,
+
+; PRE AGC INTERRUPT. CAUSED WHEN FREE STORAGE REQUEST CAN BE SATISFIED BY
+; EXTENDING CORE. IT IS CALLED "AGC" AND THE HANDLER IS PASSED THE CALLER,
+; AND THE PENDING REQUEST.
+
+
+INTAGC: MOVE A,GETNUM
+ MOVEM A,GCKNUM ; SET UP TO CAUSE INTERRUPT
+ PUSH P,C ; SAVE ARGS TO GC
+ MOVEI A,2000 ; GET WORKING SPACE
+ PUSHJ P,INTCOR ; GET IT
+ MOVSI A,TATOM ; EXAMINE BINDING OF FLAG
+ MOVE B,IMQUOTE AGC-FLAG
+ PUSHJ P,ILVAL
+ CAME A,$TUNBOUND
+ JRST INAGCO ; JUMP TO GET CORE FOR INTERRUPT
+ MOVE A,GETNUM
+ ADD A,P.TOP ; SEE IF WE CAN POSSIBLY WIN
+ ADD A,FREMIN
+ CAML A,PURBOT
+ JRST AGCCAU ; WORLD IS IN BAD SHAPE, CALL AGC
+ PUSH TP,$TTP ; BIND FLAG
+ PUSH TP,TP ; FOR UNBINDING PURPOSES
+ PUSH TP,[TATOM,,-1] ; SPECBINDS ARGS
+ PUSH TP,IMQUOTE AGC-FLAG
+ PUSH TP,$TFIX
+ PUSH TP,[-1]
+ PUSH TP,[0]
+ PUSH TP,[0]
+ PUSHJ P,SPECBIND
+
+; SET UP CALL TO HANDLER
+
+ PUSH TP,$TCHSTR ; STRING INDICATING INTERRUPT
+ PUSH TP,CHQUOTE DIVERT-AGC
+ PUSH TP,$TFIX ; PENDING REQUEST
+ PUSH TP,GETNUM
+ HLRZ C,(P)
+ PUSH TP,$TATOM
+ PUSH TP,@GCALLR(C)
+ SETZM GCHPN
+ MCALL 3,INTERR ; ENABLE INTERRUPT
+ GETYP A,A ; CHECK TO SEE IF INTERRUPT WAS ENABLED
+ HRRZ E,-6(TP) ; GET ARG FOR UNBINDING
+ PUSHJ P,SSPEC1
+ SUB TP,[8,,8] ; CLEAN OFF STACK
+ CAIE A,TFALSE ; SKIP IF NOT
+ JRST CHKWIN
+
+; CAUSE AN AGC TO HAPPEN
+
+AGCCAU: MOVE C,(P) ; INDICATOR
+ PUSHJ P,SAGC ; CALL AGC
+ JRST FINAGC
+
+; SEE WHETHER ENOUGH CORE WAS ALLOCATED
+CHKWIN: MOVE A,FRETOP
+ SUB A,GCSTOP
+ SUB A,GCKNUM ; AMOUNT NEEDED OR IN EXCESS
+ JUMPGE A,FINAGC ; JUMP IF DONE
+ MOVE A,GCKNUM
+ MOVEM A,GETNUM ; SET UP REQUEST
+ MOVE C,(P)
+ JRST AGCCAU
+FINAGC: SETZM GETNUM
+ POP P,C ; RESTORE C
+ POPJ P, ; EXIT
+
+; ROUTINE TO HANDLE INTERRUPT WHILE INTERRUPT IS RUNNING
+; IT TRIES TO ALLOCATE FOR REQUEST+ AT LEAST ONE CORE BLOCK
+
+INAGCO: MOVE A,GETNUM ; GET REQUEST
+ SUB A,GCKNUM ; CALCULATE REAL CURRENT REQUEST
+ ADDI A,1777
+ ANDCMI A,1777 ; AMOUNT WANTED
+ PUSHJ P,INTCOR ; GET IT
+ POP P,C ; RESTORE C
+ POPJ P, ; EXIT
+
+; ROUTINE TO GET CORE FOR PRE-AGC INTERRUPT. REQUEST IN A
+
+
+INTCOR: ADD A,P.TOP ; ADD TOP TO REQUEST
+ CAML A,PURBOT ; SKIP IF BELOW PURE
+ JRST AGCCA1 ; LOSE
+ MOVEM A,CORTOP ; STORE POSSIBLE CORE TOP
+ ASH A,-10. ; TO PAGES
+ PUSHJ P,P.CORE ; GET THE CORE
+ JRST AGCCA1 ; LOSE,LOSE,LOSE
+ PUSH P,B
+ MOVE B,FRETOP
+ SUBI B,2000
+ MOVE A,FRETOP
+ SETZM (B)
+ HRLI B,(B)
+ ADDI B,1
+ BLT B,-1(A)
+ POP P,B
+ MOVEM A,FRETOP
+ POPJ P, ; EXIT
+AGCCA1: MOVE C,-1(P) ; GET ARGS FOR AGC
+ SUB P,[1,,1] ; FLUSH RETURN ADDRESS
+ JRST AGCCAU+1
+
+
+
+GCALLR: MQUOTE GC-READ
+ MQUOTE BLOAT
+ MQUOTE GROW
+ IMQUOTE LIST
+ IMQUOTE VECTOR
+ IMQUOTE SET
+ IMQUOTE SETG
+ MQUOTE FREEZE
+ MQUOTE PURE-PAGE-LOADER
+ MQUOTE GC
+ MQUOTE INTERRUPT-HANDLER
+ MQUOTE NEWTYPE
+ MQUOTE PURIFY
+
+\f; OLD "ON" SETS UP EVENT AND HANDLER
+
+MFUNCTION ON,SUBR
+
+ ENTRY
+
+ HLRE 0,AB ; 0=> -2*NUM OF ARGS
+ ASH 0,-1 ; TO -NUM
+ CAME 0,[-5]
+ JRST .+3
+ MOVEI B,10(AB) ; LAST MUST BE CHAN OR LOC
+ PUSHJ P,CHNORL
+ ADDI 0,3
+ JUMPG 0,TFA ; AT LEAST 3
+ MOVEI A,0 ; SET UP IN CASE NO PROC
+ AOJG 0,ONPROC ; JUMP IF NONE
+ GETYP C,6(AB) ; CHECK IT
+ CAIE C,TPVP
+ JRST TRYFIX
+ MOVE A,7(AB) ; GET IT
+ONPROC: PUSH P,A ; SAVE AS A FLAG
+ GETYP A,(AB) ; CHECK PREV EXISTANCE
+ PUSH P,0
+ CAIN A,TATOM
+ JRST .+3
+ CAIE A,TCHSTR
+ JRST WTYP1
+ MOVEI B,(AB) ; FIND IT
+ PUSHJ P,FNDINT
+ POP P,0 ; REST NUM OF ARGS
+ JUMPN B,ON3 ; ALREADY THERE
+ SKIPE C ; SKIP IF NOTHING TO FLUSH
+ SUB TP,[2,,2]
+ PUSH TP,(AB) ; GET NAME
+ PUSH TP,1(AB)
+ PUSH TP,4(AB)
+ PUSH TP,5(AB)
+ MOVEI A,2 ; # OF ARGS TO EVENT
+ AOJG 0,ON1 ; JUMP IF NO LAST ARG
+ PUSH TP,10(AB)
+ PUSH TP,11(AB)
+ ADDI A,1
+ON1: ACALL A,EVENT
+
+ON3: PUSH TP,A
+ PUSH TP,B
+ PUSH TP,2(AB) ; NOW FCN
+ PUSH TP,3(AB)
+ MOVEI A,3 ; NUM OF ARGS
+ SKIPN (P)
+ SOJA A,ON2 ; NO PROC
+ PUSH TP,$TPVP
+ PUSH TP,7(AB)
+ON2: ACALL A,HANDLER
+ JRST FINIS
+
+
+TRYFIX: SKIPN A,7(AB)
+ CAIE C,TFIX
+ JRST WRONGT
+ JRST ONPROC
+\f
+; ROUTINE TO BUILD AN EVENT
+
+MFUNCTION EVENT,SUBR
+
+ ENTRY
+
+ HLRZ 0,AB
+ CAIN 0,-2 ; IF JUST 1
+ JRST RE.EVN ; COULD BE EVENT
+ CAIL 0,-3 ; MUST BE AT LEAST 2 ARGS
+ JRST TFA
+ GETYP A,2(AB) ; 2ND ARG MUST BE FIXED POINT PRIORITY
+ CAIE A,TFIX
+ JRST WTYP2
+ GETYP A,(AB) ; FIRST ARG SHOULD BE CHSTR
+ CAIN A,TATOM ; ALLOW ACTUAL ATOM
+ JRST .+3
+ CAIE A,TCHSTR
+ JRST WTYP1
+ CAIL 0,-5
+ JRST GOTRGS
+ CAIG 0,-7
+ JRST TMA
+ MOVEI B,4(AB)
+ PUSHJ P,CHNORL ; CHANNEL OR LOCATIVE (PUT ON STACK)
+
+GOTRGS: MOVEI B,(AB) ; NOW TRY TO FIND HEADER FOR THIS INTERRUPT
+ PUSHJ P,FNDINT ; CALL INTERNAL HACKER
+ JUMPN B,FINIS ; ALREADY ONE OF THIS NAME
+ PUSH P,C
+ JUMPE C,.+3 ; GET IT OFF STACK
+ POP TP,B
+ POP TP,A
+ PUSHJ P,MAKINT ; MAKE ONE FOR ME
+ MOVSI 0,TFIX
+ MOVEM 0,INTPRI(B) ; SET UP PRIORITY
+ MOVE 0,3(AB)
+ MOVEM 0,INTPRI+1(B)
+CH.SPC: POP P,C ; GET CODE BACK
+ SKIPGE C
+ PUSHJ P,DO.SPC ; DO ANY SPECIAL HACKS
+ JRST FINIS
+
+RE.EVN: GETYP 0,(AB)
+ CAIE 0,TINTH
+ JRST TFA ; ELSE SAY NOT ENOUGH
+ MOVE B,1(AB) ; GET IT
+ SETZM ISTATE+1(B) ; MAKE SURE ENABLED
+ SETZB D,C
+ GETYP A,INAME(B) ; CHECK FOR CHANNEL
+ CAIN A,TCHAN ; SKIP IF NOT
+ HRROI C,SS.CHA ; SET UP CHANNEL HACK
+ HRLZ E,INTPRI(B) ; GET POSSIBLE READ/WRITE BITS
+ TLNE E,.WRMON+.RDMON ; SKIP IF NOT MONITORS
+ PUSHJ P,GETNM1
+ JUMPL C,RE.EV1
+ MOVE B,INAME+1(B) ; CHECK FOR SPEC
+ PUSHJ P,SPEC1
+ MOVE B,1(AB) ; RESTORE IHEADER
+RE.EV1: PUSH TP,INAME(B)
+ PUSH TP,INAME+1(B)
+ PUSH P,C
+ MOVSI C,TATOM
+ PUSH TP,$TATOM
+ SKIPN D
+ MOVE D,MQUOTE INTERRUPT
+ PUSH TP,D
+ MOVE A,INAME(B)
+ MOVE B,INAME+1(B) ; GET IT
+ PUSHJ P,IGET ; LOOK FOR IT
+ JUMPN B,FINIS ; RETURN IT
+ MOVE A,(TB)
+ MOVE B,1(TB)
+ POP TP,D
+ POP TP,C
+ PUSH TP,(AB)
+ PUSH TP,1(AB)
+ PUSHJ P,IPUT ; REESTABLISH IT
+ MOVE A,(AB)
+ MOVE B,1(AB)
+ JRST CH.SPC
+
+\f
+; FUNCTION TO GENERATE A HANDLER FOR A GIVEN INTERRUPT
+
+MFUNCTION HANDLER,SUBR
+
+ ENTRY
+
+ HLRZ 0,AB
+ CAIL 0,-2 ; MUST BE 2 OR MORE ARGS
+ JRST TFA
+ GETYP A,(AB)
+ CAIE A,TINTH ; EVENT?
+ JRST WTYP1
+ GETYP A,2(AB)
+ CAIN 0,-4 ; IF EXACTLY 2
+ CAIE A,THAND ; COULD BE HANDLER
+ JRST CHEVNT
+
+ MOVE B,3(AB) ; GET IT
+ SKIPN IPREV+1(B) ; SKIP IF ALREADY IN USE
+ JRST HNDOK
+ MOVE D,1(AB) ; GET EVENT
+ SKIPN D,IHNDLR+1(D) ; GET FIRST HANDLER
+ JRST BADHND
+ CAMN D,B ; IS THIS IT?
+ JRST HFINIS ; YES, ALREADY "HANDLED"
+ MOVE D,INXT+1(D) ; GO TO NEXT HANDLER
+ JUMPN D,.-3
+BADHND: ERRUUO EQUOTE HANDLER-ALREADY-IN-USE
+
+CHEVNT: CAIG 0,-7 ; SKIP IF LESS THAN 4
+ JRST TMA
+ PUSH TP,$TPVP ; SLOT FOR PROCESS
+ PUSH TP,[0]
+ CAIE 0,-6 ; IF 3, LOOK FOR PROC
+ JRST NOPROC
+ GETYP 0,4(AB)
+ CAIE 0,TPVP
+ JRST WTYP3
+ MOVE 0,5(AB)
+ MOVEM 0,(TP)
+
+NOPROC: PUSHJ P,APLQ
+ JRST NAPT
+ PUSHJ P,MHAND ; MAKE THE HANDLER
+ MOVE 0,1(TB) ; GET PROCESS
+ MOVEM 0,INTPRO+1(B) ; AND PUT IT INTO HANDLER
+ MOVSI 0,TPVP ; SET UP TYPE
+ MOVEM 0,INTPRO(B)
+ MOVE 0,2(AB) ; SET UP FUNCTION
+ MOVEM 0,INTFCN(B)
+ MOVE 0,3(AB)
+ MOVEM 0,INTFCN+1(B)
+
+HNDOK: MOVE D,1(AB) ; PICK UP EVEENT
+ MOVE E,IHNDLR+1(D) ; GET POINTER TO HANDLERS
+ MOVEM B,IHNDLR+1(D) ; PUT NEW ONE IN
+ MOVSI 0,TINTH ; GET INT HDR TYPE
+ MOVEM 0,IPREV(B) ; INTO BACK POINTER
+ MOVEM D,IPREV+1(B) ; AND POINTER ITSELF
+ MOVEM E,INXT+1(B) ; NOW NEXT POINTER
+ MOVSI 0,THAND ; NOW HANDLER TYPE
+ MOVEM 0,IHNDLR(D) ; SET TYPE IN HEADER
+ MOVEM 0,INXT(B)
+ JUMPE E,HFINIS ; JUMP IF HEADER WAS EMPTY
+ MOVEM 0,IPREV(E) ; FIX UP ITS PREV
+ MOVEM B,IPREV+1(E)
+HFINIS: MOVSI A,THAND
+ JRST FINIS
+
+\f
+
+; FUNCTIONS TO SET TIME LIMITS FOR REALTIME AND RUNTIME INTS
+
+IFN ITS,[
+
+MFUNCTION RUNTIMER,SUBR
+
+ ENTRY
+
+ CAMG AB,[-3,,0]
+ JRST TMA
+ JUMPGE AB,RNTLFT
+ GETYP 0,(AB)
+ JFCL 10,.+1
+ MOVE A,1(AB)
+ CAIE 0,TFIX
+ JRST RUNT1
+ IMUL A,[245761.]
+ JRST RUNT2
+
+RUNT1: CAIE 0,TFLOAT
+ JRST WTYP1
+ FMPR A,[245760.62]
+ MULI A,400 ; FIX IT
+ TSC A,A
+ ASH B,(A)-243
+ MOVE A,B
+RUNT2: JUMPL A,OUTRNG ; NOT FOR NEG #
+ JFCL 10,OUTRNG
+ .SUSET [.SRTMR,,A]
+ MOVE A,(AB)
+ MOVE B,1(AB)
+ JRST FINIS
+RNTLFT: .SUSET [.RRTMR,,B]
+ JUMPL B,IFALSE ; RETURN FALSE IF NONE SET
+ IDIV B,[245761.] ; TO SECONDS
+ MOVSI A,TFIX
+ JRST FINIS
+
+]
+.TIMAL==5
+.TIMEL==1
+
+MFUNCTION REALTIMER,SUBR
+
+ ENTRY
+
+ CAMG AB,[-3,,0]
+ JRST TMA
+ JUMPGE AB,RLTPER
+ JFCL 10,.+1
+ GETYP 0,(AB)
+ MOVE A,1(AB)
+ CAIE 0,TFIX
+ JRST REALT1
+IFN ITS, IMULI A,60. ; TO 60THS OF SEC
+IFE ITS, IMULI A,1000. ; TO MILLI
+ JRST REALT2
+
+REALT1: CAIE 0,TFLOAT
+ JRST WTYP1
+IFN ITS, FMPRI A,(60.0)
+IFE ITS, FMPRI A,(1000.0)
+ MULI A,400
+ TSC A,A
+ ASH B,(A)-243
+ MOVE A,B
+
+REALT2: JUMPL A,OUTRNG
+ JFCL 10,OUTRNG
+ MOVEM A,RLTSAV
+IFN ITS,[
+ MOVE B,[200000,,A]
+ SKIPN A
+ MOVSI B,400000
+ .REALT B,
+ JFCL
+]
+IFE ITS,[
+ MOVE A,[MFORK,,.TIMAL] ; FLUSH CURRENT FIRST
+ TIMER
+ JRST TIMERR
+ SKIPN B,RLTSAV
+ JRST RETRLT
+ HRRI A,.TIMEL
+ MOVEI C,RLCHN
+ TIMER
+ JRST TIMERR
+RETRLT: MOVE A,(AB)
+ MOVE B,1(AB)
+]
+ JRST FINIS
+
+TIMERR: MOVNI A,1
+ PUSHJ P,TGFALS
+ JRST FINIS
+
+RLTPER: SKIPGE B,RLTSAV
+ JRST IFALSE
+IFN ITS, IDIVI B,60. ; BACK TO SECONDS
+IFE ITS, IDIVI B,1000.
+ MOVSI A,TFIX
+ JRST FINIS
+
+
+; FUNCTIONS TO ENABLE AND DISABLE INTERRUPTS
+
+MFUNCTION %ENABL,SUBR,ENABLE
+
+ PUSHJ P,GTEVNT
+ SETZM ISTATE+1(B)
+ JRST FINIS
+
+MFUNCTION %DISABL,SUBR,DISABLE
+
+
+ PUSHJ P,GTEVNT
+ SETOM ISTATE+1(B)
+ JRST FINIS
+
+GTEVNT: ENTRY 1
+ GETYP 0,(AB)
+ CAIE 0,TINTH
+ JRST WTYP1
+ MOVE A,(AB)
+ MOVE B,1(AB)
+ POPJ P,
+
+DO.SPC: HRRO C,INTBL(C) ; POINT TO SPECIAL CODE
+ HLRZ 0,AB ; - TWO TIMES NUM ARGS
+ PUSHJ P,(C) ; CALL ROUTINE
+ JUMPE E,CPOPJ ; NO BITS TO ENABLE, LEAVE
+IFE ITS,[
+ PUSH TP,A
+ PUSH TP,B
+ MOVE B,1(TB) ; CHANNEL
+ MOVE 0,CHANNO(B)
+ MOVEM 0,(E) ; SAVE IN TABLE
+ MOVEI E,(E)
+ SUBI E,NETJFN-NETCHN
+ MOVE A,0 ; SETUP FOR MTOPR
+ MOVEI B,24
+ MOVSI C,(E)
+ TLO C,770000 ; DONT SETUP INR/INS
+ MTOPR
+ MOVEI 0,1
+ MOVNS E
+ LSH 0,35.(E)
+ IORM 0,MASK1
+ MOVE B,MASK1
+ MOVEI A,MFORK
+ AIC
+
+ POP TP,B
+ POP TP,A
+ POPJ P, ; ***** TEMP ******
+]
+IFN ITS,[
+ CAILE E,35. ; SKIP IF 1ST WORD BIT
+ JRST SETW2
+ LSH 0,-1(E)
+
+ IORM 0,MASK1 ; STORE IN PROTOTYPE MASK
+ .SUSET [.SMASK,,MASK1]
+ POPJ P,
+
+SETW2: LSH 0,-36.(E)
+ IORM 0,MASK2 ; SET UP PROTO MASK2
+ .SUSET [.SMSK2,,MASK2]
+ POPJ P,
+]
+
+; ROUTINE TO CHECK FOR CHANNEL OR LOCATIVE
+
+CHNORL: GETYP A,(B) ; GET TYPE
+ CAIN A,TCHAN ; IF CHANNEL
+ JRST CHNWIN
+ PUSH P,0
+ PUSHJ P,LOCQ ; ELSE LOOCATIVE
+ JRST WRONGT
+ POP P,0
+CHNWIN: PUSH TP,(B)
+ PUSH TP,1(B)
+ POPJ P,
+\f
+; SUBROUTINE TO FIND A HANDLER OF A GIVEN NAME
+
+FNDINT: PUSHJ P,FNDNM
+ JUMPE B,CPOPJ
+ PUSHJ P,SPEC1 ; COULD BE FUNNY
+
+INTASO: PUSH P,C ; C<0 IF SPECIAL
+ PUSH TP,A
+ PUSH TP,B
+ MOVSI C,TATOM
+ SKIPN D ; COULD BE CHANGED FOR MONITOR
+ MOVE D,MQUOTE INTERRUPT
+ PUSH TP,C
+ PUSH TP,D
+ PUSHJ P,IGET
+ MOVE D,(TP)
+ SUB TP,[2,,2]
+ POP P,C ; AND RESTOR SPECIAL INDICATOR
+ SKIPE B ; IF FOUND
+ SUB TP,[2,,2] ; REMOVE CRUFT
+CPOPJ: POPJ P, ; AND RETURN
+
+; CHECK FOR SPECIAL INTERNAL INTERRUPT HACK
+
+SPEC1: MOVSI C,-SPECLN ; BUILD AOBJN PNTR
+SPCLOP: CAME B,@SPECIN(C) ; SKIP IF SPECIAL
+ AOBJN C,.-1 ; UNTIL EXHAUSTED
+ JUMPGE C,.+3
+ SKIPE E,FNDTBL(C)
+ JRST (E)
+ MOVEI 0,-1(TB) ; SEE IF OK
+ CAIE 0,(TP)
+ JRST TMA
+ POPJ P,
+
+; ROUTINE TO CREATE A NEW INTERRUPT (INTERNAL ONLY--NOT ITS FLAVOR)
+
+MAKINT: JUMPN C,GOTATM ; ALREADY HAVE NAME, GET THING
+ MOVEI B,(AB) ; POINT TO STRING
+ PUSHJ P,CSTAK ; CHARS TO STAKC
+ MOVE B,INTOBL+1
+ PUSHJ P,INSRTX
+ MOVE D,MQUOTE INTERRUPT
+GOTATM: PUSH TP,$TINTH ; MAKE SLOT FOR HEADER BLOCK
+ PUSH TP,[0]
+ PUSH TP,A
+ PUSH TP,B ; SAVE ATOM
+ PUSH TP,$TATOM
+ PUSH TP,D
+ MOVEI A,IHDRLN*2
+ PUSHJ P,GIBLOK
+ MOVE A,-3(TP) ; GET NAME AND STORE SAME
+ MOVEM A,INAME(B)
+ MOVE A,-2(TP)
+ MOVEM A,INAME+1(B)
+ SETZM ISTATE+1(B)
+ MOVEM B,-4(TP) ; STASH HEADER
+ POP TP,D
+ POP TP,C
+ EXCH B,(TP)
+ MOVSI A,TINTH
+ EXCH A,-1(TP) ; INTERNAL PUT CALL
+ PUSHJ P,IPUT
+ POP TP,B
+ POP TP,A
+ POPJ P,
+
+; FIND NAME OF INTERRUPT
+
+FNDNM: GETYP A,(B) ; TYPE
+ CAIE A,TCHSTR ; IF STRING
+ JRST FNDATM ; DONT HAVE ATOM, OTHERWISE DO
+ PUSHJ P,IILOOK
+ JRST .+2
+FNDATM: MOVE B,1(B)
+ SETZB C,D ; PREVENT LOSSAGE LATER
+ MOVSI A,TATOM
+
+; THE NEXT 2 INSTRUCTIONS ARE A KLUDGE TO GET THE RIGHT ERROR ATOM
+
+ CAMN B,IMQUOTE ERROR
+ MOVE B,MQUOTE ERROR,ERROR,INTRUP
+ POPJ P,
+
+IILOOK: PUSHJ P,CSTAK ; PUT CHRS ON STACK
+ MOVSI A,TOBLS
+ MOVE B,INTOBL+1
+ JRST ILOOKC ; LOOK IT UP
+\f
+; ROUTINE TO MAKE A HANDLER BLOCK
+
+MHAND: MOVEI A,IHANDL*2
+ JRST GIBLOK ; GET BLOCK
+
+; HERE TO GET CHANNEL FOR "CHAR" INTERRUPT
+
+GETCHN: GETYP 0,(TB) ; GET TYPE
+ CAIE 0,TCHAN ; CHANNL IS WINNER
+ JRST WRONGT
+ MOVE A,(TB) ; USE THE CHANNEL TO NAME THE INTERRUPT
+ MOVE B,1(TB)
+ SKIPN CHANNO(B) ; SKIP IF WINNING CHANNEL
+ JRST CBDCHN ; LOSER
+ POPJ P,
+
+LOCGET: GETYP 0,(TB) ; TYPE
+ CAIN 0,TCHAN ; SKIP IF LOCATIVE
+ JRST WRONGT
+ MOVE D,B
+ MOVE A,(TB)
+ MOVE B,1(TB) ; GET LOCATIVE
+ POPJ P,
+
+; FINAL MONITOR SETUP ROUTINES
+
+S.RMON: SKIPA E,[.RDMON,,]
+S.WMON: MOVSI E,.WRMON
+ PUSH TP,A
+ PUSH TP,B
+ HLRM E,INTPRI(B) ; SAVE BITS
+ MOVEI B,(TB) ; POINT TO LOCATIVE
+ HRRZ A,FSAV(TB)
+ CAIN A,OFF
+ MOVSI D,(ANDCAM E,) ; KILL INST
+ CAIN A,EVENT
+ MOVSI D,(IORM E,)
+ PUSHJ P,SMON ; GO DO IT
+ POP TP,B
+ POP TP,A
+ MOVEI E,0
+ POPJ P,
+\f
+
+; SPECIAL SETUP ROUTINES FOR INITIAL INTERRUPTS
+
+IFN ITS,[
+S.CHAR: MOVE E,1(TB) ; GET CHANNEL
+ MOVE 0,RDEVIC(E)
+ ILDB 0,0 ; 1ST CHAR TO 0
+ CAIE 0,"T ; TTY
+ JRST .+3 ; NO
+ MOVEI 0,C.INTL
+ XORM 0,-2(E) ; IN CASE OUTPUT
+ MOVE E,CHANNO(E)
+ ADDI E,36. ; GET CORRECT MASK BIT
+ONEBIT: MOVEI 0,1 ; BIT FOR INT TO RET
+ POPJ P,
+]
+IFE ITS,[
+S.CHAR: MOVE E,1(TB)
+ MOVEI 0,C.INTL
+ XORM 0,-2(E) ; IN CASE OUTPUT
+ MOVE 0,RDEVIC(E)
+ ILDB 0,0 ; 1ST CHAR
+ PUSH P,A
+ CAIE 0,"N ; NET ?
+ JRST S.CHA1
+
+ MOVEI A,0
+ HRRZ 0,CHANNO(E)
+ MOVE E,[-NNETS,,NETJFN]
+ CAMN 0,(E)
+ JRST S.CHA2
+ SKIPN (E)
+ MOVE A,E ; REMEMBER WHERE
+ AOBJN E,.-4
+ TLNN A,-1
+ FATAL NO MORE NETWORK
+ SKIPA E,A
+S.CHA1: MOVEI E,0
+S.CHA2: POP P,A
+ POPJ P,
+]
+
+
+; SPECIAL FOR CLOCK
+IFN ITS,[
+S.DOWN: SKIPA E,[7]
+S.CLOK: MOVEI E,13. ; FOR NOW JUST GET BIT #
+ JRST ONEBIT
+
+S.PAR: MOVEI E,28.
+ JRST ONEBIT
+
+; RUNTIME AND REALTIME INTERRUPTS
+
+S.RUNT: SKIPA E,[34.]
+S.REAL: MOVEI E,35.
+ JRST ONEBIT
+
+S.IOC: SKIPA E,[9.] ; IO CHANNEL ERROR
+S.PURE: MOVEI E,26.
+ JRST ONEBIT
+
+; MPV AND ILOPR
+
+S.MPV: SKIPA E,[14.] ; BIT POS
+S.ILOP: MOVEI E,6
+ JRST ONEBIT
+
+; HERE TO TURN ALL INFERIOR INTS
+
+S.INF: MOVEI E,36.+16.+2 ; START OF BITS
+ MOVEI 0,37 ; 8 BITS WORTH
+ POPJ P,
+]
+IFE ITS,[
+S.PURE:
+S.MPV:
+S.ILOP:
+S.DOWN:
+S.CLOK:
+S.PAR:
+
+
+S.RUNT: ERRUUO EQUOTE INTERRUPT-UNAVAILABLE-ON-TENEX
+S.IOC: MOVEI 0,7 ; 3 BITS FOR EOF/FULL/ERROR
+ MOVEI E,10.
+ POPJ P,
+
+S.INF:
+S.REAL: MOVEI E,0
+ POPJ P,
+]
+
+
+; HERE TO HANDLE ITS INTERRUPTS
+
+FHAND: SKIPN D,EXTINT(B) ; SKIP IF HANDLERS ARE POSSIBLE
+ JRST DIRQ
+ JRST (D)
+
+IFN ITS,[
+; SPECIAL CHARACTER HANDLERS
+
+HCHAR: MOVEI D,CHNL0+1
+ ADDI D,(B) ; POINT TO CHANNEL SLOT
+ ADDI D,(B)
+ SKIPN D,-72.(D) ; PICK UP CHANNEL
+ JRST IPCGOT ;WELL, IT GOTTA BEE THE THE IPC THEN
+ PUSH TP,$TCHAN
+ PUSH TP,D
+ LDB 0,[600,,STATUS(D)] ; GET DEVICE CODE
+ CAILE 0,2 ; SKIP IF A TTY
+ JRST HNET ; MAYBE NETWORK CHANNEL
+ HRRZ 0,-2(D)
+ TRNN 0,C.READ
+ JRST HMORE
+ CAMN D,TTICHN+1
+ SKIPE DEMFLG ; SKIP IF NOT DEMON
+ JRST .+3
+ SKIPN NOTTY
+ JRST HCHR11
+ MOVE B,D ; CHAN TO B
+ PUSH P,A
+ PUSHJ P,TTYOP2 ; RE-GOBBLE TTY
+ POP P,A
+ MOVE D,(TP)
+HCHR11: MOVE D,CHANNO(D) ; GET ITS CHANNEL
+ PUSH P,D ; AND SAVE IT
+ .CALL HOWMNY ; GET # OF CHARS
+ MOVEI B,0 ; IF TTY GONE, NO CHARS
+RECHR: ADDI B,1 ; BUMP BY ONE FOR SOSG
+ MOVEM B,CHNCNT(D) ; AND SAVE
+ IORM A,PIRQ2 ; LEAVE THE INT ON
+
+CHRLOO: MOVE D,(P) ; GET CHNNAEL NO.
+ SOSG CHNCNT(D) ; GET COUNT
+ JRST CHRDON
+
+ MOVE B,(TP)
+ MOVE D,BUFRIN(B) ; GET EXTRA BUFFER
+ XCT IOIN2(D) ; READ CHAR
+ JUMPL A,CHRDON ; NO CHAR THERE, FORGET IT
+ PUSH TP,$TCHSTR
+ PUSH TP,CHQUOTE CHAR
+ PUSH TP,$TCHRS ; SAVE CHAR FOR CALL
+ PUSH TP,A
+ PUSH TP,$TCHAN ; SAVE CHANNEL
+ PUSH TP,B
+ PUSHJ P,INCHAR ; PUT CHAR IN USERS BUFFER
+ MCALL 3,INTERRUPT ; RUN THE HANDLERS
+ JRST CHRLOO ; AND LOOP
+
+CHRDON: .CALL HOWMNY
+ MOVEI B,0
+ MOVEI A,1 ; SET FOR PI WORD CLOBBER
+ LSH A,(D)
+ JUMPG B,RECHR ; ANY MORE?
+ ANDCAM A,PIRQ2
+ SUB P,[1,,1]
+ SUB TP,[2,,2]
+ JRST DIRQ
+
+
+\f
+; HERE FOR NET CHANNEL INTERRUPT
+
+HNET: CAIE 0,26 ; NETWORK?
+ JRST HSTYET ; HANDLE PSEUDO TTY ETC.
+ PUSH TP,$TATOM
+ PUSH TP,MQUOTE CHAR,CHAR,INTRUP
+ PUSH TP,$TUVEC
+ PUSH TP,BUFRIN(D)
+ PUSH TP,$TCHAN
+ PUSH TP,D
+ MOVE B,D ; CHAN TO B
+ PUSHJ P,INSTAT ; UPDATE THE NETWRK STATE
+ MCALL 3,INTERRUPT
+ SUB TP,[2,,2]
+ JRST DIRQ
+
+HMORE:
+HSTYET: PUSH TP,$TATOM
+ PUSH TP,MQUOTE CHAR,CHAR,INTRUP
+ PUSH TP,$TCHAN
+ PUSH TP,D
+ MCALL 2,INTERRUPT
+ SUB TP,[2,,2]
+ JRST DIRQ
+
+]
+CBDCHN: ERRUUO EQUOTE BAD-CHANNEL
+
+IFN ITS,[
+
+HCLOCK: PUSH TP,$TCHSTR
+ PUSH TP,CHQUOTE CLOCK
+ MCALL 1,INTERRUPT
+ JRST DIRQ
+
+HRUNT: PUSH TP,$TATOM
+ PUSH TP,MQUOTE RUNT,RUNT,INTRUP
+ MCALL 1,INTERRUPT
+ JRST DIRQ
+]
+HREAL: PUSH TP,$TATOM
+ PUSH TP,MQUOTE REALT,REALT,INTRUP
+ MCALL 1,INTERRUPT
+ JRST DIRQ
+IFN ITS,[
+HPAR: MOVE A,MQUOTE PARITY,PARITY,INTRUP
+ JRST HMPV1
+
+HMPV: MOVE A,MQUOTE MPV,MPV,INTRUP
+ JRST HMPV1
+
+HILOPR: MOVE A,MQUOTE ILOPR,ILOPR,INTRUP
+ JRST HMPV1
+
+HPURE: MOVE A,MQUOTE PURE,PURE,INTRUP
+HMPV1: PUSH TP,$TATOM
+ PUSH TP,A
+ PUSH P,LCKINT ; SAVE LOCN
+ PUSH TP,$TATOM
+ PUSH TP,A
+ PUSH TP,$TWORD
+ PUSH TP,LCKINT
+ MCALL 2,EMERGENCY
+ POP P,A
+ MOVE C,(TP)
+ SUB TP,[2,,2]
+ JUMPN B,DIRQ
+
+ PUSH TP,$TATOM
+ PUSH TP,EQUOTE DANGEROUS-INTERRUPT-NOT-HANDLED
+ PUSH TP,$TATOM
+ PUSH TP,C
+ PUSH TP,$TWORD
+ PUSH TP,A
+ MCALL 3,ERROR
+ JRST DIRQ
+
+\f
+
+; HERE TO HANDLE SYS DOWN INTERRUPT
+
+HDOWN: PUSH TP,$TATOM
+ PUSH TP,MQUOTE SYSDOWN,SYSDOWN,INTRUP
+ .DIETI A, ; HOW LONG?
+ PUSH TP,$TFIX
+ PUSH TP,A
+ PUSH P,A ; FOR MESSAGE
+ MCALL 2,INTERRUPT
+ POP P,A
+ JUMPN B,DIRQ
+ .SUSET [.RTTY,,B] ; DO WE NOW HAVE A TTY AT ALL?
+ JUMPL B,DIRQ ; DONT HANG AROUND
+ PUSH P,A
+ MOVEI B,[ASCIZ /
+Excuse me, SYSTEM going down in /]
+ SKIPG (P) ; SKIP IF REALLY GOING DOWN
+ MOVEI B,[ASCIZ /
+Excuse me, SYSTEM has been REVIVED!
+/]
+ PUSHJ P,MSGTYP
+ POP P,B
+ JUMPE B,DIRQ
+ IDIVI B,30. ; TO SECONDS
+ IDIVI B,60. ; A/ SECONDS B/ MINUTES
+ JUMPE B,NOMIN
+ PUSH P,C
+ PUSHJ P,DECOUT
+ MOVEI B,[ASCIZ / minutes /]
+ PUSHJ P,MSGTYP
+ POP P,B
+ JRST .+2
+NOMIN: MOVEI B,(C)
+ PUSHJ P,DECOUT
+ MOVEI B,[ASCIZ / seconds.
+/]
+ PUSHJ P,MSGTYP
+ JRST DIRQ
+
+; TWO DIGIT DEC OUT FROM B/
+
+DECOUT: IDIVI B,10.
+ JUMPE B,DECOU1 ; NO TEN
+ MOVEI A,60(B)
+ PUSHJ P,MTYO
+DECOU1: MOVEI A,60(C)
+ JRST MTYO
+]
+\f
+; HERE TO HANDLE I/O CHANNEL ERRORS
+
+HIOC:
+IFN ITS,[
+ .SUSET [.RAPRC,,A] ; CONTAINS CHANNEL OF MOST RECENT LOSSAGE
+ LDB A,[330400,,A] ; GET CHAN #
+ MOVEI C,(A) ; COPY
+]
+ PUSH TP,$TATOM ; PUSH ERROR
+ PUSH TP,EQUOTE FILE-SYSTEM-ERROR
+IFE ITS, MOVE C,IOCLOS ; GET JFN
+ PUSH TP,$TCHAN
+ ASH C,1 ; GET CHANNEL
+ ADDI C,CHNL0+1 ; GET CHANNEL VECTOR
+ PUSH TP,(C)
+IFN ITS,[
+ LSH A,23. ; DO A .STATUS
+ IOR A,[.STATUS A]
+ XCT A
+]
+IFE ITS,[
+ MOVNI A,1 ; GET "MOST RECENT ERROR"
+]
+ MOVE B,(TP)
+IFN ITS, PUSHJ P,GFALS ; GEN NAMED FALSE
+IFE ITS, PUSHJ P,TGFALS
+ PUSH TP,A
+ PUSH TP,B
+ PUSH TP,$TATOM
+ PUSH TP,MQUOTE IOC,IOC,INTRUP
+
+ PUSH TP,A
+ PUSH TP,B
+ PUSH TP,-7(TP)
+ PUSH TP,-7(TP)
+ MCALL 3,EMERGENCY
+ JUMPN B,DIRQ1 ; JUMP IF HANDLED
+ MCALL 3,ERROR
+ JRST DIRQ
+
+DIRQ1: SUB TP,[6,,6]
+ JRST DIRQ
+
+; HANDLE INFERIOR KNOCKING AT THE DOOR
+
+HINF:
+IFN ITS, SUBI B,36.+16.+2 ; CONVERT TO INF #
+IFE ITS, MOVEI B,0
+ PUSH TP,$TATOM
+ PUSH TP,MQUOTE INFERIOR,INFERIOR,INTRUP
+ PUSH TP,$TFIX
+ PUSH TP,B
+ MCALL 2,INTERRUPT
+ JRST DIRQ
+\f
+IFE ITS,[
+
+; HERE FOR TENEX INTS (FIRST CUT)
+
+MFUNCTION %ACCHRS,SUBR,[ACTIVATE-CHARS]
+
+ ENTRY
+
+ JUMPGE AB,RETCHR
+ CAMGE AB,[-3,,]
+ JRST TMA
+
+ GETYP A,(AB)
+ CAIE A,TCHSTR
+ JRST WTYP1
+ HRRZ D,(AB) ; CHECK LENGTH
+ MOVEI C,0 ; SEE IF ANY NET CHANS IN USE
+ MOVE A,[-NNETS,,NETJFN]
+ SKIPE (A)
+ SUBI C,1
+ AOBJN A,.-2
+
+ CAILE D,NCHRS+NNETS(C)
+ JRST WTYP1
+
+ MOVEI 0,(D) ; CHECK THEM
+ MOVE B,1(AB)
+
+ JUMPE 0,.+4
+ ILDB C,B
+ CAILE C,32
+ JRST WTYP1
+ SOJG 0,.-3
+
+ MOVSI E,-<NCHRS+NNETS> ; ZAP CURRENT
+ HRRZ A,CHRS(E)
+ DTI
+ SETZM CHRS(E)
+ AOBJN E,.-3
+
+ MOVE A,[-NNETS,,NETJFN] ; IN CASE USED NET INTS FOR CHARS
+
+ SKIPGE (A)
+ SETZM (A)
+ AOBJN A,.-2
+
+ MOVE E,1(AB)
+ SETZB C,F ; C WILL BE MASK, F OFFSET INTO TABLE
+ MOVSI 0,400000 ; 0 WILL BE THE BIT FOR INT MASK OR'ING
+ JUMPE D,ALP1 ; JUMP IF NONE
+ MOVNS D ; BUILD AOBJN POINTER TO CHRS TABLE
+ MOVSI D,(D)
+ MOVEI B,0 ; B COUNTS NUMBER DONE
+
+ALP: ILDB A,E ; GET CHR
+ IOR C,0
+ LSH 0,-1
+ HRROM A,CHRS(D)
+ MOVSS A
+ HRRI A,(D)
+ ADDI A,(F) ; POSSIBLE OFFSET FOR MORE CHANS
+ ATI
+ ADDI B,1
+ CAIGE B,NCHRS
+ JRST ALP2
+
+ SKIPE NETJFN-NCHRS(B)
+ AOJA B,.-1
+
+ MOVEI F,36.-NNETS-UINTS-NCHRS(B)
+ MOVN G,F
+ MOVSI 0,400000
+ LSH 0,(G) ;NEW MASK FOR INT MASKS
+ SUBI F,1(D)
+
+ALP2: AOBJN D,ALP
+
+ALP1: IORM C,MASK1
+ MOVEI A,MFORK
+ MOVE B,MASK1 ; SET UP FOR INT BITS
+ AIC ; TURN THEM ON
+ MOVE A,(AB)
+ MOVE B,1(AB)
+ JRST FINIS
+
+RETCHR: MOVE C,[-NCHRS-NNETS,,CHRS]
+ MOVEI A,0
+
+RETCH1: SKIPN D,(C)
+ JRST RETDON
+ PUSH TP,$TCHRS
+ ANDI D,177
+ PUSH TP,D
+ ADDI A,1
+ AOBJN C,RETCH1
+
+RETDON: PUSHJ P,CISTNG
+ JRST FINIS
+
+HCHAR: HRRZ A,CHRS-36.(B)
+ PUSH TP,$TATOM
+ PUSH TP,MQUOTE CHAR,CHAR,INTRUP
+ PUSH TP,$TCHRS
+ PUSH TP,A
+ PUSH TP,$TCHAN
+ PUSH TP,TTICHN+1
+ MCALL 3,INTERRUPT
+ JRST DIRQ
+
+HNET: SKIPLE A,NETJFN-NINT+NNETS+UINTS+1(B)
+ JRST HNET1
+ SUBI B,36.-NNETS-UINTS-NCHRS
+ JUMPE A,DIRQ
+ JRST HCHAR
+HNET1: ASH A,1
+ ADDI A,CHNL0+1
+ MOVE B,(A)
+ PUSH TP,$TATOM
+ PUSH TP,MQUOTE CHAR,CHAR,INTRUP
+ PUSH TP,$TUVEC
+ PUSH TP,BUFRIN(B)
+ PUSH TP,$TCHAN
+ PUSH TP,B
+ PUSHJ P,INSTAT
+ MCALL 3,INTERRUPT
+ JRST DIRQ
+
+USRINT: SUBI B,36.
+ PUSH TP,$TATOM
+ PUSH TP,MQUOTE USERINT,USERINT,INTRUP
+ PUSH TP,$TFIX
+ PUSH TP,B
+ MCALL 2,INTERRUPT
+ JRST DIRQ
+]
+
+\f
+MFUNCTION OFF,SUBR
+ ENTRY
+
+ JUMPGE AB,TFA
+ HLRZ 0,AB
+ GETYP A,(AB) ; ARG TYPE
+ MOVE B,1(AB) ; AND VALUE
+ CAIN A,TINTH ; HEADER, GO HACK
+ JRST OFFHD ; QUEEN OF HEARTS
+ CAIN A,TATOM
+ JRST .+3
+ CAIE A,TCHSTR
+ JRST TRYHAN ; MAYBE INDIVIDUAL HANDLER
+ CAIN 0,-2 ; MORE THAN 1 ARG?
+ JRST OFFAC1 ; NO, GO ON
+ CAIG 0,-5 ; CANT BE MORE THAN 2
+ JRST TMA
+ MOVEI B,2(AB) ; POINT TO 2D
+ PUSHJ P,CHNORL
+OFFAC1: MOVEI B,(AB)
+ PUSHJ P,FNDINT
+ JUMPGE B,NOHAN1 ; NOT HANDLED
+
+OFFH1: PUSH P,C ; SAVE C FOR BIT CLOBBER
+ MOVSI C,TATOM
+ SKIPN D
+ MOVE D,MQUOTE INTERRUPT
+ MOVE A,INAME(B)
+ MOVE B,INAME+1(B)
+ PUSHJ P,IREMAS
+ SKIPE B ; IF NO ASSOC, DONT SMASH
+ SETOM ISTATE+1(B) ; DISABLE IN CASE QUEUED
+ POP P,C ; SPECIAL?
+ JUMPGE C,FINIS ; NO, DONE
+
+ HRRZ C,INTBL(C) ; POINT TO SPECIAL CODE
+ PUSHJ P,(C) ; GO TO SAME
+ JUMPE E,OFINIS ; DONE
+IFN ITS,[
+ CAILE E,35. ; SKIP IF 1ST WORD
+ JRST CLRW2 ; CLOBBER 2D WORD BIT
+ LSH 0,-1(E) ; POSITION BIT
+ ANDCAM 0,MASK1 ; KILL BIT
+ .SUSET [.SMASK,,MASK1]
+]
+IFE ITS,[
+ MOVE D,B
+ SETZM (E)
+ MOVEI E,(E)
+ SUBI E,NETJFN-NETCHN
+ MOVEI 0,1
+ MOVNS E
+ LSH 0,35.(E)
+ ANDCAM 0,MASK1
+ MOVEI A,MFORK
+ SETCM B,MASK1
+ DIC
+ ANDCAM 0,PIRQ ; JUST IN CASE
+ MOVE B,D
+]
+OFINIS: MOVSI A,TINTH
+ JRST FINIS
+
+IFN ITS,[
+CLRW2: LSH 0,-36.(E) ; POS BIT FOR 2D WORD
+ ANDCAM 0,MASK2
+ .SUSET [.SMSK2,,MASK2]
+ JRST OFINIS
+]
+
+TRYHAN: CAIE A,THAND ; HANDLER?
+ JRST WTYP1
+ CAIE 0,-2
+ JRST TMA
+ GETYP 0,IPREV(B) ; GET TYPE OF PREV
+ MOVE A,INXT+1(B)
+ SKIPN C,IPREV+1(B) ; dont act silly if already off! (TT)
+ JRST HFINIS
+ MOVE D,IPREV(B)
+ CAIE 0,THAND
+ JRST DOHEAD ; PREV HUST BE HDR
+ MOVEM A,INXT+1(C)
+ JRST .+2
+DOHEAD: MOVEM A,IHNDLR+1(C) ; INTO HDR
+ JUMPE A,OFFINI
+ MOVEM D,IPREV(A)
+ MOVEM C,IPREV+1(A)
+OFFINI: SETZM IPREV+1(B) ; Leave NXT slot intact for RUNINT (BKD)
+ MOVSI A,THAND
+ JRST FINIS
+
+OFFHD: CAIE 0,-2
+ JRST TMA
+ PUSHJ P,GETNMS ; GET INFOR ABOUT INT
+ JUMPE C,OFFH1
+ PUSH TP,INAME(B)
+ PUSH TP,INAME+1(B)
+ JRST OFFH1
+
+GETNMS: GETYP A,INAME(B) ; CHECK FOR SPECIAL
+ SETZB C,D
+ CAIN A,TCHAN
+ HRROI C,SS.CHA
+ PUSHJ P,LOCQ ; LOCATIVE?
+ JRST CHGTNM
+
+ MOVEI B,INAME(B) ; POINT TO LOCATIVE
+ MOVSI D,(MOVE E,)
+ PUSHJ P,SMON ; GET MONITOR
+ MOVE B,1(AB)
+GETNM1: HRROI C,SS.WMO ; ASSUME WRITE
+ TLNN E,.WRMON
+ HRROI C,SS.RMO
+ MOVE D,MQUOTE WRITE,WRITE,INTRUP
+ TLNN E,.WRMON
+ MOVE D,MQUOTE READ,READ,INTRUP
+ POPJ P,
+
+CHGTNM: JUMPL C,CPOPJ
+ MOVE B,INAME+1(B)
+ PUSHJ P,SPEC1
+ MOVE B,1(AB) ; RESTORE IHEADER
+ POPJ P,
+\f
+; EMERGENCY, CANT DEFER ME!!
+
+MQUOTE INTERRUPT
+
+EMERGENCY:
+ PUSH P,.
+ JRST INTERR+1
+
+MFUNCTION INTERRUPT,SUBR
+
+ PUSH P,[0]
+
+ ENTRY
+
+ SETZM INTHLD ; RE-ENABLE THE WORLD
+ JUMPGE AB,TFA
+ MOVE B,1(AB) ; GET HANDLER/NAME
+ GETYP A,(AB) ; CAN BE HEADER OR NAME
+ CAIN A,TINTH ; SKIP IF NOT HEADER
+ JRST GTHEAD
+ CAIN A,TATOM
+ JRST .+3
+ CAIE A,TCHSTR ; SKIP IF CHAR STRING
+ JRST WTYP1
+ MOVEI B,(AB) ; LOOK UP NAME
+ PUSHJ P,FNDNM ; GET NAME
+ JUMPE B,IFALSE
+ MOVEI D,0
+ CAMN B,MQUOTE CHAR,CHAR,INTRUP
+ PUSHJ P,CHNGT1
+ CAME B,MQUOTE READ,READ,INTRUP
+ CAMN B,MQUOTE WRITE,WRITE,INTRUP
+ PUSHJ P,GTLOC1
+ PUSHJ P,INTASO
+ JUMPE B,IFALSE
+
+GTHEAD: SKIPE ISTATE+1(B) ; ENABLED?
+ JRST IFALSE ; IGNORE COMPLETELY
+ MOVE A,INTPRI+1(B) ; GET PRIORITY OF INTERRUPT
+ CAMLE A,CURPRI ; SEE IF MUST QUEU
+ JRST SETPRI ; MAY RUN NOW
+ SKIPE (P) ; SKIP IF DEFER OK
+ JRST DEFERR
+ MOVEM A,(P)
+ PUSH TP,$TINTH ; SAVE HEADER
+ PUSH TP,B
+ MOVEI A,1 ; SAVE OTHER ARGS
+PSHARG: ADD AB,[2,,2]
+ JUMPGE AB,QUEU1 ; GO MAKE QUEU ENTRY
+ PUSH TP,(AB)
+ PUSH TP,1(AB)
+ AOJA A,PSHARG
+QUEU1: PUSHJ P,IEVECT ; GET VECTOR
+ PUSH TP,$TVEC
+ PUSH TP,[0] ; WILL HOLD QUEUE HEADER
+ PUSH TP,A
+ PUSH TP,B
+
+ POP P,A ; RESTORE PRIORITY
+
+ MOVE B,QUEUES+1 ; GET INTERRUPT QUEUES
+ MOVEI D,0
+ JUMPGE B,GQUEU ; MAKE A QUEUE HDR
+
+NXTQU: CAMN A,1(B) ; GOT PRIORITY?
+ JRST ADDQU ; YES, ADD TO THE QUEU
+ CAML A,1(B) ; SKIP IF SPOT NOT FOUND
+ JRST GQUEU
+ MOVE D,B
+ MOVE B,3(B) ; GO TO NXT QUEUE
+ JUMPL B,NXTQU
+
+GQUEU: PUSH TP,$TVEC ; SAVE NEXT POINTER
+ PUSH TP,D
+ PUSH TP,$TFIX
+ PUSH TP,A ; SAVE PRIORITY
+ PUSH TP,$TVEC
+ PUSH TP,B
+ PUSH TP,$TLIST
+ PUSH TP,[0]
+ PUSH TP,$TLIST
+ PUSH TP,[0]
+ MOVEI A,4
+ PUSHJ P,IEVECT
+ MOVE D,(TP) ; NOW SPLICE
+ SUB TP,[2,,2]
+ JUMPN D,GQUEU1
+ MOVEM B,QUEUES+1
+ JRST .+2
+GQUEU1: MOVEM B,3(D)
+
+ADDQU: MOVEM B,-2(TP) ; SAVE QUEU HDR
+ POP TP,D
+ POP TP,C
+ PUSHJ P,INCONS ; CONS IT
+ MOVE C,(TP) ;GET QUEUE HEADER
+ SKIPE D,7(C) ; IF END EXISTS
+ HRRM B,(D) ; SPLICE
+ MOVEM B,7(C)
+ SKIPN 5(C) ; SKIP IF START EXISTS
+ MOVEM B,5(C)
+
+IFINI: MOVSI A,TATOM
+ MOVE B,IMQUOTE T
+ JRST FINIS
+
+SETPRI: EXCH A,CURPRI
+ MOVEM A,(P)
+
+ PUSH TP,$TAB ; PASS AB TO HANDLERS
+ PUSH TP,AB
+
+ PUSHJ P,RUNINT ; RUN THE HANDLERS
+ POP P,A ; UNQUEU ANY WAITERS
+ PUSHJ P,UNQUEU
+
+ JRST IFINI
+
+; HERE TO UNQUEUE WAITING INTERRUPTS
+
+UNQUEU: PUSH P,A ; SAVE NEW LEVEL
+
+UNQUE1: MOVE A,(P) ; TARGET LEVEL
+ CAMLE A,CURPRI ; CHECK RUG NOT PULLED OUT
+ JRST UNDONE
+ SKIPE B,QUEUES+1
+ CAML A,1(B) ; RIGHT LEVEL?
+ JRST UNDONE ; FINISHED
+
+ SKIPN C,5(B) ; ON QUEUEU?
+ JRST UNXQ
+ HRRZ D,(C) ; CDR THE LIST
+ MOVEM D,5(B)
+ SKIPN D ; SKIP IF NOT LAST
+ SETZM 7(B) ; CLOBBER END POINTER
+ MOVE A,1(B) ; GET THIS PRIORITY LEVEL
+ MOVEM A,CURPRI ; MAKE IT THE CURRENT ONE
+ MOVE D,1(C) ; GET SAVED VECTOR OF INF
+
+ MOVE B,1(D) ; INT HEADER
+ PUSH TP,$TVEC
+ PUSH TP,D ; AND ARGS
+
+ PUSHJ P,RUNINT ; RUN THEM
+ JRST UNQUE1
+
+UNDONE: POP P,CURPRI ; SET CURRENT LEVEL
+ MOVE A,CURPRI
+ POPJ P,
+
+UNXQ: MOVE B,3(B) ; GO TO NEXT QUEUE
+ MOVEM B,QUEUES+1
+ JRST UNQUE1
+
+
+
+; SUBR TO CHANGE INTERRUPT LEVEL
+
+MFUNCTION INTLEV,SUBR,[INT-LEVEL]
+ ENTRY
+ JUMPGE AB,RETLEV ; JUST RETURN CURRENT
+ GETYP A,(AB)
+ CAIE A,TFIX
+ JRST WTYP1 ; LEVEL IS FIXED
+ SKIPGE A,1(AB)
+ JRST OUTRNG"
+ CAMN A,CURPRI ; DIFFERENT?
+ JRST RETLEV ; NO RETURN
+ PUSH P,CURPRI
+ CAMG A,CURPRI ; SKIP IF NO UNQUEUE NEEDED
+ PUSHJ P,UNQUEU
+ MOVEM A,CURPRI ; SAVE
+ POP P,A
+ SKIPA B,A
+RETLEV: MOVE B,CURPRI
+ MOVSI A,TFIX
+ JRST FINIS
+
+RUNINT: PUSH TP,$THAND ; SAVE HANDLERS LIST
+ PUSH TP,IHNDLR+1(B)
+
+ SKIPN ISTATE+1(B) ; SKIP IF DISABLED
+ SKIPN B,(TP)
+ JRST SUBTP4
+NXHND: MOVEM B,(TP) ; SAVE CURRENT HDR
+ MOVE A,-2(TP) ; SAVE ARG POINTER
+ PUSHJ P,CHSWAP ; SEE IF MUST SWAP
+ PUSH TP,[0]
+ PUSH TP,[0]
+ MOVEI C,1 ; COUNT ARGS
+ PUSH TP,SPSTOR ; SAVE INITIAL BINDING POINTER
+ PUSH TP,SPSTOR+1
+ MOVE D,PVSTOR+1
+ ADD D,[1STEPR,,1STEPR]
+ PUSH TP,BNDV
+ PUSH TP,D
+ PUSH TP,$TPVP
+ PUSH TP,[0]
+ MOVE E,TP
+NBIND: PUSH TP,INTFCN(B)
+ PUSH TP,INTFCN+1(B)
+ ADD A,[2,,2]
+ JUMPGE A,DO.HND
+ PUSH TP,(A)
+ PUSH TP,1(A)
+ AOJA C,.-4
+DO.HND: MOVE PVP,PVSTOR+1
+ SKIPN 1STEPR+1(PVP) ; NECESSARY TO DO 1STEP BINDING ?
+ JRST NBIND1 ; NO, DON'T BOTHER
+ PUSH P,C
+ PUSHJ P,SPECBE ; BIND 1 STEP FLAG
+ POP P,C
+NBIND1: ACALL C,INTAPL ; RUN HAND WITH POSSIBLY BOUND 1STEP FLAG
+ MOVE SP,SPSTOR+1 ; GET CURRENT BINDING POINTER
+ CAMN SP,-4(TP) ; SAME AS SAVED BINDING POINTER ?
+ JRST NBIND2 ; YES, 1STEP FLAG NOT BOUND
+ MOVE C,(TP) ; RESET 1 STEP
+ MOVE PVP,PVSTOR+1
+ MOVEM C,1STEPR+1(PVP)
+ MOVE SP,-4(TP) ; RESTORE SAVED BINDING POINTER
+ MOVEM SP,SPSTOR+1
+NBIND2: SUB TP,[6,,6]
+ PUSHJ P,CHUNSW
+ CAMN E,PVSTOR+1
+ SUB TP,[4,,4] ; NO PROCESS CHANGE, POP JUNK
+ CAMN E,PVSTOR+1
+ JRST .+4
+ MOVE D,TPSTO+1(E)
+ SUB D,[4,,4]
+ MOVEM D,TPSTO+1(E) ; FIXUP HIS STACK
+DO.H1: GETYP A,A ; CHECK FOR A DISMISS
+ CAIN A,TDISMI
+ JRST SUBTP4
+ MOVE B,(TP) ; TRY FOR NEXT HANDLER
+ SKIPE B,INXT+1(B)
+ JRST NXHND
+SUBTP4: SUB TP,[4,,4]
+ POPJ P,
+
+MFUNCTION INTAPL,SUBR,[RUNINT]
+ JRST APPLY
+
+
+NOHAND: JUMPE C,NOHAN1
+ PUSH TP,$TATOM
+ PUSH TP,EQUOTE INTERNAL-INTERRUPT
+NOHAN1: PUSH TP,(AB)
+ PUSH TP,1(AB)
+ PUSH TP,$TATOM
+ PUSH TP,EQUOTE NOT-HANDLED
+ SKIPE A,C
+ MOVEI A,1
+ ADDI A,2
+ JRST CALER
+
+DEFERR: PUSH TP,$TATOM
+ PUSH TP,EQUOTE ATTEMPT-TO-DEFER-UNDEFERABLE-INTERRUPT
+ PUSH TP,$TINTH
+ PUSH TP,B
+ PUSH TP,$TATOM
+ PUSH TP,MQUOTE INTERRUPT
+ MCALL 3,RERR ; FORCE REAL ERROR
+ JRST FINIS
+
+; FUNCTION TO DISMISS AN INTERRUPT TO AN ARBITRARY ACTIVATION
+
+MFUNCTION DISMISS,SUBR
+
+ HLRZ 0,AB
+ JUMPGE AB,TFA
+ CAIGE 0,-6
+ JRST TMA
+ MOVNI D,1
+ CAIE 0,-6
+ JRST DISMI3
+ GETYP 0,4(AB)
+ CAIE 0,TFIX
+ JRST WTYP
+ SKIPGE D,5(AB)
+ JRST OUTRNG
+
+DISMI3: MOVEI A,(TB)
+
+DISMI0: HRRZ B,FSAV(A)
+ HRRZ C,PCSAV(A)
+ CAIE B,INTAPL
+ JRST DISMI1
+
+ MOVE E,OTBSAV(A)
+ MOVEI 0,(A) ; SAVE FRAME
+ MOVEI A,DISMI2
+ HRRM A,PCSAV(E) ; GET IT BACK HERE
+ MOVE A,(AB)
+ MOVE B,1(AB)
+ MOVE C,TPSAV(E)
+ MOVEM A,-7(C)
+ MOVEM B,-6(C)
+ MOVEI C,0
+ CAMGE AB,[-3,,]
+ MOVEI C,2(AB)
+ MOVE B,0 ; DEST FRAME
+ JUMPL D,.+3
+ MOVE A,PSAV(E) ; NOW MUNG SAVED INT LEVEL
+ MOVEM D,-1(A) ; ZAP YOUR MUNGED
+ PUSHJ P,CHUNW ; CHECK ON UNWINDERS
+ JRST FINIS ; FALL DOWN
+
+DISMI1: MOVEI E,(A)
+ HRRZ A,OTBSAV(A)
+ JUMPN A,DISMI0
+
+ MOVE A,(AB)
+ MOVE B,1(AB)
+
+ PUSH TP,A
+ PUSH TP,B
+ SKIPGE A,D
+ JRST .+4
+ CAMG A,CURPRI
+ PUSHJ P,UNQUEU
+ MOVEM A,CURPRI
+ CAML AB,[-3,,]
+ JRST .+5
+ PUSH TP,2(AB)
+ PUSH TP,3(AB)
+ MCALL 2,ERRET
+ JRST FINIS
+
+ POP TP,B
+ POP TP,A
+ JRST FINIS
+
+DISMI2: CAMN SP,-4(TP) ; 1STEP FLAG BEEN BOUND ?
+ JRST NDISMI ; NO
+ MOVE C,(TP)
+ MOVE PVP,PVSTOR+1
+ MOVEM C,1STEPR+1(PVP)
+ MOVE SP,-4(TP)
+NDISMI: SUB TP,[6,,6]
+ PUSHJ P,CHUNSW ; UNDO ANY PROCESS HACKING
+ MOVE C,TP
+ CAME E,PVSTOR+1 ; SWAPED?
+ MOVE C,TPSTO+1(E)
+ MOVE D,-1(C)
+ MOVE 0,(C)
+ SUB TP,[4,,4]
+ SUB C,[4,,4] ; MAYBE FIXUP OTHER STACK
+ CAME E,PVSTOR+1
+ MOVEM C,TPSTO+1(E)
+ PUSH TP,D
+ PUSH TP,0
+ PUSH TP,A
+ PUSH TP,B
+ MOVE A,-1(P) ; SAVED PRIORITY
+ CAMG A,CURPRI
+ PUSHJ P,UNQUEU
+ MOVEM A,CURPRI
+ SKIPN -1(TP)
+ JRST .+3
+ MCALL 2,ERRET
+ JRST FINIS
+
+ SUB TP,[4,,4]
+ MOVSI A,TDISMI
+ MOVE B,IMQUOTE T
+ JRST DO.H1
+
+CHNGT1: HLRE B,AB
+ SUBM AB,B
+ GETYP 0,-2(B)
+ CAIE 0,TCHAN
+ JRST WTYP3
+ MOVE B,-1(B)
+ MOVSI A,TCHAN
+ POPJ P,
+
+GTLOC1: GETYP A,2(AB)
+ PUSHJ P,LOCQ
+ JRST WTYP2
+ MOVE D,B ; RET ATOM FOR ASSOC
+ MOVE A,2(AB)
+ MOVE B,3(AB)
+ POPJ P,
+\f; MONITOR CHECKERS
+
+MONCH0: HLLZ 0,(B) ; POTENTIAL MONITORS
+MONCH: TLZ 0,TYPMSK ; KILL TYPE
+ IOR C,0 ; IN NEW TYPE
+ PUSH P,0
+ MOVEI 0,(B)
+ CAIL 0,HIBOT
+ JRST PURERR
+ POP P,0
+ TLNN 0,.WRMON ; SKIP IF WRITE MONIT
+ POPJ P,
+
+; MONITOR IS ON, INVOKE HANDLER
+
+ PUSH TP,A ; SAVE OBJ
+ PUSH TP,B
+ PUSH TP,C
+ PUSH TP,D ; SAVE DATUM
+ MOVSI C,TATOM ; PREPARE TO FIND IT
+ MOVE D,MQUOTE WRITE,WRITE,INTRUP
+ PUSHJ P,IGET
+ JUMPE B,MONCH1 ; NOT FOUND IGNORE FOR NOW
+ PUSH TP,A ; START SETTING UP CALL
+ PUSH TP,B
+ PUSH TP,-5(TP)
+ PUSH TP,-5(TP)
+ PUSH TP,-5(TP)
+ PUSH TP,-5(TP)
+ PUSHJ P,FRMSTK ; PUT FRAME ON STAKC
+ MCALL 4,EMERGE ; DO IT
+MONCH1: POP TP,D
+ POP TP,C
+ POP TP,B
+ POP TP,A
+ HLLZ 0,(B) ; UPDATE MONITORS
+ TLZ 0,TYPMSK
+ IOR C,0
+ POPJ P,
+
+; NOW FOR READ MONITORS
+
+RMONC0: HLLZ 0,(B)
+RMONCH: TLNN 0,.RDMON
+ POPJ P,
+ PUSH TP,A
+ PUSH TP,B
+ MOVSI C,TATOM
+ MOVE D,MQUOTE READ,READ,INTRUP
+ PUSHJ P,IGET
+ JUMPE B,RMONC1
+ PUSH TP,A
+ PUSH TP,B
+ PUSH TP,-3(TP)
+ PUSH TP,-3(TP)
+ PUSHJ P,FRMSTK ; PUT FRAME ON STACK
+ MCALL 3,EMERGE
+RMONC1: POP TP,B
+ POP TP,A
+ POPJ P,
+
+; PUT THE CURRENT FRAME ON THE STACK
+
+FRMSTK: PUSHJ P,MAKACT
+ HRLI A,TFRAME
+ PUSH TP,A
+ PUSH TP,B
+ POPJ P,
+
+; HERE TO COMPLAIN ABOUT ATTEMPTS TO MUNG PURE CODE
+
+PURERR: PUSH TP,$TATOM
+ PUSH TP,EQUOTE ATTEMPT-TO-MUNG-PURE-STRUCTURE
+ PUSH TP,A
+ PUSH TP,B
+ MOVEI A,2
+ JRST CALER
+\f
+; PROCESS SWAPPING CODE
+
+CHSWAP: MOVE E,PVSTOR+1 ; GET CURRENT
+ POP P,0
+ SKIPE D,INTPRO+1(B) ; SKIP IF NO PROCESS GIVEN
+ CAMN D,PVSTOR+1 ; SKIP IF DIFFERENT
+ JRST PSHPRO
+
+ PUSHJ P,SWAPIT ; DO SWAP
+
+PSHPRO: PUSH TP,$TPVP
+ PUSH TP,E
+ JRST @0
+
+CHUNSW: MOVE E,PVSTOR+1 ; RET OLD PROC
+ MOVE D,-2(TP) ; GET SAVED PROC
+ CAMN D,PVSTOR+1 ; SWAPPED?
+ POPJ P,
+
+SWAPIT: PUSH P,0
+ MOVE 0,PSTAT+1(D) ; CHECK STATE
+ CAIE 0,RESMBL
+ JRST NOTRES
+ MOVE PVP,PVSTOR+1
+ MOVEM 0,PSTAT+1(PVP)
+ MOVEI 0,RUNING
+ MOVEM 0,PSTAT+1(D) ; SAVE NEW STATE
+ POP P,0
+ POP P,C
+ JRST SWAP"
+\f
+
+;SUBROUTINE TO GET BIT FOR CLOBBERAGE
+
+GETBIT: MOVNS B ;NEGATE
+ MOVSI A,400000 ;GET THE BIT
+ LSH A,(B) ;SHIFT TO POSITION
+ POPJ P, ;AND RETURN
+
+; HERE TO HANDLE PURE WRITE AND CHECK FOR POSSIBLE C/W
+
+IFN ITS,[
+GCPWRT: SKIPN GCDFLG ; SEE IF IN DUMPER OR PURIFYER
+ SKIPE NPWRIT
+ JRST .+3
+ MOVEI B,4 ; INDICATE PURE WRITE
+ JRST NOPUGC ; CONTINUE
+ TLZ A,200
+ MOVEM A,TSINT ; SVE A
+ MOVE A,TSAVA
+ SOS TSINTR
+ .SUSET [.RMPVA,,A]
+ CAML A,RPURBT ; SKIP IF NOT PURE
+ CAIL A,HIBOT ; DONT MARK IF TOUCHING INTERPRETER
+ SKIPA
+ SETOM PURMNG ; MUNGING PURENESS INDICATE
+ MOVE B,BUFGC ; GET BUFFER
+ JUMPL B,GCPW1 ; JUMP IF WINDOW IS BUFFER
+ EXCH P,GCPDL
+ PUSHJ P,%CWINF ; GO DO COPY/WRITE
+GCPW2: EXCH P,GCPDL
+ MOVE A,TSINT ; RESTORE A
+ JRST 2NDWORD ; CONTINUE
+GCPW1: EXCH P,GCPDL
+ MOVEI B,WIND ; START OF BUFFER
+ PUSHJ P,%CWINF ; C/W
+ MOVEI B,WNDP ; RESTORE WINDOW
+ MOVE A,WNDBOT ; BOTTOM OF WINDOW
+ ASH A,-10. ; TO PAGES
+ SKIPE A
+ PUSHJ P,%SHWND ; SHARE IT
+ JRST GCPW2
+]
+IFE ITS,[
+
+; HERE TO HANDLE BUFFERING FOR GC-DUMP AND PURIFY FOR TENEX
+
+PWRIT: SKIPN GCDFLG ; SEE IF IN DUMPER OR PURIFYER
+ SKIPE GPURFL
+ SKIPA
+ FATAL IMW
+ EXCH P,GCPDL ; GET A GOOD PDL
+ MOVEM A,TSAVA ; SAVE AC'S
+ MOVEM B,TSAVB
+ MOVEI A,MFORK ; FOR TWENEX THIS IS A MOVEI
+ SKIPE OPSYS ; SKIP IF TOPS20
+ MOVSI A,MFORK ; FOR A TENEX IT SHOULD BE A MOVSI
+ GTRPW ; GET TRAP WORDS
+ PUSH P,A ; SAVE ADDRESS AND WORD
+ PUSH P,B
+ ANDI A,-1
+ CAML A,RPURBT ; SKIP IF NOT PURE
+ CAIL A,HIBOT ; DONT MARK IF TOUCHING INTERPRETER
+ SKIPA
+ SETOM PURMNG ; MUNGING PURENESS INDICATE
+ MOVE B,BUFGC ; GET BUFFER
+ ANDCMI A,1777 ; TO PAGE BOUNDRY
+ JUMPL B,PWRIT2 ; USE WINDOW AS BUFFER
+PWRIT3: PUSHJ P,%CWINF ; FIX UP
+PWRIT4: POP P,B ; RESTORE AC'S
+ POP P,A
+ TLNN A,10 ; SEE IF R/W CYCLE
+ MOVEM B,(A) ; FINISH WRITE
+ EXCH P,GCPDL
+ JRST INTDON
+PWRIT2: MOVEI B,WIND
+ PUSHJ P,%CWINF ; GO TRY TO WIN
+ MOVEI B,WNDP
+ MOVE A,WNDBOT ; BOTTOM OF WINDOW
+ ASH A,-10. ; TO PAGES
+ SKIPE A
+ PUSHJ P,%SHWND ; SHARE IT
+ JRST PWRIT4
+]
+
+;HERE TO HANDLE PDL OVERFLOW. ASK FOR A GC
+
+IPDLOV:
+IFN ITS,[
+ MOVEM A,TSINT ;SAVE INT WORD
+]
+
+ SKIPE GCFLG ;IS GC RUNNING?
+ JRST GCPLOV ;YES, COMPLAIN GROSSLY
+
+ MOVEI A,200000 ;GET BIT TO CLOBBER
+ IORM A,PIRQ ;LEAVE A MESSAGE FOR HIGHER LEVEL
+
+ EXCH P,GCPDL ;GET A WINNING PDL
+ HRRZ B,TSINTR ;GET POINTER TO LOSING INSTRUCTION
+IFE ITS,[
+ SKIPE MULTSG
+ MOVE B,TSINTR+1
+]
+ SKIPG GCPDL ; SKIP IF NOT P
+ LDB B,[270400,,-1(B)] ;GET AC FIELD
+ SKIPL GCPDL ; SKIP IF P
+ MOVEI B,P
+ MOVEI A,(B) ;COPY IT
+ LSH A,1 ;TIMES 2
+ EXCH PVP,PVSTOR+1
+ ADDI A,0STO(PVP) ;POINT TO THIS ACS CURRENT TYPE
+ EXCH PVP,PVSTOR+1
+ HLRZ A,(A) ;GET THAT TYPE INTO A
+ CAIN B,P ;IS IT P
+ MOVEI B,GCPDL ;POINT TO SAVED P
+
+ CAIN B,B ;OR IS IT B ITSELF
+ MOVEI B,TSAVB
+ CAIN B,A ;OR A
+ MOVEI B,TSAVA
+
+ CAIN B,C ;OR C
+ MOVEI B,1(P) ;C WILL BE ON THE STACK
+
+ PUSH P,C
+ PUSH P,A
+
+ MOVE A,(B) ;GET THE LOSING POINTER
+ MOVEI C,(A) ;AND ISOLATE RH
+
+ CAMG C,VECTOP ;CHECK IF IN GC SPACE
+ CAMG C,VECBOT
+ JRST NOGROW ;NO, COMPLAIN
+
+; FALL THROUGH
+\f
+
+ HLRZ C,A ;GET -LENGTH
+ SUBI A,-1(C) ;POINT TO A DOPE WORD
+ POP P,C ;RESTORE TYPE INTO C
+ PUSH P,D ; SAVE FOR GROWTH HACKER
+ MOVEI D,0
+ CAIN C,TPDL ; POINT TD TO APPROPRIATE DOPE WORD
+ MOVEI D,PGROW
+ CAIN C,TTP
+ MOVEI D,TPGROW
+ JUMPE D,BADPDL ; IF D STILL 0, THIS PDL IS WEIRD
+ MOVEI A,PDLBUF(A) ; POINT TO ALLEGED REAL DOPE WORD
+ SKIPN (D) ; SKIP IF PREVIOUSLY BLOWN
+ MOVEM A,(D) ; CLOBBER IN
+ CAME A,(D) ; MAKE SURE IT IS THE SAME
+ JRST PDLOSS
+ POP P,D ; RESTORE D
+
+
+PNTRHK: MOVE C,(B) ;RESTORE PDL POINTER
+ SUB C,[PDLBUF,,0] ;FUDGE THE POINTER
+ MOVEM C,(B) ;AND STORE IT
+
+ POP P,C ;RESTORE THE WORLD
+ EXCH P,GCPDL ;GET BACK ORIG PDL
+IFN ITS,[
+ MOVE A,TSINT ;RESTORE INT WORD
+
+ JRST IMPCH ;LOOK FOR MORE INTERRUPTS
+]
+IFE ITS, JRST GCQUIT
+
+TPOVFL: SETOM INTFLG ;SIMULATE PDL OVFL
+ PUSH P,A
+ MOVEI A,200000 ;TURN ON THE BIT
+ IORM A,PIRQ
+ HLRE A,TP ;FIND DOPEW
+ SUBM TP,A ;POINT TO DOPE WORD
+ MOVEI A,PDLBUF+1(A) ; ZERO LH AND POINT TO DOPEWD
+ SKIPN TPGROW
+ HRRZM A,TPGROW
+ CAME A,TPGROW ; MAKE SURE WINNAGE
+ JRST PDLOS1
+ SUB TP,[PDLBUF,,0] ; HACK STACK POINTER
+ POP P,A
+ POPJ P,
+
+
+; GROW CORE IF PDL OVERFLOW DURING GC
+
+GCPLOV: EXCH P,GCPDL ; NEED A PDL TO CALL P.CORE
+ PUSHJ P,GPDLOV ; HANDLE PDL OVERFLOW
+ EXCH P,GCPDL
+ PUSHJ P,%FDBUF
+IFE ITS,[
+ JRST GCQUIT
+]
+IFN ITS,[
+ MOVE A,TSINT
+ JRST IMPCH
+
+]
+\f
+IFN ITS,[
+
+;HERE TO HANDLE LOW-LEVEL CHANNELS
+
+
+CHNACT: SKIPN GCFLG ;GET A WINNING PDL
+ EXCH P,GCPDL
+ ANDI A,177777 ;ISOLATE CHANNEL BITS
+ PUSH P,0 ;SAVE
+
+CHNA1: MOVEI B,0 ;BIT COUNTER
+ JFFO A,.+2 ;COUNT
+ JRST CHNA2
+ SUBI B,35. ;NOW HAVE CHANNEL
+ MOVMS B ;PLUS IT
+ MOVEI 0,1
+ LSH 0,(B)
+ ANDCM A,0
+ MOVEI 0,(B) ; COPY TO 0
+ LSH 0,23. ;POSITION FOR A .STATUS
+ IOR 0,[.STATUS 0]
+ XCT 0 ;DO IT
+ ANDI 0,77 ;ISOLATE DEVICE
+ CAILE 0,2
+ JRST CHNA1
+
+PMIN4: MOVE 0,B ; CHAN TO 0
+ .ITYIC 0, ; INTO 0
+ JRST .+2 ; DONE, GO ON
+ JRST PMIN4
+ SETZM GCFLCH ; LEAVE GC MODE
+ JRST CHNA1
+
+CHNA2: POP P,0
+ SKIPN GCFLG
+ EXCH P,GCPDL
+ JRST GCQUIT
+
+HOWMNY: SETZ
+ SIXBIT /LISTEN/
+ D
+ 402000,,B
+]
+
+MFUNCTION GASCII,SUBR,ASCII
+ ENTRY 1
+
+ GETYP A,(AB)
+ CAIE A,TCHRS
+ JRST TRYNUM
+
+ MOVE B,1(AB)
+ MOVSI A,TFIX
+ JRST FINIS
+
+TRYNUM: CAIE A,TFIX
+ JRST WTYP1
+ SKIPGE B,1(AB) ;GET NUMBER
+ JRST TOOBIG
+ CAILE B,177 ;CHECK RANGE
+ JRST TOOBIG
+ MOVSI A,TCHRS
+ JRST FINIS
+
+TOOBIG: ERRUUO EQUOTE ARGUMENT-OUT-OF-RANGE
+
+\f
+;HERE IF PDL OVERFLOW DURING GARBAGE COLLECTION
+
+BADPDL: FATAL NON PDL OVERFLOW
+
+NOGROW: FATAL PDL OVERFLOW ON NON EXPANDABLE PDL
+
+PDLOS1: MOVEI D,TPGROW
+PDLOSS: MOVSI A,(GENERAL) ; FIX UP TP DOPE WORD JUST IN CASE
+ HRRZ D,(D) ; POINT TO POSSIBLE LOSING D.W.
+ SKIPN TPGROW
+ JRST PDLOS2
+ MOVEM A,-1(D)
+ MOVEI A,(TP) ; SEE IF REL STACK SIZE WINS
+ SUBI A,(TB)
+ TRNN A,1
+ SUB TP,[1,,1]
+PDLOS2: MOVSI A,.VECT.
+ SKIPE PGROW
+ MOVEM A,-1(D)
+ SUB P,[2,,2] ; TRY TO RECOVER GRACEFULLY
+ EXCH P,GCPDL
+ MOVEI A,DOAGC ; SET UP TO IMMEDIATE GC
+IFN ITS,[
+ HRRM A,TSINTR
+]
+IFE ITS,[
+ SKIPE MULTSG
+ HRRM A,TSINTR+1
+ SKIPN MULTSG
+ HRRM A,TSINTR
+]
+IFN ITS, .DISMIS TSINTR
+IFE ITS, DEBRK
+
+DOAGC: SKIPE PGROW
+ SUB P,[2,,2] ; ALLOW ROOM FOR CALL
+ JSP E,PDL3 ; CLEANUP
+ ERRUUO EQUOTE PDL-OVERFLOW-BUFFER-EXHAUSTED
+
+
+DLOSER: PUSH P,LOSRS(B)
+ MOVE A,TSAVA
+ MOVE B,TSAVB
+ POPJ P,
+
+LOSRS: IMPV
+ ILOPR
+ IOC
+ IPURE
+
+
+;MEMORY PROTECTION INTERRUPT
+
+IOC: FATAL IO CHANNEL ERROR IN GARBAGE COLLECTOR
+IMPV: FATAL MPV IN GARBAGE COLLECTOR
+
+IPURE: FATAL PURE WRITE IN GARBAGE COLLECTOR
+ILOPR: FATAL ILLEGAL OPEREATION IN GARBAGE COLLECTOR
+
+IFN ITS,[
+
+;SUBROUTINE TO BE CALLED AT INITIALIZE TIME TO SETUP INTS
+
+INTINT: SETZM CHNCNT
+ MOVE A,[CHNCNT,,CHNCNT+1]
+ BLT A,CHNCNT+16.
+ SETZM INTFLG
+ .SUSET [.SPICLR,,[-1]]
+ MOVE A,MASK1 ;SET MASKS
+ MOVE B,MASK2
+ .SETM2 A, ;SET BOTH MASKS
+ MOVSI A,TVEC
+ MOVEM A,QUEUES
+ SETZM QUEUES+1 ;UNQUEUE ANY OLD INTERRUPTS
+ SETZM CURPRI
+ POPJ P,
+]
+IFE ITS,[
+
+; INITIALIZE TENEX INTERRUPT SYSTEM
+
+INTINT: CIS ; CLEAR THE INT WORLD
+ SETZM INTFLG ; IN CASE RESTART
+ MOVSI A,TVEC ; FIXUP QUEUES
+ MOVEM A,QUEUES
+ SETZM QUEUES+1
+ SETZM CURPRI ; AND PRIORITY LEVEL
+ MOVEI A,MFORK ; TURN ON MY INTERRUPTS
+ SKIPN MULTSG
+ JRST INTINM
+ PUSHJ P,@[DOSIR] ; HACK TO TEMP GET TO SEGMENT 0
+ JRST INTINX
+
+INTINM: MOVE B,[-36.,,CHNTAB]
+ MOVSI 0,1
+ HLLM 0,(B)
+ AOBJN B,.-1
+
+ MOVE B,[LEVTAB,,CHNTAB] ; POINT TO TABLES
+ SIR ; TELL SYSTEM ABOUT THEM
+
+INTINX: MOVSI D,-NCHRS
+ MOVEI 0,40
+ MOVEI C,0
+
+INTILP: SKIPN A,CHRS(D)
+ JRST ITTIL1
+ IOR C,0
+ MOVSS A
+ HRRI A,(D)
+ ATI
+ITTIL1: LSH 0,-1
+ AOBJN D,INTILP
+
+ DPB C,[360600,,MASK1]
+ MOVE B,MASK1 ; SET UP FOR INT BITS
+ MOVEI A,MFORK
+ AIC ; TURN THEM ON
+ MOVEI A,MFORK ; DO THE ENABLE
+ EIR
+ POPJ P,
+
+
+DOSIR: MOVE B,[-36.,,CHNTAB]
+ MOVSI 0,<1_12.>+FSEG
+ HLLM 0,(B)
+ AOBJN B,.-1
+
+ MOVEI B,..ARGB ; WILL RUN IN SEGMENT 0
+RMT [
+..ARGB: 3
+ LEVTAB
+ CHNTAB
+]
+ XSIR
+ POP P,D
+ HRLI D,FSEG
+ XJRST C ; GET BACK TO CALLING SEGMENT
+]
+\f
+
+; CNTL-G HANDLER
+
+MFUNCTION QUITTER,SUBR
+
+ ENTRY 2
+ GETYP A,(AB)
+ CAIE A,TCHRS
+ JRST WTYP1
+ GETYP A,2(AB)
+ CAIE A,TCHAN
+ JRST WTYP2
+ MOVE B,1(AB)
+ MOVE A,(AB)
+IFE ITS, CAIE ^O
+ CAIN B,^S ; HANDLE CNTL-S
+ JRST RETLIS
+ CAIE B,7
+ JRST FINIS
+
+ PUSHJ P,CLEAN ; CLEAN UP I/O CHANNELS
+ PUSH TP,$TATOM
+ PUSH TP,EQUOTE CONTROL-G?
+ MCALL 1,ERROR
+ JRST FINIS
+
+RETLIS: MOVE B,IMQUOTE LER,[LERR ]INTRUP
+ PUSHJ P,ILVAL ; GET CURRENT VALUE
+ PUSH TP,A
+ PUSH TP,B
+ MOVEI B,-1(TP)
+ PUSHJ P,CHFSWP
+ SUB TP,[2,,2]
+ MOVEI D,(TB) ; FIND A LISTEN OR ERROR TO RET TO
+
+RETLI1: HRRZ A,OTBSAV(D)
+ CAIN A,(B) ; CHECK FOR WINNER
+ JRST FNDHIM
+ HRRZ C,FSAV(A) ; CHECK FUNCTION
+ CAIE C,LISTEN
+ CAIN C,ERROR ; FOUND?
+ JRST FNDHIM ; YES, GO TO SAME
+ CAIN C,ERROR% ; FUNNY ERROR
+ JRST FNDHIM
+ CAIN C,TOPLEV ; NO ERROR/LISTEN
+ JRST FINIS
+ MOVEI D,(A)
+ JRST RETLI1
+
+FNDHIM: PUSH TP,$TTB
+ PUSH TP,D
+ PUSHJ P,CLEAN
+ MOVE B,(TP) ; NEW FRAME
+ SUB TP,[2,,2]
+ MOVEI C,0
+ PUSHJ P,CHUNW ; UNWIND?
+ MOVSI A,TATOM
+ MOVE B,IMQUOTE T
+ JRST FINIS
+
+CLEAN: MOVE B,3(AB) ; GET IN CHAN
+ PUSHJ P,RRESET
+ MOVE B,3(AB) ; CHANNEL BAKC
+ MOVE C,BUFRIN(B)
+ SKIPN C,ECHO(C) ; GET ECHO
+ JRST CLUNQ
+IFN ITS,[
+ MOVEI A,2
+ CAMN C,[PUSHJ P,MTYO]
+ JRST TYONUM
+ LDB A,[270400,,C]
+TYONUM: LSH A,23.
+ IOR A,[.RESET]
+ XCT A
+]
+IFE ITS,[
+ MOVEI A,101 ; OUTPUT JFN
+ CFOBF
+]
+
+CLUNQ: SETZB A,CURPRI
+ JRST UNQUEU
+
+\f
+IMPURE
+ONINT: 0 ; INT FUDGER
+INTBCK: 0 ; GO BACK TO THIS PC AFTER INTERRUPT
+ MOVEM TP,TPSAV(TB) ; SAVE STUFF
+ MOVEM P,PSAV(TB)
+INTBEN: SKIPL INTFLG ; PENDING INTS?
+ JRST @INTBCK
+ PUSH P,A
+ SOS A,INTBCK
+ SETZM INTBCK
+ MOVEM A,LCKINT
+ POP P,A
+ JRST LCKINT+1
+
+
+IFN ITS,[
+;RANDOM IMPURE CRUFT NEEDED
+CHNCNT: BLOCK 16. ; # OF CHARS IN EACH CHANNEL
+
+TSAVA: 0
+TSAVB: 0
+PIRQ: 0 ;HOLDS REQUEST BITS FOR 1ST WORD
+PIRQ2: 0 ;SAME FOR WORD 2
+PCOFF: 0
+MASK1: 200,,200100 ;FIRST MASK
+MASK2: 0 ;SECOND THEREOF
+CURPRI: 0 ; CURRENT PRIORITY
+RLTSAV: 0
+]
+IFE ITS,[
+CHRS: 7 ; CNTL-G
+ 23 ; CNTL-O
+ 17 ; CNTL-S
+ BLOCK NCHRS-3
+
+NETJFN: BLOCK NNETS
+MASK1: CHNMSK
+RLTSAV: 0
+TSINTR:
+P1: 0
+ 0 ; PC INT LEVEL 1 (1ST WORD IN 1 SEG MODE, 2D
+ ; IN MULTI SEG MODE)
+P2: 0
+ 0 ; PC INT LEVEL 2
+P3: 0
+ 0 ; PC INT LEVEL 3
+CURPRI: 0
+TSAVA: 0
+TSAVB: 0
+PIRQ: 0
+PIRQ2: 0
+IOCLOS: 0 ; HOLDS LOSING JFN IN TNX IOC
+]
+PURE
+
+END
+\f
\ No newline at end of file