0.6.11.37:

[sbcl.git] / src / code / gc.lisp

diff --git a/src/code/gc.lisp b/src/code/gc.lisp
index 973799d..c833068 100644 (file)
--- a/src/code/gc.lisp
+++ b/src/code/gc.lisp
@@ -153,10 +153,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
@@ -168,9 +164,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
@@ -260,21 +260,33 @@
              (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
@@ -341,14 +353,21 @@
            (/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*")
@@ -389,20 +408,18 @@
 ;;; 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