X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fgc.lisp;h=1acfa9cce24a680c8f9f171ff249902b3b684a54;hb=bb756e3d4b19c30d4a9cd4250b606c5969613ad9;hp=af6a759c4c7bcde16551823c455e10f3e960d5e7;hpb=ffde26c7766d109683ab73622b5b4294a3dd1c52;p=sbcl.git diff --git a/src/code/gc.lisp b/src/code/gc.lisp index af6a759..1acfa9c 100644 --- a/src/code/gc.lisp +++ b/src/code/gc.lisp @@ -208,8 +208,11 @@ environment these hooks may run in any thread.") (sb!thread:make-mutex :name "GC lock") "ID of thread running SUB-GC") (defun sub-gc (&key (gen 0)) - (unless (eql (sb!thread:current-thread-id) - (sb!thread::mutex-value *already-in-gc*)) + (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*) @@ -232,9 +235,10 @@ environment these hooks may run in any thread.") ;; 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))) - (sb!thread::reap-dead-threads))) - ;; Outside the mutex, these may cause another GC. + (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 @@ -293,4 +297,3 @@ environment these hooks may run in any thread.") "Disable the garbage collector." (setq *gc-inhibit* 1) nil) -