(FILECREATED "13-FEB-83 13:59:36" <BLISP>LLGC.;86   23767

      changes to:  (FNS \GCMAPTABLE)

      previous date: " 6-DEC-82 00:05:15" <BLISP>LLGC.;85)


(* Copyright (c) 1981, 1982, 1983 by Xerox Corporation)

(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)
		 (FNS \GCMAPTABLE \GC.HANDLEOVERFLOW \GCMAPSCAN \GCMAPUNSCAN \GCRECLAIMCELL 
		      \FREELISTCELL DISABLEGC \GCSCAN1 \GCSCAN2)
		 (DECLARE: DONTCOPY
			   (EXPORT (MACROS ADDREF \ADDREF DELETEREF \DELREF SCANREF \STKREF UNSCANREF 
					   CREATEREF \CREATEREF .INCREMENT.ALLOCATION.COUNT. 
					   \GCDISABLED)
				   (RECORDS HTOVERFLOW GC HTCOLL)))
		 (FNS RECLAIM \DORECLAIM RECLAIMMIN GCMESS GCGAG GCTRP)
		 (DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS (\HT2CNT (IPLUS \HT1CNT \HT1CNT))
							    (\HTCNTSHIFT 10)
							    (\HTNOSTKBIT (LOGXOR 65535 \HTSTKBIT))
							    (\HTSTK1 (LOGOR \HTSTKBIT \HT1CNT))
							    \HTHIMASK
							    (\HTSTKCNT (LOGOR \HTCNTMASK \HTSTKBIT))
							    \MAXHTCNT)
			   (MACROS .GETLINK. .DELLINK. .FREELINK. .MODENTRY. .NEWENTRY. .GCRECLAIMLP.)
			   (GLOBALVARS \RECLAIMMIN \RECLAIM.COUNTDOWN \GCTIME1 \GCTIME2)
			   (CONSTANTS \ADDREFCASE \DELREFCASE \SCANREFCASE \UNSCANREFCASE))
		 [DECLARE: DONTEVAL@LOAD DOCOPY (VARS (\RECLAIMMIN 3000)
						      (\RECLAIM.COUNTDOWN 3000)
						      (GCMESS)
						      (\GCTIME1 (CREATECELL \FIXP))
						      (\GCTIME2 (CREATECELL \FIXP]
		 (FNS GETREF \GCERROR)
		 (LOCALVARS . T)))



(* for MAKEINIT)

(DEFINEQ

(INITGC
  [LAMBDA NIL                                                (* lmm " 7-APR-82 15:35")
    (CREATEPAGES \HTMAIN (FOLDHI \HTMAINSIZE WORDSPERPAGE)
		 T T)
    (CREATEPAGES \HTOVERFLOW 1 T 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)               (* lmm " 5-DEC-82 23:44")

          (* 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)
          [COND
	    ((NOT (ZEROP (LOGAND (\GETBASE \MDSTypeTable (LRSH (fetch (POINTER PAGE#) of PTR)
							       1))
				 \TT.NOREF)))
	      (RETURN))
	    ((EQ (NTYPX PTR)
		 \VMEMPAGEP)
	      (SETQ PROBE (fetch (POINTER PAGEBASE) of PTR]
          [CHECK (ZEROP (LOGAND 1 (\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)
			  (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)
                                   (* reference count went to 1, delete list entry)
			  (.DELLINK. LINK PREV ENTRY)
			  NIL)
			((ZEROP (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

(\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                                                (* lmm "22-FEB-82 12:13")
                                                             (* 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
		      ([NOT (ZEROP (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
	    ((ZEROP (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                      (* lmm "27-DEC-81 22:15")
                                   (* 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
		      ([NOT (ZEROP (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 EMPTY of ENTRY with T))
		(T (replace (GC STKBIT) of ENTRY with NIL]
          (GO LP])

(\GCRECLAIMCELL
  [LAMBDA (PTR)                    (* lmm " 1-JAN-82 23:55")
    (PROG (DTD I VAL N)
          (CHECK (EQ (GETREF PTR)
		     1))
      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)                  (* lmm "27-DEC-81 22:14")
    (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)
		      (ZEROP (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])
)
(DECLARE: 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 
                                   (* 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 (ZEROP (\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)

)
(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 
(DECLARE: EVAL@COMPILE 

(RPAQ \HT2CNT (IPLUS \HT1CNT \HT1CNT))

(RPAQQ \HTCNTSHIFT 12Q)

(RPAQ \HTNOSTKBIT (LOGXOR 177777Q \HTSTKBIT))

(RPAQ \HTSTK1 (LOGOR \HTSTKBIT \HT1CNT))

(RPAQQ \HTHIMASK 776Q)

(RPAQ \HTSTKCNT (LOGOR \HTCNTMASK \HTSTKBIT))

(RPAQQ \MAXHTCNT 77Q)

(CONSTANTS (\HT2CNT (IPLUS \HT1CNT \HT1CNT))
	   (\HTCNTSHIFT 12Q)
	   (\HTNOSTKBIT (LOGXOR 177777Q \HTSTKBIT))
	   (\HTSTK1 (LOGOR \HTSTKBIT \HT1CNT))
	   \HTHIMASK
	   (\HTSTKCNT (LOGOR \HTCNTMASK \HTSTKBIT))
	   \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
			     ((ZEROP 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
				    ([ZEROP (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)
			     (COND ((NEQ (fetch (GC CNT)
						of ENTRY)
					 \MAXHTCNT)
				    (SELECTC CASE (\ADDREFCASE (add (fetch (GC CNT)
									   of ENTRY)
								    1))
					     (\DELREFCASE (add (fetch (GC CNT)
								      of ENTRY)
							       -1))
					     (\SCANREFCASE (replace (GC STKBIT)
								    of ENTRY with T))
					     (\UNSCANREFCASE (replace (GC STKBIT)
								      of ENTRY with NIL))
					     (\GCERROR))
				    (AND (EQ (fetch (GC CNT)
						    of ENTRY)
					     1)
					 (NOT (fetch (GC STKBIT)
						     of ENTRY])

(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

(ADDTOVAR 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

(GETREF
  [LAMBDA (PTR)                    (* lmm " 4-DEC-81 21:22")
    (PROG ((PROBE PTR)
	   ENTRY LINK)
          (COND
	    ((OR (LITATOM PTR)
		 (SMALLP PTR))
	      (RETURN 1)))
          [CHECK (ZEROP (LOGAND 1 (\LOLOC PTR]
          (AND (\GCDISABLED)
	       (RETURN 1))
          (SETQ ENTRY (\ADDBASE \HTMAIN (LRSH (\LOLOC PROBE)
					      1)))
          (COND
	    ((fetch (GC EMPTY) of ENTRY)
	      (RETURN 1))
	    ((fetch (GC LINKP) of ENTRY)
                                   (* chase down the link)
	      (GO FINDLINK))
	    ((EQ (\HILOC PTR)
		 (fetch (GC HIBITS) of ENTRY))
                                   (* matches pointer in main table)
	      (RETURN (fetch (GC CNT) of ENTRY)))
	    (T (RETURN 1)))
      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 (fetch (GC CNT) of LINK]
          (COND
	    ((NEQ (SETQ LINK (fetch NXTPTR of LINK))
		  0)
	      (SETQ LINK (\ADDBASE \HTCOLL LINK))
	      (GO LINKLOOP)))

          (* * Didn't find an entry on this chain)


          (RETURN 1])

(\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 . T)
)
(PUTPROPS LLGC COPYRIGHT ("Xerox Corporation" 3675Q 3676Q 3677Q))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1956 2430 (INITGC 1966 . 2428)) (2766 5811 (\HTFIND 2776 . 5809)) (5812 14699 (
\GCMAPTABLE 5822 . 7003) (\GC.HANDLEOVERFLOW 7005 . 7915) (\GCMAPSCAN 7917 . 9734) (\GCMAPUNSCAN 9736
 . 11014) (\GCRECLAIMCELL 11016 . 12922) (\FREELISTCELL 12924 . 13628) (DISABLEGC 13630 . 13983) (
\GCSCAN1 13985 . 14400) (\GCSCAN2 14402 . 14697)) (16667 18087 (RECLAIM 16677 . 16783) (\DORECLAIM 
16785 . 17335) (RECLAIMMIN 17337 . 17586) (GCMESS 17588 . 17674) (GCGAG 17676 . 17855) (GCTRP 17857 . 
18085)) (22085 23626 (GETREF 22095 . 23365) (\GCERROR 23367 . 23624)))))
STOP
TREF 54406Q . 57044Q) (
\GCERROR 57050Q . 57460Q)))))
STOP