-(defvar *gc-mutex* (sb!thread:make-mutex :name "GC Mutex"))
-
-(defun sub-gc (&key (gen 0))
- (when (sb!thread::mutex-value *gc-mutex*) (return-from sub-gc nil))
- (sb!thread:with-mutex (*gc-mutex* :wait-p nil)
- (let* ((start-time (get-internal-run-time)))
- (setf *need-to-collect-garbage* t)
- (when (zerop *gc-inhibit*)
- (without-interrupts
- (dolist (hook *before-gc-hooks*) (carefully-funcall hook))
- (when *gc-trigger*
- (clear-auto-gc-trigger))
- (let* ((pre-internal-gc-dynamic-usage (dynamic-usage))
- (ignore-me (funcall *internal-gc* gen))
- (post-gc-dynamic-usage (dynamic-usage))
- (n-bytes-freed (- pre-internal-gc-dynamic-usage
- post-gc-dynamic-usage))
- ;; the raw N-BYTES-FREED from GENCGC can sometimes be
- ;; substantially negative (e.g. -5872). This is
- ;; probably due to fluctuating inefficiency in the way
- ;; that the GENCGC packs things into page boundaries.
- ;; We bump the raw result up to 0: the space is
- ;; allocated even if unusable, so should be counted
- ;; for deciding when we've allocated enough to GC
- ;; next. ("Man isn't a rational animal, he's a
- ;; rationalizing animal.":-) -- WHN 2001-06-23)
- (eff-n-bytes-freed (max 0 n-bytes-freed)))
- (declare (ignore ignore-me))
- (incf *n-bytes-freed-or-purified* eff-n-bytes-freed)
- (setf *need-to-collect-garbage* nil)
- (setf *gc-trigger* (+ post-gc-dynamic-usage
- *bytes-consed-between-gcs*))
- (set-auto-gc-trigger *gc-trigger*)
- (dolist (hook *after-gc-hooks*)
- (carefully-funcall hook))))
- (scrub-control-stack)) ;XXX again? we did this from C ...
- (incf *gc-run-time* (- (get-internal-run-time) start-time))))
- nil)
-
-
-
+(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)))
+ (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))
+ (sb!thread::reap-dead-threads))))))