(FILECREATED "13-Feb-85 23:09:22" {ERIS}<LISPCORE>SOURCES>LLGC.;7
 73017Q 

      changes to:  (FNS \REFCNT)

      previous date: " 5-Jan-85 21:36:56" {ERIS}<LISPCORE>SOURCES>LLGC.;6)


(* Copyright (c) 1981, 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT LLGCCOMS)

(RPAQQ LLGCCOMS
 ((E (RESETSAVE (RADIX 8)))
		 [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]
		 (FNS \HTFIND)
		 (COMS (FNS \GC.ENTER.BIGREFCNT \GC.MODIFY.BIGREFCNT \GC.LOOKUP.BIGREFCNT 
			    \GC.BIGREFCNT.MISSING)
		       (GLOBALVARS \HTBIGCOUNT))
		 (FNS \GCMAPTABLE \GC.HANDLEOVERFLOW \GCMAPSCAN \GCMAPUNSCAN \GCRECLAIMCELL 
		      \FREELISTCELL DISABLEGC \GCSCAN1 \GCSCAN2 \REFCNT)
		 (FNS RECLAIM \DORECLAIM RECLAIMMIN GCMESS GCGAG GCTRP)
		 (DECLARE: EVAL@COMPILE DONTCOPY (COMS * GCCOMPILERDEFS))
		 [DECLARE: DONTEVAL@LOAD DOCOPY (VARS (\RECLAIMMIN 3000)
						      (\RECLAIM.COUNTDOWN 3000)
						      (GCMESS)
						      (\GCTIME1 (CREATECELL \FIXP))
						      (\GCTIME2 (CREATECELL \FIXP]
		 (FNS \GCERROR)
		 (LOCALVARS . T)))



(* 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)
)
(DEFINEQ

(\HTFIND

  (LAMBDA (PTR CASE)                                         (* JonL "10-Sep-84 22:38")


          (* 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
	    ((NEQ 0 (LOGAND (\GETBASE \MDSTypeTable (LRSH (fetch
 (POINTER PAGE#) of
 PTR)
							  1))
			    \TT.NOREF))
	      (RETURN)))
          (CHECK (EVENP (\LOLOC PTR)))
          (AND (\GCDISABLED)
	       (RETURN))
          (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)))))
)
(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)
)
(DEFINEQ

(\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)])

(\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)])

