0.8.8.29:

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

diff --git a/src/code/gc.lisp b/src/code/gc.lisp
index 684e926..1a221d6 100644 (file)
--- a/src/code/gc.lisp
+++ b/src/code/gc.lisp
@@ -152,12 +152,6 @@ and submit it as a patch."
   The functions are run with interrupts disabled and all other threads
   paused.  They should take no arguments.")
 
   The functions are run with interrupts disabled and all other threads
   paused.  They should take no arguments.")
 

-(defvar *gc-run-time* 0
-  #!+sb-doc
-  "the total CPU time spent doing garbage collection (as reported by
-   GET-INTERNAL-RUN-TIME)")
-(declaim (type index *gc-run-time*))
-

 ;;;; The following specials are used to control when garbage
 ;;;; collection occurs.
 
 ;;;; The following specials are used to control when garbage
 ;;;; collection occurs.
 

@@ -186,9 +180,6 @@ and submit it as a patch."
 (declaim (type (or index null) *gc-trigger*))
 (defvar *gc-trigger* nil)
 
 (declaim (type (or index null) *gc-trigger*))
 (defvar *gc-trigger* nil)
 

-;;; When >0, inhibits garbage collection.
-(defvar *gc-inhibit*) ; initialized in cold init
-

 ;;; When T, indicates that a GC should have happened but did not due to 
 ;;; *GC-INHIBIT*. 
 (defvar *need-to-collect-garbage* nil) ; initialized in cold init
 ;;; When T, indicates that a GC should have happened but did not due to 
 ;;; *GC-INHIBIT*. 
 (defvar *need-to-collect-garbage* nil) ; initialized in cold init

@@ -233,32 +224,27 @@ and submit it as a patch."
 
 ;;; For GENCGC all generations < GEN will be GC'ed.
 
 
 ;;; For GENCGC all generations < GEN will be GC'ed.
 

-(defvar *already-in-gc* nil "System is running SUB-GC")
-(defvar *gc-mutex* (sb!thread:make-mutex :name "GC Mutex"))
+(defvar *already-in-gc* 
+  (sb!thread:make-mutex :name "GC lock") "ID of thread running SUB-GC")

 
 (defun sub-gc (&key (gen 0) &aux (pre-gc-dynamic-usage (dynamic-usage)))
 
 (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*)
-    (sb!thread:with-recursive-lock (*gc-mutex*)
-      (let ((*already-in-gc* t))
-       (without-interrupts
-        (gc-stop-the-world)
-        #+nil
-        (dolist (h *before-gc-hooks*)
-          (carefully-funcall h))
-        (collect-garbage gen)
-        (incf *n-bytes-freed-or-purified*
-              (max 0 (- pre-gc-dynamic-usage (dynamic-usage))))
-        (setf *need-to-collect-garbage* nil)
-
-        (gc-start-the-world)))
-      (scrub-control-stack))
-    (dolist (h *after-gc-hooks*)
-      (carefully-funcall h)))
-  (values))
-       
-
+  (let ((me (sb!thread:current-thread-id)))
+    (when (eql (sb!thread::mutex-value *already-in-gc*) me) 
+      (return-from sub-gc nil))
+    (setf *need-to-collect-garbage* t)
+    (when (zerop *gc-inhibit*)
+      (loop
+       (sb!thread:with-mutex (*already-in-gc*)
+        (unless *need-to-collect-garbage* (return-from sub-gc nil))
+        (without-interrupts
+         (gc-stop-the-world)
+         (collect-garbage gen)
+         (incf *n-bytes-freed-or-purified*
+               (max 0 (- pre-gc-dynamic-usage (dynamic-usage))))
+         (scrub-control-stack)
+         (setf *need-to-collect-garbage* nil)
+         (dolist (h *after-gc-hooks*) (carefully-funcall h))
+         (gc-start-the-world)))))))

 
 ;;; This is the user-advertised garbage collection function.
 (defun gc (&key (gen 0) (full nil) &allow-other-keys)
 
 ;;; This is the user-advertised garbage collection function.
 (defun gc (&key (gen 0) (full nil) &allow-other-keys)