X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fgc.lisp;h=10f4bcecf9650dbc0b78a1a7952fef8b74648c4c;hb=a6103aace1e40d0948aeb090f7b5d5ca77fc293a;hp=dcff4924165bd5ca103116449f87c212ad35cc5e;hpb=2378b4fe567a8fea78b1e4915b9497d8c18ca92f;p=sbcl.git

diff --git a/src/code/gc.lisp b/src/code/gc.lisp
index dcff492..10f4bce 100644
--- 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
@@ -191,9 +186,6 @@ and submit it as a patch."
 (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
@@ -238,28 +230,27 @@ and submit it as a patch."
 
 ;;; 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)))
-  (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)))
-  (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)