X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fgc.lisp;h=7945c279a07079251bf04adb1524fa591ddf2371;hb=a7002797a1fb36ec3a7c30f6ebcb314b0e58e817;hp=a41dec0a4a4bd591af36ae6d73e1bb968ad9f3fe;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git diff --git a/src/code/gc.lisp b/src/code/gc.lisp index a41dec0..7945c27 100644 --- a/src/code/gc.lisp +++ b/src/code/gc.lisp @@ -49,14 +49,14 @@ (defun control-stack-usage () #!-stack-grows-downward-not-upward (- (sb!sys:sap-int (sb!c::control-stack-pointer-sap)) - (sb!vm:fixnumize sb!vm:*control-stack-start*)) + (sb!sys:sap-int (sb!di::descriptor-sap sb!vm:*control-stack-start*))) #!+stack-grows-downward-not-upward - (- (sb!vm:fixnumize sb!vm:*control-stack-end*) + (- (sb!sys:sap-int (sb!di::descriptor-sap sb!vm:*control-stack-end*)) (sb!sys:sap-int (sb!c::control-stack-pointer-sap)))) (defun binding-stack-usage () (- (sb!sys:sap-int (sb!c::binding-stack-pointer-sap)) - (sb!vm:fixnumize sb!vm:*binding-stack-start*))) + (sb!sys:sap-int (sb!di::descriptor-sap sb!vm:*binding-stack-start*)))) ;;;; ROOM @@ -70,7 +70,7 @@ (format t "Control and binding stack usage is for the current thread only.~%") (format t "Garbage collection is currently ~:[enabled~;DISABLED~].~%" - (> *gc-inhibit* 0))) + *gc-inhibit*)) (defun room-intermediate-info () (room-minimal-info) @@ -120,7 +120,10 @@ (defun gc-reinit () (gc-on) (gc) - (setf *n-bytes-freed-or-purified* 0)) + (setf *n-bytes-freed-or-purified* 0 + *gc-run-time* 0 + ;; See comment in interr.lisp + *heap-exhausted-error-condition* (make-condition 'heap-exhausted-error))) (declaim (ftype (function () unsigned-byte) get-bytes-consed)) (defun get-bytes-consed () @@ -137,40 +140,10 @@ and submit it as a patch." ;;;; GC hooks (defvar *after-gc-hooks* nil - "Called after each garbage collection. In a multithreaded -environment these hooks may run in any thread.") + "Called after each garbage collection, except for garbage collections +triggered during thread exits. In a multithreaded environment these hooks may +run in any thread.") -;;;; The following specials are used to control when garbage -;;;; collection occurs. - -;;; When the dynamic usage increases beyond this amount, the system -;;; notes that a garbage collection needs to occur by setting -;;; *NEED-TO-COLLECT-GARBAGE* to T. It starts out as NIL meaning -;;; nobody has figured out what it should be yet. -;;; -;;; FIXME: *GC-TRIGGER* seems to be denominated in bytes, not words. -;;; And limiting it to INDEX is fairly reasonable in order to avoid -;;; bignum arithmetic on every allocation, and to minimize the need -;;; for thought about weird gotchas of the GC-control mechanism itself -;;; consing as it operates. But as of sbcl-0.7.5, 512Mbytes of memory -;;; costs $54.95 at Fry's in Dallas but cheap consumer 64-bit machines -;;; are still over the horizon, so gratuitously limiting our heap size -;;; to FIXNUM bytes seems fairly stupid. It'd be reasonable to -;;; (1) allow arbitrary UNSIGNED-BYTE values of *GC-TRIGGER*, or -;;; (2) redenominate this variable in words instead of bytes, postponing -;;; the problem to heaps which exceed 50% of the machine's address -;;; space, or even -;;; (3) redemoninate this variable in CONS-sized two-word units, -;;; allowing it to cover the entire memory space at the price of -;;; possible loss of clarity. -;;; (And whatever is done, it'd also be good to rename the variable so -;;; that it's clear what unit it's denominated in.) -(declaim (type (or index null) *gc-trigger*)) -(defvar *gc-trigger* nil) - -;;; 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 ;;;; internal GC @@ -210,11 +183,11 @@ environment these hooks may run in any thread.") (defun sub-gc (&key (gen 0)) (unless (eq sb!thread:*current-thread* (sb!thread::mutex-value *already-in-gc*)) - ;; With gencgc, unless *NEED-TO-COLLECT-GARBAGE* every allocation - ;; in this function triggers another gc, potentially exceeding - ;; maximum interrupt nesting. - (setf *need-to-collect-garbage* t) - (when (zerop *gc-inhibit*) + ;; With gencgc, unless *GC-PENDING* every allocation in this + ;; function triggers another gc, potentially exceeding maximum + ;; interrupt nesting. + (setq *gc-pending* t) + (unless *gc-inhibit* (sb!thread:with-mutex (*already-in-gc*) (let ((old-usage (dynamic-usage)) (new-usage 0)) @@ -223,8 +196,11 @@ environment these hooks may run in any thread.") ;; to run as little as possible without them. (without-interrupts (gc-stop-the-world) - (collect-garbage gen) - (setf *need-to-collect-garbage* nil + (let ((start-time (get-internal-run-time))) + (collect-garbage gen) + (incf *gc-run-time* + (- (get-internal-run-time) start-time))) + (setf *gc-pending* nil new-usage (dynamic-usage)) (gc-start-the-world)) ;; Interrupts re-enabled, but still inside the mutex. @@ -239,12 +215,22 @@ environment these hooks may run in any thread.") ;; Outside the mutex, these may cause another GC. FIXME: it can ;; potentially exceed maximum interrupt nesting by triggering ;; GCs. - (run-pending-finalizers) - (dolist (hook *after-gc-hooks*) - (handler-case - (funcall hook) - (error (c) - (warn "Error calling after GC hook ~S:~% ~S" hook c))))))) + ;; + ;; Can that be avoided by having the finalizers and hooks run only + ;; from the outermost SUB-GC? + ;; + ;; KLUDGE: Don't run the hooks in GC's triggered by dying threads, + ;; so that user-code never runs with + ;; (thread-alive-p *current-thread*) => nil + ;; The long-term solution will be to keep a separate thread for + ;; finalizers and after-gc hooks. + (when (sb!thread:thread-alive-p sb!thread:*current-thread*) + (run-pending-finalizers) + (dolist (hook *after-gc-hooks*) + (handler-case + (funcall hook) + (error (c) + (warn "Error calling after-GC hook ~S:~% ~A" hook c)))))))) ;;; This is the user-advertised garbage collection function. (defun gc (&key (gen 0) (full nil) &allow-other-keys) @@ -281,19 +267,24 @@ environment these hooks may run in any thread.") (sb!alien:unsigned 32)) val)) -;;; FIXME: Aren't these utterly wrong if called inside WITHOUT-GCING? -;;; Unless something that works there too can be deviced this fact -;;; should be documented. +(declaim (inline maybe-handle-pending-gc)) +(defun maybe-handle-pending-gc () + (when (and (not *gc-inhibit*) + (or #!+sb-thread *stop-for-gc-pending* + *gc-pending*)) + (sb!unix::receive-pending-interrupt))) + +;;; These work both regardless of whether we're inside WITHOUT-GCING +;;; or not. (defun gc-on () #!+sb-doc "Enable the garbage collector." - (setq *gc-inhibit* 0) - (when *need-to-collect-garbage* - (sub-gc)) + (setq *gc-inhibit* nil) + (maybe-handle-pending-gc) nil) (defun gc-off () #!+sb-doc "Disable the garbage collector." - (setq *gc-inhibit* 1) + (setq *gc-inhibit* t) nil)