- ;; 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")
+ (dolist (hook *before-gc-hooks*) (carefully-funcall hook))
+ (when *gc-trigger*
+ (clear-auto-gc-trigger))
+ (let* ((pre-internal-gc-dynamic-usage (dynamic-usage))
+ (ignore-me (funcall *internal-gc* gen))
+ (post-gc-dynamic-usage (dynamic-usage))
+ (n-bytes-freed (- pre-internal-gc-dynamic-usage
+ post-gc-dynamic-usage))
+ ;; the raw N-BYTES-FREED from GENCGC can sometimes be
+ ;; substantially negative (e.g. -5872). This is
+ ;; probably due to fluctuating inefficiency in the way
+ ;; that the GENCGC packs things into page boundaries.
+ ;; We bump the raw result up to 0: the space is
+ ;; allocated even if unusable, so should be counted
+ ;; for deciding when we've allocated enough to GC
+ ;; next. ("Man isn't a rational animal, he's a
+ ;; rationalizing animal.":-) -- WHN 2001-06-23)
+ (eff-n-bytes-freed (max 0 n-bytes-freed)))
+ (declare (ignore ignore-me))
+ (incf *n-bytes-freed-or-purified* eff-n-bytes-freed)
+ (setf *need-to-collect-garbage* nil)
+ (setf *gc-trigger* (+ post-gc-dynamic-usage
+ *bytes-consed-between-gcs*))
+ (set-auto-gc-trigger *gc-trigger*)
+ (dolist (hook *after-gc-hooks*)
+ (carefully-funcall hook))))
+ (scrub-control-stack)) ;XXX again? we did this from C ...
+ (incf *gc-run-time* (- (get-internal-run-time) start-time))))