/[cmucl]/src/code/gc.lisp
ViewVC logotype

Diff of /src/code/gc.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by ram, Tue Feb 6 17:24:29 1990 UTC revision 1.2 by ram, Thu Feb 22 10:30:40 1990 UTC
# Line 1  Line 1 
1  ;;; -*- Mode: Lisp; Package: LISP; Log: code.log -*-  ;;; -*- Mode: Lisp; Package: LISP; Log: code.log -*-
 ;;;  
 ;;; Replacement for the GC brain damage in misc.lisp  
2  ;;;  ;;;
3  ;;; Written by Christopher Hoover.  ;;; **********************************************************************
4    ;;; This code was written as part of the Spice Lisp project at
5    ;;; Carnegie-Mellon University, and has been placed in the public domain.
6    ;;; Spice Lisp is currently incomplete and under active development.
7    ;;; If you want to use this code or any part of Spice Lisp, please contact
8    ;;; Scott Fahlman (Scott.Fahlman@CS.CMU.EDU).
9    ;;; **********************************************************************
10    ;;;
11    ;;; Garbage collection and allocation related code.
12    ;;;
13    ;;; Written by Christopher Hoover, Rob MacLachlan, Dave McDonald, et al.
14  ;;;  ;;;
15    
16  (in-package "EXTENSIONS")  (in-package "EXTENSIONS")
17  (export '(*before-gc-hooks* *after-gc-hooks* gc *ask-about-gc*  (export '(*before-gc-hooks* *after-gc-hooks* gc gc-on gc-off
18                              *bytes-consed-between-gcs*            *bytes-consed-between-gcs* *gc-verbose* *gc-inhibit-hook*
19                              *gc-verbose* *gc-notify-before* *gc-notify-after*            *gc-notify-before* *gc-notify-after* get-bytes-consed))
                             *gc-inhibit-hook*  
                             get-bytes-consed))  
20    
21  (in-package "LISP")  (in-package "LISP")
22    (export '(room))
23    
24    
25    
26  ;;;; Room.  ;;;; Room.
# Line 88  Line 96 
96            (room-summary cum-dyn cum-stat cum-ro)))))))            (room-summary cum-dyn cum-stat cum-ro)))))))
97    
98    
99  ;;;; DYNAMIC-USAGE  ;;;; DYNAMIC-USAGE.
100    
101  ;;;  ;;;
102  ;;; DYNAMIC-USAGE -- Interface  ;;; DYNAMIC-USAGE -- Interface
# Line 100  Line 108 
108    (system:%primitive dynamic-space-in-use))    (system:%primitive dynamic-space-in-use))
109    
110    
111  ;;; GET-BYTES-CONSED  ;;;; GET-BYTES-CONSED.
112    
113  ;;;  ;;;
114  ;;; Internal State  ;;; Internal State
# Line 124  Line 132 
132    *total-bytes-consed*)    *total-bytes-consed*)
133    
134    
135  ;;;; Variables and Constants  ;;;; Variables and Constants.
136    
 ;;;  
 ;;; DEFAULT-BYTES-CONSED-BETWEEN-GCS  
 ;;;  
137  ;;; The default value of *BYTES-CONSED-BETWEEN-GCS* and *GC-TRIGGER*.  ;;; The default value of *BYTES-CONSED-BETWEEN-GCS* and *GC-TRIGGER*.
 ;;; This should not be set by the user.  
138  ;;;  ;;;
139  (defconstant default-bytes-consed-between-gcs 2000000)  (defconstant default-bytes-consed-between-gcs 2000000)
140    
 ;;;  
 ;;; *BYTES-CONSED-BETWEEN-GCS*  
 ;;;  
141  ;;; This variable is the user-settable variable that specifices the  ;;; This variable is the user-settable variable that specifices the
142  ;;; minimum amount of dynamic space which must be consed before a GC  ;;; minimum amount of dynamic space which must be consed before a GC
143  ;;; will be triggered.  ;;; will be triggered.
# Line 145  Line 146 
146    "This number specifies the minimum number of bytes of dynamic space    "This number specifies the minimum number of bytes of dynamic space
147    that must be consed before the next gc will occur.")    that must be consed before the next gc will occur.")
148    
 ;;;  
 ;;; *GC-TRIGGER*  
 ;;;  
149  ;;; Internal trigger.  When the dynamic usage increases beyond this  ;;; Internal trigger.  When the dynamic usage increases beyond this
150  ;;; amount, the system notes that a garbage collection needs to occur by  ;;; amount, the system notes that a garbage collection needs to occur by
151  ;;; setting *NEED-TO-COLLECT-GARBAGE* to T.  ;;; setting *NEED-TO-COLLECT-GARBAGE* to T.
# Line 164  Line 162 
162  ;;;  ;;;
163  ;;; *GC-INHIBIT*  ;;; *GC-INHIBIT*
164  ;;;  ;;;
165  ;;; When Y, inhibits garbage collection.  ;;; When non-NIL, inhibits garbage collection.
166  ;;;  ;;;
167  (defvar *gc-inhibit* nil)  (defvar *gc-inhibit* nil)
168    
# Line 176  Line 174 
174  ;;;  ;;;
175  (defvar *already-maybe-gcing* nil)  (defvar *already-maybe-gcing* nil)
176    
 ;;;  
 ;;; *NEED-TO-COLLECT-GARBAGE*  
 ;;;  