(\GCMAPSCAN

  (LAMBDA NIL                                                (* JonL "10-Sep-84 22:39")

                                                             (* 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
 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: " 5-Jan-85 21:34")

                                                             (* scan gc tables turning of stack bits)

    (
PROG
 (ENTRY (PROBE \HTMAINSIZE))
      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]
		SCNLP
		    [
COND

		      ((fetch
 (GC STKBIT) of
 LNK)
			(
COND

			  ((
EQ
 (fetch
 (GC CNT) of
 LNK)
			       1)
			    (UNSCANREF (
\VAG2
 (fetch
 (GC HIBITS) of
 LNK)
					      (
LLSH
 PROBE 1)))
                                                             (* could have modified this collision list, so don't 

							     try to follow chain)

			    (
GO
 RETRY))
			  (T (replace
 (GC STKBIT) of
 LNK with
 NIL]
		    (
COND

		      ((
NEQ
 0 (
SETQ
 LNK (fetch
 NXTPTR of
 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 (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])

(DISABLEGC

  [LAMBDA NIL                      (* lmm "19-MAY-82 22:40")

    (replace
 (HTCOLL NEXTFREE) of
 \HTCOLL with
 \HTCOLLSIZE)
    [PROG ((VP \MDSTypeTable))
          (FRPTQ (UNFOLD \MDSTTsize WORDSPERPAGE)
		 (\PUTBASE VP 0 (LOGOR \TT.NOREF (\GETBASE VP 0)))
		 (SETQ VP (\ADDBASE VP 1]
    (SETQ \RECLAIM.COUNTDOWN)
    NIL])

(\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: "13-Feb-85 22:37")

    (
PROG
 (ENTRY LINK CNT)
          (
COND

	    ((
OR
 (
BITTEST
 (
\GETBASE
 \MDSTypeTable (
LRSH
 (fetch
 (POINTER PAGE#) of
 PTR)
							1))
			  \TT.NOREF)
		 (\GCDISABLED))                              (* 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
 NXTPTR of
 LINK))
		 0)                                          (* Didn't find an entry on this chain)

	      (
RETURN
 1))
	    (T (
SETQ
 LINK (
\ADDBASE
 \HTCOLL LINK))
	       (
GO
 LINKLOOP])
)
(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)                      (* lmm " 8-FEB-82 22:16")

    (PROG1 (OR \RECLAIMMIN T)
	   (COND
	     (N (SETQ \RECLAIM.COUNTDOWN (SETQ \RECLAIMMIN (COND
		      ((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 " 8-FEB-82 22:17")

                                   (* returns the number of storage allocations before the next gc)

    (OR (FIXP \RECLAIM.COUNTDOWN)
	MAX.INTEGER])
)
(DECLARE: EVAL@COMPILE DONTCOPY 

(RPAQQ GCCOMPILERDEFS
 ((EXPORT (MACROS ADDREF \ADDREF DELETEREF \DELREF SCANREF \STKREF UNSCANREF 
				       CREATEREF \CREATEREF .INCREMENT.ALLOCATION.COUNT. \GCDISABLED)
			       (RECORDS HTOVERFLOW GC HTCOLL))
		       (RECORDS GCOVFL)
		       (CONSTANTS \HTBIGENTRYSIZE (\HT2CNT (IPLUS \HT1CNT \HT1CNT))
				  (\HTCNTSHIFT 12Q)
				  (\HTNOSTKBIT (LOGXOR 177777Q \HTSTKBIT))
				  (\HTSTK1 (LOGOR \HTSTKBIT \HT1CNT))
				  (\HTSTKCNT (LOGOR \HTCNTMASK \HTSTKBIT))
				  \HTHIMASK \MAXHTCNT)
		       (MACROS .GETLINK. .DELLINK. .FREELINK. .MODENTRY. .NEWENTRY. .GCRECLAIMLP.)
		       (GLOBALVARS \RECLAIMMIN \RECLAIM.COUNTDOWN \GCTIME1 \GCTIME2)
		       (CONSTANTS \ADDREFCASE \DELREFCASE \SCANREFCASE \UNSCANREFCASE)))
(* 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                             (* lmm "30-NOV-81 14:08")

				 (
IGEQ
 (fetch
 (HTCOLL NEXTFREE) of
 \HTCOLL)
				       \HTCOLLSIZE)))
)
[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)))
]
(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 

(PUTPROPS .GETLINK. MACRO
 [(VAR)                             (* get a new cell from free list into VAR)

			   (
SETQ
 VAR (fetch
 (HTCOLL FREEPTR) of
 \HTCOLL))
			   [
COND

			     ((
EQ
 0 VAR)
			       (
SETQ
 VAR (fetch
 (HTCOLL NEXTFREE) of
 \HTCOLL))
			       (replace
 (HTCOLL NEXTFREE) of
 \HTCOLL with
 (
IPLUS
 VAR 2]
			   (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 

(RPAQQ \RECLAIMMIN
 5670Q)

(RPAQQ \RECLAIM.COUNTDOWN
 5670Q)

(RPAQQ GCMESS
 NIL)

(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
])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(LOCALVARS)
)
(PUTPROPS LLGC COPYRIGHT ("Xerox Corporation" 3675Q 3676Q 3677Q 3700Q 3701Q))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (2706Q 3703Q (INITGC 2720Q . 3701Q)) (4423Q 12252Q (\HTFIND 4435Q . 12250Q)) (12253Q 
23325Q (\GC.ENTER.BIGREFCNT 12265Q . 15273Q) (\GC.MODIFY.BIGREFCNT 15275Q . 21204Q) (
\GC.LOOKUP.BIGREFCNT 21206Q . 22745Q) (\GC.BIGREFCNT.MISSING 22747Q . 23323Q)) (23424Q 51014Q (
\GCMAPTABLE 23436Q . 25673Q) (\GC.HANDLEOVERFLOW 25675Q . 27513Q) (\GCMAPSCAN 27515Q . 33161Q) (
\GCMAPUNSCAN 33163Q . 36044Q) (\GCRECLAIMCELL 36046Q . 41705Q) (\FREELISTCELL 41707Q . 43207Q) (
DISABLEGC 43211Q . 43752Q) (\GCSCAN1 43754Q . 44660Q) (\GCSCAN2 44662Q . 45331Q) (\REFCNT 45333Q . 
51012Q)) (51015Q 53631Q (RECLAIM 51027Q . 51201Q) (\DORECLAIM 51203Q . 52251Q) (RECLAIMMIN 52253Q . 
52644Q) (GCMESS 52646Q . 52774Q) (GCGAG 52776Q . 53261Q) (GCTRP 53263Q . 53627Q)) (72155Q 72572Q (
\GCERROR 72167Q . 72570Q)))))
STOP