(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
\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
+(sb!alien:define-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
+(sb!alien:define-alien-routine set-auto-gc-trigger sb!c-call:void
(dynamic-usage sb!c-call:unsigned-long))
-(sb!alien:def-alien-routine clear-auto-gc-trigger sb!c-call:void)
+(sb!alien:define-alien-routine clear-auto-gc-trigger sb!c-call:void)
;;; This variable contains the function that does the real GC. This is
;;; for low-level GC experimentation. Do not touch it if you do not
\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)
*soft-heap-limit*)))
(when soft-heap-limit-exceeded?
(cerror "Continue with GC."
- "soft heap limit exceeded (temporary new limit=~D)"
+ "soft heap limit exceeded (temporary new limit=~W)"
*soft-heap-limit*))
(when (and *gc-trigger* (> pre-gc-dynamic-usage *gc-trigger*))
(setf *need-to-collect-garbage* 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")
projects / sbcl.git / blobdiff