--- /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,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,ASMK]
+[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
+ 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
+ MOVE A,[TCHAN,,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)
+ HLLM A,(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
+
+
+
+\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
projects / pdp10-muddle.git / blobdiff