X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fgc.lisp;h=04562f088ca083015583cd19a13cb5e919768e34;hb=68ea71d0f020f2726e3c56c1ec491d0af734b3a4;hp=a41dec0a4a4bd591af36ae6d73e1bb968ad9f3fe;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git diff --git a/src/code/gc.lisp b/src/code/gc.lisp index a41dec0..04562f0 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,9 @@ (defun gc-reinit () (gc-on) (gc) - (setf *n-bytes-freed-or-purified* 0)) + (setf *n-bytes-freed-or-purified* 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 () @@ -140,37 +142,6 @@ and submit it as a patch." "Called after each garbage collection. 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 +181,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 +194,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,6 +213,9 @@ 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. + ;; + ;; Can that be avoided by having the finalizers and hooks run only + ;; from the outermost SUB-GC? (run-pending-finalizers) (dolist (hook *after-gc-hooks*) (handler-case @@ -281,19 +258,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)