(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*))))
\f
;;;; ROOM
(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)
(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 ()
;;;; 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
\f
;;;; internal GC
(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))
;; 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.
;; 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)
(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)
projects / sbcl.git / blobdiff