(FILECREATED "11-Sep-85 10:49:34" {ERIS}<LISPCORE>SOURCES>LLGC.;6 112260Q
changes to: (FNS \GCRECLAIMCELL)
previous date: " 8-Sep-85 13:28:44" {ERIS}<LISPCORE>SOURCES>LLGC.;5)
(* Copyright (c) 1981, 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT LLGCCOMS)
(RPAQQ LLGCCOMS ((E (RESETSAVE (RADIX 8)))
(COMS (* Reference counting)
(FNS \HTFIND \GC.HANDLEOVERFLOW \GCMAPTABLE))
(COMS (* Overflowed reference counts)
(FNS \GC.ENTER.BIGREFCNT \GC.MODIFY.BIGREFCNT \GC.LOOKUP.BIGREFCNT
\GC.BIGREFCNT.MISSING)
(GLOBALVARS \HTBIGCOUNT))
(COMS (* GC)
(FNS \GCMAPSCAN \GCMAPUNSCAN \GCRECLAIMCELL \OLDGCRECLAIMCELL \FREELISTCELL
\GCSCAN1 \GCSCAN2 \REFCNT))
(COMS (* User entries)
(FNS RECLAIM \DORECLAIM RECLAIMMIN GCMESS GCGAG GCTRP))
(COMS (* Turning off GC)
(FNS DISABLEGC \DISABLEGC1 \DOGCDISABLEDINTERRUPT)
(INITVARS (\GCDISABLED))
(GLOBALVARS \GCDISABLED))
(DECLARE: EVAL@COMPILE DONTCOPY
(EXPORT (MACROS ADDREF \ADDREF DELETEREF \DELREF SCANREF \STKREF UNSCANREF
CREATEREF \CREATEREF .INCREMENT.ALLOCATION.COUNT.
\GCDISABLED)
(RECORDS HTOVERFLOW GC HTCOLL))
(RECORDS GCOVFL MDSTYPEWORD GCPTR)
(CONSTANTS \HTBIGENTRYSIZE (\HT2CNT (IPLUS \HT1CNT \HT1CNT))
(\HTCNTSHIFT 10)
(\HTNOSTKBIT (LOGXOR 65535 \HTSTKBIT))
(\HTSTK1 (LOGOR \HTSTKBIT \HT1CNT))
(\HTSTKCNT (LOGOR \HTCNTMASK \HTSTKBIT))
\HTHIMASK \MAXHTCNT)
(CONSTANTS \HTCOLLTHRESHOLD \HTCOLLMAX)
(MACROS .GETLINK. .DELLINK. .FREELINK. .MODENTRY. .NEWENTRY. .GCRECLAIMLP.)
(GLOBALVARS \RECLAIMMIN \RECLAIM.COUNTDOWN \GCTIME1 \GCTIME2)
(CONSTANTS \ADDREFCASE \DELREFCASE \SCANREFCASE \UNSCANREFCASE))
[DECLARE: DONTEVAL@LOAD DOCOPY (INITVARS (\RECLAIMMIN 3000)
(\RECLAIM.COUNTDOWN 3000)
(GCMESS)
(\GCTIME1 (CREATECELL \FIXP))
(\GCTIME2 (CREATECELL \FIXP]
(FNS \GCERROR)
[COMS (* for MAKEINIT)
(FNS INITGC)
(DECLARE: DONTCOPY (ADDVARS (MKI.SUBFNS (ADDREF . PROGN)
(\ADDREF . PROGN)
(\DELREF . PROGN)
(CREATEREF . PROGN)
(\CREATEREF . PROGN)
(DELETEREF . PROGN)
(.INCREMENT.ALLOCATION.COUNT. . PROGN))
)
(ADDVARS (INEWCOMS (FNS INITGC)))
EVAL@COMPILE
(ADDVARS (DONTCOMPILEFNS INITGC]
(LOCALVARS . T)))
(* Reference counting)
(DEFINEQ
(\HTFIND
[LAMBDA (PTR CASE) (* bvm: " 8-Sep-85 13:28")
(* Modify reference count of the constants ptr according to case -
Returns PTR if result is 0 ref cnt, NIL otherwise -
CASE is one of (\ADDREFCASE \DELREFCASE \SCANREFCASE \UNSCANREFCASE))
(PROG ((PROBE PTR)
ENTRY LINK PREV)
(CHECK (NOT \INTERRUPTABLE))
[COND
((fetch (MDSTYPEWORD NOREFCNT) of (\ADDBASE \MDSTypeTable (LRSH (fetch (POINTER PAGE#)
of PTR)
1)))
(* PTR not to be ref counted.
Also true when GC disabled)
(RETURN))
(\GCDISABLED (* Shouldn't happen)
(RETURN (NILL]
(CHECK (EVENP (\LOLOC PTR)))
(SETQ ENTRY (\ADDBASE \HTMAIN (LRSH (\LOLOC PROBE)
1)))
[COND
((fetch (GC EMPTY) of ENTRY) (* create new entry)
(RETURN (.NEWENTRY. ENTRY PTR CASE]
(COND
((fetch (GC LINKP) of ENTRY) (* chase down the link)
(GO FINDLINK)))
[COND
((EQ (\HILOC PTR)
(fetch (GC HIBITS) of ENTRY)) (* matches pointer in main table)
(RETURN (COND
((.MODENTRY. ENTRY CASE PTR)
(replace (GC EMPTY) of ENTRY with T)
NIL)
((EQ (fetch (GC STKCNT) of ENTRY)
0)
PTR)
(T NIL]
(* * new collision)
NEWCOLLISION
(.GETLINK. LINK)
(.GETLINK. PREV)
(replace (GC NXTPTR) of PREV with (\LOLOC LINK))
(replace (GC CONTENTS) of PREV with (fetch (GC CONTENTS) of ENTRY))
(CHECK (EVENP (\LOLOC PREV)))
(replace (GC LINKPTR) of ENTRY with (\LOLOC PREV))
(replace (GC NXTPTR) of LINK with 0)
(replace (GC EMPTY) of LINK with T)
(RETURN (.NEWENTRY. LINK PTR CASE))
FINDLINK
(SETQ LINK (\ADDBASE \HTCOLL (fetch (GC LINKPTR) of ENTRY)))
LINKLOOP
(CHECK (SELECTC (fetch (GC HIBITS) of LINK)
((LIST \SmallPosHi \SmallNegHi \AtomHI)
NIL)
T))
[COND
((EQ (fetch (GC HIBITS) of LINK)
(\HILOC PTR)) (* found the link entry)
(RETURN (COND
((.MODENTRY. LINK CASE PTR) (* reference count went to 1, delete list entry)
(.DELLINK. LINK PREV ENTRY)
NIL)
((EQ 0 (fetch (GC STKCNT) of LINK))
PTR)
(T NIL]
(SETQ PREV LINK)
(COND
((NEQ (SETQ LINK (fetch (GC NXTPTR) of LINK))
0)
(SETQ LINK (\ADDBASE \HTCOLL LINK))
(GO LINKLOOP)))
(* * Didn't find an entry on this chain)
(.GETLINK. LINK)
(replace (GC NXTPTR) of LINK with 0)
(CHECK PREV)
(replace (GC NXTPTR) of PREV with (\LOLOC LINK))
(RETURN (.NEWENTRY. LINK PTR CASE])
(\GC.HANDLEOVERFLOW
[LAMBDA (ARG) (* lmm "13-OCT-82 16:03")
(* called as PUNT after microcode has put some things in
the overflow table)
(UNINTERRUPTABLY
[PROG ((CELL \HTOVERFLOW)
PTR)
LP (COND
((SETQ PTR (fetch (HTOVERFLOW PTR) of CELL))
(\HTFIND PTR (fetch (HTOVERFLOW CASE) of CELL))
(replace (HTOVERFLOW CLEAR) of CELL with T)
(SETQ CELL (\ADDBASE CELL WORDSPERCELL))
(GO LP)))
(PROGN (SETQ PTR (\GETDTD \LISTP))
(COND
((IGREATERP (SETQ CELL (fetch DTDCNT0 of PTR))
2000Q)
(.INCREMENT.ALLOCATION.COUNT. CELL)
(.BOXIPLUS. (fetch DTDCNTLOC of PTR)
(fetch DTDCNT0 of PTR))
(replace DTDCNT0 of PTR with 0]
ARG)])
(\GCMAPTABLE
[LAMBDA (ARG) (* lmm "13-FEB-83 13:40")
(DECLARE (GLOBALVARS \MaxTypeNumber))
(* called as PUNT after microcode has put some things in the overflow table)
(UNINTERRUPTABLY
[PROG ((CELL \HTOVERFLOW)
PTR)
LP (COND
((SETQ PTR (fetch (HTOVERFLOW PTR) of CELL))
(\HTFIND PTR (fetch (HTOVERFLOW CASE) of CELL))
(replace (HTOVERFLOW CLEAR) of CELL with T)
(SETQ CELL (\ADDBASE CELL WORDSPERCELL))
(GO LP]
[bind DTD N for I from 1 to \MaxTypeNumber when (NEQ (fetch DTDSIZE of (SETQ DTD
(\GETDTD I)))
0)
do [COND
((AND (NULL (fetch DTDFREE of DTD))
(OR (EQ CDRCODING 0)
(NEQ I \LISTP)))
(SELECTQ (\INDEXATOMPNAME (fetch DTDNAME of DTD))
((NIL **DEALLOC**))
(\GCTYPE I DTD]
(COND
((NEQ 0 (SETQ N (fetch DTDCNT0 of DTD)))
(.INCREMENT.ALLOCATION.COUNT. N)
(.BOXIPLUS. (fetch DTDCNTLOC of DTD)
(fetch DTDCNT0 of DTD))
(replace DTDCNT0 of DTD with 0]
ARG)])
)
(* Overflowed reference counts)
(DEFINEQ
(\GC.ENTER.BIGREFCNT
(LAMBDA (PTR ENTRY) (* JonL "14-Sep-84 00:45")
(* Called when the ref cnt of PTR is incremented to \MAXHTCNT. PTR is inserted in a simple table pointed to by
\HTBIGCOUNT until its ref cnt comes back down)
(PROG ((OVENTRY \HTBIGCOUNT)
TMP)
(COND
((ODDP (\LOLOC PTR)) (* This should be an error, but accomodate it for now)
(SETQ PTR (\ADDBASE PTR -1))))
LP (SELECTQ (SETQ TMP (fetch OVFLPTR of OVENTRY))
(T (* Deleted entry; reuse it))
(NIL (* End of table; add new entry at end)
(COND
((EVENP (\LOLOC (\ADDBASE OVENTRY \HTBIGENTRYSIZE))
WORDSPERPAGE) (* Need to allocate another page)
(\NEWPAGE (\ADDBASE OVENTRY \HTBIGENTRYSIZE)))))
(COND
((EQ TMP PTR)
(\MP.ERROR \MP.BIGREFCNTALREADYPRESENT "PTR already in overflow table" PTR
ENTRY)
(add (fetch OVFLCNTHI of OVENTRY)
1) (* Assure it lives forever)
(RETURN))
(T (SETQ OVENTRY (\ADDBASE OVENTRY \HTBIGENTRYSIZE))
(GO LP))))
(replace OVFLCNTLO of OVENTRY with \MAXHTCNT)
(replace OVFLCNTHI of OVENTRY with 0)
(replace OVFLPTR of OVENTRY with PTR)
(replace (GC CNT) of ENTRY with \MAXHTCNT))))
(\GC.MODIFY.BIGREFCNT
(LAMBDA (ENTRY CASE PTR) (* JonL "14-Sep-84 00:51")
(* Called from .MODENTRY. to do one of the 4 reference counting cases on PTR. ENTRY is the gc table entry whose
CNT field is \MAXHTCNT)
(PROG ((OVENTRY \HTBIGCOUNT)
TMP CNT)
(COND
((ODDP (\LOLOC PTR)) (* This should be an error, but accomodate it for now)
(SETQ PTR (\ADDBASE PTR -1))))
LP (COND
((NEQ (SETQ TMP (fetch OVFLPTR of OVENTRY))
PTR)
(COND
((NULL TMP)
(\GC.BIGREFCNT.MISSING PTR ENTRY)
(RETURN)))
(SETQ OVENTRY (\ADDBASE OVENTRY \HTBIGENTRYSIZE))
(GO LP)))
(SELECTC CASE
(\ADDREFCASE (replace OVFLCNTLO of OVENTRY
with (COND
((ILESSP (SETQ TMP (fetch OVFLCNTLO of OVENTRY))
MAX.SMALLP)
(ADD1 TMP))
(T (add (fetch OVFLCNTHI of OVENTRY)
1)
0))))
(\DELREFCASE (replace OVFLCNTLO of OVENTRY
with (COND
((IGEQ (SETQ TMP (SUB1 (fetch OVFLCNTLO of OVENTRY)))
\MAXHTCNT)
TMP)
((EQ 0 (fetch OVFLCNTHI of OVENTRY))
(* Ref cnt has fallen below max, bring it out)
(replace (GC CNT) of ENTRY with TMP)
(replace OVFLPTR of OVENTRY with T)
(* mark deleted)
TMP)
((ILESSP TMP 0)
(add (fetch OVFLCNTHI of OVENTRY)
-1)
MAX.SMALLP)
(T TMP))))
(\SCANREFCASE (replace (GC STKBIT) of ENTRY with T))
(\UNSCANREFCASE (replace (GC STKBIT) of ENTRY with NIL))
NIL) (* Value is NIL to tell .MODENTRY.
that cnt ~= 1)
(RETURN NIL))))
(\GC.LOOKUP.BIGREFCNT
(LAMBDA (PTR ENTRY) (* JonL "14-Sep-84 00:50")
(* Returns ref cnt of PTR from the big table. ENTRY is the main or collision hashtable entry, but is used only for
informational purposes to RAID)
(PROG ((OVENTRY \HTBIGCOUNT)
TMP)
(COND
((ODDP (\LOLOC PTR)) (* This should be an error, but accomodate it for now)
(SETQ PTR (\ADDBASE PTR -1))))
LP (COND
((NEQ PTR (SETQ TMP (fetch OVFLPTR of OVENTRY)))
(COND
((NULL TMP)
(\GC.BIGREFCNT.MISSING PTR ENTRY)
(RETURN \MAXHTCNT)))
(SETQ OVENTRY (\ADDBASE OVENTRY \HTBIGENTRYSIZE))
(GO LP)))
(RETURN (\MAKENUMBER (fetch OVFLCNTHI of OVENTRY)
(fetch OVFLCNTLO of OVENTRY))))))
(\GC.BIGREFCNT.MISSING
(LAMBDA (PTR ENTRY) (* JonL "14-Sep-84 00:46")
(\MP.ERROR \MP.BIGREFCNTMISSING "PTR refcnt previously overflowed, but not found in table." PTR
ENTRY)))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \HTBIGCOUNT)
)
(* GC)
(DEFINEQ
(\GCMAPSCAN
[LAMBDA NIL (* bvm: " 3-Sep-85 23:00")
(* scan gc tables looking for reclaimable items)
(PROG (ENTRY PTR (PROBE \HTMAINSIZE)
LINK PREV)
NEXTENTRY
[SETQ ENTRY (\ADDBASE \HTMAIN (SETQ PROBE (OR (\GCSCAN1 PROBE)
(RETURN]
RETRY
(COND
((fetch (GC LINKP) of ENTRY) (* trace down collision table)
(SETQ PREV NIL)
(SETQ LINK (\ADDBASE \HTCOLL (fetch (GC LINKPTR) of ENTRY)))
[PROG NIL
LINKLOOP
(CHECK (EVENP (\LOLOC LINK))
(SELECTC (fetch (GC HIBITS) of LINK)
((LIST \AtomHI \SmallPosHi \SmallNegHi)
NIL)
T)
(NOT (fetch (GC LINKP) of LINK)))
[COND
((EQ (fetch (GC STKCNT) of LINK)
0)
(SETQ PTR (\VAG2 (fetch (GC HIBITS) of LINK)
(LLSH PROBE 1)))
(.DELLINK. LINK PREV ENTRY)
(.GCRECLAIMLP. PTR)
(COND
((fetch (GC EMPTY) of ENTRY)
(GO NEXTENTRY))
(T (GO RETRY]
(SETQ PREV LINK)
(COND
((NEQ 0 (SETQ LINK (fetch (GC NXTPTR) of LINK)))
(SETQ LINK (\ADDBASE \HTCOLL LINK))
(GO LINKLOOP]
(GO NEXTENTRY)))
(CHECK (SELECTC (fetch (GC HIBITS) of ENTRY)
((LIST \AtomHI \SmallPosHi \SmallNegHi)
NIL)
T))
(COND
((EQ 0 (fetch (GC STKCNT) of ENTRY)) (* REF CNT WENT TO 0 -- ERASE ENTRY IN MAIN TABLE, AND
RECLAIM POINTER)
(SETQ PTR (\VAG2 (fetch (GC HIBITS) of ENTRY)
(LLSH PROBE 1)))
(replace (GC EMPTY) of ENTRY with T)
(.GCRECLAIMLP. PTR)))
(GO NEXTENTRY])
(\GCMAPUNSCAN
[LAMBDA NIL (* bvm: " 3-Sep-85 22:54")
(* scan gc tables turning of stack bits)
(PROG ((PROBE \HTMAINSIZE)
ENTRY)
LP [SETQ ENTRY (\ADDBASE \HTMAIN (SETQ PROBE (OR (\GCSCAN2 PROBE)
(RETURN]
RETRY
[COND
[(fetch (GC LINKP) of ENTRY) (* LINK -- trace down collision table)
(PROG ((LNK (\ADDBASE \HTCOLL (fetch (GC LINKPTR) of ENTRY)))
PREV)
SCNLP
[COND
((fetch (GC STKBIT) of LNK)
(COND
((EQ (fetch (GC CNT) of LNK)
1) (* Ref count 1 with no stack bit => no entry)
(.DELLINK. LNK PREV ENTRY) (* .DELLINK. smashes the chain, so don't try to follow
it further)
(GO RETRY))
(T (replace (GC STKBIT) of LNK with NIL]
(COND
([NEQ 0 (SETQ LNK (fetch (GC NXTPTR) of (SETQ PREV LNK]
(SETQ LNK (\ADDBASE \HTCOLL LNK))
(GO SCNLP]
((fetch (GC STKBIT) of ENTRY)
(COND
((EQ (fetch (GC CNT) of ENTRY)
1)
(replace (GC EMPTY) of ENTRY with T))
(T (replace (GC STKBIT) of ENTRY with NIL]
(GO LP])
(\GCRECLAIMCELL
[LAMBDA (CELL) (* bvm: "11-Sep-85 10:45")
(* * Called with CELL a pointer being freed. It has just had its refcount bumped from zero to one.
We need to decrement the refcnt of anything it points at, and if possible reclaim any of those that are now at zero
count.)
(* * This is the new \GCRECLAIMCELL -- old version lives on as \OLDGCRECLAIMCELL if anyone wants the old behavior
(uses microcode but doesn't reclaim bushy structures))
(PROG ((PTR CELL)
DTD VAL TYPE INDEX DONEXT PTRFIELDS CODE)
LP (CHECK (EQ 1 (\REFCNT PTR)))
(SELECTC (SETQ TYPE (NTYPX PTR))
(\LISTP (COND
((EQ CDRCODING 0)
(GO NORMAL)))
[COND
((EQ (SETQ CODE (fetch CDRCODE of PTR))
\CDR.INDIRECT) (* Dispose of indirection first)
(SETQ PTR (PROG1 (fetch CARFIELD of PTR)
(\FREELISTCELL PTR)))
(SETQ CODE (fetch CDRCODE of PTR))
(CHECK (NEQ CODE \CDR.INDIRECT)
(ILEQ CODE \CDR.MAXINDIRECT]
[COND
(INDEX (* We've already decremented the CAR, start with the
CDR)
(SETQ INDEX NIL))
(T (COND
((SETQ VAL (\DELREF (CAR PTR)))
(* CAR went to zero, start working on it)
(replace (GCPTR FULLLINKFIELD) of PTR with DONEXT)
(replace CDRCODE of PTR with CODE)
(* Keep CDR Code, which was smashed by FULLLINKFIELD)
(SETQ DONEXT PTR)
(GO DOVAL]
(SETQ VAL (\DELREF (CDR PTR)))
[COND
((ILEQ CODE \CDR.MAXINDIRECT) (* indirect)
(* local indirect)
(\FREELISTCELL (\ADDBASE (fetch PAGEBASE of PTR)
(LLSH (IDIFFERENCE CODE \CDR.INDIRECT)
1]
(\FREELISTCELL PTR)
(GO DOVAL))
(\STACKP (\DECUSECOUNT (fetch (STACKP EDFXP) of PTR)))
(0 (* Out of MDS, check for arrayblock)
(COND
((type? ARRAYBLOCK PTR)
(\RECLAIMARRAYBLOCK PTR)))
(GO TRYNEXT))
[\VMEMPAGEP
(* VMEMPAGE used as a PMAP buffer so tell PMAP a buffer is no longer referenced. If PMAP doesn't want PTR put on the
free list, it will return non-NIL.)
(* Should do this with finalization)
(COND
((RELEASINGVMEMPAGE PTR)
(GO TRYNEXT]
NIL)
NORMAL
(SETQ DTD (\GETDTD TYPE))
(SETQ PTRFIELDS (fetch DTDPTRS of DTD))
(COND
(INDEX (* We have half reclaimed PTR already.
INDEX is the cell offset of the first field we haven't
decremented yet)
(SETQ INDEX (UNFOLD INDEX WORDSPERCELL))
(do (SETQ PTRFIELDS (CDR PTRFIELDS))
(CHECK PTRFIELDS) repeatuntil (EQ (CAR PTRFIELDS)
INDEX))
(SETQ INDEX NIL)))
[while PTRFIELDS do (COND
([SETQ VAL (\DELREF (\GETBASEPTR PTR (pop PTRFIELDS]
(* Suspend work on PTR, go chase VAL)
(COND
(PTRFIELDS (* There is more to do)
(replace (GCPTR FULLLINKFIELD) of PTR with DONEXT)
(CHECK (EVENP (CAR PTRFIELDS))
(ILESSP (CAR PTRFIELDS)
(UNFOLD (LLSH 1 BITSPERBYTE)
WORDSPERCELL)))
(replace (GCPTR OFFSETCODE) of PTR
with (FOLDLO (CAR PTRFIELDS)
WORDSPERCELL))
(* This assumes that no datatype is longer than 2↑8
cells long)
(SETQ DONEXT PTR)
(GO DOVAL))
(T (* That was the last pointer field anyway, so finish
up)
(GO ADDTOFREELIST]
ADDTOFREELIST
(\PUTBASEPTR PTR 0 (fetch DTDFREE of DTD))
(replace DTDFREE of DTD with PTR)
DOVAL
(COND
(VAL (\ADDREF (SETQ PTR VAL))
(SETQ VAL NIL)
(GO LP)))
TRYNEXT
(COND
(DONEXT (SETQ PTR DONEXT)
(SETQ DONEXT (fetch (GCPTR LINKFIELD) of PTR))
(SETQ INDEX (fetch (GCPTR OFFSETCODE) of PTR))
(GO LP)))
(RETURN NIL])
(\OLDGCRECLAIMCELL
[LAMBDA (PTR) (* lmm "10-Apr-84 15:23")
(PROG (DTD I VAL N)
(CHECK (EQ 1 (\REFCNT PTR)))
LP (SELECTC (SETQ N (NTYPX PTR))
(\LISTP (COND
((EQ CDRCODING 0)
(GO NORMAL)))
(SETQ VAL (\DELREF (CAR PTR)))
(SETQ VAL (OR (\DELREF (CDR PTR))
VAL))
[COND
((ILEQ (fetch CDRCODE of PTR)
\CDR.MAXINDIRECT) (* indirect)
[COND
((EQ (fetch CDRCODE of PTR)
\CDR.INDIRECT)
(SETQ PTR (PROG1 (fetch CARFIELD of PTR)
(\FREELISTCELL PTR)))
(CHECK (NEQ (fetch CDRCODE of PTR)
\CDR.INDIRECT)
(ILEQ (fetch CDRCODE of PTR)
\CDR.MAXINDIRECT]
(* local indirect)
(\FREELISTCELL (\ADDBASE (fetch PAGEBASE of PTR)
(LLSH (IDIFFERENCE (fetch CDRCODE
of PTR)
\CDR.INDIRECT)
1]
(\FREELISTCELL PTR)
(RETURN VAL))
(\STACKP (\DECUSECOUNT (fetch (STACKP EDFXP) of PTR)))
(0 (* Out of MDS, check for arrayblock)
(COND
((type? ARRAYBLOCK PTR)
(\RECLAIMARRAYBLOCK PTR)))
(RETURN))
(\VMEMPAGEP
(* VMEMPAGE used as a PMAP buffer so tell PMAP a buffer is no longer referenced. If PMAP doesn't want PTR put on the
free list, it will return non-NIL.)
(AND (RELEASINGVMEMPAGE PTR)
(RETURN)))
NIL)
NORMAL
(SETQ DTD (\GETDTD N))
[MAPC (fetch DTDPTRS of DTD)
(FUNCTION (LAMBDA (K)
(SETQ VAL (OR (\DELREF (\GETBASEPTR PTR K))
VAL]
[replace DTDFREE of DTD with (PROG1 PTR (\PUTBASEPTR PTR 0 (fetch DTDFREE of DTD]
(RETURN VAL])
(\FREELISTCELL
[LAMBDA (X) (* lmm " 1-JAN-82 23:54")
(PROG ((BASE (fetch (POINTER PAGEBASE) of X)))
(CHECK (LISTP X)
(EVENP (\LOLOC X)))
(replace CDRCODE of X with (fetch NEXTCELL of BASE))
(replace NEXTCELL of BASE with (fetch (POINTER WORD#) of X))
(COND
((AND (IGREATERP (add (fetch (CONSPAGE CNT) of BASE)
1)
2)
(EQ (fetch NEXTPAGE of BASE)
\CONSPAGE.LAST))
(replace NEXTPAGE of BASE with (fetch DTDNEXTPAGE of \LISTPDTD))
(replace DTDNEXTPAGE of \LISTPDTD with (PAGELOC BASE])
(\GCSCAN1
(LAMBDA (PROBE) (* JonL "10-Sep-84 22:40")
(PROG (ENT)
LP (COND
((ILEQ PROBE 0)
(RETURN NIL)))
(SETQ ENT (\ADDBASE \HTMAIN (SETQ PROBE (SUB1 PROBE))))
(COND
((AND (NOT (fetch (GC EMPTY) of ENT))
(OR (fetch (GC LINKP) of ENT)
(NEQ 0 (fetch (GC STKCNT) of ENT))))
(RETURN PROBE))
(T (GO LP))))))
(\GCSCAN2
[LAMBDA (PROBE) (* lmm "23-DEC-81 22:48")
(PROG NIL
LP (COND
((ILEQ PROBE 0)
(RETURN NIL))
((NEQ [LOGAND (CONSTANT (LOGOR \HTSTKBIT 1))
(\GETBASE \HTMAIN (SETQ PROBE (SUB1 PROBE]
0)
(RETURN PROBE))
(T (GO LP])
(\REFCNT
[LAMBDA (PTR) (* bvm: " 3-Sep-85 22:58")
(PROG (ENTRY LINK CNT)
(COND
((fetch (MDSTYPEWORD NOREFCNT) of (\ADDBASE \MDSTypeTable (LRSH (fetch (POINTER PAGE#)
of PTR)
1)))
(* PTR is not reference counted)
(RETURN 1)))
(CHECK (EVENP (\LOLOC PTR)))
(SETQ ENTRY (\ADDBASE \HTMAIN (LRSH (\LOLOC PTR)
1)))
[COND
((fetch (GC EMPTY) of ENTRY)
(RETURN 1))
((fetch (GC LINKP) of ENTRY) (* chase down the link)
(GO FINDLINK))
((NEQ (\HILOC PTR)
(fetch (GC HIBITS) of ENTRY)) (* Doesn't match ptr in table, so no entry)
(RETURN 1))
((ILESSP (SETQ CNT (fetch (GC CNT) of ENTRY))
\MAXHTCNT)
(RETURN CNT))
(T (* Look in overflow table)
(RETURN (\GC.LOOKUP.BIGREFCNT PTR ENTRY]
FINDLINK
(SETQ LINK (\ADDBASE \HTCOLL (fetch (GC LINKPTR) of ENTRY)))
LINKLOOP
[COND
((EQ (fetch (GC HIBITS) of LINK)
(\HILOC PTR)) (* found the link entry)
(RETURN (COND
((ILESSP (SETQ CNT (fetch (GC CNT) of LINK))
\MAXHTCNT)
CNT)
(T (\GC.LOOKUP.BIGREFCNT PTR]
(COND
((EQ (SETQ LINK (fetch (GC NXTPTR) of LINK))
0) (* Didn't find an entry on this chain)
(RETURN 1))
(T (SETQ LINK (\ADDBASE \HTCOLL LINK))
(GO LINKLOOP])
)
(* User entries)
(DEFINEQ
(RECLAIM
[LAMBDA NIL (* lmm " 1-JUN-81 20:06")
(\DORECLAIM)
0])
(\DORECLAIM
[LAMBDA NIL
(DECLARE (GLOBALVARS GCMESS \RECLAIM.COUNTDOWN)) (* lmm "15-OCT-82 12:12")
(COND
((NOT (\GCDISABLED))
(UNINTERRUPTABLY
(SETQ \RECLAIM.COUNTDOWN NIL)
(PROG ((GCTIME1 (CLOCK 2 \GCTIME1)))
(AND GCMESS (FLIPCURSOR))
(\CONTEXTSWITCH \GCFXP)
(AND GCMESS (FLIPCURSOR))
(\BOXIPLUS (LOCF (fetch GCTIME of \MISCSTATS))
(\BOXIDIFFERENCE (CLOCK 2 \GCTIME2)
GCTIME1)))
(SETQ \RECLAIM.COUNTDOWN \RECLAIMMIN))])
(RECLAIMMIN
[LAMBDA (N) (* bvm: " 3-Sep-85 22:20")
(PROG1 (OR \RECLAIMMIN T)
(COND
(N (SETQ \RECLAIM.COUNTDOWN (SETQ \RECLAIMMIN (COND
((AND (NOT \GCDISABLED)
(NEQ N T))
(IMIN (IMAX N 144Q)
MAX.SMALL.INTEGER])
(GCMESS
[LAMBDA (NUM STR) (* lmm " 1-JUN-81 20:08")
NIL])
(GCGAG
[LAMBDA (MESSAGE) (* rrb "11-JUN-81 10:13")
(DECLARE (GLOBALVARS GCMESS))
(PROG1 GCMESS (SETQ GCMESS MESSAGE])
(GCTRP
[LAMBDA NIL (* lmm "14-Apr-85 20:24")
(* returns the number of storage allocations before the
next gc)
(OR (FIXP \RECLAIM.COUNTDOWN)
0])
)
(* Turning off GC)
(DEFINEQ
(DISABLEGC
[LAMBDA (NOERROR) (* bvm: " 3-Sep-85 21:49")
(UNINTERRUPTABLY
(\DISABLEGC1 NOERROR))])
(\DISABLEGC1
[LAMBDA (NOERROR) (* bvm: " 3-Sep-85 22:10")
(* * Do all the things necessary when GC must be turned off)
[LET ((TYPEBASE \MDSTypeTable)) (* Mark every type entry in the world "don't ref count"
)
(FRPTQ (UNFOLD \MDSTTsize WORDSPERPAGE)
(replace (MDSTYPEWORD NOREFCNT) of TYPEBASE with T)
(SETQ TYPEBASE (\ADDBASE TYPEBASE 1]
(SETQ \RECLAIM.COUNTDOWN (SETQ \RECLAIMMIN))
(PROGN (COND
((AND (NOT NOERROR)
(NOT \GCDISABLED)) (* Cause an interrupt and warning at next opportune
time)
(replace GCDISABLED of \INTERRUPTSTATE with T)
(SETQ \PENDINGINTERRUPT T)))
(SETQ \GCDISABLED T))
NIL])
(\DOGCDISABLEDINTERRUPT
[LAMBDA NIL (* bvm: " 8-Sep-85 13:25")
(* * Called while interruptable after GC disabled. So informs user.)
(LET ((W (CREATEW (CREATEREGION 454Q (IDIFFERENCE SCREENHEIGHT 144Q)
702Q 144Q)
"GC Disabled Warning")))
(printout W T
"Internal garbage collector tables have overflowed, due
to too many pointers with reference count greater than 1.
*** The garbage collector is now disabled. ***
Save your work and reload as soon as possible.")
(replace GCDISABLED of \INTERRUPTSTATE with NIL)
(FLASHWINDOW W 4)
(HELP "GC Disabled" "
Save and reload a.s.a.p."])
)
(RPAQ? \GCDISABLED )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \GCDISABLED)
)
(DECLARE: EVAL@COMPILE DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
[PUTPROPS ADDREF MACRO (OPENLAMBDA (PTR)
(PROG1 PTR (\ADDREF PTR]
(PUTPROPS \ADDREF DMACRO ((X)
((OPCODES GCREF 0)
X)))
[PUTPROPS DELETEREF MACRO (OPENLAMBDA (PTR)
(PROG1 PTR (\DELREF PTR]
(PUTPROPS \DELREF DMACRO ((X)
((OPCODES GCREF 1)
X)))
(PUTPROPS SCANREF MACRO (= . \STKREF))
(PUTPROPS \STKREF DMACRO ((X)
((OPCODES GCREF 2)
X)))
(PUTPROPS UNSCANREF MACRO ((PTR)
(\HTFIND PTR 3)))
(PUTPROPS CREATEREF MACRO (= . \CREATEREF))
[PUTPROPS \CREATEREF MACRO (OPENLAMBDA (PTR)
(PROG1 (\DELREF PTR)
(.INCREMENT.ALLOCATION.COUNT. 1]
[PUTPROPS .INCREMENT.ALLOCATION.COUNT. MACRO (OPENLAMBDA (N)
(DECLARE (GLOBALVARS \RECLAIM.COUNTDOWN))
(AND \RECLAIM.COUNTDOWN
(COND ((IGREATERP \RECLAIM.COUNTDOWN N)
(SETQ \RECLAIM.COUNTDOWN
(IDIFFERENCE
\RECLAIM.COUNTDOWN N)))
(T (SETQ \RECLAIM.COUNTDOWN)
(\DORECLAIM]
(PUTPROPS \GCDISABLED MACRO (NIL (PROGN (DECLARE (GLOBALVARS \GCDISABLED))
\GCDISABLED)))
)
[DECLARE: EVAL@COMPILE
(BLOCKRECORD HTOVERFLOW ((CASE BYTE)
(PTR XPOINTER))
[ACCESSFNS HTOVERFLOW ((CLEAR NIL (\PUTBASEPTR DATUM 0 NIL])
(BLOCKRECORD GC ((CNT BITS 6)
(STKBIT FLAG)
(HIBITS BITS 10Q)
(LINKP FLAG)
(NXTPTR WORD))
(BLOCKRECORD GC ((STKCNT BITS 7)))
[ACCESSFNS GC ((EMPTY (EQ 0 (\GETBASE DATUM 0))
(\PUTBASE DATUM 0 0))
(CONTENTS (\GETBASE DATUM 0)
(\PUTBASE DATUM 0 NEWVALUE))
(LINKPTR (LOGAND (\GETBASE DATUM 0)
177776Q)
(\PUTBASE DATUM 0 (LOGOR NEWVALUE 1])
(BLOCKRECORD HTCOLL ((FREEPTR WORD)
(NEXTFREE WORD)))
]
(* END EXPORTED DEFINITIONS)
[DECLARE: EVAL@COMPILE
(BLOCKRECORD GCOVFL ((OVFLPTR FULLXPOINTER)
(OVFLCNTHI WORD)
(OVFLCNTLO WORD)))
(BLOCKRECORD MDSTYPEWORD ((NOREFCNT FLAG)
(NIL BITS 17Q)))
(BLOCKRECORD GCPTR ((OFFSETCODE BYTE) (* What to do next)
(LINKFIELD XPOINTER) (* Link to next thing to work on after this)
)
(BLOCKRECORD GCPTR ((FULLLINKFIELD FULLXPOINTER))))
]
(DECLARE: EVAL@COMPILE
(RPAQQ \HTBIGENTRYSIZE 4)
(RPAQ \HT2CNT (IPLUS \HT1CNT \HT1CNT))
(RPAQQ \HTCNTSHIFT 12Q)
(RPAQ \HTNOSTKBIT (LOGXOR 177777Q \HTSTKBIT))
(RPAQ \HTSTK1 (LOGOR \HTSTKBIT \HT1CNT))
(RPAQ \HTSTKCNT (LOGOR \HTCNTMASK \HTSTKBIT))
(RPAQQ \HTHIMASK 776Q)
(RPAQQ \MAXHTCNT 77Q)
(CONSTANTS \HTBIGENTRYSIZE (\HT2CNT (IPLUS \HT1CNT \HT1CNT))
(\HTCNTSHIFT 12Q)
(\HTNOSTKBIT (LOGXOR 177777Q \HTSTKBIT))
(\HTSTK1 (LOGOR \HTSTKBIT \HT1CNT))
(\HTSTKCNT (LOGOR \HTCNTMASK \HTSTKBIT))
\HTHIMASK \MAXHTCNT)
)
(DECLARE: EVAL@COMPILE
(RPAQQ \HTCOLLTHRESHOLD 177770Q)
(RPAQQ \HTCOLLMAX 177776Q)
(CONSTANTS \HTCOLLTHRESHOLD \HTCOLLMAX)
)
(DECLARE: EVAL@COMPILE
[PUTPROPS .GETLINK. MACRO ((VAR)
(* get a new cell from free list into VAR)
(SETQ VAR (fetch (HTCOLL FREEPTR)
of \HTCOLL))
(COND ((EQ 0 VAR)
[COND ((IGEQ (SETQ VAR (fetch (HTCOLL NEXTFREE)
of \HTCOLL))
\HTCOLLTHRESHOLD)
(\DISABLEGC1)
(COND ((EQ VAR \HTCOLLMAX)
(* Don't wrap it around. Should never get here -- stop ref counting
if gc is disabled!)
(SETQ VAR (IDIFFERENCE VAR 2]
(replace (HTCOLL NEXTFREE)
of \HTCOLL with (IPLUS VAR 2))
(SETQ VAR (\ADDBASE \HTCOLL VAR)))
(T (replace (HTCOLL FREEPTR)
of \HTCOLL with (fetch (GC NXTPTR)
of
(SETQ VAR (\ADDBASE \HTCOLL VAR]
[PUTPROPS .DELLINK. MACRO ((LINK PREV ENTRY)
(PROGN [COND (PREV (replace (GC NXTPTR)
of PREV with (fetch (GC NXTPTR)
of LINK)))
(T (replace (GC LINKPTR)
of ENTRY with (fetch (GC NXTPTR)
of LINK]
(* skip over this guy)
(.FREELINK. LINK)
(* put him on the free list)
(COND ([EQ 0 (fetch (GC NXTPTR)
of
(SETQ LINK (\ADDBASE \HTCOLL (fetch (GC LINKPTR)
of ENTRY]
(* if there is now only one entry on this chain, put him back on the free
list too)
(replace (GC CONTENTS)
of ENTRY with (fetch (GC CONTENTS)
of LINK))
(.FREELINK. LINK]
[PUTPROPS .FREELINK. DMACRO (OPENLAMBDA (LINKCELL)
(* put LINKCELL back on HTCOLL freelist)
(replace (GC CONTENTS)
of LINKCELL with 0)
(replace (GC NXTPTR)
of LINKCELL with (fetch (HTCOLL FREEPTR)
of \HTCOLL))
(replace (HTCOLL FREEPTR)
of \HTCOLL with (\LOLOC LINKCELL]
[PUTPROPS .MODENTRY. DMACRO ((ENTRY CASE PTR)
(PROG ((GCCNT (fetch (GC CNT)
of ENTRY)))
(DECLARE (LOCALVARS GCCNT))
(COND [(NEQ GCCNT \MAXHTCNT)
(SELECTC CASE [\ADDREFCASE (COND ((EQ GCCNT (SUB1 \MAXHTCNT))
(\GC.ENTER.BIGREFCNT PTR ENTRY))
(T (replace (GC CNT)
of ENTRY with (ADD1 GCCNT]
(\DELREFCASE (OR (NEQ 0 GCCNT)
(\MP.ERROR \MP.DELREF0
"DELREF on PTR with 0 refcnt"
PTR ENTRY))
(replace (GC CNT)
of ENTRY with (SUB1 GCCNT)))
(\SCANREFCASE (replace (GC STKBIT)
of ENTRY with T))
(\UNSCANREFCASE (replace (GC STKBIT)
of ENTRY with NIL))
(\GCERROR))
(RETURN (EQ (fetch (GC STKCNT)
of ENTRY)
(LLSH 1 1]
(T (\GC.MODIFY.BIGREFCNT ENTRY CASE PTR]
[PUTPROPS .NEWENTRY. MACRO ((ENTRY PTR CASE)
(PROGN (CHECK (fetch (GC EMPTY)
of ENTRY))
(replace (GC HIBITS)
of ENTRY with (\HILOC PTR))
(SELECTC CASE (\ADDREFCASE (replace (GC CNT)
of ENTRY with 2)
NIL)
(\DELREFCASE PTR)
(\SCANREFCASE (replace (GC CNT)
of ENTRY with 1)
(replace (GC STKBIT)
of ENTRY with T)
NIL)
(\GCERROR]
[PUTPROPS .GCRECLAIMLP. DMACRO ((X)
(PROG NIL LP (COND ((SETQ X (\GCRECLAIMCELL X))
(\ADDREF X)
(GO LP]
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \RECLAIMMIN \RECLAIM.COUNTDOWN \GCTIME1 \GCTIME2)
)
(DECLARE: EVAL@COMPILE
(RPAQQ \ADDREFCASE 0)
(RPAQQ \DELREFCASE 1)
(RPAQQ \SCANREFCASE 2)
(RPAQQ \UNSCANREFCASE 3)
(CONSTANTS \ADDREFCASE \DELREFCASE \SCANREFCASE \UNSCANREFCASE)
)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(RPAQ? \RECLAIMMIN 5670Q)
(RPAQ? \RECLAIM.COUNTDOWN 5670Q)
(RPAQ? GCMESS )
(RPAQ? \GCTIME1 (CREATECELL \FIXP))
(RPAQ? \GCTIME2 (CREATECELL \FIXP))
)
(DEFINEQ
(\GCERROR
[LAMBDA (REASON FLG) (* lmm " 8-DEC-81 14:21")
(PROG NIL
(COND
((AND FLG REASON (\GCDISABLED))
(RETURN)))
(until (RAID (OR REASON "Bad CASE arg to \HTFIND")))
(DISABLEGC])
)
(* for MAKEINIT)
(DEFINEQ
(INITGC
[LAMBDA NIL (* bvm: "13-Feb-84 18:14")
(CREATEPAGES \HTMAIN (FOLDHI \HTMAINSIZE WORDSPERPAGE)
T T)
(CREATEPAGES \HTOVERFLOW 1 T T)
(CREATEPAGES \HTBIGCOUNT 1 T)
(CREATEPAGES \HTCOLL 1 NIL T)
(CREATEPAGES (\ADDBASE \HTCOLL WORDSPERPAGE)
(SUB1 (FOLDHI \HTCOLLSIZE WORDSPERPAGE))
T)
(replace (HTCOLL FREEPTR) of \HTCOLL with 0)
(replace (HTCOLL NEXTFREE) of \HTCOLL with 2])
)
(DECLARE: DONTCOPY
(ADDTOVAR MKI.SUBFNS (ADDREF . PROGN)
(\ADDREF . PROGN)
(\DELREF . PROGN)
(CREATEREF . PROGN)
(\CREATEREF . PROGN)
(DELETEREF . PROGN)
(.INCREMENT.ALLOCATION.COUNT. . PROGN))
(ADDTOVAR INEWCOMS (FNS INITGC))
EVAL@COMPILE
(ADDTOVAR DONTCOMPILEFNS INITGC)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(PUTPROPS LLGC COPYRIGHT ("Xerox Corporation" 3675Q 3676Q 3677Q 3700Q 3701Q))
(DECLARE: DONTCOPY
(FILEMAP (NIL (4752Q 17473Q (\HTFIND 4764Q . 13412Q) (\GC.HANDLEOVERFLOW 13414Q . 15232Q) (\GCMAPTABLE
15234Q . 17471Q)) (17544Q 30616Q (\GC.ENTER.BIGREFCNT 17556Q . 22564Q) (\GC.MODIFY.BIGREFCNT 22566Q
. 26475Q) (\GC.LOOKUP.BIGREFCNT 26477Q . 30236Q) (\GC.BIGREFCNT.MISSING 30240Q . 30614Q)) (30734Q
64046Q (\GCMAPSCAN 30746Q . 34642Q) (\GCMAPUNSCAN 34644Q . 37513Q) (\GCRECLAIMCELL 37515Q . 51311Q) (
\OLDGCRECLAIMCELL 51313Q . 55424Q) (\FREELISTCELL 55426Q . 56726Q) (\GCSCAN1 56730Q . 57634Q) (
\GCSCAN2 57636Q . 60305Q) (\REFCNT 60307Q . 64044Q)) (64100Q 67164Q (RECLAIM 64112Q . 64264Q) (
\DORECLAIM 64266Q . 65334Q) (RECLAIMMIN 65336Q . 66075Q) (GCMESS 66077Q . 66225Q) (GCGAG 66227Q .
66512Q) (GCTRP 66514Q . 67162Q)) (67220Q 72616Q (DISABLEGC 67232Q . 67476Q) (\DISABLEGC1 67500Q .
71245Q) (\DOGCDISABLEDINTERRUPT 71247Q . 72614Q)) (107644Q 110261Q (\GCERROR 107656Q . 110257Q)) (
110313Q 111310Q (INITGC 110325Q . 111306Q)))))
STOP