Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
(FILECREATED "11-Apr-82 09:50:52" <DONC>LOSTLISTS..17 5890
changes to: Sweep HowMany Mark MarkAtoms
previous date: " 9-Apr-82 14:23:52" <DONC>LOSTLISTS..15)
(PRETTYCOMPRINT LOSTLISTSCOMS)
(RPAQQ LOSTLISTSCOMS ((FNS HowMany InitLostLists Mark MarkAtoms
MarkFreeCells ReInit Sweep)
(VARS SaveSizes)))
(DEFINEQ
(HowMany
[LAMBDA NIL (* edited:
"11-Apr-82 09:47")
(LIST (PROG ((Sum (ITIMES 1000 1000))
(Index (ITIMES 1000 1000))
Word) (* a non SMALLNUM)
(SETN Index (ARRAYSIZE BitTable))
(SETN Sum 0)
(until (EQP Index 0)
do (SETQ Word (ELT BitTable Index))
(for (I _ 0) to 31
unless (ZEROP (LOGAND 1 (RSH Word I)))
do (SETN Sum (ADD1 Sum)))
(SETN Index (SUB1 Index)))
(RETURN Sum))
(QUOTE of) |
(ITIMES 512 (LENGTH ListPages))
(QUOTE cells) |
(QUOTE marked])
(InitLostLists
(LAMBDA NIL
(SETQ PageTable (ARRAY 512 512))
(SETQ ListPages (for i to 512 when (LISTP (VAG (ITIMES i 512)))
collect i))
(for P in ListPages as (i _ 1) by 16 do (SETA PageTable P i))
(SETQ BitTable (ARRAY (ITIMES 16 (LENGTH ListPages))
(ITIMES 16 (LENGTH ListPages))))
(SETQ BadPage NIL)
NIL))
(Mark
[LAMBDA (L) (* edited:
"11-Apr-82 09:50")
(* do (COND ((LISTP L) (PROG NIL
(SETN Adr (LOC L)) (SETN WordAdr
(IPLUS (ELT PageTable (RSH Adr 9))
(LOGAND 15 (RSH Adr 5)))) (SETN Mask
(LSH 1 (LOGAND 31 Adr))) (RETURN
(COND ((EQP 0 (LOGAND Mask (SETN Data
(ELT BitTable WordAdr)))) (SETA BitTable WordAdr
(LOGOR Data Mask)) (ADD1 (IPLUS
(Mark (CAR L)) (Mark (CDR L)))))
(T 0))))) (T 0)) without GC -
RETURN UNBOXED)
(PROG ((BitTab BitTable)
(PageTab PageTable))
(RETURN (ASSEMBLE NIL
(SUB 2 , 2)
(CQ L)
(PUSHJ CP , (TREF RealMark))
(JRST (TREF RtnMark))
RealMark
(JSP 6 , SKLST)
(RET) (* stop on non LIST)
(MOVE 3 , 1) (* compute adr of
bittable word)
(ASH 3 , -11Q)
(LDV2 (QUOTE PageTab) |
SP 4)
(ADD 3 , 4)
(MOVE 3 , 1 (3)) (* AC3 is now index into
BitTab)
(JUMPE 3 , (TREF BadPage))
(LDV2 (QUOTE BitTab) |
SP 4)
(ADD 3 , 4)
(MOVE 4 , 1)
(ASH 4 , -5)
(ANDI 4 , 17Q)
(ADD 3 , 4) (* AC3 is now the word
adr -1)
(MOVE 4 , 1)
(ANDI 4 , 37Q)
(MOVEI 5 , 1)
(ASH 5 , 0 (4)) (* AC5 is now the mask)
(AND 5 , 1 (3)) (* nonzero means already
marked)
(SKIPE 5)
(RET)
(ADDI 2 , 1)
(MOVE 4 , 1) (* recompute mask)
(ANDI 4 , 37Q)
(MOVEI 5 , 1)
(ASH 5 , 0 (4))
(IORM 5 , 1 (3))
(PUSH CP , 1)
(CAR1)
(PUSHJ CP , (TREF RealMark))
(* mark the CAR)
(POP CP , 1)
(CDR1)
(JRST (TREF RealMark))
BadPage (* This page not in
PageTab)
(SETQ BadPage)
(RET)
RtnMark
(MOVE 1 , 2])
(MarkAtoms
[LAMBDA (Quiet) (* edited:
"11-Apr-82 09:47")
(PROG NIL |
(MAPATOMS |
(FUNCTION (LAMBDA (A) |
(PROG (Space OldSpace) |
(SETQ OldSpace (GETPROP A (QUOTE Space))) |
[SETQ Space |
(IPLUS (LOC (Mark (GETPROPLIST A))) |
(LOC (Mark (GETD A))) |
(LOC (Mark (AND (BOUNDP A) |
(EVAL A] |
(COND |
((EQP Space OldSpace) |
(RETURN)) |
((NULL OldSpace) |
(AND (ZEROP Space) |
(RETURN)) |
(SETQ Space (IPLUS Space 2)) |
(* for prop to be added)
(SETQ OldSpace 0))) |
(AND SaveSizes (PUTPROP A (QUOTE Space) |
Space) |
(NOT Quiet) |
(PRIN1 A) |
(PRIN1 " : ") |
(PRIN1 OldSpace) |
(PRIN1 " -> ") |
(PRINT Space])
(MarkFreeCells
(LAMBDA NIL
(PROG ((n (RECLAIM)))
(PRIN1 "Please do not interrupt for a little while")
(until (EQP n 0) do (SETN n (SUB1 n))
(Mark (CONS)))
(PRIN1 "...OK") (* this must be compiled so as not to
allocate numbers and thereby GC)
)))
(ReInit
(LAMBDA NIL
(COND
(BadPage (InitLostLists))
(T (PROG ((Index (ARRAYSIZE BitTable)))
(until (EQP Index 0) do (SETA BitTable Index 0)
(SETN Index (SUB1 Index))))))))
(Sweep
[LAMBDA NIL (* edited:
"11-Apr-82 09:20")
(PROG (Answer Cell) |
[for P in (REVERSE ListPages)
do
(PROG [(Loc (ITIMES 512 (ADD1 P]
(for I to 512
do
(SETN Loc (SUB1 Loc))
(OR [ZEROP (LOC (Mark (SETQ Cell (VAG Loc] |
(SETQ Answer
(CONS Cell (COND |
((EQ (CDR Cell) |
(LISTP (CAR Answer))) |
(CDR Answer)) |
(T Answer] |
|
(* Marking from higher adrs takes care of lists |
built with LIST and the EQ check tries to take care |
of those built with PUSH) |
|
|
(RETURN Answer])
)
(RPAQQ SaveSizes T)
(DECLARE: DONTCOPY
(FILEMAP (NIL (347 5843 (HowMany 359 . 1002) (InitLostLists 1006 . 1363)
(Mark 1367 . 3366) (MarkAtoms 3370 . 4500) (MarkFreeCells 4504 . 4825)
(ReInit 4829 . 5043) (Sweep 5047 . 5840)))))
STOP