mirror of
https://github.com/PDP-10/its.git
synced 2026-03-07 03:35:53 +00:00
a7399d0f9a
Looking at the backup dates for files in <mdl.int>, mdl106.exe is from 20th January 1981, whereas some of the source files are from a couple of years later. Revert to the last version prior to 20th January 1981 -- in every case, this was the earliest revision that was kept in <mdl.int>. This undoes the changes that we'd previously made to these files, many of which are no longer necessary now that we're using MIDAS 73.
866 lines
20 KiB
Plaintext
866 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,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,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
|
||
|
||
|
||
; 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
|
||
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
|
||
|
||
|
||
|
||
|
||
; 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
|