(FILECREATED " 2-Feb-86 17:20:57" {DSK}<LISPFILES2>GC.LSP;2
 3598   

      changes to:  (VARS GCCOMS))


(* Copyright (c) 1986 by Quintus Computer Systems, Inc. All rights reserved.)

(PRETTYCOMPRINT GCCOMS)

(RPAQQ GCCOMS
 ((FNS QP.ADD.REF QP.SWEEP QP.TRIMCORE \GCSCANPROLOG\)
		 (ADDVARS (GLOBALVARS QP.REF.LIMIT)
			  (GLOBALVARS QP.REF.COUNT)
			  (GLOBALVARS QP.REF.TABLE))
		 (P (SETQ QP.REF.TABLE (HARRAY 1000)))
		 (P (SETQ QP.REF.LIMIT (FIX (TIMES (HARRAYSIZE QP.REF.TABLE)
						   .8))))
		 (P (SETQ QP.REF.COUNT 0))))
(DEFINEQ

(QP.ADD.REF

  (LAMBDA (X)
    (if
 (
NOT
 (
OR
 (
LITATOM
 X)
		       (
SMALLP
 X)
		       (
TYPENAMEP
 X (
QUOTE
 QP.PROCEDURE.RECORD))
		       (
\BLOCKDATAP
 X)
		       (
GETHASH
 X QP.REF.TABLE)))
	then
 (
PUTHASH
 X T QP.REF.TABLE)
	       (
SETQ
 QP.REF.COUNT (
ADD1
 QP.REF.COUNT))
	       (if
 (
IGEQ
 QP.REF.COUNT QP.REF.LIMIT)
		   then
 (QP.TRIMCORE
 X)))
    X))

(QP.SWEEP

  (LAMBDA (P Q TABLE COUNT)
    (
PROG
 (Y)
	L   (if
 (
NOT
 (
OR
 (
ILESSP
 (
\GETBASE
 P 0)
					 other.tag.16)
			       (
TYPENAMEP
 (
SETQ
 Y (
\GETBASEPTR
 P 0))
					    (
QUOTE
 QP.PROCEDURE.RECORD))
			       (
\BLOCKDATAP
 Y)
			       (
GETHASH
 Y TABLE)))
		then
 (
PUTHASH
 Y T TABLE)
		       (
SETQ
 COUNT (
ADD1
 COUNT)))
	    (if
 (
EQ
 P Q)
		then
 (
RETURN
 COUNT))
	    (
SETQ
 P (
\ADDBASE
 P 2))
	    (
GO
 L))))

(QP.TRIMCORE

  (LAMBDA (X)
    (
PROG
 (TABLE COUNT LIMIT)
	    (
SETQ
 LIMIT (
HARRAYSIZE
 QP.REF.TABLE))
	    (
SETQ
 TABLE (
HARRAY
 LIMIT))
	    (
SETQ
 COUNT 0)
	    (put.Amem 1 (get.Aval 1))
	    (put.Amem 2 (get.Aval 2))
	    (put.Amem 3 (get.Aval 3))
	    (put.Amem 4 (get.Aval 4))
	    (
SETQ
 COUNT (QP.SWEEP
 (loc.Amem 1)
				      (loc.Amem 255)
				      TABLE COUNT))
	    (put.cell H 0 (tag.other X))
	    (
SETQ
 COUNT (QP.SWEEP
 QP.init.H (get.24 H)
				      TABLE COUNT))
	    (
SETQ
 COUNT (QP.SWEEP
 QP.init.E (if
 (before E B)
						    then
 (get.24 B)
						  else
 (E.plus.env.size.from.CP))
				      TABLE COUNT))
	    (
PROMPTPRINT
 "")
	    (
SETQ
 QP.REF.COUNT COUNT)
	    (
SETQ
 QP.REF.LIMIT (if
 (
GREATERP
 COUNT (
TIMES
 LIMIT .75))
				     then
 (
FIX
 (
TIMES
 LIMIT 1.5))
				   elseif
 (
AND
 (
LESSP
 COUNT (
TIMES
 LIMIT .25))
						   (
IGREATERP
 LIMIT 1000))
				     then
 (
FIX
 (
TIMES
 LIMIT .7))
				   else
 LIMIT))
	    (if
 (
EQ
 QP.REF.LIMIT LIMIT)
		then
 (
SETQ
 QP.REF.TABLE TABLE)
	      else
 (
SETQ
 QP.REF.TABLE (
HARRAY
 QP.REF.LIMIT))
		     (
MAPHASH
 TABLE (
FUNCTION
 (LAMBDA (VAL KEY)
				    (
PUTHASH
 KEY VAL QP.REF.TABLE)))))
	    (
SETQ
 QP.REF.LIMIT (
FIX
 (
TIMES
 (
HARRAYSIZE
 QP.REF.TABLE)
						 .8))))
    X))

(\GCSCANPROLOG\

  (LAMBDA NIL
    (if
 (
AND
 (
IGREATERP
 (
ReadPrologTag
 T0)
			      immed.tag.8)
		 (
NOT
 (
SMALLP
 (
ReadPrologPtr
 T0))))
	then
 (\STKREF (
ReadPrologPtr
 T0)))
    (if
 (
AND
 (
IGREATERP
 (
ReadPrologTag
 T1)
			      immed.tag.8)
		 (
NOT
 (
SMALLP
 (
ReadPrologPtr
 T1))))
	then
 (\STKREF (
ReadPrologPtr
 T1)))))
)

(ADDTOVAR GLOBALVARS
 QP.REF.LIMIT)

(ADDTOVAR GLOBALVARS
 QP.REF.COUNT)

(ADDTOVAR GLOBALVARS
 QP.REF.TABLE)
(SETQ QP.REF.TABLE (HARRAY 1000))
(SETQ QP.REF.LIMIT (FIX (TIMES (HARRAYSIZE QP.REF.TABLE)
			       .8)))
(SETQ QP.REF.COUNT 0)
(PUTPROPS GC.LSP COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (539 3260 (QP.ADD.REF 549 . 969) (QP.SWEEP 971 . 1469) (QP.TRIMCORE 1471 . 2871) (
\GCSCANPROLOG\ 2873 . 3258)))))
STOP