mirror of
https://github.com/PDP-10/its.git
synced 2026-03-25 01:47:08 +00:00
888 lines
20 KiB
Plaintext
888 lines
20 KiB
Plaintext
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
|
||
|
||
|
||
; 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
|
||
|
||
|
||
; 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
|
||
|
||
|
||
; 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
|
||
|
||
|
||
; 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
|
||
|
||
|
||
; 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
|
||
|
||
; 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
|
||
|
||
|
||
; 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
|
||
|
||
; 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
|
||
|
||
; 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
|
||
|
||
; 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
|
||
|
||
|
||
; 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,
|
||
|
||
|
||
|
||
; 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
|
||
|
||
|
||
; 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,
|
||
|
||
|
||
; 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
|