X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fgc.lisp;h=f3b961540ee68d6d41407664b2a1ec503f0cd584;hb=e9c546b14771ebe96447c3920a75e9e580f9075f;hp=e94a3928aa8f8663483168cc10965f8c7182d4c7;hpb=edb227f57bcf629a9e8c3b8e6e1b37d644d8f217;p=sbcl.git

diff --git a/src/code/gc.lisp b/src/code/gc.lisp
index e94a392..f3b9615 100644
--- a/src/code/gc.lisp
+++ b/src/code/gc.lisp
@@ -196,57 +196,72 @@ run in any thread.")
 (defvar *gc-epoch* (cons nil nil))
 
 (defun sub-gc (&key (gen 0))
-  (unless (sb!thread:holding-mutex-p *already-in-gc*)
-    ;; With gencgc, unless *GC-PENDING* every allocation in this
-    ;; function triggers another gc, potentially exceeding maximum
-    ;; interrupt nesting. If *GC-INHIBIT* is not true, however,
-    ;; there is no guarantee that we would ever check for pending
-    ;; GC -- so in that case we must first disable interrupts, which
-    ;; needs to be done for GC anyways...
-    (cond (*gc-inhibit*
-           (setf *gc-pending* t))
-          (t
-           (without-interrupts
-             (setf *gc-pending* t)
-             (sb!thread:with-mutex (*already-in-gc*)
-               (let ((old-usage (dynamic-usage))
-                     (new-usage 0))
-                 (unsafe-clear-roots)
-
-                 (gc-stop-the-world)
-                 (let ((start-time (get-internal-run-time)))
-                   (collect-garbage gen)
-                   (setf *gc-epoch* (cons nil nil))
-                   (incf *gc-run-time*
-                         (- (get-internal-run-time) start-time)))
-                 (setf *gc-pending* nil
-                       new-usage (dynamic-usage))
-                 (gc-start-the-world)
-
-                 ;; 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, interrupts enabled: these may cause
-           ;; another GC. FIXME: it can potentially exceed maximum
-           ;; interrupt nesting by triggering GCs.
-           ;;
-           ;; Can that be avoided by having the finalizers and hooks
-           ;; run only from the outermost SUB-GC?
+  (cond (*gc-inhibit*
+         (setf *gc-pending* t))
+        (t
+         (without-interrupts
+           (setf *gc-pending* :in-progress)
+           ;; Tricks to to prevent triggerring a recursive gc. This is
+           ;; like a WITHOUT-GCING inside the lock except that we
+           ;; cannot call MAYBE-HANDLE-PENDING-GC at the end, because
+           ;; that would lead to a recursive attempt on the lock. In
+           ;; case you are wondering, wrapping the lock in a
+           ;; WITHOUT-GCING would also deadlock. The
+           ;; *IN-WITHOUT-GCING* part is used to tell the runtime that
+           ;; it's ok to have a pending gc even though *GC-INHIBIT* is
+           ;; NIL.
            ;;
-           ;; KLUDGE: Don't run the hooks in GC's triggered by dying
-           ;; threads, so that user-code never runs with
-           ;;   (thread-alive-p *current-thread*) => nil
-           ;; The long-term solution will be to keep a separate thread
-           ;; for finalizers and after-gc hooks.
-           (when (sb!thread:thread-alive-p sb!thread:*current-thread*)
-             (run-pending-finalizers)
-             (call-hooks "after-GC" *after-gc-hooks* :on-error :warn))))))
+           ;; Now, if GET-MUTEX did not cons, that would be enough.
+           ;; Because it does, we need the :IN-PROGRESS bit above to
+           ;; tell the runtime not to trigger gcs.
+           (let ((sb!impl::*in-without-gcing* t))
+             (sb!thread:with-mutex (*already-in-gc*)
+               (let ((*gc-inhibit* t))
+                 (let ((old-usage (dynamic-usage))
+                       (new-usage 0))
+                   (unsafe-clear-roots)
+                   (gc-stop-the-world)
+                   (let ((start-time (get-internal-run-time)))
+                     (collect-garbage gen)
+                     (setf *gc-epoch* (cons nil nil))
+                     (incf *gc-run-time*
+                           (- (get-internal-run-time) start-time)))
+                   (setf *gc-pending* nil
+                         new-usage (dynamic-usage))
+                   #!+sb-thread
+                   (assert (not *stop-for-gc-pending*))
+                   (gc-start-the-world)
+                   ;; 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)))))))
+           ;; While holding the mutex we were protected from
+           ;; SIG_STOP_FOR_GC and recursive GCs. Now, in order to
+           ;; preserve the invariant (*GC-PENDING* ->
+           ;; pseudo-atomic-interrupted or *GC-INHIBIT*), let's check
+           ;; explicitly for a pending gc before interrupts are
+           ;; enabled again.
+           (maybe-handle-pending-gc))
+         ;; Outside the mutex, interrupts enabled: these may cause
+         ;; another GC. FIXME: it can potentially exceed maximum
+         ;; interrupt nesting by triggering GCs.
+         ;;
+         ;; Can that be avoided by having the finalizers and hooks
+         ;; run only from the outermost SUB-GC?
+         ;;
+         ;; KLUDGE: Don't run the hooks in GC's triggered by dying
+         ;; threads, so that user-code never runs with
+         ;;   (thread-alive-p *current-thread*) => nil
+         ;; The long-term solution will be to keep a separate thread
+         ;; for finalizers and after-gc hooks.
+         (when (sb!thread:thread-alive-p sb!thread:*current-thread*)
+           (run-pending-finalizers)
+           (call-hooks "after-GC" *after-gc-hooks* :on-error :warn)))))
 
 ;;; This is the user-advertised garbage collection function.
 (defun gc (&key (gen 0) (full nil) &allow-other-keys)