- ;; 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*
- (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*)
- (carefully-funcall hook))
- (when *gc-trigger*
- (clear-auto-gc-trigger))
- #!-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*))
- (let* ((post-gc-dyn-usage (dynamic-usage))
- (bytes-freed (- pre-gc-dyn-usage post-gc-dyn-usage)))
- (/show0 "got (DYNAMIC-USAGE) and BYTES-FREED")
- (when *last-bytes-in-use*
- (/show0 "doing *LAST-BYTES-IN-USE* thing")
- (incf *total-bytes-consed*
- (- pre-gc-dyn-usage *last-bytes-in-use*))
- (/show0 "setting *LAST-BYTES-IN-USE*")
- (setq *last-bytes-in-use* post-gc-dyn-usage))
- (/show0 "clearing *NEED-TO-COLLECT-GARBAGE*")
- (setf *need-to-collect-garbage* nil)
- (/show0 "calculating NEW-GC-TRIGGER")
- (let ((new-gc-trigger (+ post-gc-dyn-usage
- *bytes-consed-between-gcs*)))
- (/show0 "setting *GC-TRIGGER*")
- (setf *gc-trigger* new-gc-trigger))
- (/show0 "calling SET-AUTO-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*
- (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.")))))
- (scrub-control-stack))) ;XXX again? we did this from C ...
- (incf *gc-run-time* (- (get-internal-run-time)
- start-time))))
- ;; FIXME: should probably return (VALUES), here and in RETURN-FROM
- nil)