0.pre7.60:
[sbcl.git] / src / code / gc.lisp
index c3a5998..fc87d3d 100644 (file)
           (current-dynamic-space-start))))
 
 (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 ()
@@ -122,7 +131,7 @@ probably want either to hack in at a lower level (as the code in the
 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
 
@@ -131,7 +140,7 @@ and submit it as a patch."
 ;;;
 ;;; 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
@@ -194,10 +203,11 @@ and submit it as a patch."
 \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 at internal runtime ~:D.~%"
-         bytes-in-use
-         (get-internal-run-time))
+  (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
@@ -221,11 +231,11 @@ and submit it as a patch."
   (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
 
@@ -244,7 +254,7 @@ has finished GC'ing.")
 \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)
@@ -338,8 +348,8 @@ has finished GC'ing.")
                   (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")