X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fgc.lisp;h=89daf1f0fe6848538e6c5dc5dbe82d349d0201eb;hb=5108495b13b99452d5a85c4600f68432ff8894b2;hp=a2ad5f54d3f393adba43432fca1b5186a77d943b;hpb=5f338d314224411587a7cac218ea320bc982f19f;p=sbcl.git diff --git a/src/code/gc.lisp b/src/code/gc.lisp index a2ad5f5..89daf1f 100644 --- a/src/code/gc.lisp +++ b/src/code/gc.lisp @@ -10,9 +10,6 @@ ;;;; files for more information. (in-package "SB!KERNEL") - -(file-comment - "$Header$") ;;;; DYNAMIC-USAGE and friends @@ -26,8 +23,19 @@ (defun ,lisp-fun () (sb!alien:extern-alien ,c-var-name (sb!alien:unsigned 32)))))) +#!+(or cgc gencgc) (progn #!-sb-fluid (declaim (inline dynamic-usage)) -(def-c-var-frob dynamic-usage "bytes_allocated") +(def-c-var-frob dynamic-usage "bytes_allocated")) + +#!-(or cgc gencgc) +(defun dynamic-usage () + (the (unsigned-byte 32) + (- (sb!sys:sap-int (sb!c::dynamic-space-free-pointer)) + (current-dynamic-space-start)))) + +#!-gencgc (progn +#!-sb-fluid (declaim (inline current-dynamic-space-start)) +(def-c-var-frob current-dynamic-space-start "current_dynamic_space")) (defun static-space-usage () (- (* sb!vm:*static-space-free-pointer* sb!vm:word-bytes) @@ -39,13 +47,13 @@ (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)) ;;;; ROOM @@ -156,10 +164,6 @@ 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 @@ -171,9 +175,13 @@ #!+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 @@ -232,17 +240,18 @@ (finish-output notify-stream)) (defparameter *gc-notify-after* #'default-gc-notify-after #!+sb-doc - "The function bound to this variable is invoked after GC'ing (unless - *GC-VERBOSE* is NIL) with the value of *GC-NOTIFY-STREAM*, - the amount of dynamic usage (in bytes) now free, the number of - bytes freed by the GC, and the new GC trigger threshold. The function - should notify the user that the system has finished GC'ing.") + "The function bound to this variable is invoked after GC'ing with +the value of *GC-NOTIFY-STREAM*, the amount of dynamic usage (in +bytes) now free, the number of bytes freed by the GC, and the new GC +trigger threshold. The function should notify the user that the system +has finished GC'ing.") ;;;; internal GC (sb!alien:def-alien-routine collect-garbage sb!c-call:int #!+gencgc (last-gen sb!c-call:int)) + (sb!alien:def-alien-routine set-auto-gc-trigger sb!c-call:void (dynamic-usage sb!c-call:unsigned-long)) @@ -263,21 +272,32 @@ (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 (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 @@ -302,15 +322,12 @@ 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 @@ -321,7 +338,6 @@ ;; 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* @@ -329,11 +345,9 @@ (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 @@ -341,28 +355,33 @@ #!+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))) + (/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") (if (streamp *gc-notify-stream*) (carefully-funcall *gc-notify-after* *gc-notify-stream* @@ -371,13 +390,10 @@ *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*") + (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 - (/show "returning from tail of SUB-GC") nil) ;;; This routine is called by the allocation miscops to decide whether @@ -388,24 +404,14 @@ object) ;;; This is the user-advertised garbage collection function. -;;; -;;; KLUDGE: GC shouldn't have different parameters depending on what -;;; garbage collector we use. -- WHN 19991020 -#!-gencgc -(defun gc (&optional (verbose-p *gc-verbose*)) - #!+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)) -#!+gencgc -(defun gc (&key (verbose *gc-verbose*) (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." - ;; 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))) + +(defun gc (&key (gen 0) (full nil) &allow-other-keys) + #!+(and sb-doc gencgc) + "Initiates a garbage collection. GEN controls the number of generations to garbage collect" + #!+(and sb-doc (not gencgc)) + "Initiates a garbage collection. GEN may be provided for compatibility, but is ignored" + (sub-gc :force-p t :gen (if full 6 gen))) + ;;;; auxiliary functions