(defun ,lisp-fun ()
(sb!alien:extern-alien ,c-var-name (sb!alien:unsigned 32))))))
-#!+(or cgc gencgc) (progn
-#!-sb-fluid (declaim (inline dynamic-usage))
-(def-c-var-frob dynamic-usage "bytes_allocated"))
-
+#!-gencgc
+(progn
+ ;; This is called once per PROFILEd function call, so it's worth a
+ ;; little possible space cost to reduce its time cost.
+ #!-sb-fluid
+ (declaim (inline current-dynamic-space-start))
+ (def-c-var-frob current-dynamic-space-start "current_dynamic_space"))
+
+#!-sb-fluid
+(declaim (inline dynamic-usage)) ; to reduce PROFILEd call overhead
+#!+(or cgc gencgc)
+(def-c-var-frob dynamic-usage "bytes_allocated")
#!-(or cgc gencgc)
(defun dynamic-usage ()
(the (unsigned-byte 32)
(- (sb!sys:sap-int (sb!c::dynamic-space-free-pointer))
(current-dynamic-space-start))))
-#!-gencgc (progn
-#!-sb-fluid (declaim (inline current-dynamic-space-start))
-(def-c-var-frob current-dynamic-space-start "current_dynamic_space"))
-
(defun static-space-usage ()
- (- (* sb!vm:*static-space-free-pointer* sb!vm:word-bytes)
+ (- (* sb!vm:*static-space-free-pointer* sb!vm:n-word-bytes)
sb!vm:static-space-start))
(defun read-only-space-usage ()
- (- (* sb!vm::*read-only-space-free-pointer* sb!vm:word-bytes)
+ (- (* sb!vm::*read-only-space-free-pointer* sb!vm:n-word-bytes)
sb!vm:read-only-space-start))
(defun control-stack-usage ()
;;; (We save this so that we can calculate the total number of bytes
;;; ever allocated by adding this to the number of bytes currently
;;; allocated and never freed.)
-(declaim (type pcounter *n-bytes-freed-or-purified-pcounter*))
-(defvar *n-bytes-freed-or-purified-pcounter* (make-pcounter))
+(declaim (type unsigned-byte *n-bytes-freed-or-purified*))
+(defvar *n-bytes-freed-or-purified* 0)
+(push (lambda ()
+ (setf *n-bytes-freed-or-purified* 0))
+ ;; KLUDGE: It's probably not quite safely right either to do
+ ;; this in *BEFORE-SAVE-INITIALIZATIONS* (since consing, or even
+ ;; worse, something which depended on (GET-BYTES-CONSED), might
+ ;; happen after that) or in *AFTER-SAVE-INITIALIZATIONS*. But
+ ;; it's probably not a big problem, and there seems to be no
+ ;; other obvious time to do it. -- WHN 2001-07-30
+ *after-save-initializations*)
(declaim (ftype (function () unsigned-byte) get-bytes-consed))
(defun get-bytes-consed ()
SB-PROFILE package does), or to design a more microefficient interface
and submit it as a patch."
(+ (dynamic-usage)
- (pcounter->integer *n-bytes-freed-or-purified-pcounter*)))
+ *n-bytes-freed-or-purified*))
\f
;;;; variables and constants
;;;
;;; Unlike CMU CL, we don't export this variable. (There's no need to,
;;; since our BYTES-CONSED-BETWEEN-GCS function is SETFable.)
-(defvar *bytes-consed-between-gcs* (* 2 (expt 10 6)))
+(defvar *bytes-consed-between-gcs* (* 4 (expt 10 6)))
(declaim (type index *bytes-consed-between-gcs*))
;;;; GC hooks
(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.
+;;; 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
+;;; 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
;;; nobody has figured out what it should be yet.
(defvar *gc-trigger* nil)
\f
(defun default-gc-notify-before (notify-stream bytes-in-use)
(declare (type stream notify-stream))
- (format notify-stream
- "~&; GC is beginning with ~:D bytes in use.~%"
- bytes-in-use)
+ (format
+ notify-stream
+ "~&; GC is beginning with ~:D bytes in use at internal runtime ~:D.~%"
+ bytes-in-use
+ (get-internal-run-time))
(finish-output notify-stream))
(defparameter *gc-notify-before* #'default-gc-notify-before
#!+sb-doc
new-trigger)
(declare (type stream notify-stream))
(format notify-stream
- "~&; GC has finished with ~:D bytes in use (~:D bytes freed).~%"
+ "~&; GC has finished with ~:D bytes in use (~:D bytes freed)~@
+ ; at internal runtime ~:D. The new GC trigger is ~:D bytes.~%"
bytes-retained
- bytes-freed)
- (format notify-stream
- "~&; The new GC trigger is ~:D bytes.~%"
+ bytes-freed
+ (get-internal-run-time)
new-trigger)
(finish-output notify-stream))
(defparameter *gc-notify-after* #'default-gc-notify-after
#!+sb-doc
- "The function bound to this variable is invoked after GC'ing with
-the value of *GC-NOTIFY-STREAM*, the amount of dynamic usage (in
-bytes) now free, the number of bytes freed by the GC, and the new GC
-trigger threshold. The function should notify the user that the system
-has finished GC'ing.")
+ "The function bound to this variable is invoked after GC'ing with the
+value of *GC-NOTIFY-STREAM*, the amount of dynamic usage (in bytes) now
+free, the number of bytes freed by the GC, and the new GC trigger
+threshold; or if *GC-NOTIFY-STREAM* is NIL, it's not invoked. The
+function should notify the user that the system has finished GC'ing.")
\f
;;;; internal GC
(sb!alien:def-alien-routine collect-garbage sb!c-call:int
#!+gencgc (last-gen sb!c-call:int))
-
(sb!alien:def-alien-routine set-auto-gc-trigger sb!c-call:void
(dynamic-usage sb!c-call:unsigned-long))
\f
;;;; SUB-GC
-;;; Used to carefully invoke hooks.
+;;; This is used to carefully invoke hooks.
(eval-when (:compile-toplevel :execute)
(sb!xc:defmacro carefully-funcall (function &rest args)
`(handler-case (funcall ,function ,@args)
;;; is not greater than *GC-TRIGGER*.
;;;
;;; For GENCGC all generations < GEN will be GC'ed.
-(defun sub-gc (&key force-p (gen 0))
+(defun sub-gc (&key force-p (gen 0))
(/show0 "entering SUB-GC")
(unless *already-maybe-gcing*
(let* ((*already-maybe-gcing* t)
(eff-n-bytes-freed (max 0 n-bytes-freed)))
(declare (ignore ignore-me))
(/show0 "got (DYNAMIC-USAGE) and EFF-N-BYTES-FREED")
- (incf-pcounter *n-bytes-freed-or-purified-pcounter*
- eff-n-bytes-freed)
+ (incf *n-bytes-freed-or-purified*
+ eff-n-bytes-freed)
(/show0 "clearing *NEED-TO-COLLECT-GARBAGE*")
(setf *need-to-collect-garbage* nil)
(/show0 "calculating NEW-GC-TRIGGER")
object)
;;; This is the user-advertised garbage collection function.
-
(defun gc (&key (gen 0) (full nil) &allow-other-keys)
#!+(and sb-doc gencgc)
"Initiate a garbage collection. GEN controls the number of generations
to garbage collect."
#!+(and sb-doc (not gencgc))
- "Initiate a garbage collection. GEN may be provided for compatibility, but
- is ignored."
+ "Initiate a garbage collection. GEN may be provided for compatibility with
+ generational garbage collectors, but is ignored in this implementation."
(sub-gc :force-p t :gen (if full 6 gen)))
\f
projects / sbcl.git / blobdiff