X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fgc.lisp;h=98c4e4c8594669c257bf93f6707e2f2e134fefee;hb=11b388bac03fea3220e058eb93466bef7b66af75;hp=f3dacccbcd22e1dba6d3afb5b8a3438e2f19182b;hpb=ebdf67c1da1884d5def43062a97174f28fcb6a2c;p=sbcl.git diff --git a/src/code/gc.lisp b/src/code/gc.lisp index f3daccc..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 () @@ -143,25 +142,14 @@ and submit it as a patch." (defvar *before-gc-hooks* nil ; actually initialized in cold init #!+sb-doc "A list of functions that are called before garbage collection occurs. - The functions should take no arguments.") + The functions are run with interrupts disabled and all other threads + paused. They should take no arguments.") (defvar *after-gc-hooks* nil ; actually initialized in cold init #!+sb-doc "A list of functions that are called after garbage collection occurs. - The functions should take no arguments.") - -(defvar *gc-notify-stream* nil ; (actually initialized in cold init) - #!+sb-doc - "When non-NIL, this must be a STREAM; and the functions bound to - *GC-NOTIFY-BEFORE* and *GC-NOTIFY-AFTER* are called with the - STREAM value before and after a garbage collection occurs - respectively.") - -(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 functions are run with interrupts disabled and all other threads + paused. They should take no arguments.") ;;;; The following specials are used to control when garbage ;;;; collection occurs. @@ -191,9 +179,6 @@ and submit it as a patch." (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 @@ -204,9 +189,14 @@ and submit it as a patch." (#!+gencgc last-gen #!-gencgc ignore sb!alien:int)) #!+sb-thread -(def-c-var-frob gc-thread-pid "gc_thread_pid") +(progn + (sb!alien:define-alien-routine gc-stop-the-world sb!alien:void) + (sb!alien:define-alien-routine gc-start-the-world sb!alien:void)) +#!-sb-thread +(progn + (defun gc-stop-the-world ()) + (defun gc-start-the-world ())) - ;;;; SUB-GC @@ -220,7 +210,8 @@ and submit it as a patch." ;;; SUB-GC does a garbage collection. This is called from three places: ;;; (1) The C runtime will call here when it detects that we've consed -;;; enough to exceed the gc trigger threshold +;;; enough to exceed the gc trigger threshold. This is done in +;;; alloc() for gencgc or interrupt_maybe_gc() for cheneygc ;;; (2) The user may request a collection using GC, below ;;; (3) At the end of a WITHOUT-GCING section, we are called if ;;; *NEED-TO-COLLECT-GARBAGE* is true @@ -232,40 +223,28 @@ and submit it as a patch." ;;; For GENCGC all generations < GEN will be GC'ed. -#!+sb-thread -(defun sub-gc (&key (gen 0) &aux (pre-gc-dynamic-usage (dynamic-usage))) - (setf *need-to-collect-garbage* t) - (when (zerop *gc-inhibit*) - (setf (sb!alien:extern-alien "maybe_gc_pending" (sb!alien:unsigned 32)) - (1+ gen)) - (if (zerop (sb!alien:extern-alien "stop_the_world" (sb!alien:unsigned 32))) - (sb!unix:unix-kill (gc-thread-pid) :SIGALRM)) - (loop - (when (zerop - (sb!alien:extern-alien "maybe_gc_pending" (sb!alien:unsigned 32))) - (return nil))) - (incf *n-bytes-freed-or-purified* - (max 0 (- pre-gc-dynamic-usage (dynamic-usage)))) - (setf *need-to-collect-garbage* nil) - (scrub-control-stack)) - (values)) +(defvar *already-in-gc* + (sb!thread:make-mutex :name "GC lock") "ID of thread running SUB-GC") -#!-sb-thread -(defvar *already-in-gc* nil "System is running SUB-GC") -#!-sb-thread (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*) - (let ((*already-in-gc* t)) - (without-interrupts (collect-garbage gen)) - (incf *n-bytes-freed-or-purified* - (max 0 (- pre-gc-dynamic-usage (dynamic-usage)))) - (setf *need-to-collect-garbage* nil)) - (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)