(+ (dynamic-usage)
*n-bytes-freed-or-purified*))
\f
-;;;; variables and constants
-
-;;; the minimum amount of dynamic space which must be consed before a
-;;; GC will be triggered
-;;;
-;;; Unlike CMU CL, we don't export this variable. (There's no need to,
-;;; since our BYTES-CONSED-BETWEEN-GCS function is SETFable.)
-(defvar *bytes-consed-between-gcs*
- #!+gencgc (* 4 (expt 10 6))
- ;; Stop-and-copy GC is really really slow when used too often. CSR
- ;; reported that even on his old 64 Mb SPARC, 20 Mb is much faster
- ;; than 4 Mb when rebuilding SBCL ca. 0.7.1. For modern machines
- ;; with >> 128 Mb memory, the optimum could be significantly more
- ;; than this, but at least 20 Mb should be better than 4 Mb.
- #!-gencgc (* 20 (expt 10 6)))
-(declaim (type index *bytes-consed-between-gcs*))
-
;;;; GC hooks
(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.
(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
(#!+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 ()))
-
\f
;;;; SUB-GC
;;; 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
;;; 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)))))))
;;; This is the user-advertised garbage collection function.
(defun gc (&key (gen 0) (full nil) &allow-other-keys)
projects / sbcl.git / blobdiff