--- /dev/null
+
+TITLE INTERRUPT HANDLER FOR MUDDLE
+
+RELOCATABLE
+
+;C. REEVE APRIL 1971
+
+.INSRT MUDDLE >
+
+PDLGRO==10000 ;AMOUNT TO GROW A PDL THAT LOSES
+NINT==72. ;MAXIMUM NUMBER OF INTERRUPTS POSSIBLE
+
+;SET UP LOCATION 42 TO POINT TO TSINT
+
+ZZZ==. ;SAVE CURRENT LOCATION
+
+LOC 42
+î JSR TSINT ;GO TO HANDLER
+
+LOC ZZZ
+
+; GLOBALS NEEDED BY INTERRUPT HANDLER
+
+.GLOBA GCFLG ;TELLS WHETHER OR NOT GARBAGE COLLECTOR IS RUNNING
+.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 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 PPGROW ;BLOWN PLANNER PDL
+.GLOBAL PLDGRO ;SEE ABOVE
+.GLOBAL CALER1,TMA,TFA
+.GLOBAL BUFRIN,CHANL0,SYSCHR ;CHANNEL GLOBALS
+.GLOBAL IFALSE,TPOVFL,PDLOSS
+.GLOBAL FLFLG ;-1 IFF INTERRUPT IN FAIL
+
+
+.GLOBAL INTINT ;CALLED BY INITIALIZER TO TAKE CARE OF INT PCS
+
+.GLOBAL MSGTYP,TYI,IFLUSH,OCLOS,ERRET ;SUBROUTINES USED
+;BEGINNING OF ACTUAL INTERRUPT HANDLER (MUST BE IMPURE)
+
+TSINT: 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
+
+;THE REST OF THIS CODE IS PURE
+
+TSINTP: SOSGE INTFLG ; SKIP IF ENABLED
+ SETOM INTFLG ;DONT GET LESS THAN -1
+
+ 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: TRZE A,20000 ;IS IT A MEMORY PROTECTION VIOLATION?
+ JRST IMPV ;YES, GO HANDLE IT
+
+ TRZE A,40 ;ILLEGAL OP CODE?
+ JRST ILOPR ;YES, GO HANDLE
+
+;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
+ MOVEM A,LCKINT ;STORE ELSEWHERE
+ MOVEI A,DOINTE ;CAUSE DISMISS TO HANDLER
+ HRRM A,TSINTR ;STORE IN INT RETURN
+ PUSH P,INTFLG ;SAVE INT FLAG
+ SETOM INTFLG ;AND DISABLE
+
+
+INTDON: MOVE A,TSAVA ;RESTORE ACS
+ MOVE B,TSAVB
+ .DISMISS TSINTR ;AND DISMISS THE INTERRUPT
+
+; HERE IF INTERRUPTED IN OTHER THAN GC
+
+DOINT: PUSH P,INTFLG
+DOINTE: PUSH P,LCKINT ;SAVE RETURN
+ SETZM INTFLG ;DISABLE
+ AOS -1(P) ;INCR SAVED FLAG
+
+;NOW SAVE WORKING ACS
+
+IRP A,,[0,A,B,C,D,E]
+ PUSH TP,A!STO(PVP)
+ SETZM A!STO(PVP) ;NOW ZERO TYPE
+ PUSH TP,A
+ TERMIN
+ PUSH P,INTNUM+1(TVP) ;PUSH CURRENT VALUE
+
+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:
+ POP P,INTNUM+1(TVP) ;RESTORE CURRENT
+IRP A,,[E,D,C,B,A,0]
+ POP TP,A
+ POP TP,A!STO(PVP)
+ TERMIN
+
+ POP P,LCKINT
+ POP P,INTFLG
+ JRST @LCKINT ;AND RETURN
+
+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:
+ CAIN B,21 ;PDL OVERFLOW?
+ JRST PDL2 ;YES, HACK APPROPRIATELY
+ MOVEM B,INTNUM+1(TVP) ;AND SAVE
+ LSH B,1 ;TIMES 2
+ ADD B,INTVEC+1(TVP) ;POINT TO LIST OF TASKS
+ SKIPN A,(B) ;ANY TASKS?
+ JRST DIRQ ;NO, PUNT
+
+ PUSH TP,$TLIST ;SAVE LIST
+ PUSH TP,A
+DOINTS: HLRZ C,(A) ;GET TYPE
+ CAIE C,TLIST ;LIST?
+ JRST IWTYP
+ HRRZ A,1(A)
+ JUMPE A,IWTYP ;LIST IS NIL, LOSE
+ HLRZ C,(A) ;CHECK FOR A PROCESS
+ CAIE C,TPVP
+ JRST IWTYP
+ HRRZ D,(A) ;POINT TO 2D PART OF PAIR
+ PUSH TP,(D) ;SETUP CALL TO EVAL
+ PUSH TP,1(D)
+ MOVE D,TB ;GET CURRENT FRAME POINTER
+ MOVE C,1(A) ;GET PROCESS WHO WANTS THIS INTERRUPT
+ CAME C,PVP ;SKIP IF CURRENT PROCESS
+ MOVE D,TBSTO+1(C) ;GET SAVED FRAME
+ HLRE A,C ;COMPUTE DOPE WORD POINTER
+ SUBI C,-1(A) ;HAVE POINTER
+ HRLI C,TFRAME ;BUILD A FRAME HACK
+ HLL D,OTBSAV(D) ;GET A WINNING TIME
+ PUSH TP,C ;AND PUSH IT
+ PUSH TP,D
+ MCALL 2,EVAL
+INTCDR: HRRZ A,@(TP) ;CDR THE LIST OF TASKS
+ JUMPE A,TPPOP
+ MOVEM A,(TP) ;SAVE THE CDR'D LIST
+ JRST DOINTS
+
+TPPOP: SUB TP,[2,,2] ;REMOVE LIST
+ JRST DIRQ
+
+IWTYP: PUSH TP,(A) ;SAVE TASK
+ PUSH TP,1(A)
+ PUSH TP,$TATOM
+ PUSH TP,MQUOTE BAD-INTERRUPT-HANDLER-TASK-IGNORED
+ MCALL 1,PRINT
+ MCALL 1,PRINT
+ JRST INTCDR
+
+PDL2: MOVEI B,PDLGRO_-6 ;GET GROWTH SPEC
+ SKIPE A,PGROW ;SKIP IF A P IS NOT GROWING
+ DPB B,[111100,,-1(A)] ;STORE GROWTH SPEC
+TRYTPG: SKIPE A,TPGROW ;IS TP BLOWN
+ DPB B,[111100,,-1(A)] ;YES, SET GROWTH SPEC
+ SKIPE A,PPGROW ;POINT TO BLOWN PP
+ DPB B,[111100,,-1(A)]
+ PUSHJ P,AGC ;COLLECT GARBAGE
+ SETZM PPGROW
+ SETZM PGROW
+ SETZM TPGROW
+ JRST INTDN1
+
+
+
+;SUBROUTINE TO SET AN INTERRUPT HANDLER
+
+MFUNCTION SETINT,SUBR
+ ENTRY 2
+
+ HLRZ A,(AB) ;FIRST IS FIXED
+ CAIE A,TFIX
+ JRST WTYP1
+ HLRZ A,2(AB)
+ CAIE A,TLIST
+ JRST WTYP2
+ SKIPGE B,1(AB) ;GET NUMBER
+ JRST NEGINT ;INTERRUPT NEGATIVE
+ HRRZ C,3(AB) ;PICKUP LIST
+ISENT1: PUSH P,CFINIS ;FALL INTO INTERNAL SET TO POP TO FINIS
+
+ISETNT: MOVEI D,(B) ;COPY
+ LSH B,1
+ HRLI B,(B) ;TO 2 HALVES
+ ADD B,INTVEC+1(TVP) ;POINT TO HANDLER
+ JUMPGE B,INTOBG ;OUT OF RANGE
+ HRRZ E,(B) ;AND OLD POINTER
+ HRRM E,(C) ;SPLICE
+ HRRM C,(B)
+ CAILE D,35. ;WHICH MASK?
+ JRST SETW2
+
+ SUBI D,36. ;FIND BIT POSITION
+ MOVSI A,400000
+ LSH A,(D) ;POSTITION
+ IORM A,MASK1
+ .SUSET [.SMASK,,MASK1]
+SETIN1: MOVE A,(AB)
+ MOVE B,1(AB)
+CFINIS: POPJ P,FINIS ;USED BY SETINT TO SETUP RETURN
+
+SETW2: SUBI D,71.
+ MOVSI A,400000
+ LSH A,(D)
+ IORM A,MASK2
+ .SUSET [.SMSK2,,MASK2]
+ JRST SETIN1
+WTYP1: PUSH TP,$TATOM
+ PUSH TP,MQUOTE FIRST-ARG-WRONG-TYPE
+ JRST CALER1
+
+
+WTYP2: PUSH TP,$TATOM
+ PUSH TP,MQUOTE SECOND-ARG-WRONG-TYPE
+ JRST CALER1
+
+NEGINT: PUSH TP,$TATOM
+ PUSH TP,MQUOTE NEGATIVE-INTERRUPT-NUMBER
+ JRST CALER1
+INTOBG: PUSH TP,$TATOM
+ PUSH TP,MQUOTE INT-NUMBER-TOO-LARGE
+ JRST CALER1
+
+BADCHN: PUSH TP,$TATOM
+ PUSH TP,MQUOTE CHANNEL-NOT-PHYSICAL
+ JRST CALER1
+
+LWTYP: PUSH TP,$TATOM
+ PUSH TP,MQUOTE LAST-ARG-WRONG-TYPE
+ JRST CALER1
+
+; SET A CHANNEL INTERRUPT
+
+MFUNCTION ONCHAR,SUBR
+
+ ENTRY
+
+ SKIPL B,AB ;COPY ARG POINTER
+ JRST TFA
+ ADD B,[2,,2] ;POINT TO EXPRESSION ARG
+ PUSHJ P,CHKRGS ;CHECK OUT THE ARGS AND MAKE THE LIST
+ GETYP A,(AB) ;CHECK FOR A CHANNEL
+ CAIE A,TCHAN
+ JRST WTYP1
+ MOVE C,1(AB) ;GET CHANNEL
+ SKIPN C,CHANNO(C) ;GET CHANNEL
+ JRST BADCHN
+ ADDI C,36. ;POINT INTO INT VECTOR
+ EXCH B,C
+ PUSHJ P,ISETNT ;SET THE INTERRUPT
+ MOVE A,2(AB) ;RETURN ARG
+ MOVE B,3(AB)
+ JRST FINIS
+
+; SET A CLOCK INTERRUPT
+
+MFUNCTION ONCLOCK,SUBR
+
+ ENTRY
+
+ MOVE B,AB
+ PUSHJ P,CHKRGS ;CHECK ARGS AND MAKE LIST
+ MOVE C,B ;COPY LIST POINTER
+ MOVEI B,13. ;CLOCK INT NUMBER
+ JRST ISENT1 ;SET UP THE INT
+
+CHKRGS: JUMPGE B,TFA
+ MOVE C,PVP ;GET CURRENT PROCESS
+ CAML B,[-2,,0] ;CHECK FOR PROCESS ARG
+ JRST GOTPVP
+ CAMGE B,[-4,,0] ;SKIP IF RIGHT NO. OF ARGS
+ JRST TMA ;TOO MANY
+ GETYP A,2(B) ;CHECK TYPE
+ CAIE A,TPVP
+ JRST LWTYP ;WRONG TYPE
+ MOVE C,3(B) ;GET PROCESS
+GOTPVP: PUSH TP,$TPVP
+ PUSH TP,C
+ PUSH TP,(B) ;PUSH EXPRESSION
+ PUSH TP,1(B)
+ MCALL 2,LIST ;MAKE THE LIST
+ PUSH TP,A
+ PUSH TP,B
+ MCALL 1,LIST ;MAKE A LIST OF A LIST
+ POPJ P,
+
+
+;ROUTINE TO GET CURRENT INT NUMBER
+
+MFUNCTION GETINT,SUBR
+
+ ENTRY 0
+ MOVSI A,TFIX
+ MOVE B,INTNUM+1(TVP)
+ JRST FINIS
+
+MFUNCTION INTCHAR,SUBR
+
+ ENTRY
+ PUSH P,CFINIS ;CAUSE RETURN TO FINIS
+INTCH1: MOVE B,INTNUM+1(TVP)
+ JUMPGE AB,GOTNUM
+ HLRZ A,(AB)
+ CAIE A,TFIX
+ JRST WTYP1
+ MOVE B,1(AB)
+
+GOTNUM: SUBI B,36. ;CONVERT TO CHANNEL
+ MOVEI C,(B) ;SAVE A COPY OF CHANNEL
+ .ITYIC B,
+ JRST NOCHRS
+
+ LSH B,29.
+ MOVSI A,TCHRS
+ MOVEI D,(C) ;COPY CHANNEL AGAIN
+ LSH D,1 ;TIMES 2
+ ADDI D,CHANL0+1(TVP) ;POINT TO INFO
+ HRRZ E,(D) ;POINT TO CHANNEL
+ HRRZ E,BUFRIN(E) ;POINT TO ADDL INFO
+ AOS SYSCHR(E)
+
+REINT: MOVEI E,1 ;PREPARE TO RENABLE
+ LSH E,(C)
+ IORM E,MASK2
+ .SUSET [.SMSK2,,MASK2]
+ POPJ P,
+
+
+NOCHRS: MOVEI B,0
+ MOVSI A,TFALSE
+ JRST REINT
+
+MFUNCTION QUITTER,SUBR
+
+ ENTRY 0
+
+REQT: PUSHJ P,INTCH1 ;CHECK FOR A CHAR
+ CAMN A,$TFALSE ;ANY LEFT?
+ JRST FINIS ;NO
+ CAME B,[7_29.] ;CNTL G?
+ JRST REQT
+ PUSH TP,$TCHAN ;QUIT HERE
+ PUSH TP,(D) ;PUSH CHANNEL
+ MCALL 1,RRRES
+ PUSH TP,$TATOM
+ PUSH TP,MQUOTE CONTROL-G
+ MCALL 1,ERROR
+ JRST FINIS
+
+MFUNCTION INTRCH,SUBR,INTCHAN
+
+ ENTRY 0
+
+ MOVE B,INTNUM+1(TVP) ;GET INT NUMBER
+ SUBI B,36.
+ JUMPL B,IFALSE ;NOT A CHANNEL
+ CAILE B,17
+ JRST IFALSE ;NOT A CHANNEL
+ LSH B,1 ;TIMES 2
+ ADDI B,CHANL0(TVP) ;GET POINTER TO CHANNEL
+ MOVE A,(B)
+ MOVE B,1(B)
+ JRST FINIS
+
+MFUNCTION GASCII,SUBR,ASCII
+ ENTRY 1
+
+ HLRZ A,(AB)
+ CAIE A,TCHRS
+ JRST TRYNUM
+
+ MOVE B,1(AB)
+ TDNN B,[3777,,-1]
+ LSH B,-29.
+ 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
+ LSH B,29.
+ MOVSI A,TCHRS
+ JRST FINIS
+
+TOOBIG: PUSH TP,$TATOM
+ PUSH TP,MQUOTE OUT-OF-RANGE
+ JRST CALER1
+
+;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 PDL OVERFLOW. ASK FOR A GC
+
+IPDLOV: SKIPE FLFLG ;DURING FAILURE,
+ JRST IMPCH ;LET FAIL HANDLE BLOWN PDLS
+ MOVEM A,TSINT ;SAVE INT WORD
+ MOVEI A,200000 ;GET BIT TO CLOBBER
+ IORM A,PIRQ ;LEAVE A MESSAGE FOR HIGHER LEVEL
+
+ SKIPE GCFLG ;IS GC RUNNING?
+ JRST GCPLOV ;YES, COMPLAIN GROSSLY
+
+ EXCH P,GCPDL ;GET A WINNING PDL
+ HRRZ B,TSINTR ;GET POINTER TO LOSING INSTRUCTION
+ LDB B,[270400,,-1(B)] ;GET AC FIELD
+ MOVEI A,(B) ;COPY IT
+ LSH A,1 ;TIMES 2
+ ADDI A,0STO(PVP) ;POINT TO THIS ACS CURRENT TYPE
+ 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
+
+ HLRZ C,A ;GET -LENGTH
+ SUBI A,-1(C) ;POINT TO A DOPE WORD
+ POP P,C ;RESTORE TYPE INTO C
+ CAIE C,TPDL ;IS IT A P STACK?
+ JRST TRYTP ;NO
+ SKIPE PGROW ;YES, ALREADY GROWN?
+ JRST PDLOSS ;YES, LOSE
+ ADDI A,PDLBUF ;POINT TO REAL DOPE WORD
+ HRRM A,PGROW ;STORE
+ JRST PNTRHK ;FIX UP THE PDL POINTER
+
+TRYTP: CAIE C,TTP ;TP STACK
+ JRST TRYPP
+ SKIPE TPGROW ;ALREADY GROWN?
+ JRST PDLOSS
+ ADDI A,PDLBUF ;POINT TO REAL DOPE WORD
+ HRRM A,TPGROW
+ JRST PNTRHK ;GO MUNG POINTER
+
+TRYPP: CAIE C,TPP ;PLANNER PDL?
+ JRST BADPDL
+ SKIPE PPGROW
+ JRST PDLOSS ;LOSER
+ ADDI A,PDLBUF
+ HRRM A,PPGROW
+
+
+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
+ MOVE A,TSINT ;RESTORE INT WORD
+
+ EXCH P,GCPDL ;GET BACK ORIG PDL
+ JRST IMPCH ;LOOK FOR MORE INTERRUPTS
+
+TPOVFL: SETOM INTFLG ;SIMULATE PDL OVFL
+ PUSH P,A
+ MOVEI A,200000 ;TURN ON THE BIT
+ IORM A,PIRQ
+ SUB TP,[PDLBUF,,0] ;HACK STACK POINTER
+ HLRE A,TP ;FIND DOPEW
+ SUBM TP,A ;POINT TO DOPE WORD
+ ADDI A,1
+ HRRZM A,TPGROW
+ POP P,A
+ POPJ P,
+
+
+;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) ;SET TO CLOBBER BIT
+ ANDCM A,0
+ LSH B,23. ;POSITION FOR A .STATUS
+ IOR B,[.STATUS B]
+ XCT B ;DO IT
+ ANDI B,77 ;ISOLATE DEVICE
+ CAILE B,2
+ JRST CHNA1
+ ANDCAM 0,MASK2 ;TURN OFF BIT
+ .SUSET [.SMSK2,,MASK2]
+ JRST CHNA1
+
+CHNA2: POP P,0
+ SKIPN GCFLG
+ EXCH P,GCPDL
+ JRST GCQUIT
+
+;HERE IF PDL OVERFLOW DURING GARBAGE COLLECTION
+
+BADPDL: SKIPA B,[[ASCIZ /NON-PDL OVERFLOW
+/]]
+GCPLOV: MOVEI B,[ASCIZ /PDL OVERFLOW DURING GARBAGE COLLECTION
+/]
+GFATER: MOVE P,GCPDL ;GET ORIGINAL PDL FOR TYPE OUT
+ JRST FATERR ;GO TO FATAL ERROR ROUTINE
+
+NOGROW: MOVEI B,[ASCIZ /PDL OVERFLOW ON NON-EXPANDABLE PDL
+/]
+ JRST GFATER
+
+PDLOSS: MOVEI B,[ASCIZ /PDL OVERFLOW BUFFER EXHAUSTED
+/]
+ JRST GFATER
+
+FATERR: PUSHJ P,MSGTYP ;TYPE THE MESSAGE
+ MOVEI B,[ASCIZ /FATAL ERROR, PLEASE DUMP SO THAT MUDDLE SYSTEM PROGRAMMERS
+MAY DEBUG./]
+ PUSHJ P,MSGTYP ;TYPE THE LOSER MESSAGE
+ PUSHJ P,OCLOS ;CLOSE THE TTY
+ .VALUE
+ JRST .-1
+
+
+;MEMORY PROTECTION INTERRUPT
+
+IMPV: MOVEI B,[ASCIZ /MPV -- /]
+
+IMPV1: PUSHJ P,MSGTYP ;TYPE
+ SKIPE GCFLG ;THESE ERRORS FATAL IN GARBAGE COLLECTOR
+ JRST GCERR
+
+ MOVE P,GCPDL ;MAKE SURE OF A WINNING PDL
+ERLP: MOVEI B,[ASCIZ /TYPE "S" TO GO TO SUPERIOR, "R" TO RESTART PROCESS./]
+ PUSHJ P,IFLUSH ;FLUSH AWAITING INPUT
+ PUSHJ P,MSGTYP
+
+ PUSHJ P,TYI ;READ THE CHARACTER
+
+ PUSHJ P,UPLO ;CONVERT TO UPPER CASE
+ CAIN A,"S
+ .VALUE
+
+ CAIE A,"R ;DOES HE WANT TO RESTART
+ JRST ERLP ;NO, TELL HIM AGAIN
+
+ MCALL 0,INTABR ;ABORT THE PROCESS
+
+INTABR: MOVEI A,ERRET ;REAALY GO TO ERRET
+ HRRM A,TSINTR
+ .DISMISS TSINTR
+
+
+GCERR: MOVEI B,[ASCIZ /IN GARBAGE COLLECTOR
+/]
+ JRST FATERR
+
+ILOPR: MOVEI B,[ASCIZ /ILLEGAL OPERATION -- /]
+ JRST IMPV1
+
+; SUBROUTINE TO CONVERT LOWER CASE LETTERS TO UPPER
+
+UPLO: CAIG A,172 ;GEATER THAN Z?
+ CAIG A,140 ;NO, LESS THAN A
+ POPJ P, ;YES, LOSE
+ SUBI A,40 ;MAKE UPPER CASE
+ POPJ P,
+
+;SUBROUTINE TO BE CALLED AT INITIALIZE TIME TO FUDGE INT PC
+
+INTINT: PUSHJ P,PCHACK ;FUDGE PC LOSSAGE
+ MOVE A,MASK1 ;SET MASKS
+ MOVE B,MASK2
+ .SETM2 A, ;SET BOTH MASKS
+ POPJ P,
+
+PCHACK: .SUSET [.SMASK,,[200000]] ;SET FOR ONLY PDL OVERFLOW
+ MOVE D,TSINT+2 ;SAVE CONTENTS OF ITERRUPT HANDLER
+ MOVEI A,FUNINT ;POINT TO DUMMY THEREOF
+ HRRM A,TSINT+2 ;AND STORE IT
+ HRROI A,0 ;MAKE A VERY SHORT PDL
+CHPUSH: PUSH A,0 ;PUSH SOMETHING AND OVERFLOW
+ .VALUE [ASCIZ /?/] ;SHOULD NEVER GET HERE
+
+FUNINT: HRRM D,TSINT+2 ;RESTORE STANDARD HANDLER
+ HRRZ D,TSINTR ;GET THE LOCATION STORED
+ SUBI D,CHPUSH ;FIND THE DIFFERENCE
+ MOVEM D,PCOFF ;AND SAVE
+ POP P,TSINTR ; POP INTO DISMISS WORD
+ .DISMISS TSINTR ;AND DISMISS
+
+
+
+INTLOS: .VALUE [ASCIZ /INT/]
+CHARCH: .VALUE [ASCIZ /CHAR?/]
+;RANDOM IMPURE CRUFT NEEDED
+
+TSAVA: 0
+TSAVB: 0
+PIRQ: 0 ;HOLDS REQUEST BITS FOR 1ST WORD
+PIRQ2: 0 ;SAME FOR WORD 2
+PCOFF: 0
+MASK1: 220040 ;FIRST MASK
+MASK2: 0 ;SECOND THEREOF
+
+
+END
+\f\f\ 3\f
\ No newline at end of file
projects / pdp10-muddle.git / blobdiff