(+ (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
(#!+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))
- (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)))
- (setf *need-to-collect-garbage* nil)
- (scrub-control-stack))
- (values))
-
-#!-sb-thread
(defvar *already-in-gc* nil "System is running SUB-GC")
-#!-sb-thread
-(defun sub-gc (&key (gen 0))
+(defvar *gc-mutex* (sb!thread:make-mutex :name "GC Mutex"))
+
+(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))
- (setf *need-to-collect-garbage* nil))
- (scrub-control-stack))
+ (sb!thread:with-recursive-lock (*gc-mutex*)
+ (let ((*already-in-gc* t))
+ (without-interrupts
+ (gc-stop-the-world)
+ ;; XXX run before-gc-hooks
+ (collect-garbage gen)
+ (incf *n-bytes-freed-or-purified*
+ (max 0 (- pre-gc-dynamic-usage (dynamic-usage))))
+ (setf *need-to-collect-garbage* nil)
+ ;; XXX run after-gc-hooks
+ (gc-start-the-world)))
+ (scrub-control-stack)))
(values))
#!+(and sb-doc (not gencgc))
"Initiate a garbage collection. GEN may be provided for compatibility with
generational garbage collectors, but is ignored in this implementation."
- (sub-gc :gen (if full 6 gen)))
+ (sub-gc :gen (if full 6 gen)))
\f
;;;; auxiliary functions