From 5945911aaa4f7f8c3f327e39a0a109369348cffb Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Sat, 13 Oct 1990 04:51:06 +0000
Subject: [PATCH] Added stuff to automatically trigger a GC when we exceed
 *gc-trigger*.

---
 code/gc.lisp | 31 ++++++++++++++++++++++++-------
 1 file changed, 24 insertions(+), 7 deletions(-)

diff --git a/code/gc.lisp b/code/gc.lisp
index 575c5b873..080af4915 100644
--- a/code/gc.lisp
+++ b/code/gc.lisp
@@ -8,7 +8,7 @@
 ;;; Scott Fahlman (Scott.Fahlman@CS.CMU.EDU). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/gc.lisp,v 1.4 1990/08/24 18:11:14 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/gc.lisp,v 1.5 1990/10/13 04:51:06 wlott Exp $
 ;;; 
 ;;; Garbage collection and allocation related code.
 ;;;
@@ -150,9 +150,10 @@
 
 ;;; 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.
+;;; setting *NEED-TO-COLLECT-GARBAGE* to T.  It starts out as NIL meaning
+;;; nobody has figured out what it should be yet.
 ;;; 
-(defvar *gc-trigger* default-bytes-consed-between-gcs)
+(defvar *gc-trigger* nil)
 
 
 ;;;
@@ -255,6 +256,14 @@
 
 (def-c-routine ("collect_garbage" collect-garbage) (int))
 
+(def-c-routine ("set_auto_gc_trigger" set-auto-gc-trigger)
+	       (void)
+  (dynamic-usage unsigned-long))
+
+(def-c-routine ("clear_auto_gc_trigger" clear-auto-gc-trigger)
+	       (void))
+
+
 (defun %gc ()
   (let ((old-usage (dynamic-usage)))
     (collect-garbage)
@@ -303,10 +312,11 @@
 	(warn "The value of *BYTES-CONSED-BETWEEN-GCS*, ~S, is not an ~
 	integer.  Reseting it to 2000000" *bytes-consed-between-gcs*)
 	(setf *bytes-consed-between-gcs* default-bytes-consed-between-gcs))
-      (when (> *bytes-consed-between-gcs* *gc-trigger*)
-	(setf *gc-trigger* *bytes-consed-between-gcs*))
-      (when (> pre-gc-dyn-usage *gc-trigger*)
-	(setf *need-to-collect-garbage* t))
+      (when *gc-trigger*
+	(when (> *bytes-consed-between-gcs* *gc-trigger*)
+	  (setf *gc-trigger* *bytes-consed-between-gcs*))
+	(when (> pre-gc-dyn-usage *gc-trigger*)
+	  (setf *need-to-collect-garbage* t)))
       (when (or force-p
 		(and *need-to-collect-garbage* (not *gc-inhibit*)))
 	(setf *gc-inhibit* t) ; Set *GC-INHIBIT* to T before calling the hook
@@ -320,12 +330,15 @@
 	    (carefully-funcall *gc-notify-before* pre-gc-dyn-usage))
 	  (dolist (hook *before-gc-hooks*)
 	    (carefully-funcall hook))
+	  (when *gc-trigger*
+	    (clear-auto-gc-trigger))
 	  (funcall *internal-gc*)
 	  (let* ((post-gc-dyn-usage (dynamic-usage))
 		 (bytes-freed (- pre-gc-dyn-usage post-gc-dyn-usage)))
 	    (setf *need-to-collect-garbage* nil)
 	    (setf *gc-trigger*
 		  (+ post-gc-dyn-usage *bytes-consed-between-gcs*))
+	    (set-auto-gc-trigger *gc-trigger*)
 	    (dolist (hook *after-gc-hooks*)
 	      (carefully-funcall hook))
 	    (when verbose-p
@@ -359,9 +372,13 @@
 
 ;;;; Auxiliary Functions.
 
+
 (defun gc-on ()
   "Enables the garbage collector."
   (setq *gc-inhibit* nil)
+  (unless *gc-trigger*
+    (setf *gc-trigger* *bytes-consed-between-gcs*)
+    (set-auto-gc-trigger *gc-trigger*))
   (when *need-to-collect-garbage*
     (sub-gc *gc-verbose* nil))
   nil)
-- 
GitLab