From d0cab6a7a96eabe41ff77048ce246e93a5e69137 Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Thu, 26 Mar 1992 03:24:14 +0000 Subject: [PATCH] Added GC-INIT to facilitate making sure set-auto-gc-trigger. Changed room-minimal-info to print everything that doesn't use map-allocated- objects and also to indicate whether or not the garbage collector is currenty on or off. Changed sub-gc to handle updating *total-bytes-consed* instead of having %GC do it so that it happens even when *internal-gc* is bound to something else. Flush %GC because it now does nothing but call COLLECT-GARBAGE. --- code/gc.lisp | 68 +++++++++++++++++++++++++++------------------------- 1 file changed, 36 insertions(+), 32 deletions(-) diff --git a/code/gc.lisp b/code/gc.lisp index f03914ab5..5f12d482e 100644 --- a/code/gc.lisp +++ b/code/gc.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/gc.lisp,v 1.11 1992/02/19 19:19:00 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/gc.lisp,v 1.12 1992/03/26 03:24:14 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -84,7 +84,12 @@ (defun room-minimal-info () (format t "Dynamic Space Usage: ~10:D bytes.~%" (dynamic-usage)) (format t "Read-Only Space Usage: ~10:D bytes.~%" (read-only-space-usage)) - (format t "Static Space Usage: ~10:D bytes.~%" (static-space-usage))) + (format t "Static Space Usage: ~10:D bytes.~%" (static-space-usage)) + (format t "Control Stack Usage: ~10:D bytes.~%" (control-stack-usage)) + (format t "Binding Stack Usage: ~10:D bytes.~%" (binding-stack-usage)) + (format t "The current dynamic space is ~D.~%" (current-dynamic-space)) + (format t "Garbage collection is currently ~:[DISABLED~;enabled.~]~%" + *gc-trigger*)) (defun room-intermediate-info () (room-minimal-info) @@ -95,9 +100,6 @@ (defun room-maximal-info () (room-minimal-info) - (format t "Control Stack Usage: ~10:D bytes.~%" (control-stack-usage)) - (format t "Binding Stack Usage: ~10:D bytes.~%" (binding-stack-usage)) - (format t "The current dynamic space is ~D.~%" (current-dynamic-space)) (vm:memory-usage :count-spaces '(:static :dynamic)) (vm:structure-usage :dynamic :top-n 10) (vm:structure-usage :static :top-n 10)) @@ -120,7 +122,8 @@ (room-intermediate-info)) (t (error "No way man! The optional argument to ROOM must be T, NIL, ~ - or :DEFAULT.~%What do you think you are doing?")))) + or :DEFAULT.~%What do you think you are doing?"))) + (values)) ;;;; GET-BYTES-CONSED. @@ -163,14 +166,16 @@ ;;; (defvar *bytes-consed-between-gcs* default-bytes-consed-between-gcs "This number specifies the minimum number of bytes of dynamic space - that must be consed before the next gc will occur.") + that must be consed before the next gc will occur.") + +(declaim (type index *bytes-consed-between-gcs*)) ;;; Public (defvar *gc-run-time* 0 "The total CPU time spend doing garbage collection (as reported by GET-INTERNAL-RUN-TIME.)") -(declaim (type index *bytes-consed-between-gcs* *gc-run-time*)) +(declaim (type index *gc-run-time*)) ;;; Internal trigger. When the dynamic usage increases beyond this ;;; amount, the system notes that a garbage collection needs to occur by @@ -309,16 +314,6 @@ (defun clear-auto-gc-trigger () (setf rt::*internal-gc-trigger* -1)) - -(defun %gc () - (let ((old-usage (dynamic-usage))) - (collect-garbage) - (let ((new-bytes (dynamic-usage))) - (when *last-bytes-in-use* - (incf *total-bytes-consed* (- old-usage *last-bytes-in-use*)) - (setq *last-bytes-in-use* new-bytes))))) - - ;;; ;;; *INTERNAL-GC* ;;; @@ -326,7 +321,7 @@ ;;; for low-level GC experimentation. Do not touch it if you do not ;;; know what you are doing. ;;; -(defvar *internal-gc* #'%gc) +(defvar *internal-gc* #'collect-garbage) ;;;; SUB-GC @@ -350,22 +345,20 @@ ;;; called. The FORCE-P flags controls if a GC should occur even if the ;;; dynamic usage is not greater than *GC-TRIGGER*. ;;; -(defun sub-gc (verbose-p force-p) +(defun sub-gc (&key (verbose-p *gc-verbose*) force-p) (unless *already-maybe-gcing* (let* ((*already-maybe-gcing* t) (start-time (get-internal-run-time)) (pre-gc-dyn-usage (dynamic-usage))) (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 for + ;; *bytes-consed-between-gcs*. (warn "The value of *BYTES-CONSED-BETWEEN-GCS*, ~S, is not an ~ integer. Reseting it to ~D." *bytes-consed-between-gcs* default-bytes-consed-between-gcs) (setf *bytes-consed-between-gcs* default-bytes-consed-between-gcs)) - (when (or (not *gc-trigger*) - (> *bytes-consed-between-gcs* *gc-trigger*)) - (when *gc-trigger* (clear-auto-gc-trigger)) - (setf *gc-trigger* *bytes-consed-between-gcs*) - (set-auto-gc-trigger *gc-trigger*)) - (when (> pre-gc-dyn-usage *gc-trigger*) + (when (and *gc-trigger* (> pre-gc-dyn-usage *gc-trigger*)) (setf *need-to-collect-garbage* t)) (when (or force-p (and *need-to-collect-garbage* (not *gc-inhibit*))) @@ -385,6 +378,10 @@ (funcall *internal-gc*) (let* ((post-gc-dyn-usage (dynamic-usage)) (bytes-freed (- pre-gc-dyn-usage post-gc-dyn-usage))) + (when *last-bytes-in-use* + (incf *total-bytes-consed* + (- pre-gc-dyn-usage *last-bytes-in-use*)) + (setq *last-bytes-in-use* post-gc-dyn-usage)) (setf *need-to-collect-garbage* nil) (setf *gc-trigger* (+ post-gc-dyn-usage *bytes-consed-between-gcs*)) @@ -406,7 +403,7 @@ ;;; which must be returned to the caller. ;;; (defun maybe-gc (&optional object) - (sub-gc *gc-verbose* nil) + (sub-gc) object) ;;; @@ -418,7 +415,7 @@ "Initiates a garbage collection. The optional argument, VERBOSE-P, which defaults to the value of the variable *GC-VERBOSE* controls whether or not GC statistics are printed." - (sub-gc verbose-p t)) + (sub-gc :verbose-p verbose-p :force-p t)) ;;;; Auxiliary Functions. @@ -427,14 +424,21 @@ (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)) + (sub-gc)) nil) (defun gc-off () "Disables the garbage collector." (setq *gc-inhibit* t) nil) + + + +;;;; Initialization stuff. + +(defun gc-init () + (when *gc-trigger* + (if (< *gc-trigger* (dynamic-usage)) + (sub-gc) + (set-auto-gc-trigger *gc-trigger*)))) -- GitLab