(FILECREATED "26-Feb-86 15:56:30" {ERIS}<LISPCORE>GC>LLGC.;13
 154237Q

      changes to:  (MACROS \SINGLE.REFP)
                   (RECORDS GC)
                   (FNS \REFCNT)

      previous date: "24-Feb-86 15:39:37" {ERIS}<LISPCORE>GC>LLGC.;10)


(* Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986 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 \EQREFCNT1))
        (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 \HALFMAXHTCNT)
               (CONSTANTS \HTCOLLTHRESHOLD \HTCOLLMAX)
               (MACROS .GETLINK. .DELLINK. .FREELINK. .MODENTRY. \GC.ZEROP.OVFLCNT \GARBAGE.ENTRYP 
                      \SINGLE.REFP .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)                                                       (* gbn 
                                                                           "11-Feb-86 14:47")
            
            (* 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)
                         ((\GARBAGE.ENTRYP ENTRY)                          (* gbn- this now has to 
                                                                           check if stack, count 
                                                                           and countoverflow are 
                                                                           all zero before 
                                                                           determining that this 
                                                                           ptr is garbage)
                          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)
                         ((\GARBAGE.ENTRYP 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)                                                      (* gbn 
                                                                           "17-Feb-86 16:56")
            
            (* Called when the ref cnt of PTR is incremented to \MAXHTCNT+1.
            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 (GCOVFL 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)
                  (replace (GCOVFL OVFLCNT) of OVENTRY with MAX.SMALLP)    (* Assure it lives 
                                                                           forever)
                  (RETURN))
                 (T (SETQ OVENTRY (\ADDBASE OVENTRY \HTBIGENTRYSIZE))
                    (GO LP]
          (replace (GCOVFL OVFLCNT) of OVENTRY with \HALFMAXHTCNT)         (* this is somewhat 
                                                                           odd, since 
                                                                           \HALFMAXHTCNT + 
                                                                           \HALFMAXHTCNT is 
                                                                           actually \MAXHTCNT+1)
          (replace (GCOVFL OVFLPTR) of OVENTRY with PTR)
          (replace (GC CNTOVERFLOW) of ENTRY with T)
          (replace (GC CNT) of ENTRY with \HALFMAXHTCNT])

(\GC.MODIFY.BIGREFCNT
  [LAMBDA (ENTRY CASE PTR)                                                 (* gbn 
                                                                           "17-Feb-86 16:35")
            
            (* * Called from .MODENTRY. to do one of the 4 reference counting cases on 
            PTR. ENTRY is the gc table entry whose CNT field has overflowed)

    (PROG ((OVENTRY \HTBIGCOUNT)
           (GCCNT (fetch (GC CNT) of ENTRY))
           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 (GCOVFL OVFLPTR) of OVENTRY))
                   PTR)
              (COND
                 ((NULL TMP)
                  (\GC.BIGREFCNT.MISSING PTR ENTRY)
                  (RETURN)))
              (SETQ OVENTRY (\ADDBASE OVENTRY \HTBIGENTRYSIZE))
              (GO LP)))                                                    (* blecch -
                                                                           linear search for 
                                                                           oventry.)
          (SELECTC CASE
              (\ADDREFCASE                                                 (* we were called to do 
                                                                           this because CNT 
                                                                           overflowed again.
                                                                           Increase the overflow 
                                                                           count by \MAXHTCOUNT/2)
                           (replace (GC CNT) of ENTRY with \HALFMAXHTCNT)
                           (\BOXIPLUS (LOCF (FETCH (GCOVFL OVFLCNT) OF OVENTRY))
                                  \HALFMAXHTCNT))
              (\DELREFCASE                                                 (* CNT underflowed.
                                                                           Lower the overflow 
                                                                           count by \MAXHTCOUNT/2 
                                                                           and check if this 
                                                                           should still be a big 
                                                                           refcnt.)
                           (replace (GC CNT) of ENTRY with (IDIFFERENCE \HALFMAXHTCNT 1))
                           (\BOXIDIFFERENCE (LOCF (fetch (GCOVFL OVFLCNT) of OVENTRY))
                                  \HALFMAXHTCNT)
                           (if (\GC.ZEROP.OVFLCNT OVENTRY)
                               then                                        (* ref count no longer 
                                                                           needs to be big refcnt, 
                                                                           mark it as deleted.)
                                    (replace (GCOVFL OVFLPTR) of OVENTRY with T)
                                    (replace (GC CNTOVERFLOW) of ENTRY with NIL)))
              (\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)                                                      (* gbn 
                                                                           "13-Feb-86 17:18")
            
            (* * Returns ref cnt of PTR 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 (IPLUS (FETCH (GCOVFL OVFLCNT) OF OVENTRY)
                         (FETCH (GC CNT) OF ENTRY])

(\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                                                              (* gbn 
                                                                           "13-Feb-86 17:23")
                                                                           (* 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
                       ((\GARBAGE.ENTRYP LINK)
                        (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
             ((\GARBAGE.ENTRYP 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)                                                          (* gbn 
                                                                           "13-Feb-86 17:28")
    (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)
                       (NOT (\GARBAGE.ENTRYP 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)
                                                        (* gbn 
                                                                           "17-Feb-86 15: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))
             ((NOT (FETCH
 (GC CNTOVERFLOW) OF
 ENTRY))
              (RETURN (fetch
 (GC CNT) of
 ENTRY)))
             (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
                         ((NOT (FETCH
 (GC CNTOVERFLOW) OF
 LINK))
                          (fetch
 (GC CNT) of
 LINK))
                         (T (\GC.LOOKUP.BIGREFCNT
 PTR LINK]
          (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])

(\EQREFCNT1

  [LAMBDA (PTR)                                              (* bvm: "20-Jan-86 12:06")


          (* * True if PTR's refcnt is definitely one -- this differs from (EQ (\REFCNT PTR) 1) because it is false for 

	  objects that are not reference counted, and also for objects whose stack bit is on (during gc))



    (
PROG
 (ENTRY LINK)
	    (
COND

	      ((fetch
 (MDSTYPEWORD NOREFCNT) of
 (
\ADDBASE
 \MDSTypeTable
								(
LRSH
 (fetch
 (POINTER PAGE#)
									   of
 PTR)
									1)))
                                                             (* PTR is not reference counted--ref cnt is 

							     indeterminate)

		(
RETURN
 NIL)))
	    (CHECK (
EVENP
 (
\LOLOC
 PTR)))
	    (
SETQ
 ENTRY (
\ADDBASE
 \HTMAIN (
LRSH
 (
\LOLOC
 PTR)
						      1)))
	    [
COND

	      ((
NOT
 (fetch
 (GC LINKP) of
 ENTRY))       (* Ref cnt is 1 if there's no entry, or this entry is 

							     not for PTR)

		(
RETURN
 (
OR
 (fetch
 (GC EMPTY) of
 ENTRY)
				(
NEQ
 (
\HILOC
 PTR)
				       (fetch
 (GC HIBITS) of
 ENTRY]
                                                             (* chase down the link)

	    (
SETQ
 LINK (
\ADDBASE
 \HTCOLL (fetch
 (GC LINKPTR) of
 ENTRY)))
	LINKLOOP
	    (
COND

	      ((
EQ
 (fetch
 (GC HIBITS) of
 LINK)
		     (
\HILOC
 PTR))                         (* found the link entry, so must not be 1)

		(
RETURN
 NIL))
	      ((
EQ
 (
SETQ
 LINK (fetch
 (GC NXTPTR) of
 LINK))
		     0)                                      (* Didn't find an entry on this chain)

		(
RETURN
 T))
	      (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 5)
                     (CNTOVERFLOW FLAG)
                     (STKBIT FLAG)
                     (HIBITS BITS 10Q)
                     (LINKP FLAG)
                     (NXTPTR WORD))
                    (BLOCKRECORD GC ((STKCNTOVERFLOW 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)
                         (OVFLCNT FIXP)))

(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
 37Q)

(RPAQQ \HALFMAXHTCNT
 20Q)

(CONSTANTS \HTBIGENTRYSIZE (\HT2CNT (IPLUS \HT1CNT \HT1CNT))
       (\HTCNTSHIFT 12Q)
       (\HTNOSTKBIT (LOGXOR 177777Q \HTSTKBIT))
       (\HTSTK1 (LOGOR \HTSTKBIT \HT1CNT))
       (\HTSTKCNT (LOGOR \HTCNTMASK \HTSTKBIT))
       \HTHIMASK \MAXHTCNT \HALFMAXHTCNT)
)

(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))
                                   (SELECTC CASE [\ADDREFCASE (COND ((NEQ GCCNT \MAXHTCNT)
                                                                     (* whether or not overflow, just 
                                                                        increment the low order bits)
                                                                     (replace (GC CNT)
                                                                            of ENTRY with
                                                                            (ADD1 GCCNT)))
                                                                    ((fetch (GC CNTOVERFLOW)
                                                                            of ENTRY)
                                                                     (* This was already a bigrefcnt, 
                                                                        so increment it)
                                                                     (\GC.MODIFY.BIGREFCNT ENTRY CASE 
                                                                            PTR))
                                                                    (T (* a new bigrefcount, go enter 
                                                                          it.)
                                                                       (\GC.ENTER.BIGREFCNT PTR ENTRY
                                                                              ]
                                          [\DELREFCASE (COND ((NEQ 0 GCCNT)
                                                              (* if this is an overflow case or not, 
                                                                 the low order bits of the cnt can 
                                                                 just be decremented.)
                                                              (replace (GC CNT)
                                                                     of ENTRY with (SUB1 GCCNT)))
                                                             ((fetch (GC CNTOVERFLOW)
                                                                     of ENTRY)
                                                              (* this is an underflow of the cnt)
                                                              (\GC.MODIFY.BIGREFCNT ENTRY CASE PTR))
                                                             (T (\MP.ERROR \MP.DELREF0 
                                                                       "DELREF on PTR with 0 refcnt" 
                                                                       PTR ENTRY]
                                          (\SCANREFCASE (replace (GC STKBIT)
                                                               of ENTRY with T))
                                          (\UNSCANREFCASE (replace (GC STKBIT)
                                                                 of ENTRY with NIL))
                                          (\GCERROR))
                                   (RETURN (\SINGLE.REFP ENTRY]
[PUTPROPS \GC.ZEROP.OVFLCNT DMACRO ((OVENTRY)
                                    (AND [EQ 0 (fetch (FIXP HINUM)
                                                      of
                                                      (LOCF (fetch (GCOVFL OVFLCNT)
                                                                   of OVENTRY]
                                         (EQ 0 (fetch (FIXP LONUM)
                                                      of
                                                      (LOCF (fetch (GCOVFL OVFLCNT)
                                                                   of OVENTRY]
[PUTPROPS \GARBAGE.ENTRYP MACRO ((LINK)
                                 (* * this entry is garbage if the count is 0, it is not overflowed 
                                    and the stack bit is not on)
                                 (EQ 0 (fetch (GC STKCNTOVERFLOW)
                                              of LINK]
[PUTPROPS \SINGLE.REFP DMACRO ((ENTRY)
                               (* returns T if this entry has a refcount of 1,
                                  (and can then be deleted from the table))
                               (EQ (fetch (GC STKCNTOVERFLOW)
                                          of ENTRY)
                                   (LLSH 1 2]
[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 3702Q))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (6460Q 23514Q (\HTFIND 6472Q . 17433Q) (\GC.HANDLEOVERFLOW 17435Q . 21253Q) (\GCMAPTABLE
 21255Q . 23512Q)) (23565Q 43217Q (\GC.ENTER.BIGREFCNT 23577Q . 30760Q) (\GC.MODIFY.BIGREFCNT 30762Q
 . 40407Q) (\GC.LOOKUP.BIGREFCNT 40411Q . 42637Q) (\GC.BIGREFCNT.MISSING 42641Q . 43215Q)) (43335Q 
105517Q (\GCMAPSCAN 43347Q . 51056Q) (\GCMAPUNSCAN 51060Q . 53727Q) (\GCRECLAIMCELL 53731Q . 65525Q) (
\OLDGCRECLAIMCELL 65527Q . 71640Q) (\FREELISTCELL 71642Q . 73142Q) (\GCSCAN1 73144Q . 74224Q) (
\GCSCAN2 74226Q . 74675Q) (\REFCNT 74677Q . 102171Q) (\EQREFCNT1 102173Q . 105515Q)) (105551Q 110635Q 
(RECLAIM 105563Q . 105735Q) (\DORECLAIM 105737Q . 107005Q) (RECLAIMMIN 107007Q . 107546Q) (GCMESS 
107550Q . 107676Q) (GCGAG 107700Q . 110163Q) (GCTRP 110165Q . 110633Q)) (110671Q 114267Q (DISABLEGC 
110703Q . 111147Q) (\DISABLEGC1 111151Q . 112716Q) (\DOGCDISABLEDINTERRUPT 112720Q . 114265Q)) (
151441Q 152056Q (\GCERROR 151453Q . 152054Q)) (152110Q 153105Q (INITGC 152122Q . 153103Q)))))
STOP