1 ;;;; garbage collection and allocation-related code
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
12 (in-package "SB!KERNEL")
14 ;;;; DYNAMIC-USAGE and friends
16 (declaim (special sb!vm:*read-only-space-free-pointer*
17 sb!vm:*static-space-free-pointer*))
19 (eval-when (:compile-toplevel :execute)
20 (sb!xc:defmacro def-c-var-frob (lisp-fun c-var-name)
22 #!-sb-fluid (declaim (inline ,lisp-fun))
24 (sb!alien:extern-alien ,c-var-name (sb!alien:unsigned 32))))))
28 ;; This is called once per PROFILEd function call, so it's worth a
29 ;; little possible space cost to reduce its time cost.
31 (declaim (inline current-dynamic-space-start))
32 (def-c-var-frob current-dynamic-space-start "current_dynamic_space"))
35 (declaim (inline dynamic-usage)) ; to reduce PROFILEd call overhead
37 (def-c-var-frob dynamic-usage "bytes_allocated")
39 (defun dynamic-usage ()
40 (the (unsigned-byte 32)
41 (- (sb!sys:sap-int (sb!c::dynamic-space-free-pointer))
42 (current-dynamic-space-start))))
44 (defun static-space-usage ()
45 (- (* sb!vm:*static-space-free-pointer* sb!vm:word-bytes)
46 sb!vm:static-space-start))
48 (defun read-only-space-usage ()
49 (- (* sb!vm::*read-only-space-free-pointer* sb!vm:word-bytes)
50 sb!vm:read-only-space-start))
52 (defun control-stack-usage ()
53 #!-x86 (- (sb!sys:sap-int (sb!c::control-stack-pointer-sap))
54 sb!vm:control-stack-start)
55 #!+x86 (- sb!vm:control-stack-end
56 (sb!sys:sap-int (sb!c::control-stack-pointer-sap))))
58 (defun binding-stack-usage ()
59 (- (sb!sys:sap-int (sb!c::binding-stack-pointer-sap))
60 sb!vm:binding-stack-start))
64 (defun room-minimal-info ()
65 (format t "Dynamic space usage is: ~10:D bytes.~%" (dynamic-usage))
66 (format t "Read-only space usage is: ~10:D bytes.~%" (read-only-space-usage))
67 (format t "Static space usage is: ~10:D bytes.~%" (static-space-usage))
68 (format t "Control stack usage is: ~10:D bytes.~%" (control-stack-usage))
69 (format t "Binding stack usage is: ~10:D bytes.~%" (binding-stack-usage))
70 (format t "Garbage collection is currently ~:[enabled~;DISABLED~].~%"
73 (defun room-intermediate-info ()
75 (sb!vm:memory-usage :count-spaces '(:dynamic)
80 (defun room-maximal-info ()
82 (sb!vm:memory-usage :count-spaces '(:static :dynamic))
83 (sb!vm:instance-usage :dynamic :top-n 10)
84 (sb!vm:instance-usage :static :top-n 10))
86 (defun room (&optional (verbosity :default))
88 "Print to *STANDARD-OUTPUT* information about the state of internal
89 storage and its management. The optional argument controls the
90 verbosity of output. If it is T, ROOM prints out a maximal amount of
91 information. If it is NIL, ROOM prints out a minimal amount of
92 information. If it is :DEFAULT or it is not supplied, ROOM prints out
93 an intermediate amount of information."
101 (room-intermediate-info)))
104 ;;;; GET-BYTES-CONSED
106 ;;; the total number of bytes freed so far (including any freeing
107 ;;; which goes on in PURIFY)
109 ;;; (We save this so that we can calculate the total number of bytes
110 ;;; ever allocated by adding this to the number of bytes currently
111 ;;; allocated and never freed.)
112 (declaim (type unsigned-byte *n-bytes-freed-or-purified*))
113 (defvar *n-bytes-freed-or-purified* 0)
115 (setf *n-bytes-freed-or-purified* 0))
116 ;; KLUDGE: It's probably not quite safely right either to do
117 ;; this in *BEFORE-SAVE-INITIALIZATIONS* (since consing, or even
118 ;; worse, something which depended on (GET-BYTES-CONSED), might
119 ;; happen after that) or in *AFTER-SAVE-INITIALIZATIONS*. But
120 ;; it's probably not a big problem, and there seems to be no
121 ;; other obvious time to do it. -- WHN 2001-07-30
122 *after-save-initializations*)
124 (declaim (ftype (function () unsigned-byte) get-bytes-consed))
125 (defun get-bytes-consed ()
127 "Return the number of bytes consed since the program began. Typically
128 this result will be a consed bignum, so if you have an application (e.g.
129 profiling) which can't tolerate the overhead of consing bignums, you'll
130 probably want either to hack in at a lower level (as the code in the
131 SB-PROFILE package does), or to design a more microefficient interface
132 and submit it as a patch."
134 *n-bytes-freed-or-purified*))
136 ;;;; variables and constants
138 ;;; the minimum amount of dynamic space which must be consed before a
139 ;;; GC will be triggered
141 ;;; Unlike CMU CL, we don't export this variable. (There's no need to,
142 ;;; since our BYTES-CONSED-BETWEEN-GCS function is SETFable.)
143 (defvar *bytes-consed-between-gcs* (* 2 (expt 10 6)))
144 (declaim (type index *bytes-consed-between-gcs*))
148 (defvar *before-gc-hooks* nil ; actually initialized in cold init
150 "A list of functions that are called before garbage collection occurs.
151 The functions should take no arguments.")
153 (defvar *after-gc-hooks* nil ; actually initialized in cold init
155 "A list of functions that are called after garbage collection occurs.
156 The functions should take no arguments.")
158 (defvar *gc-notify-stream* nil ; (actually initialized in cold init)
160 "When non-NIL, this must be a STREAM; and the functions bound to
161 *GC-NOTIFY-BEFORE* and *GC-NOTIFY-AFTER* are called with the
162 STREAM value before and after a garbage collection occurs
165 (defvar *gc-run-time* 0
167 "the total CPU time spent doing garbage collection (as reported by
168 GET-INTERNAL-RUN-TIME)")
169 (declaim (type index *gc-run-time*))
171 ;;; a limit to help catch programs which allocate too much memory,
172 ;;; since a hard heap overflow is so hard to recover from
173 (declaim (type (or unsigned-byte null) *soft-heap-limit*))
174 (defvar *soft-heap-limit* nil)
176 ;;; When the dynamic usage increases beyond this amount, the system
177 ;;; notes that a garbage collection needs to occur by setting
178 ;;; *NEED-TO-COLLECT-GARBAGE* to T. It starts out as NIL meaning
179 ;;; nobody has figured out what it should be yet.
180 (defvar *gc-trigger* nil)
182 (declaim (type (or index null) *gc-trigger*))
184 ;;; On the X86, we store the GC trigger in a ``static'' symbol instead
185 ;;; of letting magic C code handle it. It gets initialized by the
188 (defvar sb!vm::*internal-gc-trigger*)
190 ;;;; The following specials are used to control when garbage collection
193 ;;; When non-NIL, inhibits garbage collection.
194 (defvar *gc-inhibit*) ; initialized in cold init
196 ;;; This flag is used to prevent recursive entry into the garbage
198 (defvar *already-maybe-gcing*) ; initialized in cold init
200 ;;; When T, indicates that the dynamic usage has exceeded the value
202 (defvar *need-to-collect-garbage* nil) ; initialized in cold init
204 (defun default-gc-notify-before (notify-stream bytes-in-use)
205 (declare (type stream notify-stream))
206 (format notify-stream
207 "~&; GC is beginning with ~:D bytes in use at internal runtime ~:D.~%"
209 (get-internal-run-time))
210 (finish-output notify-stream))
211 (defparameter *gc-notify-before* #'default-gc-notify-before
213 "This function bound to this variable is invoked before GC'ing (unless
214 *GC-NOTIFY-STREAM* is NIL) with the value of *GC-NOTIFY-STREAM* and
215 current amount of dynamic usage (in bytes). It should notify the
216 user that the system is going to GC.")
218 (defun default-gc-notify-after (notify-stream
222 (declare (type stream notify-stream))
223 (format notify-stream
224 "~&; GC has finished with ~:D bytes in use (~:D bytes freed)~@
225 ; at internal runtime ~:D. The new GC trigger is ~:D bytes.~%"
228 (get-internal-run-time)
230 (finish-output notify-stream))
231 (defparameter *gc-notify-after* #'default-gc-notify-after
233 "The function bound to this variable is invoked after GC'ing with
234 the value of *GC-NOTIFY-STREAM*, the amount of dynamic usage (in
235 bytes) now free, the number of bytes freed by the GC, and the new GC
236 trigger threshold. The function should notify the user that the system
237 has finished GC'ing.")
241 (sb!alien:def-alien-routine collect-garbage sb!c-call:int
242 #!+gencgc (last-gen sb!c-call:int))
244 (sb!alien:def-alien-routine set-auto-gc-trigger sb!c-call:void
245 (dynamic-usage sb!c-call:unsigned-long))
247 (sb!alien:def-alien-routine clear-auto-gc-trigger sb!c-call:void)
249 ;;; This variable contains the function that does the real GC. This is
250 ;;; for low-level GC experimentation. Do not touch it if you do not
251 ;;; know what you are doing.
252 (defvar *internal-gc* #'collect-garbage)
256 ;;; Used to carefully invoke hooks.
257 (eval-when (:compile-toplevel :execute)
258 (sb!xc:defmacro carefully-funcall (function &rest args)
259 `(handler-case (funcall ,function ,@args)
261 (warn "(FUNCALL ~S~{ ~S~}) lost:~%~A" ',function ',args cond)
264 ;;; SUB-GC decides when and if to do a garbage collection. The FORCE-P
265 ;;; flags controls whether a GC should occur even if the dynamic usage
266 ;;; is not greater than *GC-TRIGGER*.
268 ;;; For GENCGC all generations < GEN will be GC'ed.
269 (defun sub-gc (&key force-p (gen 0))
270 (/show0 "entering SUB-GC")
271 (unless *already-maybe-gcing*
272 (let* ((*already-maybe-gcing* t)
273 (start-time (get-internal-run-time))
274 (pre-gc-dynamic-usage (dynamic-usage))
275 ;; Currently we only check *SOFT-HEAP-LIMIT* at GC time,
276 ;; not for every allocation. That makes it cheap to do,
277 ;; even if it is a little ugly.
278 (soft-heap-limit-exceeded? (and *soft-heap-limit*
279 (> pre-gc-dynamic-usage
281 (*soft-heap-limit* (if soft-heap-limit-exceeded?
282 (+ pre-gc-dynamic-usage
283 *bytes-consed-between-gcs*)
285 (when soft-heap-limit-exceeded?
286 (cerror "Continue with GC."
287 "soft heap limit exceeded (temporary new limit=~D)"
289 (when (and *gc-trigger* (> pre-gc-dynamic-usage *gc-trigger*))
290 (setf *need-to-collect-garbage* t))
292 (and *need-to-collect-garbage* (not *gc-inhibit*)))
293 ;; KLUDGE: Wow, we really mask interrupts all the time we're
294 ;; collecting garbage? That seems like a long time.. -- WHN 19991129
296 ;; FIXME: We probably shouldn't do this evil thing to
297 ;; *STANDARD-OUTPUT* in a binding which is wrapped around
298 ;; calls to user-settable GC hook functions.
299 (let ((*standard-output* *terminal-io*))
300 (when *gc-notify-stream*
301 (if (streamp *gc-notify-stream*)
302 (carefully-funcall *gc-notify-before*
304 pre-gc-dynamic-usage)
306 "*GC-NOTIFY-STREAM* is set, but not a STREAM -- ignored.")))
307 (dolist (hook *before-gc-hooks*)
308 (carefully-funcall hook))
310 (clear-auto-gc-trigger))
311 (let* (;; We do DYNAMIC-USAGE once more here in order to
312 ;; get a more accurate measurement of the space
313 ;; actually freed, since the messing around, e.g.
314 ;; GC-notify stuff, since the DYNAMIC-USAGE which
315 ;; triggered GC could've done a fair amount of
317 (pre-internal-gc-dynamic-usage (dynamic-usage))
319 #!-gencgc (funcall *internal-gc*)
320 ;; FIXME: This EQ test is pretty gross. Among its other
321 ;; nastinesses, it looks as though it could break if we
322 ;; recompile COLLECT-GARBAGE. We should probably just
323 ;; straighten out the interface so that all *INTERNAL-GC*
324 ;; functions accept a GEN argument (and then the
325 ;; non-generational ones just ignore it).
326 #!+gencgc (if (eq *internal-gc* #'collect-garbage)
327 (funcall *internal-gc* gen)
328 (funcall *internal-gc*)))
329 (post-gc-dynamic-usage (dynamic-usage))
330 (n-bytes-freed (- pre-internal-gc-dynamic-usage
331 post-gc-dynamic-usage))
332 ;; In sbcl-0.6.12.39, the raw N-BYTES-FREED from
333 ;; GENCGC could sometimes be substantially negative
334 ;; (e.g. -5872). I haven't looked into what causes
335 ;; that, but I suspect it has to do with
336 ;; fluctuating inefficiency in the way that the
337 ;; GENCGC packs things into page boundaries.
338 ;; Bumping the raw result up to 0 is a little ugly,
339 ;; but shouldn't be a problem, and it's even
340 ;; possible to sort of justify it: the packing
341 ;; inefficiency which has caused (DYNAMIC-USAGE) to
342 ;; grow is effectively consing, or at least
343 ;; overhead of consing, so it's sort of correct to
344 ;; add it to the running total of consing. ("Man
345 ;; isn't a rational animal, he's a rationalizing
346 ;; animal.":-) -- WHN 2001-06-23
347 (eff-n-bytes-freed (max 0 n-bytes-freed)))
348 (declare (ignore ignore-me))
349 (/show0 "got (DYNAMIC-USAGE) and EFF-N-BYTES-FREED")
350 (incf *n-bytes-freed-or-purified*
352 (/show0 "clearing *NEED-TO-COLLECT-GARBAGE*")
353 (setf *need-to-collect-garbage* nil)
354 (/show0 "calculating NEW-GC-TRIGGER")
355 (let ((new-gc-trigger (+ post-gc-dynamic-usage
356 *bytes-consed-between-gcs*)))
357 (/show0 "setting *GC-TRIGGER*")
358 (setf *gc-trigger* new-gc-trigger))
359 (/show0 "calling SET-AUTO-GC-TRIGGER")
360 (set-auto-gc-trigger *gc-trigger*)
361 (dolist (hook *after-gc-hooks*)
362 (/show0 "doing a hook from *AFTER-GC--HOOKS*")
363 ;; FIXME: This hook should be called with the same
364 ;; kind of information as *GC-NOTIFY-AFTER*. In
365 ;; particular, it would be nice for the hook function
366 ;; to be able to adjust *GC-TRIGGER* intelligently to
367 ;; e.g. 108% of total memory usage.
368 (carefully-funcall hook))
369 (when *gc-notify-stream*
370 (if (streamp *gc-notify-stream*)
371 (carefully-funcall *gc-notify-after*
373 post-gc-dynamic-usage
377 "*GC-NOTIFY-STREAM* is set, but not a stream -- ignored.")))))
378 (scrub-control-stack))) ;XXX again? we did this from C ...
379 (incf *gc-run-time* (- (get-internal-run-time)
381 ;; FIXME: should probably return (VALUES), here and in RETURN-FROM
384 ;;; This routine is called by the allocation miscops to decide whether
385 ;;; a GC should occur. The argument, OBJECT, is the newly allocated
386 ;;; object which must be returned to the caller.
387 (defun maybe-gc (&optional object)
391 ;;; This is the user-advertised garbage collection function.
392 (defun gc (&key (gen 0) (full nil) &allow-other-keys)
393 #!+(and sb-doc gencgc)
394 "Initiate a garbage collection. GEN controls the number of generations
396 #!+(and sb-doc (not gencgc))
397 "Initiate a garbage collection. GEN may be provided for compatibility with
398 generational garbage collectors, but is ignored in this implementation."
399 (sub-gc :force-p t :gen (if full 6 gen)))
402 ;;;; auxiliary functions
404 (defun bytes-consed-between-gcs ()
406 "Return the amount of memory that will be allocated before the next garbage
407 collection is initiated. This can be set with SETF."
408 *bytes-consed-between-gcs*)
409 (defun (setf bytes-consed-between-gcs) (val)
410 ;; FIXME: Shouldn't this (and the DECLAIM for the underlying variable)
411 ;; be for a strictly positive number type, e.g.
412 ;; (AND (INTEGER 1) FIXNUM)?
413 (declare (type index val))
414 (let ((old *bytes-consed-between-gcs*))
415 (setf *bytes-consed-between-gcs* val)
417 (setf *gc-trigger* (+ *gc-trigger* (- val old)))
418 (cond ((<= (dynamic-usage) *gc-trigger*)
419 (clear-auto-gc-trigger)
420 (set-auto-gc-trigger *gc-trigger*))
422 ;; FIXME: If SCRUB-CONTROL-STACK is required here, why
423 ;; isn't it built into SUB-GC? And *is* it required here?
424 (sb!sys:scrub-control-stack)
430 "Enable the garbage collector."
431 (setq *gc-inhibit* nil)
432 (when *need-to-collect-garbage*
438 "Disable the garbage collector."
439 (setq *gc-inhibit* t)
442 ;;;; initialization stuff
446 (if (< *gc-trigger* (dynamic-usage))
448 (set-auto-gc-trigger *gc-trigger*))))