0.8.13.69:

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

diff --git a/src/code/gc.lisp b/src/code/gc.lisp
index e048d8d..db65ac7 100644 (file)
--- a/src/code/gc.lisp
+++ b/src/code/gc.lisp
@@ -83,10 +83,14 @@
                      :print-summary nil))
 
 (defun room-maximal-info ()
                      :print-summary nil))
 
 (defun room-maximal-info ()

-  (room-minimal-info)
-  (sb!vm:memory-usage :count-spaces '(:static :dynamic))
-  (sb!vm:instance-usage :dynamic :top-n 10)
-  (sb!vm:instance-usage :static :top-n 10))
+  ;; FIXME: SB!VM:INSTANCE-USAGE calls suppressed until bug 344 is fixed
+  (room-intermediate-info)
+  ;; old way, could be restored when bug 344 fixed:
+  ;;x (room-minimal-info)
+  ;;x (sb!vm:memory-usage :count-spaces '(:static :dynamic))
+  ;;x (sb!vm:instance-usage :dynamic :top-n 10)
+  ;;x (sb!vm:instance-usage :static :top-n 10)
+  )

 
 (defun room (&optional (verbosity :default))
   #!+sb-doc
 
 (defun room (&optional (verbosity :default))
   #!+sb-doc

@@ -152,12 +156,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 +184,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,28 +228,28 @@ 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)))

-  ;; catch attempts to gc recursively or during post-hooks and ignore them
-  (when (sb!thread::mutex-value *gc-mutex*)  (return-from sub-gc nil))
-  (sb!thread:with-mutex (*gc-mutex* :wait-p nil)
+  (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*)
     (setf *need-to-collect-garbage* t)
     (when (zerop *gc-inhibit*)

-      (without-interrupts
-       (gc-stop-the-world)
-       (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)
-      (setf *need-to-collect-garbage* nil)
-      (dolist (h *after-gc-hooks*) (carefully-funcall h))))
-  (values))
-       
-
+      (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))
+        (sb!thread::reap-dead-threads))))))

 
 ;;; 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)