X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Fgc.lisp;h=98c4e4c8594669c257bf93f6707e2f2e134fefee;hb=70b1a2776c9f3947503b4bcbb8ca5d944e635fb0;hp=10f4bcecf9650dbc0b78a1a7952fef8b74648c4c;hpb=dcf5978d9d33098e868ae6eea28e1b310038c03d;p=sbcl.git diff --git a/src/code/gc.lisp b/src/code/gc.lisp index 10f4bce..98c4e4c 100644 --- 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 () @@ -152,12 +151,6 @@ and submit it as a patch." The functions are run with interrupts disabled and all other threads paused. They should take no arguments.") -(defvar *gc-run-time* 0 - #!+sb-doc - "the total CPU time spent doing garbage collection (as reported by - GET-INTERNAL-RUN-TIME)") -(declaim (type index *gc-run-time*)) - ;;;; The following specials are used to control when garbage ;;;; collection occurs. @@ -250,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)