-(defun sub-gc (&key (gen 0) &aux (pre-gc-dynamic-usage (dynamic-usage)))
- (let ((me (sb!thread:current-thread-id)))
- (when (eql (sb!thread::mutex-value *already-in-gc*) me)
- (return-from sub-gc nil))
- (setf *need-to-collect-garbage* t)
- (when (zerop *gc-inhibit*)
- (loop
- (sb!thread:with-mutex (*already-in-gc*)
- (unless *need-to-collect-garbage* (return-from sub-gc nil))
- (without-interrupts
- (gc-stop-the-world)
- (collect-garbage gen)
- (incf *n-bytes-freed-or-purified*
- (max 0 (- pre-gc-dynamic-usage (dynamic-usage))))
- (scrub-control-stack)
- (setf *need-to-collect-garbage* nil)
- (dolist (h *after-gc-hooks*) (carefully-funcall h))
- (gc-start-the-world))
- (sb!thread::reap-dead-threads))))))
+;;; 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*))
+ ;; With gencgc, unless *GC-PENDING* every allocation in this
+ ;; function triggers another gc, potentially exceeding maximum
+ ;; 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)
+ (call-hooks "after-GC" *after-gc-hooks* :on-error :warn))))))