0.6.12.59:

	simplified *N-BYTES-FREED-OR-PURIFIED-PCOUNTER* to
		*N-BYTES-FREED-OR-PURIFIED*, an ordinary UNSIGNED-BYTE
	cleared *N-BYTES-FREED-OR-PURIFIED* on program startup

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 21a6d6f..588d14a 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -704,7 +704,7 @@ retained, possibly temporariliy, because it might be used internally."
              "PCOUNTER->INTEGER"
              "PCOUNTER-OR-FIXNUM->INTEGER"
              "PCOUNTER-P"
              "PCOUNTER->INTEGER"
              "PCOUNTER-OR-FIXNUM->INTEGER"
              "PCOUNTER-P"

-             "*N-BYTES-FREED-OR-PURIFIED-PCOUNTER*"
+             "*N-BYTES-FREED-OR-PURIFIED*"

 
              ;; miscellaneous non-standard but handy user-level functions..
              "ASSQ" "DELQ" "MEMQ" "POSQ" "NEQ"
 
              ;; miscellaneous non-standard but handy user-level functions..
              "ASSQ" "DELQ" "MEMQ" "POSQ" "NEQ"

diff --git a/src/code/gc.lisp b/src/code/gc.lisp
index c3a5998..5ed0b35 100644 (file)
--- a/src/code/gc.lisp
+++ b/src/code/gc.lisp
@@ -109,8 +109,17 @@
 ;;; (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.)
 ;;; (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 ()
 
 (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)
 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
 
 \f
 ;;;; variables and constants
 

@@ -338,8 +347,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")
                   (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")
              (/show0 "clearing *NEED-TO-COLLECT-GARBAGE*")
              (setf *need-to-collect-garbage* nil)
              (/show0 "calculating NEW-GC-TRIGGER")

diff --git a/src/code/print.lisp b/src/code/print.lisp
index 66c865e..ef0fb4e 100644 (file)
--- a/src/code/print.lisp
+++ b/src/code/print.lisp
@@ -148,13 +148,13 @@
                     ((:pprint-dispatch *print-pprint-dispatch*)
                      *print-pprint-dispatch*))
   #!+sb-doc
                     ((:pprint-dispatch *print-pprint-dispatch*)
                      *print-pprint-dispatch*))
   #!+sb-doc