177  ;;; When T, indicates that the dynamic usage has exceeded the value  ;;; When T, indicates that the dynamic usage has exceeded the value
178  ;;; *GC-TRIGGER*.  ;;; *GC-TRIGGER*.
179  ;;;  ;;;
180  (defvar *need-to-collect-garbage* nil)  (defvar *need-to-collect-garbage* nil)
181    
182    
183  ;;;; GC Hooks  ;;;; GC Hooks.
184    
185  ;;;  ;;;
186  ;;; *BEFORE-GC-HOOKS*  ;;; *BEFORE-GC-HOOKS*
# Line 219  Line 214 
214    
215    
216    
217    ;;;
218    ;;; *GC-VERBOSE*
219    ;;;
220    (defvar *gc-verbose* t
221      "When non-NIL, causes the functions bound to *GC-NOTIFY-BEFORE* and
222      *GC-NOTIFY-AFTER* to be called before and after a garbage collection
223      occurs respectively.")
224    
225    
226  (defun default-gc-notify-before (bytes-in-use)  (defun default-gc-notify-before (bytes-in-use)
227    (system:beep *standard-output*)    (system:beep *standard-output*)
228    (format t "~&[GC threshold exceeded with ~:D bytes in use.  ~    (format t "~&[GC threshold exceeded with ~:D bytes in use.  ~
# Line 226  Line 230 
230    (finish-output))    (finish-output))
231  ;;;  ;;;
232  (defparameter *gc-notify-before* #'default-gc-notify-before  (defparameter *gc-notify-before* #'default-gc-notify-before
233    "This function is invoked before GC'ing with the number of bytes in use.  It    "This function bound to this variable is invoked before GC'ing (unless
234     notifies the user that the system is going into GC.")    *GC-VERBOSE* is NIL) with the current amount of dynamic usage (in
235      bytes).  It should notify the user that the system is going to GC.")
236    
237  (defun default-gc-notify-after (bytes-retained bytes-freed new-trigger)  (defun default-gc-notify-after (bytes-retained bytes-freed new-trigger)
238    (format t "[GC completed with ~:D bytes retained and ~:D bytes freed.]~%"    (format t "[GC completed with ~:D bytes retained and ~:D bytes freed.]~%"
# Line 238  Line 243 
243    (finish-output))    (finish-output))
244  ;;;  ;;;
245  (defparameter *gc-notify-after* #'default-gc-notify-after  (defparameter *gc-notify-after* #'default-gc-notify-after
246    "This function is invoked after GC'ing with the number of bytes freed.  It    "The function bound to this variable is invoked after GC'ing (unless
247     notifies the user that the system is going into GC.")    *GC-VERBOSE* is NIL) with the amount of dynamic usage (in bytes) now
248      free, the number of bytes freed by the GC, and the new GC trigger
249      threshold.  The function should notify the user that the system has
250      finished GC'ing.")
251    
252    
253  ;;;; Stack grovelling:  ;;;; Stack grovelling:
# Line 574  Line 582 
582  ;;; which must be returned to the caller.  ;;; which must be returned to the caller.
583  ;;;  ;;;
584  (defun maybe-gc (object)  (defun maybe-gc (object)
585    (sub-gc t nil)    (sub-gc *gc-verbose* nil)
586    object)    object)
587    
588  ;;;  ;;;
# Line 582  Line 590 
590  ;;;  ;;;
591  ;;; This is the user advertised garbage collection function.  ;;; This is the user advertised garbage collection function.
592  ;;;  ;;;
593  (defun gc (&optional (verbose-p t))  (defun gc (&optional (verbose-p *gc-verbose*))
594    "Initiates a garbage collection.  The optional argument, VERBOSE-P,    "Initiates a garbage collection.  The optional argument, VERBOSE-P,
595    controls wether or not GC statistics are printed."    which defaults to the value of the variable *GC-VERBOSE* controls
596    (sub-gc verbose-p t)    whether or not GC statistics are printed."
597    nil)    (sub-gc verbose-p t))
598    
599    
600  ;;;; Auxiliary Functions  ;;;; Auxiliary Functions.
601    
602  (defun gc-on ()  (defun gc-on ()
603    "Enables the garbage collector."    "Enables the garbage collector."
604    (setq *gc-inhibit* nil)    (setq *gc-inhibit* nil)
605    (when *need-to-collect-garbage*    (when *need-to-collect-garbage*
606      (sub-gc t nil))      (sub-gc *gc-verbose* nil))
607    nil)    nil)
608    
609  (defun gc-off ()  (defun gc-off ()

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

  ViewVC Help
Powered by ViewVC 1.1.5