: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
;;; 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 ()
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.
(declaim (type (or index null) *gc-trigger*))
(defvar *gc-trigger* nil)
-;;; When >0, inhibits garbage collection.
-(defvar *gc-inhibit*) ; initialized in cold init
-
;;; When T, indicates that a GC should have happened but did not due to
;;; *GC-INHIBIT*.
(defvar *need-to-collect-garbage* nil) ; initialized in cold init
;;; For GENCGC all generations < GEN will be GC'ed.
-(defvar *already-in-gc* nil "System is running SUB-GC")
-(defvar *gc-mutex* (sb!thread:make-mutex :name "GC Mutex"))
+(defvar *already-in-gc*
+ (sb!thread:make-mutex :name "GC lock") "ID of thread running SUB-GC")
(defun sub-gc (&key (gen 0) &aux (pre-gc-dynamic-usage (dynamic-usage)))
- (when *already-in-gc* (return-from sub-gc nil))
- (setf *need-to-collect-garbage* t)
- (when (zerop *gc-inhibit*)
- (sb!thread:with-recursive-lock (*gc-mutex*)
- (let ((*already-in-gc* t))
- (without-interrupts
- (gc-stop-the-world)
- (dolist (h *before-gc-hooks*)
- (carefully-funcall h))
- (collect-garbage gen)
- (incf *n-bytes-freed-or-purified*
- (max 0 (- pre-gc-dynamic-usage (dynamic-usage))))
- (setf *need-to-collect-garbage* nil)
- (dolist (h *after-gc-hooks*)
- (carefully-funcall h))
- (gc-start-the-world)))
- (scrub-control-stack)))
- (values))
-
-
+ (let ((me (sb!thread:current-thread-id)))
+ (when (eql (sb!thread::mutex-value *already-in-gc*) me)
+ (return-from sub-gc nil))
+ (setf *need-to-collect-garbage* t)
+ (when (zerop *gc-inhibit*)
+ (loop
+ (sb!thread:with-mutex (*already-in-gc*)
+ (unless *need-to-collect-garbage* (return-from sub-gc nil))
+ (without-interrupts
+ (gc-stop-the-world)
+ (collect-garbage gen)
+ (incf *n-bytes-freed-or-purified*
+ (max 0 (- pre-gc-dynamic-usage (dynamic-usage))))
+ (scrub-control-stack)
+ (setf *need-to-collect-garbage* nil)
+ (dolist (h *after-gc-hooks*) (carefully-funcall h))
+ (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)