X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fgc.lisp;h=f3dacccbcd22e1dba6d3afb5b8a3438e2f19182b;hb=860543cc7ba0266e41e1d41ac9b6a208f3795f1a;hp=95663655942c4b7ba0cb9bb615372d9c8d03312c;hpb=0e2c926fea68a32c8ec58f12daa0c2b5befef1d4;p=sbcl.git

diff --git a/src/code/gc.lisp b/src/code/gc.lisp
index 9566365..f3daccc 100644
--- a/src/code/gc.lisp
+++ b/src/code/gc.lisp
@@ -52,14 +52,14 @@
 (defun control-stack-usage ()
   #!-stack-grows-downward-not-upward
   (- (sb!sys:sap-int (sb!c::control-stack-pointer-sap))
-     (sb!vm:fixnumize sb!vm::*control-stack-start*))
+     (sb!vm:fixnumize sb!vm:*control-stack-start*))
   #!+stack-grows-downward-not-upward
-  (- (sb!vm:fixnumize sb!vm::*control-stack-end*)
+  (- (sb!vm:fixnumize sb!vm:*control-stack-end*)
      (sb!sys:sap-int (sb!c::control-stack-pointer-sap))))
 
 (defun binding-stack-usage ()
   (- (sb!sys:sap-int (sb!c::binding-stack-pointer-sap))
-     (sb!vm:fixnumize sb!vm::*binding-stack-start*)))
+     (sb!vm:fixnumize sb!vm:*binding-stack-start*)))
 
 ;;;; ROOM
 
@@ -138,23 +138,6 @@ and submit it as a patch."
   (+ (dynamic-usage)
      *n-bytes-freed-or-purified*))
 
-;;;; variables and constants
-
-;;; the minimum amount of dynamic space which must be consed before a
-;;; GC will be triggered
-;;;
-;;; Unlike CMU CL, we don't export this variable. (There's no need to,
-;;; since our BYTES-CONSED-BETWEEN-GCS function is SETFable.)
-(defvar *bytes-consed-between-gcs*
-  #!+gencgc (* 4 (expt 10 6))
-  ;; Stop-and-copy GC is really really slow when used too often. CSR
-  ;; reported that even on his old 64 Mb SPARC, 20 Mb is much faster
-  ;; than 4 Mb when rebuilding SBCL ca. 0.7.1. For modern machines
-  ;; with >> 128 Mb memory, the optimum could be significantly more
-  ;; than this, but at least 20 Mb should be better than 4 Mb.
-  #!-gencgc (* 20 (expt 10 6)))
-(declaim (type index *bytes-consed-between-gcs*))
-
 ;;;; GC hooks
 
 (defvar *before-gc-hooks* nil ; actually initialized in cold init
@@ -250,7 +233,7 @@ and submit it as a patch."
 ;;; For GENCGC all generations < GEN will be GC'ed.
 
 #!+sb-thread
-(defun sub-gc (&key (gen 0))
+(defun sub-gc (&key (gen 0) &aux (pre-gc-dynamic-usage (dynamic-usage)))
   (setf *need-to-collect-garbage* t)
   (when (zerop *gc-inhibit*)
     (setf (sb!alien:extern-alien "maybe_gc_pending" (sb!alien:unsigned 32))
@@ -261,6 +244,8 @@ and submit it as a patch."
      (when (zerop
 	    (sb!alien:extern-alien "maybe_gc_pending" (sb!alien:unsigned 32)))
        (return nil)))
+    (incf *n-bytes-freed-or-purified*
+	  (max 0 (- pre-gc-dynamic-usage (dynamic-usage))))
     (setf *need-to-collect-garbage* nil)
     (scrub-control-stack))
   (values))
@@ -268,12 +253,14 @@ and submit it as a patch."
 #!-sb-thread
 (defvar *already-in-gc* nil "System is running SUB-GC")
 #!-sb-thread
-(defun sub-gc (&key (gen 0))
+(defun sub-gc (&key (gen 0) &aux (pre-gc-dynamic-usage (dynamic-usage)))
   (when *already-in-gc* (return-from sub-gc nil))
   (setf *need-to-collect-garbage* t)
   (when (zerop *gc-inhibit*)
     (let ((*already-in-gc* t))
       (without-interrupts (collect-garbage gen))
+      (incf *n-bytes-freed-or-purified*
+	    (max 0 (- pre-gc-dynamic-usage (dynamic-usage))))
       (setf *need-to-collect-garbage* nil))
     (scrub-control-stack))
   (values))
@@ -288,7 +275,7 @@ and submit it as a patch."
   #!+(and sb-doc (not gencgc))
   "Initiate a garbage collection. GEN may be provided for compatibility with
   generational garbage collectors, but is ignored in this implementation."
-  (sub-gc  :gen (if full 6 gen)))
+  (sub-gc :gen (if full 6 gen)))
 
 
 ;;;; auxiliary functions