X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fgc.lisp;h=04562f088ca083015583cd19a13cb5e919768e34;hb=22a6702974b7d6ff4e8f2b3b7b5ff446fc632de0;hp=b9d7fb1e930a4383792b8401782452ae0456e550;hpb=47eb330ef0f3b99d24c0e24d897b757f16950c4b;p=sbcl.git

diff --git a/src/code/gc.lisp b/src/code/gc.lisp
index b9d7fb1..04562f0 100644
--- a/src/code/gc.lisp
+++ b/src/code/gc.lisp
@@ -49,14 +49,14 @@
 (defun control-stack-usage ()
   #!-stack-grows-downward-not-upward
   (- (sb!sys:sap-int (sb!c::control-stack-pointer-sap))
-     (sb!vm:fixnumize sb!vm:*control-stack-start*))
+     (sb!sys:sap-int (sb!di::descriptor-sap sb!vm:*control-stack-start*)))
   #!+stack-grows-downward-not-upward
-  (- (sb!vm:fixnumize sb!vm:*control-stack-end*)
+  (- (sb!sys:sap-int (sb!di::descriptor-sap sb!vm:*control-stack-end*))
      (sb!sys:sap-int (sb!c::control-stack-pointer-sap))))
 
 (defun binding-stack-usage ()
   (- (sb!sys:sap-int (sb!c::binding-stack-pointer-sap))
-     (sb!vm:fixnumize sb!vm:*binding-stack-start*)))
+     (sb!sys:sap-int (sb!di::descriptor-sap sb!vm:*binding-stack-start*))))
 
 ;;;; ROOM
 
@@ -120,7 +120,9 @@
 (defun gc-reinit ()
   (gc-on)
   (gc)
-  (setf *n-bytes-freed-or-purified* 0))
+  (setf *n-bytes-freed-or-purified* 0
+        ;; See comment in interr.lisp
+        *heap-exhausted-error-condition* (make-condition 'heap-exhausted-error)))
 
 (declaim (ftype (function () unsigned-byte) get-bytes-consed))
 (defun get-bytes-consed ()
@@ -192,7 +194,10 @@ environment these hooks may run in any thread.")
           ;; to run as little as possible without them.
           (without-interrupts
             (gc-stop-the-world)
-            (collect-garbage gen)
+            (let ((start-time (get-internal-run-time)))
+              (collect-garbage gen)
+              (incf *gc-run-time*
+                    (- (get-internal-run-time) start-time)))
             (setf *gc-pending* nil
                   new-usage (dynamic-usage))
             (gc-start-the-world))
@@ -208,6 +213,9 @@ environment these hooks may run in any thread.")
       ;; Outside the mutex, 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?
       (run-pending-finalizers)
       (dolist (hook *after-gc-hooks*)
         (handler-case
@@ -250,16 +258,20 @@ environment these hooks may run in any thread.")
                                (sb!alien:unsigned 32))
         val))
 
+(declaim (inline maybe-handle-pending-gc))
+(defun maybe-handle-pending-gc ()
+  (when (and (not *gc-inhibit*)
+             (or #!+sb-thread *stop-for-gc-pending*
+                 *gc-pending*))
+    (sb!unix::receive-pending-interrupt)))
+
 ;;; These work both regardless of whether we're inside WITHOUT-GCING
 ;;; or not.
 (defun gc-on ()
   #!+sb-doc
   "Enable the garbage collector."
   (setq *gc-inhibit* nil)
-  (when (and (not *gc-inhibit*)
-             (or #!+sb-thread *stop-for-gc-pending*
-                 *gc-pending*))
-    (sb!unix::receive-pending-interrupt))
+  (maybe-handle-pending-gc)
   nil)
 
 (defun gc-off ()