0.8.16.2: TYPE-ERROR for ERROR

[sbcl.git] / src / code / gc.lisp

diff --git a/src/code/gc.lisp b/src/code/gc.lisp
index 1a221d6..98c4e4c 100644 (file)
--- a/src/code/gc.lisp
+++ b/src/code/gc.lisp
@@ -83,10 +83,14 @@
                      :print-summary nil))
 
 (defun room-maximal-info ()
-  (room-minimal-info)
-  (sb!vm:memory-usage :count-spaces '(:static :dynamic))
-  (sb!vm:instance-usage :dynamic :top-n 10)
-  (sb!vm:instance-usage :static :top-n 10))
+  ;; FIXME: SB!VM:INSTANCE-USAGE calls suppressed until bug 344 is fixed
+  (room-intermediate-info)
+  ;; old way, could be restored when bug 344 fixed:
+  ;;x (room-minimal-info)
+  ;;x (sb!vm:memory-usage :count-spaces '(:static :dynamic))
+  ;;x (sb!vm:instance-usage :dynamic :top-n 10)
+  ;;x (sb!vm:instance-usage :static :top-n 10)
+  )
 
 (defun room (&optional (verbosity :default))
   #!+sb-doc
@@ -116,15 +120,10 @@
 ;;; allocated and never freed.)
 (declaim (type unsigned-byte *n-bytes-freed-or-purified*))
 (defvar *n-bytes-freed-or-purified* 0)
-(push (lambda ()
-       (setf *n-bytes-freed-or-purified* 0))
-      ;; KLUDGE: It's probably not quite safely right either to do
-      ;; this in *BEFORE-SAVE-INITIALIZATIONS* (since consing, or even
-      ;; worse, something which depended on (GET-BYTES-CONSED), might
-      ;; happen after that) or in *AFTER-SAVE-INITIALIZATIONS*. But
-      ;; it's probably not a big problem, and there seems to be no
-      ;; other obvious time to do it. -- WHN 2001-07-30
-      *after-save-initializations*)
+(defun gc-reinit ()
+  (gc-on)
+  (gc)
+  (setf *n-bytes-freed-or-purified* 0))
 
 (declaim (ftype (function () unsigned-byte) get-bytes-consed))
 (defun get-bytes-consed ()
@@ -244,7 +243,8 @@ and submit it as a patch."
          (scrub-control-stack)
          (setf *need-to-collect-garbage* nil)
          (dolist (h *after-gc-hooks*) (carefully-funcall h))
-         (gc-start-the-world)))))))
+         (gc-start-the-world))
+        (sb!thread::reap-dead-threads))))))
 
 ;;; This is the user-advertised garbage collection function.
 (defun gc (&key (gen 0) (full nil) &allow-other-keys)