X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Fgc.lisp;h=7ba3b3b3e05f7e3a2e50819992006df7b7018cec;hb=4603ca100a7d181fe4316429365fc725501336dd;hp=1a5abc7fc08053a88f2f1dfac2ccebc5c852b2d3;hpb=9f81202cf33e2f87c98ecac8f0511f67932214c8;p=sbcl.git diff --git a/src/code/gc.lisp b/src/code/gc.lisp index 1a5abc7..7ba3b3b 100644 --- a/src/code/gc.lisp +++ b/src/code/gc.lisp @@ -121,6 +121,7 @@ (gc-on) (gc) (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))) @@ -179,57 +180,79 @@ run in any thread.") (defvar *already-in-gc* (sb!thread:make-mutex :name "GC lock") "ID of thread running SUB-GC") +;;; A unique GC id. This is supplied for code that needs to detect +;;; whether a GC has happened since some earlier point in time. For +;;; example: +;;; +;;; (let ((epoch *gc-epoch*)) +;;; ... +;;; (unless (eql epoch *gc-epoch) +;;; ....)) +;;; +;;; This isn't just a fixnum counter since then we'd have theoretical +;;; problems when exactly 2^29 GCs happen between epoch +;;; comparisons. Unlikely, but the cost of using a cons instead is too +;;; small to measure. -- JES, 2007-09-30 +(declaim (type cons *gc-epoch*)) +(defvar *gc-epoch* (cons nil nil)) + (defun sub-gc (&key (gen 0)) (unless (eq sb!thread:*current-thread* - (sb!thread::mutex-value *already-in-gc*)) + (sb!thread:mutex-value *already-in-gc*)) ;; 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)) - (unsafe-clear-roots) - ;; We need to disable interrupts for GC, but we also want - ;; to run as little as possible without them. - (without-interrupts - (gc-stop-the-world) - (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. - ;; In a multithreaded environment the other threads will - ;; see *n-b-f-o-p* change a little late, but that's OK. - (let ((freed (- old-usage new-usage))) - ;; GENCGC occasionally reports negative here, but the - ;; current belief is that it is part of the normal order - ;; of things and not a bug. - (when (plusp freed) - (incf *n-bytes-freed-or-purified* freed))))) - ;; Outside the mutex, these may cause another GC. FIXME: it can - ;; potentially exceed maximum interrupt nesting by triggering - ;; GCs. - ;; - ;; 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)))))))) + ;; interrupt nesting. If *GC-INHIBIT* is not true, however, + ;; there is no guarantee that we would ever check for pending + ;; GC -- so in that case we must first disable interrupts, which + ;; needs to be done for GC anyways... + (cond (*gc-inhibit* + (setf *gc-pending* t)) + (t + (without-interrupts + (setf *gc-pending* t) + (sb!thread:with-mutex (*already-in-gc*) + (let ((old-usage (dynamic-usage)) + (new-usage 0)) + (unsafe-clear-roots) + + (gc-stop-the-world) + (let ((start-time (get-internal-run-time))) + (collect-garbage gen) + (setf *gc-epoch* (cons nil nil)) + (incf *gc-run-time* + (- (get-internal-run-time) start-time))) + (setf *gc-pending* nil + new-usage (dynamic-usage)) + (gc-start-the-world) + + ;; In a multithreaded environment the other threads will + ;; see *n-b-f-o-p* change a little late, but that's OK. + (let ((freed (- old-usage new-usage))) + ;; GENCGC occasionally reports negative here, but the + ;; current belief is that it is part of the normal order + ;; of things and not a bug. + (when (plusp freed) + (incf *n-bytes-freed-or-purified* freed)))))) + + ;; Outside the mutex, interrupts enabled: these may cause + ;; another GC. FIXME: it can potentially exceed maximum + ;; interrupt nesting by triggering GCs. + ;; + ;; 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) + (serious-condition (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) @@ -246,6 +269,9 @@ run in any thread.") ;; as having these cons more then we have space left leads to huge ;; badness. (scrub-control-stack) + ;; Power cache of the bignum printer: drops overly large bignums and + ;; removes duplicate entries. + (scrub-power-cache) ;; FIXME: CTYPE-OF-CACHE-CLEAR isn't thread-safe. #!-sb-thread (ctype-of-cache-clear))