-  "Outputs OBJECT to the specified stream, defaulting to *STANDARD-OUTPUT*"
+  "Output OBJECT to the specified stream, defaulting to *STANDARD-OUTPUT*"

   (output-object object (out-synonym-of stream))
   object)
 
 (defun prin1 (object &optional stream)
   #!+sb-doc
   (output-object object (out-synonym-of stream))
   object)
 
 (defun prin1 (object &optional stream)
   #!+sb-doc

-  "Outputs a mostly READable printed representation of OBJECT on the specified
+  "Output a mostly READable printed representation of OBJECT on the specified

   STREAM."
   (let ((*print-escape* T))
     (output-object object (out-synonym-of stream)))
   STREAM."
   (let ((*print-escape* T))
     (output-object object (out-synonym-of stream)))

@@ -162,7 +162,7 @@
 
 (defun princ (object &optional stream)
   #!+sb-doc
 
 (defun princ (object &optional stream)
   #!+sb-doc

-  "Outputs an aesthetic but not necessarily READable printed representation
+  "Output an aesthetic but not necessarily READable printed representation

   of OBJECT on the specified STREAM."
   (let ((*print-escape* NIL)
        (*print-readably* NIL))
   of OBJECT on the specified STREAM."
   (let ((*print-escape* NIL)
        (*print-readably* NIL))

@@ -171,7 +171,7 @@
 
 (defun print (object &optional stream)
   #!+sb-doc
 
 (defun print (object &optional stream)
   #!+sb-doc

-  "Outputs a terpri, the mostly READable printed represenation of OBJECT, and
+  "Output a newline, the mostly READable printed representation of OBJECT, and

   space to the specified STREAM."
   (let ((stream (out-synonym-of stream)))
     (terpri stream)
   space to the specified STREAM."
   (let ((stream (out-synonym-of stream)))
     (terpri stream)

@@ -181,7 +181,7 @@
 
 (defun pprint (object &optional stream)
   #!+sb-doc
 
 (defun pprint (object &optional stream)
   #!+sb-doc

-  "Prettily outputs OBJECT preceded by a newline."
+  "Prettily output OBJECT preceded by a newline."

   (let ((*print-pretty* t)
        (*print-escape* t)
        (stream (out-synonym-of stream)))
   (let ((*print-pretty* t)
        (*print-escape* t)
        (stream (out-synonym-of stream)))

@@ -208,18 +208,18 @@
               ((:pprint-dispatch *print-pprint-dispatch*)
                *print-pprint-dispatch*))
   #!+sb-doc
               ((:pprint-dispatch *print-pprint-dispatch*)
                *print-pprint-dispatch*))
   #!+sb-doc

-  "Returns the printed representation of OBJECT as a string."
+  "Return the printed representation of OBJECT as a string."

   (stringify-object object))
 
 (defun prin1-to-string (object)
   #!+sb-doc
   (stringify-object object))
 
 (defun prin1-to-string (object)
   #!+sb-doc

-  "Returns the printed representation of OBJECT as a string with
+  "Return the printed representation of OBJECT as a string with

    slashification on."
   (stringify-object object t))
 
 (defun princ-to-string (object)
   #!+sb-doc
    slashification on."
   (stringify-object object t))
 
 (defun princ-to-string (object)
   #!+sb-doc

-  "Returns the printed representation of OBJECT as a string with
+  "Return the printed representation of OBJECT as a string with

   slashification off."
   (stringify-object object nil))
 
   slashification off."
   (stringify-object object nil))
 

@@ -288,18 +288,17 @@
 ;;; marker, it is incremented.
 (defvar *circularity-counter* nil)
 
 ;;; marker, it is incremented.
 (defvar *circularity-counter* nil)
 

+;;; Check to see whether OBJECT is a circular reference, and return something
+;;; non-NIL if it is. If ASSIGN is T, then the number to use in the #n= and
+;;; #n# noise is assigned at this time. Note: CHECK-FOR-CIRCULARITY must
+;;; be called *EXACTLY* once with ASSIGN T, or the circularity detection noise
+;;; will get confused about when to use #n= and when to use #n#. If this
+;;; returns non-NIL when ASSIGN is T, then you must call HANDLE-CIRCULARITY
+;;; on it. If you are not using this inside a WITH-CIRCULARITY-DETECTION,
+;;; then you have to be prepared to handle a return value of :INITIATE which
+;;; means it needs to initiate the circularity detection noise. See the
+;;; source for info on how to do that.

 (defun check-for-circularity (object &optional assign)
 (defun check-for-circularity (object &optional assign)

-  #!+sb-doc
-  "Check to see whether OBJECT is a circular reference, and return something
-   non-NIL if it is. If ASSIGN is T, then the number to use in the #n= and
-   #n# noise is assigned at this time. Note: CHECK-FOR-CIRCULARITY must
-   be called *EXACTLY* once with ASSIGN T, or the circularity detection noise
-   will get confused about when to use #n= and when to use #n#. If this
-   returns non-NIL when ASSIGN is T, then you must call HANDLE-CIRCULARITY
-   on it. If you are not using this inside a WITH-CIRCULARITY-DETECTION,
-   then you have to be prepared to handle a return value of :INITIATE which
-   means it needs to initiate the circularity detection noise. See the
-   source for info on how to do that."

   (cond ((null *print-circle*)
         ;; Don't bother, nobody cares.
         nil)
   (cond ((null *print-circle*)
         ;; Don't bother, nobody cares.
         nil)

@@ -344,11 +343,10 @@
              ;; Second or later occurance.
              (- value)))))))
 
              ;; Second or later occurance.
              (- value)))))))
 

+;;; Handle the results of CHECK-FOR-CIRCULARITY. If this returns T then
+;;; you should go ahead and print the object. If it returns NIL, then
+;;; you should blow it off.

 (defun handle-circularity (marker stream)
 (defun handle-circularity (marker stream)

-  #!+sb-doc
-  "Handle the results of CHECK-FOR-CIRCULARITY. If this returns T then
-   you should go ahead and print the object. If it returns NIL, then
-   you should blow it off."

   (case marker
     (:initiate
      ;; Someone forgot to initiate circularity detection.
   (case marker
     (:initiate
      ;; Someone forgot to initiate circularity detection.

@@ -379,9 +377,8 @@
    arguments (the object and the stream) or NIL to indicate that there is
    no pretty printer installed.")
 
    arguments (the object and the stream) or NIL to indicate that there is
    no pretty printer installed.")
 

+;;; Output OBJECT to STREAM observing all printer control variables.

 (defun output-object (object stream)
 (defun output-object (object stream)

-  #!+sb-doc
-  "Output OBJECT to STREAM observing all printer control variables."

   (labels ((print-it (stream)
             (if *print-pretty*
                 (if *pretty-printer*
   (labels ((print-it (stream)
             (if *print-pretty*
                 (if *pretty-printer*

@@ -423,12 +420,11 @@
          (t
           (print-it stream)))))
 
          (t
           (print-it stream)))))
 

+;;; Output OBJECT to STREAM observing all printer control variables
+;;; except for *PRINT-PRETTY*. Note: if *PRINT-PRETTY* is non-NIL,
+;;; then the pretty printer will be used for any components of OBJECT,
+;;; just not for OBJECT itself.

 (defun output-ugly-object (object stream)
 (defun output-ugly-object (object stream)

-  #!+sb-doc
-  "Output OBJECT to STREAM observing all printer control variables except
-   for *PRINT-PRETTY*. Note: if *PRINT-PRETTY* is non-NIL, then the pretty
-   printer will be used for any components of OBJECT, just not for OBJECT
-   itself."

   (typecase object
     ;; KLUDGE: The TYPECASE approach here is non-ANSI; the ANSI definition of
     ;; PRINT-OBJECT says it provides printing and we're supposed to provide
   (typecase object
     ;; KLUDGE: The TYPECASE approach here is non-ANSI; the ANSI definition of
     ;; PRINT-OBJECT says it provides printing and we're supposed to provide

@@ -610,7 +606,7 @@
 (declaim (type (simple-array (unsigned-byte 16) (#.char-code-limit))
               *character-attributes*))
 
 (declaim (type (simple-array (unsigned-byte 16) (#.char-code-limit))
               *character-attributes*))
 

-;;; Constants which are a bit-mask for each interesting character attribute.
+;;; constants which are a bit-mask for each interesting character attribute

 (defconstant other-attribute           (ash 1 0)) ; Anything else legal.
 (defconstant number-attribute          (ash 1 1)) ; A numeric digit.
 (defconstant uppercase-attribute       (ash 1 2)) ; An uppercase letter.
 (defconstant other-attribute           (ash 1 0)) ; Anything else legal.
 (defconstant number-attribute          (ash 1 1)) ; A numeric digit.
 (defconstant uppercase-attribute       (ash 1 2)) ; An uppercase letter.

diff --git a/src/code/profile.lisp b/src/code/profile.lisp
index 524b5fd..02fc54a 100644 (file)
--- a/src/code/profile.lisp
+++ b/src/code/profile.lisp
@@ -169,18 +169,7 @@
                    (*enclosed-ticks* 0)
                    (*enclosed-consing* 0)
                    (*enclosed-profiles* 0)
                    (*enclosed-ticks* 0)
                    (*enclosed-consing* 0)
                    (*enclosed-profiles* 0)

-                   (nbf-pcounter *n-bytes-freed-or-purified-pcounter*)
-                   ;; Typically NBF-PCOUNTER will represent a bignum.
-                   ;; In general we don't want to cons up a new
-                   ;; bignum for every encapsulated call, so instead
-                   ;; we keep track of the PCOUNTER internals, so
-                   ;; that as long as we only cons small amounts,
-                   ;; we'll almost always just do fixnum arithmetic.
-                   ;; (And for encapsulated functions which cons
-                   ;; large amounts, then a single extra consed
-                   ;; bignum tends to be proportionally negligible.)
-                   (nbf0-integer (pcounter-integer nbf-pcounter))
-                   (nbf0-fixnum (pcounter-fixnum nbf-pcounter))
+                   (nbf0 *n-bytes-freed-or-purified*)

                    (dynamic-usage-0 (sb-kernel:dynamic-usage)))
               (declare (inline pcounter-or-fixnum->integer))
               (multiple-value-prog1
                    (dynamic-usage-0 (sb-kernel:dynamic-usage)))
               (declare (inline pcounter-or-fixnum->integer))
               (multiple-value-prog1

@@ -192,19 +181,12 @@
                       (dynamic-usage-1 (sb-kernel:dynamic-usage)))
                   (setf dticks (fastbig- (get-internal-ticks) start-ticks))
                   (setf dconsing
                       (dynamic-usage-1 (sb-kernel:dynamic-usage)))
                   (setf dticks (fastbig- (get-internal-ticks) start-ticks))
                   (setf dconsing

-                        (if (and (eq (pcounter-integer nbf-pcounter)
-                                     nbf0-integer)
-                                 (eq (pcounter-fixnum nbf-pcounter)
-                                     nbf0-fixnum))
+                        (if (eql *n-bytes-freed-or-purified* nbf0)

                             ;; common special case where we can avoid
                             ;; bignum arithmetic
                             ;; common special case where we can avoid
                             ;; bignum arithmetic

-                            (- dynamic-usage-1
-                               dynamic-usage-0)
+                            (- dynamic-usage-1 dynamic-usage-0)

                             ;; general case
                             ;; general case

-                            (- (get-bytes-consed)
-                               nbf0-integer
-                               nbf0-fixnum
-                               dynamic-usage-0)))
+                            (- (get-bytes-consed) nbf0 dynamic-usage-0)))

                   (setf inner-enclosed-profiles
                         (pcounter-or-fixnum->integer *enclosed-profiles*))
                   (let ((net-dticks (fastbig- dticks *enclosed-ticks*)))
                   (setf inner-enclosed-profiles
                         (pcounter-or-fixnum->integer *enclosed-profiles*))
                   (let ((net-dticks (fastbig- dticks *enclosed-ticks*)))

diff --git a/version.lisp-expr b/version.lisp-expr
index 15245d5..753e5a1 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -16,4 +16,4 @@
 ;;; four numeric fields, is used for versions which aren't released
 ;;; but correspond only to CVS tags or snapshots.
 
 ;;; four numeric fields, is used for versions which aren't released
 ;;; but correspond only to CVS tags or snapshots.
 

-"0.6.12.58"
+"0.6.12.59"