0.8.4.1

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

diff --git a/src/code/gc.lisp b/src/code/gc.lisp
index dcff492..e048d8d 100644 (file)
--- a/src/code/gc.lisp
+++ b/src/code/gc.lisp
@@ -143,19 +143,14 @@ and submit it as a patch."
 (defvar *before-gc-hooks* nil ; actually initialized in cold init
   #!+sb-doc
   "A list of functions that are called before garbage collection occurs.
-  The functions should take no arguments.")
+  The functions are run with interrupts disabled and all other threads
+  paused.  They should take no arguments.")
 
 (defvar *after-gc-hooks* nil ; actually initialized in cold init
   #!+sb-doc
   "A list of functions that are called after garbage collection occurs.
-  The functions should take no arguments.")
-
-(defvar *gc-notify-stream* nil ; (actually initialized in cold init)
-  #!+sb-doc
-  "When non-NIL, this must be a STREAM; and the functions bound to
-  *GC-NOTIFY-BEFORE* and *GC-NOTIFY-AFTER* are called with the
-  STREAM value before and after a garbage collection occurs
-  respectively.")
+  The functions are run with interrupts disabled and all other threads
+  paused.  They should take no arguments.")
 
 (defvar *gc-run-time* 0
   #!+sb-doc
@@ -242,21 +237,21 @@ and submit it as a patch."
 (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*)
-    (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)))
+  ;; 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)
+    (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))