0.8.3.6:

[sbcl.git] / src / code / gc.lisp

diff --git a/src/code/gc.lisp b/src/code/gc.lisp
index 9566365..dcff492 100644 (file)
--- 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*)))
 \f
 ;;;; ROOM
 
@@ -138,23 +138,6 @@ and submit it as a patch."
   (+ (dynamic-usage)
      *n-bytes-freed-or-purified*))
 \f
-;;;; 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
@@ -221,9 +204,14 @@ and submit it as a patch."
   (#!+gencgc last-gen #!-gencgc ignore sb!alien:int))
 
 #!+sb-thread
-(def-c-var-frob gc-thread-pid "gc_thread_pid")
+(progn
+  (sb!alien:define-alien-routine gc-stop-the-world sb!alien:void)
+  (sb!alien:define-alien-routine gc-start-the-world sb!alien:void))
+#!-sb-thread
+(progn
+  (defun gc-stop-the-world ())
+  (defun gc-start-the-world ()))
 
-       
 \f
 ;;;; SUB-GC
 
@@ -237,7 +225,8 @@ and submit it as a patch."
 
 ;;; SUB-GC does a garbage collection.  This is called from three places:
 ;;; (1) The C runtime will call here when it detects that we've consed 
-;;;     enough to exceed the gc trigger threshold
+;;;     enough to exceed the gc trigger threshold.  This is done in
+;;;     alloc() for gencgc or interrupt_maybe_gc() for cheneygc
 ;;; (2) The user may request a collection using GC, below
 ;;; (3) At the end of a WITHOUT-GCING section, we are called if
 ;;;     *NEED-TO-COLLECT-GARBAGE* is true
@@ -249,33 +238,25 @@ and submit it as a patch."
 
 ;;; For GENCGC all generations < GEN will be GC'ed.
 
-#!+sb-thread
-(defun sub-gc (&key (gen 0))
-  (setf *need-to-collect-garbage* t)
-  (when (zerop *gc-inhibit*)
-    (setf (sb!alien:extern-alien "maybe_gc_pending" (sb!alien:unsigned 32))
-         (1+ gen))
-    (if (zerop (sb!alien:extern-alien "stop_the_world" (sb!alien:unsigned 32)))
-       (sb!unix:unix-kill (gc-thread-pid) :SIGALRM))
-    (loop
-     (when (zerop
-           (sb!alien:extern-alien "maybe_gc_pending" (sb!alien:unsigned 32)))
-       (return nil)))
-    (setf *need-to-collect-garbage* nil)
-    (scrub-control-stack))
-  (values))
-
-#!-sb-thread
 (defvar *already-in-gc* nil "System is running SUB-GC")
-#!-sb-thread
-(defun sub-gc (&key (gen 0))
+(defvar *gc-mutex* (sb!thread:make-mutex :name "GC Mutex"))
+
+(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))
-      (setf *need-to-collect-garbage* nil))
-    (scrub-control-stack))
+    (sb!thread:with-recursive-lock (*gc-mutex*)
+      (let ((*already-in-gc* t))
+       (without-interrupts
+        (gc-stop-the-world)
+        ;; XXX run before-gc-hooks
+        (collect-garbage gen)
+        (incf *n-bytes-freed-or-purified*
+              (max 0 (- pre-gc-dynamic-usage (dynamic-usage))))
+        (setf *need-to-collect-garbage* nil)
+        ;; XXX run after-gc-hooks
+        (gc-start-the-world)))
+      (scrub-control-stack)))
   (values))
        
 
@@ -288,7 +269,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)))
 
 \f
 ;;;; auxiliary functions