;;;; files for more information.
(in-package "SB!KERNEL")
-
-(file-comment
- "$Header$")
\f
;;;; DYNAMIC-USAGE and friends
(defun ,lisp-fun ()
(sb!alien:extern-alien ,c-var-name (sb!alien:unsigned 32))))))
-(def-c-var-frob sb!vm:control-stack-start "control_stack")
-#!+x86 (def-c-var-frob control-stack-end "control_stack_end")
-
#!-sb-fluid (declaim (inline dynamic-usage))
(def-c-var-frob dynamic-usage "bytes_allocated")
(defun control-stack-usage ()
#!-x86 (- (sb!sys:sap-int (sb!c::control-stack-pointer-sap))
- (control-stack-start))
- #!+x86 (- (control-stack-end)
+ sb!vm:control-stack-start)
+ #!+x86 (- 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:binding-stack-start)))
+ sb!vm:binding-stack-start))
\f
;;;; ROOM
usage. The function should return NIL if garbage collection should
continue and non-NIL if it should be inhibited. Use with caution.")
-(defvar *gc-verbose* nil ; (actually initialized in cold init)
- #!+sb-doc
- "Should low-level GC functions produce verbose diagnostic output?")
-
(defvar *gc-notify-stream* nil ; (actually initialized in cold init)
#!+sb-doc
"When non-NIL, this must be a STREAM; and the functions bound to
#!+sb-doc
"The total CPU time spent doing garbage collection (as reported by
GET-INTERNAL-RUN-TIME.)")
-
(declaim (type index *gc-run-time*))
+;;; a limit to help catch programs which allocate too much memory,
+;;; since a hard heap overflow is so hard to recover from.
+(declaim (type (or unsigned-byte null) *soft-heap-limit*))
+(defvar *soft-heap-limit* nil)
+
;;; Internal trigger. 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
(warn "(FUNCALL ~S~{ ~S~}) lost:~%~A" ',function ',args cond)
nil))))
-;;; SUB-GC decides when and if to do a garbage collection. The
-;;; VERBOSE-P flag controls whether or not the notify functions are
-;;; called. The FORCE-P flags controls if a GC should occur even if
+;;; SUB-GC decides when and if to do a garbage collection.
+;;; The FORCE-P flags controls if a GC should occur even if
;;; the dynamic usage is not greater than *GC-TRIGGER*.
;;;
;;; For GENCGC all generations < GEN will be GC'ed.
;;;
-;;; FIXME: The VERBOSE-P stuff is no longer used.
-(defun sub-gc (&key (verbose-p *gc-verbose*) force-p #!+gencgc (gen 0))
+(defun sub-gc (&key 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)))
+ (pre-gc-dyn-usage (dynamic-usage))
+ ;; Currently we only check *SOFT-HEAP-LIMIT* at GC time,
+ ;; not for every allocation. That makes it cheap to do,
+ ;; even if it is a little ugly.
+ (soft-heap-limit-exceeded? (and *soft-heap-limit*
+ (> pre-gc-dyn-usage
+ *soft-heap-limit*)))
+ (*soft-heap-limit* (if soft-heap-limit-exceeded?
+ (+ pre-gc-dyn-usage
+ *bytes-consed-between-gcs*)
+ *soft-heap-limit*)))
+ (when soft-heap-limit-exceeded?
+ (cerror "Continue with GC."
+ "soft heap limit exceeded (temporary new limit=~D)"
+ *soft-heap-limit*))
(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
(/show0 "back from FUNCALL to *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.
+ ;; 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")
(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")
+ (/show0 "returning from tail of SUB-GC")
nil)
;;; This routine is called by the allocation miscops to decide whether
;;; KLUDGE: GC shouldn't have different parameters depending on what
;;; garbage collector we use. -- WHN 19991020
#!-gencgc
-(defun gc (&optional (verbose-p *gc-verbose*))
+(defun gc ()
#!+sb-doc
- "Initiates a garbage collection. VERBOSE-P controls
- whether or not GC statistics are printed."
- (sub-gc :verbose-p verbose-p :force-p t))
+ "Initiates a garbage collection."
+ (sub-gc :force-p t))
#!+gencgc
-(defun gc (&key (verbose *gc-verbose*) (gen 0) (full nil))
+(defun gc (&key (gen 0) (full nil))
#!+sb-doc
- "Initiates a garbage collection. VERBOSE controls whether or not GC
- statistics are printed. GEN controls the number of generations to garbage
- collect."
+ "Initiates a garbage collection.
+ GEN controls the number of generations to garbage collect."
;; FIXME: The bare 6 here (corresponding to a bare 6 in
;; the gencgc.c sources) is nasty.
- (sub-gc :verbose-p verbose :force-p t :gen (if full 6 gen)))
+ (sub-gc :force-p t :gen (if full 6 gen)))
\f
;;;; auxiliary functions