- (when *already-in-gc* (return-from sub-gc nil))
- (setf *need-to-collect-garbage* t)
- (when (zerop *gc-inhibit*)
- (let ((*already-in-gc* t))
- (without-interrupts (collect-garbage gen))
- (setf *need-to-collect-garbage* nil))
- (scrub-control-stack))
- (values))
-
-
+ (unless (eq sb!thread:*current-thread*
+ (sb!thread::mutex-value *already-in-gc*))
+ ;; With gencgc, unless *NEED-TO-COLLECT-GARBAGE* every allocation
+ ;; in this function triggers another gc, potentially exceeding
+ ;; maximum interrupt nesting.
+ (setf *need-to-collect-garbage* t)
+ (when (zerop *gc-inhibit*)
+ (sb!thread:with-mutex (*already-in-gc*)
+ (let ((old-usage (dynamic-usage))
+ (new-usage 0))
+ (unsafe-clear-roots)
+ ;; We need to disable interrupts for GC, but we also want
+ ;; to run as little as possible without them.
+ (without-interrupts
+ (gc-stop-the-world)
+ (collect-garbage gen)
+ (setf *need-to-collect-garbage* nil
+ new-usage (dynamic-usage))
+ (gc-start-the-world))
+ ;; Interrupts re-enabled, but still inside the mutex.
+ ;; In a multithreaded environment the other threads will
+ ;; see *n-b-f-o-p* change a little late, but that's OK.
+ (let ((freed (- old-usage new-usage)))
+ ;; GENCGC occasionally reports negative here, but the
+ ;; current belief is that it is part of the normal order
+ ;; of things and not a bug.
+ (when (plusp freed)
+ (incf *n-bytes-freed-or-purified* freed)))))
+ ;; Outside the mutex, these may cause another GC. FIXME: it can
+ ;; potentially exceed maximum interrupt nesting by triggering
+ ;; GCs.
+ (run-pending-finalizers)
+ (dolist (hook *after-gc-hooks*)
+ (handler-case
+ (funcall hook)
+ (error (c)
+ (warn "Error calling after GC hook ~S:~% ~S" hook c)))))))