--- /dev/null
+TITLE AMSGC MUDDLE MARK SWEEP GARBAGE COLLECTOR
+
+RELOCATABLE
+
+.GLOBAL RCL,RCLV,IAMSGC,MAXLEN,REALGC,RGCLEN,GCFLG,SQUPNT,GCMONF,MSGTYP,GCCAUS
+.GLOBAL GCCALL,PVSTOR,DSTORE,TYPVEC,N.CHNS,CHNL1,MAINPR,STOGC,CTIME,GCTIM,IMTYO
+.GLOBAL FNMSGC,SATMSK,NUMSAT,NUMPRI,PURBOT,GCSTOP,GCSBOT,STOSTR,TYPMSK,PDLBUF,ITEM,INDIC
+.GLOBAL VAL,NODPNT,UBIT,ASOLNT,GCHAPN,RBLDM,TOTCNT,MARK2S,MKTBS
+.GLOBAL FRMUNG,BYTDOP,TD.GET,TD.LNT,TD.AGC,ABOTN,SLENGC,LENGC,REALGC,AGCLD,RLENGC
+.GLOBAL RSLENG
+
+GCST=$.
+
+LOC REALGC+RLENGC
+
+OFFS=AGCLD-$.
+OFFSET OFFS
+
+.INSRT MUDDLE >
+
+TYPNT==AB
+F==PVP
+
+
+; THIS IS THE MUDDLE MARK SWEEP GARBAGE COLLECTOR. IT IS MUCH FASTER THAN THE COPYING
+; GARBAGE COLLECTOR BUT DOESN'T COMPACT. IT CONSES FREE THINGS ONTO RCL AND RCLV.
+; THIS GARBAGE COLLECTOR CAN ONLY BE USED IF THE GARBAGE COLLECT IS A FREE STORAGE
+; GARBAGE COLLECT
+
+\f
+; FIRST INITIALIZE VARIABLES
+
+IAMSGC: SETZB M,RCL ; CLEAR OUT LIST RECYCLE AND RSUBR BASE
+ SETZM RCLV ; CLEAR VECTOR RECYCLE
+ SETZM MAXLEN ; CLEAR MAXIMUM LENGTH FOUND TO RECYCLE
+ SETOM GCFLG ; A GC HAS HAPPENED
+ SETZM TOTCNT
+ HLLZS SQUPNT ; CLEAR OUT SQUOZE TABLE
+
+; SET UP MESSAGE PRINTING AND SAVE CAUSE AND CAUSER
+
+ PUSH P,A
+ PUSH P,B
+ PUSH P,C ; SAVE ACS
+ MOVEI B,[ASCIZ /MSGIN / ] ; PRINT GIN IF WINNING
+ SKIPE GCMONF
+ PUSHJ P,MSGTYP
+ HRRZ C,(P) ; GET CAUSE INDICATOR
+ ADDI B,1 ; AOS TO GET REAL CAUS
+ MOVEM B,GCCAUS
+ SKIPN GCMONF
+ JRST NOMON2
+ MOVE B,MSGGCT(C) ; GET CAUSE MESSAGE
+ PUSHJ P,MSGTYP
+NOMON2: HLRZ C,(P) ; FIND OUT WHO CAUSED THE GC
+ MOVEM C,GCCALL
+ SKIPN GCMONF ; PRINT IF GCMON IS ON
+ JRST NOMON3
+ MOVE B,MSGGFT(C) ; GET POINTER TO MESSAGE
+ PUSHJ P,MSGTYP
+NOMON3: SUB P,[1,,1]
+ POP P,B ; RESTORE ACS
+ POP P,A
+
+; MOVE ACS INTO THE PVP
+
+ EXCH PVP,PVSTOR+1 ; GET REAL PROCESS VECTOR
+
+ IRP AC,,[0,A,B,C,D,E,TVP,SP,AB,TB,TP,FRM,M,R,P]
+ MOVEM AC,AC!STO+1(PVP)
+ TERMIN
+
+ MOVE 0,PVSTOR+1 ; GET OLD VALUE OF PVP
+ MOVEM 0,PVPSTO+1(PVP) ; SAVE PVP
+ MOVE 0,DSTORE ; SAVE D'S TYPE
+ MOVEM 0,DSTO(PVP)
+ MOVEM PVP,PVSTOR+1
+
+; SET UP TYPNT TO POINT TO TYPE VECTOR
+
+ GETYP E,TYPVEC ; FIRST SEE IF TYPVEC IS A VECTOR
+ CAIE E,TVEC
+ FATAL TYPE VECTOR NOT OF TYPE VECTOR
+ HRRZ TYPNT,TYPVEC+1
+ HRLI TYPNT,B ; TYPNT IS NOW TYPEVECTOR(B)
+
+; NOW SET UP GCPDL AND FENCE POST PDL'S
+
+ MOVEI A,(TB)
+ MOVE D,P ; SAVE P POINTER
+ PUSHJ P,FRMUNG
+ MOVE P,[-2000,,MRKPDL] ; SET UP MARK PDL
+ MOVEI A,(TB) ; FIXUP TOP FRAME
+ SETOM 1(TP) ; FENCEPOST TP
+ SETOM 1(D) ; FENCEPOST P
+
+; NOW SETUP AUTO CHANNEL CLOSE
+
+ MOVEI 0,N.CHNS-1 ; NUMBER OF CHANNELS
+ MOVEI A,CHNL1 ; FIRST CHANNEL SLOT
+CHNCLR: SKIPE 1(A) ; IS IT A CHANNEL
+ SETZM (A) ; CLEAR UP TYPE SLOT
+ ADDI A,2
+ SOJG 0,CHNCLR
+
+; NOW DO MARK AND SWEEP PHASES
+
+ MOVSI D,400000 ; MARK BIT
+ MOVEI B,TPVP ; GET TYPE
+ MOVE A,PVSTOR+1 ; GET VALUE OF CURRENT PROCESS VECTOR
+ PUSHJ P,MARK
+ MOVEI B,TPVP ; GET TYPE OF MAIN PROCESS VECTOR
+ MOVE A,MAINPR
+ PUSHJ P,MARK ; MARK
+ PUSHJ P,CHNFLS ; DO CHANNEL FLUSHING
+ PUSHJ P,CHFIX
+ PUSHJ P,STOGC ; FIX UP FROZEN WORLD
+ PUSHJ P,SWEEP ; SWEEP WORLD
+
+; PRINT GOUT
+
+ MOVEI B,[ASCIZ /MSGOUT /] ; PRINT OUT ENDING MESSAGE IF GCMONING
+ SKIPE GCMONF
+ PUSHJ P,MSGTYP
+
+; RESTORE ACS
+
+ MOVE PVP,PVSTOR+1 ; GET PVP
+ IRP AC,,[0,A,B,C,D,E,TVP,SP,AB,TB,TP,FRM,M,R,P]
+ MOVE AC,AC!STO+1(PVP)
+ TERMIN
+
+ SKIPN DSTORE ; CLEAR OUT TYPE IF NO TYPE THERE
+ SETZM DSTO(PVP)
+ MOVE PVP,PVPSTO+1(PVP)
+
+; PRINT TIME
+
+ PUSH P,A ; SAVE ACS
+ PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ PUSHJ P,CTIME ; GET CURRENT CPU TIME
+ FSBR B,GCTIM ; COMPUTE TIME ELAPSED
+ MOVEM B,GCTIM ; SAVE TIME AWAY
+ SKIPN GCMONF ; PRINT IT OUT?
+ JRST GCCONT
+ PUSHJ P,FIXSEN
+ MOVEI A,15 ; OUTPUT CR/LF
+ PUSHJ P,IMTYO
+ MOVEI A,12
+ PUSHJ P,IMTYO
+GCCONT: POP P,D ; RESTORE ACS
+ POP P,C
+ POP P,B
+ POP P,A
+ SETZM GCFLG
+ SETOM GCHAPN
+ SETOM INTFLG
+ PUSHJ P,RBLDM
+ JRST FNMSGC ; DONE
+
+\f
+; THIS IS THE MARK PHASE
+
+; GENERAL MARK ROUTINE, CALLED TO MARK ALL THINGS
+; /A POINTER TO GOODIE
+; /B TYPE OF GOODIE
+; FOR MARK2, MARK1 /C POINTER TO PAIR NOT NEEDED FOR CALLS DIRECTLY TO MARK
+
+MARK2S:
+MARK2: HLRZ B,(C) ; TYPE
+MARK1: MOVE A,1(C) ; VALUE
+MARK: JUMPE A,CPOPJ ; DONE IF ZERO
+ MOVEI 0,1(A) ; SEE IF PURE
+ CAML 0,PURBOT
+ JRST CPOPJ
+ ANDI B,TYPMSK ; FLUSH MONITORS
+ HRLM C,(P)
+ CAIG B,NUMPRI ; IS A BASIC TYPE
+ JRST @MTYTBS(B) ; TYPE DISPATCH
+ LSH B,1 ; NOW GET PRIMTYPE
+ HRRZ B,@TYPNT ; GET PRIMTYPE
+ ANDI B,SATMSK ; FLUSH DOWN TO SAT
+ CAIG B,NUMSAT ; SKIP IF TEMPLATE DATA
+ JRST @MSATBS(B) ; JUMP OFF SAT TABLE
+ JRST TD.MK
+
+GCRET: HLRZ C,(P) ; GET SAVED C
+CPOPJ: POPJ P,
+
+; TYPE DISPATCH TABLE
+MTYTBS:
+
+OFFSET 0
+
+DUM1:
+
+IRP XX,,[[TLOSE,GCRET],[TFIX,GCRET],[TFLOAT,GCRET],[TCHRS,GCRET]
+[TENTRY,GCRET],[TSUBR,GCRET],[TFSUBR,GCRET],[TILLEG,GCRET],[TUNBOU,GCRET]
+[TBIND,GCRET],[TTIME,GCRET],[TLIST,PAIRMK],[TFORM,PAIRMK],[TSEG,PAIRMK]
+[TEXPR,PAIRMK],[TFUNAR,PAIRMK],[TLOCL,PAIRMK],[TFALSE,PAIRMK],[TDEFER,DEFQMK]
+[TUVEC,UVMK],[TOBLS,UVMK],[TVEC,VECMK],[TCHAN,VECMK] ,[TLOCV,VECMK]
+[TTVP,VECMK],[TBVL,VECMK],[TTAG,VECMK],[TPVP,VECMK],[TLOCI,TPMK],[TTP,TPMK]
+[TSP,TPMK],[TMACRO,PAIRMK],[TPDL,PMK],[TARGS,ARGMK],[TAB,ABMK]
+[TTB,TBMK],[TFRAME,FRMK],[TCHSTR,BYTMK],[TATOM,ATOMK],[TLOCD,LOCMK],[TBYTE,BYTMK]
+[TENV,FRMK],[TACT,FRMK],[TASOC,ASMK],[TLOCU,UVMK],[TLOCS,BYTMK],[TLOCA,ARGMK]
+[TCBLK,GCRET],[TTMPLT,TD.MK],[TLOCT,TD.MK],[TLOCR,GCRET],[TINFO,GCRET]
+[TRDTB,GCRDMK],[TWORD,GCRET],[TRSUBR,VECMK],[TCODE,UVMK],[TSATC,GCRET]
+[TBITS,GCRET],[TSTORA,UVMK],[TPICTU,UVMK],[TSKIP,TPMK],[TLINK,ATOMK]
+[TDECL,PAIRMK],[TENTER,VECMK],[THAND,VECMK],[TINTH,VECMK],[TDISMI,ATOMK]
+[TDCLI,PAIRMK],[TPCODE,GCRET],[TTYPEW,GCRET],[TTYPEC,GCRET]
+[TGATOM,GATOMK],[TREADA,FRMK],[TUBIND,GCRET],[TUNWIN,TBMK],[TLOCB,BYTMK]
+[TDEFQ,DEFQMK],[TSPLIC,PAIRMK],[TLOCN,ASMK],[TOFFS,OFFSMK]]
+ IRP A,B,[XX]
+ LOC DUM1+A
+ SETZ B
+ .ISTOP
+ TERMIN
+TERMIN
+
+LOC DUM1+NUMPRI+1
+
+OFFSET OFFS
+
+; SAT DISPATCH TABLE
+
+MSATBS:
+
+OFFSET 0
+
+DISTB2 DUM2,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,UVMK],[STBASE,TBMK]
+[STPSTK,TPMK],[SARGS,<SETZ ARGMK>],[S2NWORD,VECMK],[SPSTK,TPMK],[SSTORE,UVMK]
+[SFRAME,<SETZ FRMK>],[SBYTE,<SETZ BYTMK>],[SATOM,ATOMK],[SPVP,VECMK],[SGATOM,GATOMK]
+[SLOCID,<SETZ LOCMK>],[SCHSTR,<SETZ BYTMK>],[SASOC,ASMK],[SLOCL,PAIRMK],[SABASE,ABMK]
+[SLOCA,<SETZ ARGMK>],[SLOCV,VECMK],[SLOCU,UVMK],[SLOCS,<SETZ BYTMK>],[SLOCN,ASMK]
+[SRDTB,GCRDMK],[SLOCB,<SETZ BYTMK>],[SDEFQ,DEFQMK],[SOFFS,OFFSMK]]
+
+OFFSET OFFS
+
+\f
+; ROUTINE TO MARK PAIRS
+
+PAIRMK: MOVEI C,(A)
+PAIRM1: CAMG C,GCSTOP ; SEE IF IN RANGE
+ CAIGE C,STOSTR
+ JRST BADPTR ; FATAL ERROR
+ HLRE B,(C) ; SKIP IF NOT MARKED
+ JUMPL B,GCRET
+ IORM D,(C) ; MARK IT
+ PUSHJ P,MARK1 ; MARK THE ITEM
+ HRRZ C,(C) ; GET NEXT ELEMENT OF LIST
+ JUMPE C,GCRET
+ CAML C,PURBOT
+ JRST GCRET
+ JRST PAIRM1
+
+; ROUTINE TO MARK DEFERS
+
+DEFMK: HLRE B,(A)
+ JUMPL B,GCRET
+ MOVEI C,(A)
+ IORM D,(C)
+ PUSHJ P,MARK1
+ JRST GCRET
+
+; ROUTINE TO MARK POSSIBLE DEFERS DEF?
+
+DEFQMK: GETYP B,(A) ; GET THE TYPE OF THE OBJECT
+ LSH B,1 ; COMPUTE THE SAT
+ HRRZ B,@TYPNT
+ ANDI B,SATMSK
+ SKIPL MKTBS(B) ; SKIP IF NOT DEFERED
+ JRST PAIRMK
+ JRST DEFMK ; GO TO DEFMK
+
+\f
+; ROUTINE TO MARK VECTORS
+
+VECMK: HLRE B,A ; GET LENGTH
+ SUB A,B
+ MOVEI C,1(A) ; POINT TO SECOND DOPE WORD
+ CAIL C,STOSTR ; CHECK FOR IN RANGE
+ CAMLE C,GCSTOP
+ JRST BADPTR
+ HLRE B,(C)
+ JUMPL B,GCRET
+ IORM D,(C) ; MARK IT
+ SUBI C,-1(B) ; GET TO BEGINNING
+VECMK1: HLRE B,(C) ; GET TYPE AND SKIP IF NOT DOPE WORD
+ JUMPL B,GCRET ; DONE
+ PUSHJ P,MARK1 ; MARK IT
+ ADDI C,2 ; NEXT ELEMENT
+ JRST VECMK1
+
+; ROUTINE TO MARK UVECTORS
+
+UVMK: HLRE B,A ; GET LENGTH
+ SUB A,B ; A POINTS TO FIRST DOPE WORD
+ MOVEI C,1(A) ; C POINTS TO SECOND DOPE WORD
+ CAIL C,STOSTR ; CHECK FOR IN RANGE
+ CAMLE C,GCSTOP
+ JRST BADPTR
+ HLRE F,(C) ; GET LENGTH
+ JUMPL F,GCRET
+ IORM D,(C) ; MARK IT
+ GETYP B,-1(C) ; GET TYPE
+ MOVEI E,(B) ; COPY TYPE FOR SAT COMPUTATION
+ LSH B,1
+ HRRZ B,@TYPNT ; GET SAT
+ ANDI B,SATMSK
+ MOVEI B,@MSATBS(B) ; GET JUMP LOCATION
+ CAIN B,GCRET
+ JRST GCRET
+ SUBI C,(F) ; POINT TO BEGINNING OF UVECTOR
+ SUBI F,2
+ JUMPE F,GCRET
+ PUSH P,F ; SAVE LENGTH
+ PUSH P,E
+UNLOOP: MOVE B,(P)
+ MOVE A,1(C) ; GET VALUE POINTER
+ PUSHJ P,MARK
+ SOSE -1(P) ; SKIP IF NON-ZERO
+ AOJA C,UNLOOP ; GO BACK AGAIN
+ SUB P,[2,,2] ; CLEAN OFF STACK
+ JRST GCRET
+
+; ROUTINE TO INDICATE A BAD POINTER
+
+BADPTR: FATAL POINTER POINTS OUT OF GARBAGE COLLECTED SPACE
+ JRST GCRET
+
+\f
+; ROUTINE TO MARK A TPSTACK
+
+TPMK: HLRE B,A ; GET LENGTH
+ SUB A,B ; A POINTS TO FIRST DOPE WORD
+ MOVEI C,PDLBUF+1(A) ; C POINTS TO SECOND DOPE WORD
+ CAIL C,STOSTR ; CHECK FOR IN RANGE
+ CAMLE C,GCSTOP
+ JRST BADPTR
+ HLRE A,(C)
+ JUMPL A,GCRET
+ IORM D,(C) ; MARK IT
+ SUBI C,-1(A) ; GO TO BEGINNING
+
+TPLP: HLRE B,(C) ; GET TYPE AND MARKING
+ JUMPL B,GCRET ; EXIT ON FENCE-POST
+ ANDI B,TYPMSK ; FLUSH MONITORS
+ CAIE B,TCBLK ; CHECK FOR FRAME
+ CAIN B,TENTRY
+ JRST MFRAME ; MARK THE FRAME
+ CAIE B,TUBIND ; BINDING BLOCK
+ CAIN B,TBIND
+ JRST MBIND
+ PUSHJ P,MARK1 ; NOTHING SPECIAL SO MARK IT
+ ADDI C,2 ; POINT TO NEXT OBJECT
+ JRST TPLP ; MARK IT
+
+; MARK A FRAME ON THE STACK, [I.E. ITS FSAV AND PSAV SLOTS]
+
+MFRAME: HRROI C,FRAMLN+FSAV-1(C) ; POINT TO FUNCTION
+ HRRZ A,1(C) ; GET POINTER
+ CAIL A,STOSTR ; SEE IF IN GC SPACE
+ CAMLE A,GCSTOP
+ JRST MFRAM1 ; SKIP OVER IT, NOT IN GC-SPACE
+ HRL A,(A) ; GET LENGTH
+ MOVEI B,TVEC ; TYPE IS VECTOR [RSUBR OR RSUBR-ENTRY]
+ PUSHJ P,MARK
+MFRAM1: MOVE A,PSAV-FSAV+1(C) ; MARK THE PSTACK
+ MOVEI B,TPDL
+ PUSHJ P,MARK
+ HRROI C,-FSAV+1(C) ; POINT PAST FRAME
+ JRST TPLP ; GO BACK TO START OF LOOP
+
+; MARK A BINDING ON THE STACK [I.E. THE ATOM, VALUE, DECL, AND PREVIOUS BINDING]
+
+MBIND: MOVEI B,TATOM ; START BY MARKING THE ATOM
+ PUSHJ P,MARK1 ; MARK IT
+ ADDI C,2 ; POINT TO VALUE SLOT
+ PUSHJ P,MARK2 ; MARK THE VALUE
+ ADDI C,2 ; POINT TO DECL AND PREV BINDING
+ MOVEI B,TLIST ; MARK DECL
+ HLRZ A,(C)
+ PUSHJ P,MARK
+ SKIPL A,1(C) ; SKIP IF PREVIOUS BINDING
+ JRST NOTLCI
+ MOVEI B,TLOCI ; GET TYPE
+ PUSHJ P,MARK
+NOTLCI: ADDI C,2 ; POINT PAST BINDING
+ JRST TPLP
+
+
+PMK: HLRE B,A ; GET LENGTH
+ SUB A,B ; A POINTS TO FIRST DOPE WORD
+ MOVEI C,PDLBUF+1(A) ; C POINTS TO SECOND DOPE WORD
+ CAIL C,STOSTR ; CHECK FOR IN RANGE
+ CAMLE C,GCSTOP
+ JRST BADPTR
+ IORM D,(C) ; MARK IT
+ JRST GCRET
+\f
+; ROUTINE TO MARK TB POINTER
+
+TBMK: HRRZS A ; CHECK FOR NIL POINTER
+ SKIPN A
+ JRST GCRET
+ MOVE A,TPSAV(A) ; GET A TP POINTER
+ MOVEI B,TTP ; TYPE WORD
+ PUSHJ P,MARK
+ JRST GCRET
+
+; ROUTINE TO MARK AB POINTERS
+
+ABMK: HLRE B,A ; GET TO FRAME
+ SUB A,B
+ MOVE A,FRAMLN+TPSAV(A) ; GET A TP POINTER
+ MOVEI B,TTP ; TYPE WORD
+ PUSHJ P,MARK
+ JRST GCRET
+
+; ROUTINE TO MARK FRAME POINTERS
+
+FRMK: HRLZ B,A ; GET THE TIME
+ HLRZ F,OTBSAV(A) ; GET TIME FROM FRAME
+ CAIE B,(F) ; SKIP IF TIMES AGREE
+ JRST GCRET ; IGNORE POINTER IF THEY DONT
+ HRRZ A,(C) ; GET POINTER TO PROCESS
+ SUBI A,1 ; FUDGE FOR VECTOR MARKING
+ MOVEI B,TPVP ; TYPE WORD
+ PUSHJ P,MARK
+ HRRZ A,1(C) ; GET POINTER TO FRAME
+ JRST TBMK ; MARK IT
+
+; ROUTINE TO MARK ARGUMENT BLOCKS [TUPLES]
+
+ARGMK: HLRE B,A ; GET LENGTH
+ SUB A,B ; POINT PAST BLOCK
+ CAIL A,STOSTR
+ CAMLE A,GCSTOP ; SEE IF IN GCSPACE
+ JRST GCRET
+ HRLZ 0,(A) ; GET TYPE
+ ANDI 0,TYPMSK ; FLUSH MONITORS
+ CAIE 0,TENTRY
+ CAIN 0,TCBLK
+ JRST ARGMK1 ; AT FRAME
+ CAIE 0,TINFO ; AT FRAME
+ JRST GCRET ; NOT A LEGAL TYPE GO AWAY
+ HRRZ A,1(A) ; POINTING TO FRAME
+ HRL A,(C) ; GET TIME
+ JRST TBMK
+ARGMK1: HRRI A,FRAMLN(A) ; MAKE POINTER
+ HRL A,(C) ; GET TIME
+ JRST TBMK
+\f
+
+; ROUTINE TO MARK GLOBAL SLOTS
+
+GATOMK: HRRZ B,(C) ; GET POSSIBLE GDECL
+ JUMPE B,ATOMK ; NONE GO TO MARK ATOM
+ CAIN B,-1 ; SKIP IF NOT MANIFEST
+ JRST ATOMK
+ PUSH P,A ; I DOUBT THIS IS RIGHT, BUT IT WORKED ONCE--TAA
+ MOVEI C,(A)
+ MOVEI A,(B)
+ MOVEI B,TLIST ; TYPE WORD LIST
+ PUSHJ P,MARK ; MARK IT
+ POP P,A
+ JRST ATOMK5
+
+ATOMK:
+ATOMK5: HLRE B,A
+ SUB A,B ; A POINTS TO DOPE WORD
+ SKIPGE 1(A) ; SKIP IF NOT MARKED
+ JRST GCRET ; EXIT IF MARKED
+ HLRZ B,1(A)
+ SUBI B,3
+ HRLI B,1(B)
+ MOVEI C,-1(A)
+ SUB C,B ; IN CASE WAS DW
+ IORM D,1(A) ; MARK IT
+ HRRZ A,2(C) ; MARK OBLIST
+ CAMG A,VECBOT
+ JRST NOOBL ; NO IMPURE OBLIST
+ HRLI A,-1
+ MOVEI B,TOBLS ; MARK THE OBLIST
+ PUSHJ P,MARK
+NOOBL: HLRZ A,2(C) ; GET NEXT ATOM
+ MOVEI B,TATOM
+ PUSHJ P,MARK
+ HLRZ B,(C) ; GET VALUE SLOT
+ TRZ B,400000 ; TURN OFF MARK BIT
+ SKIPE B ; SEE IF 0
+ CAIN B,TUNBOUN ; SEE IF UNBOUND
+ JRST GCRET
+ HRRZ 0,(C) ; SEE IF VECTOR OR TP POINTER
+ MOVEI B,TVEC ; ASSUME VECTOR
+ SKIPE 0 ; SKIP IF VECTOR
+ MOVEI B,TTP ; IT IS A TP POINTER
+ PUSHJ P,MARK1 ; GO MARK IT
+ JRST GCRET
+\f
+; ROUTINE TO MARK BYTE AND STRING POINTERS
+
+BYTMK: PUSHJ P,BYTDOP ; GET TO DOPE WORD INTO A
+ HRLZ F,-1(A) ; SEE IF SPECIAL ATOM [SPNAME]
+ ANDI F,SATMSK ; GET SAT
+ CAIN F,SATOM
+ JRST ATMSET ; IT IS AN ATOM
+ IORM D,(A) ; MARK IT
+ JRST GCRET
+
+ATMSET: HLRZ B,(A) ; GET LENGTH
+ TRZ B,400000 ; TURN OFF POSSIBLE MARK BIT
+ MOVNI B,-2(B) ; GENERATE AOBJN POINTER
+ ADDI A,-1(B) ; GET BACK TO BEGINNING
+ HRLI A,(B) ; PUT IN LEFT HALF
+ MOVEI B,TATOM ; MARK AS AN ATOM
+ PUSHJ P,MARK ; GO MARK
+ JRST GCRET
+
+; MARK LOCID GOODIES
+
+LOCMK: HRRZ B,(C) ; CHECK FOR TIME
+ JUMPE B,LOCMK1 ; SKIP LEGAL CHECK FOR GLOBAL
+ HRRZ 0,2(A) ; GET OTHER TIME
+ CAIE 0,(B) ; SAME?
+ JRST GCRET
+ MOVEI B,TTP
+ PUSHJ P,MARK1
+ JRST GCRET
+LOCMK1: MOVEI B,TVEC ; GLOBAL
+ PUSHJ P,MARK1 ; MARK VALUE
+ JRST GCRET
+
+; MARK ASSOCIATION BLOCK
+
+ASMK: MOVEI C,(A) ; SAVE POINTER TO BEGINNING OF ASSOCATION
+ ADDI A,ASOLNT ; POINT TO DOPE WORD
+ HLRE B,1(A) ; GET SECOND D.W.
+ JUMPL B,GCRET ; MARKED SO LEAVE
+ IORM D,1(A) ; MARK ASSOCATION
+ PUSHJ P,MARK2 ; MARK ITEM
+ MOVEI C,INDIC(C)
+ PUSHJ P,MARK2
+ MOVEI C,VAL-INDIC(C)
+ PUSHJ P,MARK2
+ HRRZ A,NODPNT-VAL(C) ; GET NEXT IN CHAIN
+ JUMPN A,ASMK ; GO MARK IT
+ JRST GCRET
+\f
+; MARK OFFSETS
+
+OFFSMK: PUSH P,$TLIST
+ HLRZ 0,1(C) ; PICK UP LIST POINTER
+ PUSH P,0
+ MOVEI C,-1(P)
+ PUSHJ P,MARK2 ; MARK THE LIST
+ SUB P,[2,,2]
+ JRST GCRET ; AND RETURN
+\f
+; HERE TO MARK TEMPLATE DATA STRUCTURES
+
+TD.MK: HLRZ B,(A) ; GET REAL SPEC TYPE
+ ANDI B,37777 ; KILL SIGN BIT
+ MOVEI E,-NUMSAT-1(B) ; GET REL POINTER TO TABLE
+ HRLI E,(E)
+ ADD E,TD.AGC+1
+ HRRZS C,A ; FLUSH COUNT AND SAVE
+ SKIPL E ; WITHIN BOUNDS
+ FATAL BAD SAT IN AGC
+ SKIPL 1(A) ; SEE IF MARKED
+ JRST GCRET ; IF MARKED LEAVE
+ IORM D,1(A)
+
+ SKIPE (E)
+ JRST USRAGC
+ SUB E,TD.AGC+1 ; POINT TO LENGTH
+ ADD E,TD.LNT+1
+ XCT (E) ; RET # OF ELEMENTS IN B
+
+ HLRZ D,B ; GET POSSIBLE "BASIC LENGTH" FOR RESTS
+ PUSH P,[0] ; TEMP USED IF RESTS EXIST
+ PUSH P,D
+ MOVEI B,(B) ; ZAP TO ONLY LENGTH
+ PUSH P,C ; SAVE POINTER TO TEMPLATE STRUCTURE
+ PUSH P,B ; SAVE
+ SUB E,TD.LNT+1
+ PUSH P,E ; SAVE FOR FINDING OTHER TABLES
+ JUMPE D,TD.MR2 ; NO REPEATING SEQ
+ ADD E,TD.GET+1 ; COMP LNTH OF REPEATING SEQ
+ HLRE E,(E) ; E ==> - LNTH OF TEMPLATE
+ ADDI E,(D) ; E ==> -LENGTH OF REP SEQ
+ MOVNS E
+ HRLM E,-3(P) ; SAVE IT AND BASIC
+
+TD.MR2: SKIPG D,-1(P) ; ANY LEFT?
+ JRST TD.MR1
+
+ MOVE E,TD.GET+1
+ ADD E,(P)
+ MOVE E,(E) ; POINTER TO VECTOR IN E
+ MOVEM D,-4(P) ; SAVE ELMENT #
+ SKIPN B,-3(P) ; SKIP IF "RESTS" EXIST
+ SOJA D,TD.MR3
+
+ MOVEI 0,(B) ; BASIC LNT TO 0
+ SUBI 0,(D) ; SEE IF PAST BASIC
+ JUMPGE 0,.-3 ; JUMP IF O.K.
+ MOVSS B ; REP LNT TO RH, BASIC TO LH
+ IDIVI 0,(B) ; A==> -WHICH REPEATER
+ MOVNS A
+ ADD A,-3(P) ; PLUS BASIC
+ ADDI A,1 ; AND FUDGE
+ MOVEM A,-4(P) ; SAVE FOR PUTTER
+ ADDI E,-1(A) ; POINT
+ SOJA D,.+2
+
+TD.MR3: ADDI E,(D) ; POINT TO SLOT
+ XCT (E) ; GET THIS ELEMENT INTO A AND B
+ JFCL ; NO-OP FOR ANY CASE
+ EXCH A,B ; REARRANGE
+ HLRZS B
+ MOVSI D,400000 ; RESET FOR MARK
+ PUSHJ P,MARK ; AND MARK THIS GUY (RET FIXED POINTER IN A)
+ MOVE C,-2(P) ; RESTORE POINTER IN CASE MUNGED
+ JRST TD.MR2
+
+TD.MR1: SUB P,[5,,5]
+ JRST GCRET
+
+USRAGC: XCT (E) ; MARK THE TEMPLATE
+ JRST GCRET
+
+\f
+; ROUTINE TO MARK THE GC-READ TABLE. MARKS THE ATOMS AT THE DOPE WORDS
+; AND UPDATES PTR TO THE TABLE.
+
+GCRDMK: MOVEI C,(A) ; SAVE POINTER TO GCREAD TABLE
+ HLRE B,A ; GET TO DOPE WORD
+ SUB A,B
+ SKIPGE 1(A) ; SKIP IF NOT MARKED
+ JRST GCRET
+ IORM D,1(A) ; MARK THE CHOMPER!!!
+ SUBI A,2
+ MOVE B,ABOTN ; GET TOP OF ATOM TABLE
+ ADD B,0 ; GET BOTTOM OF ATOM TABLE
+GCRD1: CAMG A,B ; DON'T SKIP IF DONE
+ JRST GCRET
+ HLRZ C,(A) ; GET MARKING
+ TRZN C,400000 ; SKIP IF MARKED
+ JRST GCRD3
+ MOVEI E,(A)
+ SUBI A,(C) ; GO BACK ONE ATOM
+ PUSH P,B ; SAVE B
+ PUSH P,A ; SAVE POINTER
+ MOVEI C,-2(E) ; SET UP POINTER
+ MOVEI B,TATOM ; GO TO MARK
+ MOVE A,1(C)
+ PUSHJ P,MARK
+ POP P,A
+ POP P,B
+ JRST GCRD1
+GCRD3: SUBI A,(C) ; TO NEXT ATOM
+ JRST GCRD1
+
+
+; ROUTINE TO FIX UP CHANNELS
+
+CHNFLS: MOVEI 0,N.CHNS-1
+ MOVEI A,CHNL1 ; SET UP POINTER
+CHFL1: SKIPN B,1(A) ; GET POINTER TO CHANNEL
+ JRST CHFL2 ; NO CHANNEL LOOP TO NEXT
+ HLRE C,B ; POINT TO DOPE WORD OF CHANNEL
+ SUBI B,(C)
+ MOVEI F,TCHAN
+ HRLM F,(A) ; PUT TYPE BACK
+ SKIPL 1(B) ; SKIP IF MARKED
+ JRST FLSCH ; FLUSH THE CHANNEL
+ MOVEI F,1 ; MARK THE CHANNEL AS GOOD
+ HRRM F,(A) ; SMASH IT IN
+CHFL2: ADDI A,2
+ SOJG 0,CHFL1
+ POPJ P, ; EXIT
+FLSCH: HLLOS F,(A) ; -1 INTO SLOT INDICATES LOSSAGE
+ JRST CHFL2
+
+
+; THIS ROUTINE MARKS ALL THE CHANNELS
+
+CHFIX: MOVEI 0,N.CHNS-1
+ MOVEI A,CHNL1 ; SLOTS
+
+DHNFL2: SKIPN 1(A)
+ JRST DHNFL1
+ PUSH P,0 ; SAVE 0
+ PUSH P,A ; SAVE A
+ MOVEI C,(A)
+ MOVE A,1(A)
+ MOVEI B,TCHAN
+ PUSHJ P,MARK
+ POP P,A ; RESTORE A
+ POP P,0 ; RESTORE
+DHNFL1: ADDI A,2
+ SOJG 0,DHNFL2
+ POPJ P,
+
+
+\f
+; CONVERSION FROM FLOAT TO DECIMAL. X 100 AND SEND OUT WITH APPROPRIATELY PLACED DECIMAL
+; POINT.
+
+FIXSEN: PUSH P,B ; SAVE TIME
+ MOVEI B,[ASCIZ /TIME= /]
+ PUSHJ P,MSGTYP ; PRINT OUT MESSAGE
+ POP P,B ; RESTORE B
+ FMPRI B,(100.0) ; CONVERT TO FIX
+ MULI B,400
+ TSC B,B
+ ASH C,-163.(B)
+ MOVEI A,1 ; INITIALIZE COUNT OF CHARACTERS FOR PUTTING OUT TIME
+ PUSH P,C
+ IDIVI C,10. ; START COUNTING
+ JUMPLE C,.+2
+ AOJA A,.-2
+ POP P,C
+ CAIN A,1 ; SEE IF THERE IS ONLY ONE CHARACTER
+ JRST DOT1
+FIXOUT: IDIVI C,10. ; RECOVER NUMBER
+ HRLM D,(P)
+ SKIPE C
+ PUSHJ P,FIXOUT
+ PUSH P,A ; SAVE A
+ CAIN A,2 ; DECIMAL POINT HERE?
+ JRST DOT2
+FIX1: HLRZ A,(P)-1 ; GET NUMBER
+ ADDI A,60 ; MAKE IT A CHARACTER
+ PUSHJ P,IMTYO ; OUT IT GOES
+ POP P,A
+ SOJ A,
+ POPJ P,
+DOT1: MOVEI A,". ; OUTPUT DECIMAL POINT AND PADDING 0
+ PUSHJ P,IMTYO
+ MOVEI A,"0
+ PUSHJ P,IMTYO
+ JRST FIXOUT ; CONTINUE
+DOT2: MOVEI A,". ; OUTPUT DECIMAL POINT
+ PUSHJ P,IMTYO
+ JRST FIX1
+
+\f
+; ROUTINE TO SEEP THROUGH GC SPACE LOOKING FOR FREE SLOTS. PAIRS ARE PLACED ON THE
+; RCL LIST, VECTORS ON THE RCLV LIST.
+
+SWEEP: MOVE C,GCSTOP ; GET TOP OF GC SPACE
+ SUBI C,1 ; POINT TO FIRST OBJECT
+ SETZB E,F ; CURRENT SLOT AND CURRENT LENGTH
+LSWEEP: CAMG C,GCSBOT ; SKIP IF ABOVE GCSBOT
+ JRST ESWEEP ; DONE
+ HLRE A,-1(C) ; SEE IF LIST OR VECTOR
+ TRNE A,UBIT ; SKIP IF LIST
+ JRST VSWEEP ; IT IS A VECTOR
+ JUMPGE A,LSWP1 ; JUMP IF NOT MARKED
+ ANDCAM D,-1(C) ; TURN OFF MARK BIT
+ PUSHJ P,SWCONS ; CONS ON CURRENT OBJECT
+ SUBI C,2 ; SKIP OVER LIST
+ JRST LSWEEP
+LSWP1: ADDI F,2 ; ADD TO CURRENT OBJECT COUNT
+ JUMPN E,LSWP2 ; JUMP IF CURRENT OBJECT EXISTS
+ MOVEI E,(C) ; GET ADDRESS
+LSWP2: SUBI C,2
+ JRST LSWEEP
+
+VSWEEP: HLRE A,(C) ; GET LENGTH
+ JUMPGE A,VSWP1 ; SKIP IF MARKED
+ ANDCAM D,(C) ; TURN OFF MARK BIT
+ PUSHJ P,SWCONS
+ ANDI A,377777 ; GET LENGTH PART
+ SUBI C,(A) ; GO PAST VECTOR
+ JRST LSWEEP
+VSWP1: ADDI F,(A) ; ADD LENGTH
+ JUMPN E,VSWP2
+ MOVEI E,(C) ; GET NEW OBJECT LOCATION
+VSWP2: SUBI C,(A) ; GO BACK PAST VECTOR
+ JRST LSWEEP
+
+ESWEEP:
+SWCONS: JUMPE E,CPOPJ
+ ADDM F,TOTCNT ; HACK TOTCNT
+ CAMLE F,MAXLEN ; SEE IF NEW MAXIMUM
+ MOVEM F,MAXLEN
+ CAIGE F,2 ; MAKE SURE AT LEAST TWO LONG
+ FATAL SWEEP FAILURE
+ CAIN F,2
+ JRST LCONS
+ SETZM (E)
+ MOVEI 0,(E)
+ SUBI 0,-1(F)
+ SETZM @0
+ HRLS 0
+ ADDI 0,1
+ BLT 0,-2(E)
+ HRRZ 0,RCLV ; GET VECTOR RECYCLE
+ HRRM 0,(E) ; SMASH INTO LINKING SLOT
+ HRRZM E,RCLV ; NEW RECYCLE SLOT
+ HRLM F,(E)
+ MOVSI F,UBIT
+ MOVEM F,-1(E)
+ SETZB E,F
+ POPJ P, ; DONE
+LCONS: SETZM (E)
+ SUBI E,1
+ HRRZ 0,RCL ; GET RECYCLE LIST
+ HRRZM 0,(E) ; SMASH IN
+ HRRZM E,RCL
+ SETZB E,F
+ POPJ P,
+
+\f
+; THESE ARE THE MESSAGES INDICATING THE CAUSE OF THE GC
+
+MSGGCT: [ASCIZ /USER CALLED- /]
+ [ASCIZ /FREE STORAGE- /]
+ [ASCIZ /TP-STACK- /]
+ [ASCIZ /TOP-LEVEL LOCALS- /]
+ [ASCIZ /GLOBAL VALUES- /]
+ [ASCIZ /TYPES- /]
+ [ASCIZ /STATIONARY IMPURE STORAGE- /]
+ [ASCIZ /P-STACK /]
+ [ASCIZ /BOTH STACKS BLOWN- /]
+ [ASCIZ /PURE STORAGE- /]
+ [ASCIZ /GC-RCALL- /]
+
+; THESE ARE MESSAGES INDICATING WHO CAUSED THE GC
+
+GCPAT: SPBLOK 100
+EGCPAT: -1
+
+MSGGFT: [ASCIZ /GC-READ /]
+ [ASCIZ /BLOAT /]
+ [ASCIZ /GROW /]
+ [ASCIZ /LIST /]
+ [ASCIZ /VECTOR /]
+ [ASCIZ /SET /]
+ [ASCIZ /SETG /]
+ [ASCIZ /FREEZE /]
+ [ASCIZ /PURE-PAGE LOADER /]
+ [ASCIZ /GC /]
+ [ASCIZ /INTERRUPT-HANDLER /]
+ [ASCIZ /NEWTYPE /]
+ [ASCIZ /PURIFY /]
+
+CONSTANTS
+
+HERE
+
+CONSTANTS
+
+OFFSET 0
+
+ZZ==$.+1777
+
+.LOP ANDCM ZZ 1777
+
+ZZ1==.LVAL1
+
+LOC ZZ1
+
+OFFSET OFFS
+
+MRKPDL==.-1
+
+ENDGC:
+
+OFFSET 0
+
+ZZ2==ENDGC-AGCLD
+
+.LOP <ASH @> ZZ2 <,-10.>
+SLENGC==.LVAL1
+.LOP <ASH @> SLENGC <10.>
+RSLENG==.LVAL1
+LOC GCST
+
+.LPUR=$.
+
+END
--- /dev/null
+
+TITLE ATOMHACKER FOR MUDDLE
+
+RELOCATABLE
+
+.INSRT MUDDLE >
+.GLOBAL RLOOKU,CHMAK,OBLNT,ROOT,INTOBL,ERROBL,IFALSE,PVSTOR,SPSTOR
+.GLOBAL .BLOCK,IDVAL,NXTDCL,CHRWRD,CSTACK,CSTAK,ILOOKC,IGVAL,BYTDOP,HASHTB
+.GLOBAL ICONS,INCONS,IBLOCK,INSRTX,GCHACK,IMPURIFY,BSETG,TYPVEC,IGET,IPUT
+.GLOBAL CINSER,CIRMV,CLOOKU,CATOM,CIPNAM,MPOPJ,CSETG,CSPNAM,GPURFL,IMPURX
+.GLOBAL NOATMS
+
+LPVP==SP
+TYPNT==AB
+LNKBIT==200000
+
+; FUNCTION TO GENERATE AN EMPTY OBLIST
+
+MFUNCTION MOBLIST,SUBR
+
+ ENTRY
+ CAMGE AB,[-5,,0] ;CHECK NUMBER OF ARGS
+ JRST TMA
+ JUMPGE AB,MOBL2 ; NO ARGS
+ MOVE A,(AB)
+ MOVE B,1(AB)
+ MOVSI C,TATOM
+ MOVE D,IMQUOTE OBLIST
+ PUSHJ P,IGET ; CHECK IF IT EXISTS ALREADY
+ CAMN A,$TOBLS
+ JRST FINIS
+MOBL2:
+ MOVEI A,1
+ PUSHJ P,IBLOCK ;GET A UNIFORM VECTOR
+ MOVSI C,TLIST+.VECT. ;IT IS OF TYPE LIST
+ HLRE D,B ;-LENGTH TO D
+ SUBM B,D ;D POINTS TO DOPE WORD
+ MOVEM C,(D) ;CLOBBER TYPE IN
+ MOVSI A,TOBLS
+ JUMPGE AB,FINIS ; IF NO ARGS, DONE
+ GETYP A,(AB)
+ CAIE A,TATOM
+ JRST WTYP1
+ MOVSI A,TOBLS
+ PUSH TP,$TOBLS
+ PUSH TP,B
+ MOVSI C,TATOM
+ MOVE D,IMQUOTE OBLIST
+ PUSH TP,(AB)
+ PUSH TP,1(AB)
+ PUSHJ P,IPUT ; PUT THE NAME ON THE OBLIST
+ MOVE A,(AB)
+ MOVE B,1(AB)
+ MOVSI C,TATOM
+ MOVE D,IMQUOTE OBLIST
+ PUSH TP,(TB)
+ PUSH TP,1(TB)
+ PUSHJ P,IPUT ; PUT THE OBLIST ON THE NAME
+
+ POP TP,B
+ POP TP,A
+ JRST FINIS
+
+MFUNCTION GROOT,SUBR,ROOT
+ ENTRY 0
+ MOVE A,ROOT
+ MOVE B,ROOT+1
+ JRST FINIS
+
+MFUNCTION GINTS,SUBR,INTERRUPTS
+ ENTRY 0
+ MOVE A,INTOBL
+ MOVE B,INTOBL+1
+ JRST FINIS
+
+MFUNCTION GERRS,SUBR,ERRORS
+ ENTRY 0
+ MOVE A,ERROBL
+ MOVE B,ERROBL+1
+ JRST FINIS
+
+
+COBLQ: SKIPN B,2(B) ; SKIP IF EXISTS
+ JRST IFLS
+ MOVSI A,TOBLS
+
+ ANDI B,-1
+ CAMG B,VECBOT ; TVP IS IN FROZEN SPACE, NEVER OBLISTS
+ MOVE B,(B)
+ HRLI B,-1
+
+CPOPJ1: AOS (P)
+ POPJ P,
+
+IFLS: MOVEI B,0
+ MOVSI A,TFALSE
+ POPJ P,
+
+MFUNCTION OBLQ,SUBR,[OBLIST?]
+
+ ENTRY 1
+ GETYP A,(AB)
+ CAIE A,TATOM
+ JRST WTYP1
+ MOVE B,1(AB) ; GET ATOM
+ PUSHJ P,COBLQ
+ JFCL
+ JRST FINIS
+
+\f; FUNCTION TO FIND AN ATOM ON A GIVEN OBLIST WITH A GIVEN PNAME
+
+MFUNCTION LOOKUP,SUBR
+
+ ENTRY 2
+ PUSHJ P,ILOOKU ;CALL INTERNAL ROUTINE
+ JRST FINIS
+
+CLOOKU: SUBM M,(P)
+ PUSH TP,A
+ PUSH TP,B
+ MOVEI B,-1(TP)
+ PUSH TP,$TOBLS
+ PUSH TP,C
+ GETYP A,A
+ PUSHJ P,CSTAK
+ MOVE B,(TP)
+ MOVSI A,TOBLS ; THIS IS AN OBLIST
+ PUSHJ P,ILOOK
+ POP P,D
+ HRLI D,(D)
+ SUB P,D
+ SKIPE B
+ SOS (P)
+ SUB TP,[4,,4]
+ JRST MPOPJ
+
+ILOOKU: PUSHJ P,ARGCHK ;CHECK ARGS
+ PUSHJ P,CSTACK ;PUT CHARACTERS ON THE STACK
+
+CALLIT: MOVE B,3(AB) ;GET OBLIST
+ MOVSI A,TOBLS
+ILOOKC: PUSHJ P,ILOOK ;LOOK IT UP
+ POP P,D ;RESTORE COUNT
+ HRLI D,(D) ;TO BOTH SIDES
+ SUB P,D
+ POPJ P,
+
+;THIS ROUTINE CHECKS ARG TYPES
+
+ARGCHK: GETYP A,(AB) ;GET TYPES
+ GETYP C,2(AB)
+ CAIE A,TCHRS ;IS IT EITHER CHAR STRING
+ CAIN A,TCHSTR
+ CAIE C,TOBLS ;IS 2ND AN OBLIST
+ JRST WRONGT ;TYPES ARE WRONG
+ POPJ P,
+
+;THIS SUBROUTINE PUTS CHARACTERS ON THE STACK (P WILL BE CHANGED)
+
+
+CSTACK: MOVEI B,(AB)
+CSTAK: POP P,D ;RETURN ADDRESS TO D
+ CAIE A,TCHRS ;IMMEDIATE?
+ JRST NOTIMM ;NO, HAIR
+ MOVE A,1(B) ; GET CHAR
+ LSH A,29. ; POSITION
+ PUSH P,A ;ONTO P
+ PUSH P,[1] ;WITH NUMBER
+ JRST (D) ;GO CALL SEARCHER
+
+NOTIMM: MOVEI A,1 ; CLEAR CHAR COUNT
+ MOVE C,(B) ; GET COUNT OF CHARS
+ TRNN C,-1
+ JRST NULST ; FLUSH NULL STRING
+ MOVE PVP,PVSTOR+1
+ MOVEM C,BSTO(PVP)
+ ANDI C,-1
+ MOVE B,1(B) ;GET BYTE POINTER
+
+CLOOP1: PUSH P,[0] ; STORE CHARS ON STACK
+ MOVSI E,(<440700,,(P)>) ; SETUP BYTE POINTER
+CLOOP: SKIPL INTFLG ; SO CAN WIN WITH INTERRUPTS
+ JRST CLOOP2
+ MOVE PVP,PVSTOR+1
+ HRRM C,BSTO(PVP) ;SAVE STRING LENGTH
+ JSR LCKINT
+CLOOP2: ILDB 0,B ;GET A CHARACTER
+ IDPB 0,E ;STORE IT
+ SOJE C,CDONE ; ANY MORE?
+ TLNE E,760000 ; WORD FULL
+ JRST CLOOP ;NO CONTINUE
+ AOJA A,CLOOP1 ;AND CONTINUE
+
+CDONE:
+CDONE1: MOVE PVP,PVSTOR+1
+ SETZM BSTO(PVP)
+ PUSH P,A ;AND NUMBER OF WORDS
+ JRST (D) ;RETURN
+
+
+NULST: ERRUUO EQUOTE NULL-STRING
+\f; THIS FUNCTION LOOKS FOR ATOMS. CALLED BY PUSHJ P,ILOOK
+; A,B/ OBLIST POINTER (CAN BE LIST OF SAME)
+; -1(P)/ LENGTH IN WORDS OF CHARACTER BLOCK
+; CHAR STRING IS ON THE STACK
+; IF ATOM EXISTS RETURNS:
+; B/ THE ATOM
+; C/ THE BUCKET
+; 0/ THE PREVIOUS BUCKET
+;
+; IF NOT
+; B/ 0
+; 0/ PREV IF ONE WITH SAME PNAME, ELSE 0
+; C/ BUCKET
+
+ILOOK: PUSH TP,A
+ PUSH TP,B
+
+ MOVN A,-1(P) ;GET -LENGTH
+ HRLI A,-1(A) ;<-LENGTH-1>,,-LENGTH
+ PUSH TP,$TFIX ;SAVE
+ PUSH TP,A
+ ADDI A,-1(P) ;HAVE AOBJN POINTER TO CHARS
+ MOVE 0,[202622077324] ;HASH WORD
+ ROT 0,1
+ TSC 0,(A)
+ AOBJN A,.-2 ;XOR THEM ALL TOGETHER
+ HLRE A,HASHTB+1
+ MOVNS A
+ MOVMS 0 ; MAKE SURE + HASH CODE
+ IDIVI 0,(A) ;DIVIDE
+ HRLI A,(A) ;TO BOTH HALVES
+ ADD A,HASHTB+1
+
+ MOVE C,A
+ HRRZ A,(A) ; POINT TO FIRST ATOM
+ SETZB E,0 ; INDICATE NO ATOM
+
+ JUMPE A,NOTFND
+LOOK2: HLRZ E,1(A) ; PREPARE TO BUILD AOBJN
+ ANDI E,377777 ; SIGN MIGHT BE ON IF IN PURIFY ETC.
+ SUBI E,2
+ HRLS E
+ SUBB A,E
+
+ ADD A,[3,,3] ;POINT TO ATOMS PNAME
+ MOVE D,(TP) ;GET PSEUDO AOBJN POINTER TO CHARS
+ ADDI D,-1(P) ;NOW ITS A REAL AOBJN POINTER
+ JUMPE D,CHECK0 ;ONE IS EMPTY
+LOOK1:
+ MOVE SP,(D)
+ CAME SP,(A)
+
+ JRST NEXT1 ;THIS ONE DOESN'T MATCH
+ AOBJP D,CHECK ;ONE RAN OUT
+ AOBJN A,LOOK1 ;JUMP IF STILL MIGHT WIN
+
+NEXT1: HRRZ A,-1(TP) ; SEE IF WE'VE ALREADY SEEN THIS NAME
+ GETYP D,-3(TP) ; SEE IF LIST OF OBLISTS
+ CAIN D,TLIST
+ JUMPN A,CHECK3 ; DON'T LOOK FURTHER
+ JUMPN A,NOTFND
+NEXT:
+ MOVE 0,E
+ HLRZ A,2(E) ; NEXT ATOM
+ JUMPN A,LOOK2
+ HRRZ A,-1(TP)
+ JUMPN A,NEXT1
+
+ SETZB E,0
+
+NOTFND:
+ MOVEI B,0
+ MOVSI A,TFALSE
+CPOPJT:
+
+ SUB TP,[4,,4]
+ POPJ P,
+
+CHECK0: JUMPN A,NEXT1 ;JUMP IF NOT ALSO EMPTY
+ SKIPA
+CHECK: AOBJN A,NEXT1 ;JUMP IF NO MATCH
+
+CHECK5: HRRZ A,-1(TP) ; SEE IF FIRST SHOT AT THIS GUY?
+ SKIPN A
+ MOVE B,0 ; REMEMBER ATOM FOR FALL BACK
+ HLLOS -1(TP) ; INDICATE NAME MATCH HAS OCCURRED
+ HRRZ A,2(E) ; COMPUTE OBLIST POINTER
+ CAMGE A,VECBOT
+ MOVE A,(A)
+ HRROS A
+ GETYP D,-3(TP) ; SEE IF LIST OF OBLISTS OR
+ CAIE D,TOBLS
+ JRST CHECK1
+ CAME A,-2(TP) ; DO OBLISTS MATCH?
+ JRST NEXT
+
+CHECK2: MOVE B,E ; RETURN ATOM
+ HLRE A,B
+ SUBM B,A
+ MOVE A,(A)
+ TRNE A,LNKBIT
+ SKIPA A,$TLINK
+ MOVSI A,TATOM
+ JRST CPOPJT
+
+CHECK1: MOVE D,-2(TP) ; ANY LEFT?
+ CAMN A,1(D) ; MATCH
+ JRST CHECK2
+ JRST NEXT
+
+CHECK3: MOVE D,-2(TP)
+ HRRZ D,(D)
+ MOVEM D,-2(TP)
+ JUMPE D,NOTFND
+ JUMPE B,CHECK6
+ HLRZ E,2(B)
+CHECK7: HLRZ A,1(E)
+ ANDI A,377777 ; SIGN MIGHT BE ON IF IN PURIFY ETC.
+ SUBI A,2
+ HRLS A
+ SUBB E,A
+ JRST CHECK5
+
+CHECK6: HRRZ E,(C)
+ JRST CHECK7
+
+\f; FUNCTION TO INSERT AN ATOM ON AN OBLIST
+
+MFUNCTION INSERT,SUBR
+
+ ENTRY 2
+ GETYP A,2(AB)
+ CAIE A,TOBLS
+ JRST WTYP2
+ MOVE A,(AB)
+ MOVE B,1(AB)
+ MOVE C,3(AB)
+ PUSHJ P,IINSRT
+ JRST FINIS
+
+CINSER: SUBM M,(P)
+ PUSHJ P,IINSRT
+ JRST MPOPJ
+
+IINSRT: PUSH TP,A
+ PUSH TP,B
+ PUSH TP,$TOBLS
+ PUSH TP,C
+ GETYP A,A
+ CAIN A,TATOM
+ JRST INSRT0
+
+;INSERT WITH A GIVEN PNAME
+
+ CAIE A,TCHRS
+ CAIN A,TCHSTR
+ JRST .+2
+ JRST WTYP1
+
+ PUSH TP,$TFIX ;FLAG CALL
+ PUSH TP,[0]
+ MOVEI B,-5(TP)
+ PUSHJ P,CSTAK ;COPY ONTO STACK
+ MOVE B,-2(TP)
+ MOVSI A,TOBLS
+ PUSHJ P,ILOOK ;LOOK IT UP (BUCKET RETURNS IN C)
+ SETZM -4(TP)
+ SETZM -5(TP) ; KILL STRING POINTER TO KEEP FROM CONFUSING GC
+ JUMPN B,ALRDY ;EXISTS, LOSE
+ MOVE D,-2(TP) ; GET OBLIST BACK
+INSRT1: PUSH TP,$TATOM
+ PUSH TP,0 ; PREV ATOM
+ PUSH TP,$TUVEC ;SAVE BUCKET POINTER
+ PUSH TP,C
+ PUSH TP,$TOBLS
+ PUSH TP,D ; SAVE OBLIST
+INSRT3: PUSHJ P,IATOM ; MAKE AN ATOM
+ HLRE A,B ; FIND DOPE WORD
+ SUBM B,A
+ ANDI A,-1
+ SKIPN E,-4(TP) ; AFTER AN ATOM?
+ JRST INSRT7 ; NO, FIRST IN BUCKET
+ MOVEI 0,(E) ; CHECK IF PURE
+ CAIG 0,HIBOT
+ JRST INSRNP
+ PUSH TP,$TATOM ; SAVE NEW ATOM
+ PUSH TP,B
+ MOVE B,E
+ PUSHJ P,IMPURIF
+ MOVE B,(TP)
+ MOVE E,-6(TP)
+ SUB TP,[2,,2]
+ HLRE A,B ; FIND DOPE WORD
+ SUBM B,A
+ ANDI A,-1
+
+INSRNP: HLRZ 0,2(E) ; NEXT
+ HRLM A,2(E) ; SPLICE
+ HRLM 0,2(B)
+ JRST INSRT8
+
+INSRT7: MOVE E,-2(TP)
+ EXCH A,(E)
+ HRLM A,2(B) ; IN CASE OLD ONE
+
+INSRT8: MOVE E,(TP) ; GET OBLIST
+ HRRM E,2(B) ; STORE OBLIST
+ MOVE E,(E) ; POINT TO LIST OF ATOMS
+ PUSHJ P,LINKCK
+ PUSHJ P,ICONS
+ MOVE E,(TP)
+ HRRM B,(E) ;INTO NEW BUCKET
+ MOVSI A,TATOM
+ MOVE B,1(B) ;GET ATOM BACK
+ MOVE C,-6(TP) ;GET FLAG
+ SUB TP,[8,,8] ;POP STACK
+ JUMPN C,(C)
+ SUB TP,[4,,4]
+ POPJ P,
+
+;INSERT WITH GIVEN ATOM
+INSRT0: MOVE A,-2(TP) ;GOBBLE PNAME
+ SKIPE 2(A) ; SKIP IF NOT ON AN OBLIST
+ JRST ONOBL
+ ADD A,[3,,3]
+ HLRE C,A
+ MOVNS C
+ PUSH P,(A) ;FLUSH PNAME ONTO P STACK
+ AOBJN A,.-1
+ PUSH P,C
+ MOVE B,(TP) ; GET OBLIST FOR LOOKUP
+ MOVSI A,TOBLS
+ PUSHJ P,ILOOK ;ALREADY THERE?
+ JUMPN B,ALRDY
+ MOVE D,-2(TP)
+
+ HLRE A,-2(TP) ; FIND DOPE WORD
+ SUBM D,A ; TO A
+ JUMPE 0,INSRT9 ; NO CURRENT ATOM
+ MOVE E,0
+ MOVEI 0,(E)
+ CAIGE 0,HIBOT ; PURE?
+ JRST INSRPN
+ PUSH TP,$TATOM
+ PUSH TP,E
+ PUSH TP,$TATOM
+ PUSH TP,D
+ MOVE B,E
+ PUSHJ P,IMPURIF
+ MOVE D,(TP)
+ MOVE E,-2(TP)
+ SUB TP,[4,,4]
+ HLRE A,D
+ SUBM D,A
+
+
+INSRPN: HLRZ 0,2(E) ; POINT TO NEXT
+ HRLM A,2(E) ; CLOBBER NEW GUY IN
+ HRLM 0,2(D) ; FINISH SLPICE
+ JRST INSRT6
+
+INSRT9: ANDI A,-1
+ EXCH A,(C) ; INTO BUCKET
+ HRLM A,2(D)
+
+INSRT6: HRRZ E,(TP)
+ HRRZ E,(E)
+ MOVE B,D
+ PUSHJ P,LINKCK
+ PUSHJ P,ICONS
+ MOVE C,(TP) ;RESTORE OBLIST
+ HRRZM B,(C)
+ MOVE B,-2(TP) ; GET BACK ATOM
+ HRRM C,2(B) ; CLOBBER OBLIST IN
+ MOVSI A,TATOM
+ SUB TP,[4,,4]
+ POP P,C
+ HRLI C,(C)
+ SUB P,C
+ POPJ P,
+
+LINKCK: HRRZ C,FSAV(TB) ;CALLER'S NAME
+ MOVE D,B
+ CAIE C,LINK
+ SKIPA C,$TATOM ;LET US INSERT A LINK INSTEAD OF AN ATOM
+ SKIPA C,$TLINK ;GET REAL ATOM FOR CALL TO ICONS
+ POPJ P,
+ HLRE A,D
+ SUBM D,A
+ MOVEI B,LNKBIT
+ IORM B,(A)
+ POPJ P,
+
+
+ALRDY: ERRUUO EQUOTE ATOM-ALREADY-THERE
+
+ONOBL: ERRUUO EQUOTE ON-AN-OBLIST-ALREADY
+
+; INTERNAL INSERT CALL
+
+INSRTX: POP P,0 ; GET RET ADDR
+ PUSH TP,$TFIX
+ PUSH TP,0
+ PUSH TP,$TATOM
+ PUSH TP,[0]
+ PUSH TP,$TUVEC
+ PUSH TP,[0]
+ PUSH TP,$TOBLS
+ PUSH TP,B
+ MOVSI A,TOBLS
+ PUSHJ P,ILOOK
+ JUMPN B,INSRXT
+ MOVEM 0,-4(TP)
+ MOVEM C,-2(TP)
+ JRST INSRT3 ; INTO INSERT CODE
+
+INSRXT: PUSH P,-4(TP)
+ SUB TP,[6,,6]
+ POPJ P,
+ JRST IATM1
+\f
+; FUNCTION TO REMOVE AN ATOM FROM AN OBLIST
+
+MFUNCTION REMOVE,SUBR
+
+ ENTRY
+
+ JUMPGE AB,TFA
+ CAMGE AB,[-5,,]
+ JRST TMA
+ MOVEI C,0
+ CAML AB,[-3,,] ; SKIP IF OBLIST GIVEN
+ JRST .+5
+ GETYP 0,2(AB)
+ CAIE 0,TOBLS
+ JRST WTYP2
+ MOVE C,3(AB)
+ MOVE A,(AB)
+ MOVE B,1(AB)
+ PUSHJ P,IRMV
+ JRST FINIS
+
+CIRMV: SUBM M,(P)
+ PUSHJ P,IRMV
+ JRST MPOPJ
+
+IRMV: PUSH TP,A
+ PUSH TP,B
+ PUSH TP,$TOBLS
+ PUSH TP,C
+IRMV1: GETYP 0,A ; CHECK 1ST ARG
+ CAIN 0,TLINK
+ JRST .+3
+ CAIE 0,TATOM ; ATOM, TREAT ACCORDINGLY
+ JRST RMV1
+
+ HRRZ D,2(B) ; SKIP IF ON OBLIST AND GET SAME
+ JUMPE D,RMVDON
+ CAMG D,VECBOT ; SKIP IF REAL OBLIST
+ HRRZ D,(D) ; NO, REF, GET IT
+
+ JUMPGE C,GOTOBL
+ CAIE D,(C) ; BETTER BE THE SAME
+ JRST ONOTH
+
+GOTOBL: ADD B,[3,,3] ; POINT TO PNAME
+ HLRE A,B
+ MOVNS A
+ PUSH P,(B) ; PUSH PNAME
+ AOBJN B,.-1
+ PUSH P,A
+ HRROM D,(TP) ; SAVE OBLIST
+ JRST RMV3
+
+RMV1: JUMPGE C,TFA
+ CAIE 0,TCHRS
+ CAIN 0,TCHSTR
+ SKIPA A,0
+ JRST WTYP1
+ MOVEI B,-3(TP)
+ PUSHJ P,CSTAK
+RMV3: MOVE B,(TP)
+ MOVSI A,TOBLS
+ PUSHJ P,ILOOK
+ POP P,D
+ HRLI D,(D)
+ SUB P,D
+ JUMPE B,RMVDON
+
+ MOVEI A,(B)
+ CAIGE A,HIBOT ; SKIP IF PURE
+ JRST RMV2
+ PUSH TP,$TATOM
+ PUSH TP,0
+ PUSHJ P,IMPURIFY
+ MOVE 0,(TP)
+ SUB TP,[2,,2]
+ MOVE A,-3(TP)
+ MOVE B,-2(TP)
+ MOVE C,(TP)
+ JRST IRMV1
+
+RMV2: JUMPN 0,RMV9 ; JUMP IF FIRST NOT IN BUCKET
+ HLRZ 0,2(B) ; POINT TO NEXT
+ MOVEM 0,(C)
+ JRST RMV8
+
+RMV9: MOVE C,0 ; C IS PREV ATOM
+ HLRZ 0,2(B) ; NEXT
+ HRLM 0,2(C)
+
+RMV8: SETZM 2(B) ; CLOBBER OBLIST SLOT
+ MOVE C,(TP) ; GET OBLIST FOR SPLICE OUT
+ MOVEI 0,-1
+ HRRZ E,(C)
+
+RMV7: JUMPE E,RMVDON
+ CAMN B,1(E) ; SEARCH OBLIST
+ JRST RMV6
+ MOVE C,E
+ HRRZ E,(C)
+ SOJG 0,RMV7
+
+RMVDON: SUB TP,[4,,4]
+ MOVSI A,TATOM
+ POPJ P,
+
+RMV6: HRRZ E,(E)
+ HRRM E,(C) ; SMASH IN
+ JRST RMVDON
+
+\f
+;INTERNAL CALL FROM THE READER
+
+RLOOKU: PUSH TP,$TFIX ;PUSH A FLAG
+ POP P,C ;POP OFF RET ADR
+ PUSH TP,C ;AND USE AS A FLAG FOR INTERNAL
+ MOVE C,(P) ; CHANGE CHAR COUNT TO WORD
+ ADDI C,4
+ IDIVI C,5
+ MOVEM C,(P)
+ GETYP D,A
+
+ CAIN D,TOBLS ;IS IT ONE OBLIST?
+ JRST .+3
+ CAIE D,TLIST ;IS IT A LIST
+ JRST BADOBL
+
+ JUMPE B,BADLST
+ PUSH TP,$TUVEC ; SLOT FOR REMEBERIG
+ PUSH TP,[0]
+ PUSH TP,$TOBLS
+ PUSH TP,[0]
+ PUSH TP,A
+ PUSH TP,B
+ CAIE D,TLIST
+ JRST RLOOK1
+
+ PUSH TP,$TLIST
+ PUSH TP,B
+RLOOK2: GETYP A,(B) ;CHECK THIS IS AN OBLIST
+ CAIE A,TOBLS
+ JRST DEFALT
+
+ SKIPE -4(TP) ; SKIP IF DEFAULT NOT STORED
+ JRST RLOOK4
+ MOVE D,1(B) ; OBLIST
+ MOVEM D,-4(TP)
+RLOOK4: INTGO
+ HRRZ B,@(TP) ;CDR THE LIST
+ HRRZM B,(TP)
+ JUMPN B,RLOOK2
+ SUB TP,[2,,2]
+ JRST .+3
+
+RLOOK1: MOVE B,(TP)
+ MOVEM B,-2(TP)
+ MOVE A,-1(TP)
+ MOVE B,(TP)
+ PUSHJ P,ILOOK
+ JUMPN B,RLOOK3
+ SKIPN D,-2(TP) ; RESTORE FOR INSERT
+ JRST BADDEF ; NO DEFAULT, USER LOST ON SPECIFICATION
+ SUB TP,[6,,6] ; FLUSH CRAP
+ SKIPN NOATMS
+ JRST INSRT1
+ JRST INSRT1
+
+DEFFLG==1 ;SPECIAL FLAG USED TO INDICATE THAT A DEFAULT HAS ALREADY BEEN
+ ; SPECIFIED
+DEFALT: MOVE 0,1(B)
+ CAIN A,TATOM ;SPECIAL DEFAULT INDICATING ATOM ?
+ CAME 0,MQUOTE DEFAULT
+ JRST BADDEF ;NO, LOSE
+ MOVEI A,DEFFLG
+ XORB A,-11(TP) ;SET AND TEST FLAG
+ TRNN A,DEFFLG ; HAVE WE BEEN HERE BEFORE ?
+ JRST BADDEF ; YES, LOSE
+ SETZM -6(TP) ;ZERO OUT PREVIOUS DEFAULT
+ SETZM -4(TP)
+ JRST RLOOK4 ;CONTINUE
+
+
+INSRT2: JRST .+2 ;
+RLOOK3: SUB TP,[6,,6] ;POP OFF LOSSAGE
+ PUSHJ P,ILINK ;IF THIS IS A LINK FOLLOW IT
+ PUSH P,(TP) ;GET BACK RET ADR
+ SUB TP,[2,,2] ;POP TP
+ JRST IATM1 ;AND RETURN
+
+
+BADOBL: ERRUUO EQUOTE BAD-OBLIST-OR-LIST-THEREOF
+
+BADDEF: ERRUUO EQUOTE BAD-DEFAULT-OBLIST-SPECIFICATION
+
+ONOTH: ERRUUO EQUOTE ATOM-ON-DIFFERENT-OBLIST
+\f;SUBROUTINE TO MAKE AN ATOM
+
+IMFUNCTION ATOM,SUBR
+
+ ENTRY 1
+
+ MOVE A,(AB)
+ MOVE B,1(AB)
+ PUSHJ P,IATOMI
+ JRST FINIS
+
+CATOM: SUBM M,(P)
+ PUSHJ P,IATOMI
+ JRST MPOPJ
+
+IATOMI: GETYP 0,A ;CHECK ARG TYPE
+ CAIE 0,TCHRS
+ CAIN 0,TCHSTR
+ JRST .+2 ;JUMP IF WINNERS
+ JRST WTYP1
+
+ PUSH TP,A
+ PUSH TP,B
+ MOVEI B,-1(TP)
+ MOVE A,0
+ PUSHJ P,CSTAK ;COPY ONTO STACK
+ PUSHJ P,IATOM ;NOW MAKE THE ATOM
+ SUB TP,[2,,2]
+ POPJ P,
+
+;INTERNAL ATOM MAKER
+
+IATOM: MOVE A,-1(P) ;GET WORDS IN PNAME
+ ADDI A,3 ;FOR VALUE CELL
+ PUSHJ P,IBLOCK ; GET BLOCK
+ MOVSI C,<(GENERAL)>+SATOM ;FOR TYPE FIELD
+ MOVE D,-1(P) ;RE-GOBBLE LENGTH
+ ADDI D,3(B) ;POINT TO DOPE WORD
+ MOVEM C,(D)
+ SKIPG -1(P) ;EMPTY PNAME ?
+ JRST IATM0 ;YES, NO CHARACTERS TO MOVE
+ MOVE E,B ;COPY ATOM POINTER
+ ADD E,[3,,3] ;POINT TO PNAME AREA
+ MOVEI C,-1(P)
+ SUB C,-1(P) ;POINT TO STRING ON STACK
+ MOVE D,(C) ;GET SOME CHARS
+ MOVEM D,(E) ;AND COPY THEM
+ ADDI C,1
+ AOBJN E,.-3
+IATM0: MOVSI A,TATOM ;TYPE TO ATOM
+IATM1: POP P,D ;RETURN ADR
+ POP P,C
+ HRLI C,(C)
+ SUB P,C
+ JRST (D) ;RETURN
+
+\f;SUBROUTINE TO GET AN ATOM'S PNAME
+
+MFUNCTION PNAME,SUBR
+
+ ENTRY 1
+
+ GETYP A,(AB)
+ CAIE A,TATOM ;CHECK TYPE IS ATOM
+ JRST WTYP1
+ MOVE A,1(AB)
+ PUSHJ P,IPNAME
+ JRST FINIS
+
+CIPNAM: SUBM M,(P)
+ PUSHJ P,IPNAME
+ JRST MPOPJ
+
+IPNAME: ADD A,[3,,3]
+ HLRE B,A
+ MOVM B,B
+ PUSH P,(A) ;FLUSH PNAME ONTO P
+ AOBJN A,.-1
+ MOVE 0,(P) ; LAST WORD
+ PUSHJ P,PNMCNT
+ PUSH P,B
+ PUSHJ P,CHMAK ;MAKE A STRING
+ POPJ P,
+
+PNMCNT: IMULI B,5 ; CHARS TO B
+ MOVE A,0
+ SUBI A,1 ; FIND LAST 1
+ ANDCM 0,A ; 0 HAS 1ST 1
+ JFFO 0,.+1
+ HRREI 0,-34.(A) ; FIND HOW MUCH TO ADD
+ IDIVI 0,7
+ ADD B,0
+ POPJ P,
+
+MFUNCTION SPNAME,SUBR
+
+ ENTRY 1
+
+ GETYP 0,(AB)
+ CAIE 0,TATOM
+ JRST WTYP1
+
+ MOVE B,1(AB)
+ PUSHJ P,CSPNAM
+ JRST FINIS
+
+CSPNAM: ADD B,[3,,3]
+ MOVEI D,(B)
+ HLRE A,B
+ SUBM B,A
+ MOVE 0,-1(A)
+ HLRES B
+ MOVMS B
+ PUSHJ P,PNMCNT
+ MOVSI A,TCHSTR
+ HRRI A,(B)
+ MOVSI B,010700
+ HRRI B,-1(D)
+ POPJ P,
+
+\f; BLOCK STRUCTURE SUBROUTINES FOR MUDDLE
+
+IMFUNCTION BLK,SUBR,BLOCK
+
+ ENTRY 1
+
+ GETYP A,(AB) ;CHECK TYPE OF ARG
+ CAIE A,TOBLS ;IS IT AN OBLIST
+ CAIN A,TLIST ;OR A LIAT
+ JRST .+2
+ JRST WTYP1
+ MOVSI A,TATOM ;LOOK UP OBLIST
+ MOVE B,IMQUOTE OBLIST
+ PUSHJ P,IDVAL ;GET VALUE
+ PUSH TP,A
+ PUSH TP,B
+ MOVE PVP,PVSTOR+1
+ PUSH TP,.BLOCK(PVP) ;HACK THE LIST
+ PUSH TP,.BLOCK+1(PVP)
+ MCALL 2,CONS ;CONS THE LIST
+ MOVE PVP,PVSTOR+1
+ MOVEM A,.BLOCK(PVP) ;STORE IT BACK
+ MOVEM B,.BLOCK+1(PVP)
+ PUSH TP,$TATOM
+ PUSH TP,IMQUOTE OBLIST
+ PUSH TP,(AB)
+ PUSH TP,1(AB)
+ MCALL 2,SET ;SET OBLIST TO ARG
+ JRST FINIS
+
+MFUNCTION ENDBLOCK,SUBR
+
+ ENTRY 0
+
+ MOVE PVP,PVSTOR+1
+ SKIPN B,.BLOCK+1(PVP) ;IS THE LIST NIL?
+ JRST BLKERR ;YES, LOSE
+ HRRZ C,(B) ;CDR THE LIST
+ HRRZM C,.BLOCK+1(PVP)
+ PUSH TP,$TATOM ;NOW RESET OBLIST
+ PUSH TP,IMQUOTE OBLIST
+ HLLZ A,(B) ;PUSH THE TYPE OF THE CAR
+ PUSH TP,A
+ PUSH TP,1(B) ;AND VALUE OF CAR
+ MCALL 2,SET
+ JRST FINIS
+
+BLKERR: ERRUUO EQUOTE UNMATCHED
+
+BADLST: ERRUUO EQUOTE NIL-LIST-OF-OBLISTS
+\f;SUBROUTINE TO CREATE CHARACTER STRING GOODIE
+
+CHMAK: MOVE A,-1(P)
+ ADDI A,4
+ IDIVI A,5
+ PUSHJ P,IBLOCK
+ MOVEI C,-1(P) ;FIND START OF CHARS
+ HLRE E,B ; - LENGTH
+ ADD C,E ;C POINTS TO START
+ MOVE D,B ;COPY VECTOR RESULT
+ JUMPGE D,NULLST ;JUMP IF EMPTY
+ MOVE A,(C) ;GET ONE
+ MOVEM A,(D)
+ ADDI C,1 ;BUMP POINTER
+ AOBJN D,.-3 ;COPY
+NULLST: MOVSI C,TCHRS+.VECT. ;GET TYPE
+ MOVEM C,(D) ;CLOBBER IT IN
+ MOVE A,-1(P) ; # WORDS
+ HRLI A,TCHSTR
+ HRLI B,010700
+ MOVMM E,-1(P) ; SO IATM1 WORKS
+ SOJA B,IATM1 ;RETURN
+
+; SUBROUTINE TO READ FIVE CHARS FROM STRING.
+; TWO CALLS, ONE WITH A POINTING TO LIST ELEMENT,
+; THE OTHER WITH B POINTING TO PAIR. SKIPS IF WINNER, ELSE DOESNT
+
+NXTDCL: GETYP B,(A) ;CHECK TYPE
+ CAIE B,TDEFER ;LOSE IF NOT DEFERRED
+ POPJ P,
+
+ MOVE B,1(A) ;GET REAL BYTE POINTER
+CHRWRD: PUSH P,C
+ GETYP C,(B) ;CHECK IT IS CHSTR
+ CAIE C,TCHSTR
+ JRST CPOPJC ;NO, QUIT
+ PUSH P,D
+ PUSH P,E
+ PUSH P,0
+ MOVEI E,0 ;INITIALIZE DESTINATION
+ HRRZ C,(B) ; GET CHAR COUNT
+ JUMPE C,GOTDCL ; NULL, FINISHED
+ MOVE B,1(B) ;GET BYTE POINTER
+ MOVE D,[440700,,E] ;BYTE POINT TO E
+CHLOOP: ILDB 0,B ; GET A CHR
+ IDPB 0,D ;CLOBBER AWAY
+ SOJE C,GOTDCL ; JUMP IF DONE
+ TLNE D,760000 ; SKIP IF WORD FULL
+ JRST CHLOOP ; MORE THAN 5 CHARS
+ TRO E,1 ; TURN ON FLAG
+
+GOTDCL: MOVE B,E ;RESULT TO B
+ AOS -4(P) ;SKIP RETURN
+CPOPJ0: POP P,0
+ POP P,E
+ POP P,D
+CPOPJC: POP P,C
+ POPJ P,
+
+\f;ROUTINES TO DEFINE AND HANDLE LINKS
+
+MFUNCTION LINK,SUBR
+ ENTRY
+ CAML AB,[-6,,0] ;NO MORE THAN 3 ARGS
+ CAML AB,[-2,,0] ;NO LESS THAN 2 ARGS
+ JRST WNA
+ CAML AB,[-4,,0] ;ONLY TWO ARGS SUPPLIED ?
+ JRST GETOB ;YES, GET OBLIST FROM CURRENT PATH
+ MOVE A,2(AB)
+ MOVE B,3(AB)
+ MOVE C,5(AB)
+ JRST LINKIN
+GETOB: MOVSI A,TATOM
+ MOVE B,IMQUOTE OBLIST
+ PUSHJ P,IDVAL
+ CAMN A,$TOBLS
+ JRST LINKP
+ CAME A,$TLIST
+ JRST BADOBL
+ JUMPE B,BADLST
+ GETYPF A,(B)
+ MOVE B,(B)+1
+LINKP: MOVE C,B
+ MOVE A,2(AB)
+ MOVE B,3(AB)
+LINKIN: PUSHJ P,IINSRT
+ CAMN A,$TFALSE ;LINK NAME ALREADY USED ?
+ JRST ALRDY ;YES, LOSE
+ MOVE C,B
+ MOVE A,(AB)
+ MOVE B,1(AB)
+ PUSHJ P,CSETG
+ JRST FINIS
+
+
+ILINK: HLRE A,B
+ SUBM B,A ;FOUND A LINK ?
+ MOVE A,(A)
+ TRNE A,LNKBIT
+ JRST .+3
+ MOVSI A,TATOM
+ POPJ P, ;NO, FINISHED
+ MOVSI A,TATOM
+ PUSHJ P,IGVAL ;GET THE LINK'S DESTINATION
+ CAME A,$TUNBOUND ;WELL FORMED LINK ?
+ POPJ P, ;YES
+ ERRUUO EQUOTE BAD-LINK
+
+\f
+; THIS SUBROUTINE IMPURIFIES A PURE ATOM TO ALLOW MODIFICATION OF SYSTEM SUBRS
+
+IMPURIFY:
+ PUSH TP,$TATOM
+ PUSH TP,B
+ MOVE C,B
+ MOVEI 0,(C)
+ CAIGE 0,HIBOT
+ JRST RTNATM ; NOT PURE, RETURN
+ JRST IMPURX
+
+; ROUTINE PASSED TO GCHACK
+
+ATFIX: CAME D,(TP)
+ CAMN D,-2(TP)
+ JRST .+2
+ POPJ P,
+
+ ASH C,1
+ ADD C,TYPVEC+1 ; COMPUTE SAT
+ HRRZ C,(C)
+ ANDI C,SATMSK
+ CAIE C,SATOM
+CPOPJ: POPJ P,
+
+ SUB D,-2(TP)
+ ADD D,-4(TP)
+ SKIPE B
+ MOVEM D,1(B)
+ POPJ P,
+
+
+; SUBROUTINE TO FIND A BYTE STRINGS DOPE WORD
+; RECEIVES POINTER TO PAIR CONNTAINIGN CHSTR IN C, RETURNS DOPE WORD IN A
+
+BYTDOP: PUSH P,B ; SAVE SOME ACS
+ PUSH P,D
+ PUSH P,E
+ MOVE B,1(C) ; GET BYTE POINTER
+ LDB D,[360600,,B] ; POSITION TO D
+ LDB E,[300600,,B] ; AND BYTE SIZE
+ MOVEI A,(E) ; A COPY IN A
+ IDIVI D,(E) ; D=> # OF BYTES IN WORD 1
+ HRRZ E,(C) ; GET LENGTH
+ SUBM E,D ; # OF BYTES IN OTHER WORDS
+ JUMPL D,BYTDO1 ; NEAR DOPE WORD
+ MOVEI B,36. ; COMPUTE BYTES PER WORD
+ IDIVM B,A
+ ADDI D,-1(A) ; NOW COMPUTE WORDS
+ IDIVI D,(A) ; D/ # NO. OF WORDS PAST 1ST
+ ADD D,1(C) ; D POINTS TO DOPE WORD
+ MOVEI A,2(D)
+
+BYTDO2: POP P,E
+ POP P,D
+ POP P,B
+ POPJ P,
+BYTDO1: MOVEI A,2(B)
+ JRST BYTDO2
+
+; 1) IMPURIFY ITS OBLIST LIST
+
+IMPURX: HRRZ B,2(C) ; PICKUP OBLIST IF IT EXISTS
+ JUMPE B,IMPUR0 ; NOT ON ONE, IGNORE THIS CODE
+
+ HRRO E,(B)
+ PUSH TP,$TOBLS ; SAVE BUCKET
+ PUSH TP,E
+
+ MOVE B,(E) ; GET NEXT ONE
+IMPUR4: MOVEI 0,(B)
+ MOVE D,1(B)
+ CAME D,-2(TP)
+ JRST .+3
+ SKIPE GPURFL ; IF PURIFY SMASH THE OBLIST SLOT TO PROTECT
+ ; ATOM
+ HRRM D,1(B)
+ CAIGE 0,HIBOT ; SKIP IF PURE
+ JRST IMPUR3 ; FOUND IMPURE NESS, SKIP IT
+ HLLZ C,(B) ; SET UP ICONS CALL
+ HRRZ E,(B)
+IMPR1: PUSHJ P,ICONS ; CONS IT UP
+IMPR2: HRRZ E,(TP) ; RETRV PREV
+ HRRM B,(E) ; AND CLOBBER
+IMPUR3: MOVE D,1(B)
+ CAMN D,-2(TP) ; HAVE GOTTEN TO OUR SLOT?
+ JRST IMPPR3
+ MOVSI 0,TLIST
+ MOVEM 0,-1(TP) ; FIX TYPE
+ HRRZM B,(TP) ; STORE GOODIE
+ HRRZ B,(B) ; CDR IT
+ JUMPN B,IMPUR4 ; LOOP
+IMPPR3: SUB TP,[2,,2] ; FLUSH TP CRUFT
+
+; 1.5) IMPURIFY GLOBAL HASH BUCKET, A REAL PAIN
+
+IMPUR0: MOVE C,(TP) ; GET ATOM
+
+ HRRZ B,2(C)
+ MOVE B,(B)
+ ADD C,[3,,3] ; POINT TO PNAME
+ HLRE A,C ; GET LNTH IN WORDS OF PNAME
+ MOVNS A
+; PUSH P,[SETZ IMPUR2] ; FAKE OUT ILOOKC
+ XMOVEI 0,IMPUR2
+ PUSH P,0
+ PUSH P,(C) ; PUSH UP THE PNAME
+ AOBJN C,.-1
+ PUSH P,A ; NOW THE COUNT
+ MOVSI A,TOBLS
+ JRST ILOOKC ; GO FIND BUCKET
+
+IMPUR2: JUMPE B,IMPUR1
+ JUMPE 0,IMPUR1 ; YUP, DONE
+ HRRZ C,0
+ CAIG C,HIBOT ; SKIP IF PREV IS PURE
+ JRST IMPUR1
+
+ MOVE B,0
+ PUSH P,GPURFL ; PRERTEND OUT OF PURIFY
+ HLRE C,B
+ SUBM B,C
+ HRRZ C,(C) ; ARE WE ON PURIFY LIST
+ CAIG C,HIBOT ; IF SO, WE ARE STILL PURIFY
+ SETZM GPURFL
+ PUSHJ P,IMPURIF ; RECURSE
+ POP P,GPURFL
+ MOVE B,(TP) ; AND RETURN ORIGINAL
+
+; 2) GENERATE A DUPLICATE ATOM
+
+IMPUR1: SKIPE GPURFL ; SEE IF IN PURIFY
+ JRST IMPUR7
+ HLRE A,(TP) ; GET LNTH OF ATOM
+ MOVNS A
+ PUSH P,A
+ PUSHJ P,IBLOCK ; GET NEW BLOCK FOR ATOM
+ PUSH TP,$TATOM
+ PUSH TP,B
+ HRL B,-2(TP) ; SETUP BLT
+ POP P,A
+ ADDI A,(B) ; END OF BLT
+ BLT B,(A) ; CLOBBER NEW ATOM
+ MOVSI B,.VECT. ; TURN ON BIT FOR GCHACK
+ IORM B,(A)
+
+; 3) NOW COPY GLOBAL VALUE
+
+IMPUR7: MOVE B,(TP) ; ATOM BACK
+ GETYP 0,(B)
+ SKIPE A,1(B) ; NON-ZER POINTER?
+ CAIN 0,TUNBOU ; BOUND?
+ JRST IMPUR5 ; NO, DONT COPY GLOB VAL
+ PUSH TP,(A)
+ PUSH TP,1(A)
+ PUSH TP,$TATOM
+ PUSH TP,B
+ SETZM (B)
+ SETZM 1(B)
+ SKIPN GPURFL ; HERE IS SOME CODE NEEDED FOR PURIFY
+ JRST IMPUR8
+ PUSH P,LPVP
+ MOVE PVP,PVSTOR+1
+ PUSH P,AB ; GET AB BACK
+ MOVE AB,ABSTO+1(PVP)
+IMPUR8: PUSHJ P,BSETG ; SETG IT
+ SKIPN GPURFL
+ JRST .+3 ; RESTORE SP AND AB FOR PURIFY
+ POP P,TYPNT
+ POP P,SP
+ SUB TP,[2,,2] ; KILL ATOM SLOTS ON TP
+ POP TP,C ;POP OFF VALUE SLOTS
+ POP TP,A
+ MOVEM A,(B) ; FILL IN SLOTS ON GLOBAL STACK
+ MOVEM C,1(B)
+IMPUR5: SKIPE GPURFL ; FINISH OFF DIFFERENTLY FOR PURIFY
+ JRST IMPUR9
+
+ PUSH TP,$TFIX ;SAVE OLD ATOM WITH FUNNY TYPE TO AVOID LOSSAGE
+ PUSH TP,-3(TP)
+ PUSH TP,$TFIX ; OTHER KIND OF POINTER ALSO
+ HLRE 0,-1(TP)
+ HRRZ A,-1(TP)
+ SUB A,0
+ PUSH TP,A
+
+; 4) UPDATE ALL POINTERS TO THIS ATOM
+
+ MOVE A,[PUSHJ P,ATFIX] ; INS TO PASS TO GCHACK
+ MOVEI PVP,1 ; SAY MIGHT BE NON-ATOMS
+ PUSHJ P,GCHACK
+ SUB TP,[6,,6]
+
+RTNATM: POP TP,B
+ POP TP,A
+ POPJ P,
+
+IMPUR9: SUB TP,[2,,2]
+ POPJ P, ; RESTORE AND GO
+
+
+
+END
--- /dev/null
+
+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
projects / pdp10-muddle.git / commitdiff