(FILECREATED "23-Apr-86 15:49:53" {DSK}<LISPFILES2>DCOMS>GC.;4
 3727   

      changes to:  (FNS QP.TRIMCORE)
		   (VARS GCCOMS)

      previous date: " 9-Feb-86 23:32:18" {DSK}<LISPFILES2>DCOMS>GC.;2)


(* 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 40)))
		 (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)                                                (* pds: "23-Apr-86 15:36")

    (
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))
	    (
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 40))
				     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 40))
(SETQ QP.REF.LIMIT (FIX (TIMES (HARRAYSIZE QP.REF.TABLE)
			       .8)))
(SETQ QP.REF.COUNT 0)
(PUTPROPS GC COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (635 3395 (QP.ADD.REF 645 . 1065) (QP.SWEEP 1067 . 1563) (QP.TRIMCORE 1565 . 3015) (
\GCSCANPROLOG\ 3017 . 3393)))))
STOP