-;;; FIXME: The VERBOSE-P stuff is no longer used.
-(defun sub-gc (&key (verbose-p *gc-verbose*) force-p #!+gencgc (gen 0))
- (/show0 "entering SUB-GC")
- (unless *already-maybe-gcing*
- (/show0 "not *ALREADY-MAYBE-GCING*")
- (let* ((*already-maybe-gcing* t)
- (start-time (get-internal-run-time))
- (pre-gc-dyn-usage (dynamic-usage)))
- (unless (integerp (symbol-value '*bytes-consed-between-gcs*))
- ;; The noise w/ symbol-value above is to keep the compiler
- ;; from optimizing the test away because of the type declaim
- ;; for *bytes-consed-between-gcs*.
- ;;
- ;; FIXME: I'm inclined either to get rid of the DECLAIM or to
- ;; trust it, instead of doing this weird hack. It's not
- ;; particularly trustable, since (SETF
- ;; *BYTES-CONSED-BETWEEN-GCS* 'SEVEN) works. But it's also not
- ;; very nice to have the type of the variable specified in two
- ;; places which can (and in CMU CL 2.4.8 did, INTEGER vs.
- ;; INDEX) drift apart. So perhaps we should just add a note to
- ;; the variable documentation for *BYTES-CONSED-BETWEEN-GCS*
- ;; that it must be an INDEX, and remove the DECLAIM. Or we
- ;; could make a SETFable (BYTES-CONSED-BETWEEN-GCS) function
- ;; and enforce the typing that way. And in fact the SETFable
- ;; function already exists, so all we need do is make the
- ;; variable private, and then we can trust the DECLAIM.
- (warn "The value of *BYTES-CONSED-BETWEEN-GCS*, ~S, is not an ~
- integer. Resetting it to ~D."
- *bytes-consed-between-gcs*
- default-bytes-consed-between-gcs)
- (setf *bytes-consed-between-gcs* default-bytes-consed-between-gcs))
- (when (and *gc-trigger* (> pre-gc-dyn-usage *gc-trigger*))
- (/show0 "setting *NEED-TO-COLLECT-GARBAGE* to T")
- (setf *need-to-collect-garbage* t))
- (when (or force-p
- (and *need-to-collect-garbage* (not *gc-inhibit*)))
- (/show0 "Evidently we ought to collect garbage..")
- (when (and (not force-p)
- *gc-inhibit-hook*
- (carefully-funcall *gc-inhibit-hook* pre-gc-dyn-usage))
- (/show0 "..but we're inhibited.")
- (setf *gc-inhibit* t)
- (return-from sub-gc nil))
- ;; KLUDGE: Wow, we really mask interrupts all the time we're
- ;; collecting garbage? That seems like a long time.. -- WHN 19991129
- (without-interrupts
- ;; FIXME: We probably shouldn't do this evil thing to
- ;; *STANDARD-OUTPUT* in a binding which is wrapped around
- ;; calls to user-settable GC hook functions.
- (let ((*standard-output* *terminal-io*))
- (when *gc-notify-stream*
- (/show0 "doing the *GC-NOTIFY-BEFORE* thing")
- (if (streamp *gc-notify-stream*)
- (carefully-funcall *gc-notify-before*
- *gc-notify-stream*
- pre-gc-dyn-usage)
- (warn
- "*GC-NOTIFY-STREAM* is set, but not a STREAM -- ignored.")))
- (dolist (hook *before-gc-hooks*)
- (/show0 "doing a hook from *BEFORE-GC-HOOKS*")
- (carefully-funcall hook))
- (when *gc-trigger*
- (clear-auto-gc-trigger))
- (/show0 "FUNCALLing *INTERNAL-GC*, one way or another")
- #!-gencgc (funcall *internal-gc*)
- ;; FIXME: This EQ test is pretty gross. Among its other
- ;; nastinesses, it looks as though it could break if we
- ;; recompile COLLECT-GARBAGE.
- #!+gencgc (if (eq *internal-gc* #'collect-garbage)
- (funcall *internal-gc* gen)
- (funcall *internal-gc*))
- (/show0 "back from FUNCALL to *INTERNAL-GC*")
- (let* ((post-gc-dyn-usage (dynamic-usage))
- (bytes-freed (- pre-gc-dyn-usage post-gc-dyn-usage)))
- (when *last-bytes-in-use*
- (incf *total-bytes-consed*
- (- pre-gc-dyn-usage *last-bytes-in-use*))
- (setq *last-bytes-in-use* post-gc-dyn-usage))
- (setf *need-to-collect-garbage* nil)
- (let ((new-gc-trigger (+ post-gc-dyn-usage
- *bytes-consed-between-gcs*)))
- (setf *gc-trigger* new-gc-trigger))
- (set-auto-gc-trigger *gc-trigger*)
- (dolist (hook *after-gc-hooks*)
- (/show0 "doing a hook from *AFTER-GC--HOOKS*")
- ;; FIXME: This hook should be called with the
- ;; same kind of information as *GC-NOTIFY-AFTER*.
- ;; In particular, it would be nice for the
- ;; hook function to be able to adjust *GC-TRIGGER*
- ;; intelligently to e.g. 108% of total memory usage.
- (carefully-funcall hook))
- (when *gc-notify-stream*
- (/show0 "doing the *GC-NOTIFY-AFTER* thing")
- (if (streamp *gc-notify-stream*)
- (carefully-funcall *gc-notify-after*
- *gc-notify-stream*
- post-gc-dyn-usage
- bytes-freed
- *gc-trigger*)
- (warn
- "*GC-NOTIFY-STREAM* is set, but not a stream -- ignored.")))))
- (/show0 "scrubbing control stack")
- (scrub-control-stack)))
- (/show0 "updating *GC-RUN-TIME*")
- (incf *gc-run-time* (- (get-internal-run-time)
- start-time))))
- ;; FIXME: should probably return (VALUES), here and in RETURN-FROM
- (/show "returning from tail of SUB-GC")
- nil)
-
-;;; This routine is called by the allocation miscops to decide whether
-;;; a GC should occur. The argument, OBJECT, is the newly allocated
-;;; object which must be returned to the caller.
-(defun maybe-gc (&optional object)
- (sub-gc)
- object)
+;;; 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))
+ (cond (*gc-inhibit*
+ (setf *gc-pending* t)
+ nil)
+ (t
+ (without-interrupts
+ (setf *gc-pending* :in-progress)
+ ;; Tricks to to prevent triggerring a recursive gc. This is
+ ;; like a WITHOUT-GCING inside the lock except that we
+ ;; cannot call MAYBE-HANDLE-PENDING-GC at the end, because
+ ;; that would lead to a recursive attempt on the lock. In
+ ;; case you are wondering, wrapping the lock in a
+ ;; WITHOUT-GCING would also deadlock. The
+ ;; *IN-WITHOUT-GCING* part is used to tell the runtime that
+ ;; it's ok to have a pending gc even though *GC-INHIBIT* is
+ ;; NIL.
+ ;;
+ ;; Now, if GET-MUTEX did not cons, that would be enough.
+ ;; Because it does, we need the :IN-PROGRESS bit above to
+ ;; tell the runtime not to trigger gcs.
+ (let ((sb!impl::*in-without-gcing* t)
+ (sb!impl::*deadline* nil)
+ (sb!impl::*deadline-seconds* nil))
+ (sb!thread:with-mutex (*already-in-gc*)
+ (let ((*gc-inhibit* t))
+ (let ((old-usage (dynamic-usage))
+ (new-usage 0))
+ (unsafe-clear-roots gen)
+ (gc-stop-the-world)
+ (let ((start-time (get-internal-run-time)))
+ (collect-garbage gen)
+ (setf *gc-epoch* (cons nil nil))
+ (let ((run-time (- (get-internal-run-time) start-time)))
+ ;; KLUDGE: Sometimes we see the second getrusage() call
+ ;; return a smaller value than the first, which can
+ ;; lead to *GC-RUN-TIME* to going negative, which in
+ ;; turn is a type-error.
+ (when (plusp run-time)
+ (incf *gc-run-time* run-time))))
+ (setf *gc-pending* nil
+ new-usage (dynamic-usage))
+ #!+sb-thread
+ (assert (not *stop-for-gc-pending*))
+ (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)))))))
+ ;; While holding the mutex we were protected from
+ ;; SIG_STOP_FOR_GC and recursive GCs. Now, in order to
+ ;; preserve the invariant (*GC-PENDING* ->
+ ;; pseudo-atomic-interrupted or *GC-INHIBIT*), let's check
+ ;; explicitly for a pending gc before interrupts are
+ ;; enabled again.
+ (maybe-handle-pending-gc))
+ t)))
+
+(defun post-gc ()
+ ;; Outside the mutex, interrupts may be 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? If the nested GCs happen in interrupt
+ ;; handlers that's not enough.
+ ;;
+ ;; KLUDGE: Don't run the hooks in GC's if:
+ ;;
+ ;; A) this thread is dying, so that user-code never runs with
+ ;; (thread-alive-p *current-thread*) => nil
+ ;;
+ ;; B) interrupts are disabled somewhere up the call chain since we
+ ;; don't want to run user code in such a case.
+ ;;
+ ;; 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*)
+ (when *allow-with-interrupts*
+ (with-interrupts
+ (run-pending-finalizers)
+ (call-hooks "after-GC" *after-gc-hooks* :on-error :warn)))))