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

diff --git a/src/code/gc.lisp b/src/code/gc.lisp
index f3b9615..06d38a0 100644
--- a/src/code/gc.lisp
+++ b/src/code/gc.lisp
@@ -13,9 +13,6 @@
 
 ;;;; DYNAMIC-USAGE and friends
 
-(declaim (special sb!vm:*read-only-space-free-pointer*
-                  sb!vm:*static-space-free-pointer*))
-
 (eval-when (:compile-toplevel :execute)
   (sb!xc:defmacro def-c-var-fun (lisp-fun c-var-name)
     `(defun ,lisp-fun ()
@@ -197,7 +194,8 @@ run in any thread.")
 
 (defun sub-gc (&key (gen 0))
   (cond (*gc-inhibit*
-         (setf *gc-pending* t))
+         (setf *gc-pending* t)
+         nil)
         (t
          (without-interrupts
            (setf *gc-pending* :in-progress)
@@ -214,7 +212,9 @@ run in any thread.")
            ;; 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))
+           (let ((sb!impl::*in-without-gcing* t)
+                 (sb!impl::*deadline* nil)
+                 (sb!impl::*deadline-seconds* nil))
              (sb!thread:with-mutex (*already-in-gc*)
                (let ((*gc-inhibit* t))
                  (let ((old-usage (dynamic-usage))
@@ -247,21 +247,32 @@ run in any thread.")
            ;; 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)))))
+         t)))
+
+(defun post-gc ()
+  ;; Outside the mutex, interrupts may be 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? If the nested GCs happen in interrupt
+  ;; handlers that's not enough.
+  ;;
+  ;; KLUDGE: Don't run the hooks in GC's if:
+  ;;
+  ;; A) this thread is dying, so that user-code never runs with
+  ;;    (thread-alive-p *current-thread*) => nil
+  ;;
+  ;; B) interrupts are disabled somewhere up the call chain since we
+  ;;    don't want to run user code in such a case.
+  ;;
+  ;; 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*)
+    (when *allow-with-interrupts*
+      (with-interrupts
+        (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)
@@ -271,7 +282,10 @@ run in any thread.")
   #!+(and sb-doc (not gencgc))
   "Initiate a garbage collection. GEN may be provided for compatibility with
   generational garbage collectors, but is ignored in this implementation."
-  (sub-gc :gen (if full 6 gen)))
+  (when (sub-gc :gen (if full 6 gen))
+    (post-gc)))
+
+(define-alien-routine scrub-control-stack sb!alien:void)
 
 (defun unsafe-clear-roots ()
   ;; KLUDGE: Do things in an attempt to get rid of extra roots. Unsafe