0.6.12.38:

	tweaked PCOUNTER stuff in anticipation of future changes
		in GET-BYTES-CONSED..
	..moved PCOUNTER code from profile.lisp to new pcounter.lisp
	..exported PCOUNTER stuff from SB-INT

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 351bae9..72e02f0 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -690,6 +690,16 @@ retained, possibly temporariliy, because it might be used internally."
              "PHYSICALIZE-PATHNAME"
              "SANE-DEFAULT-PATHNAME-DEFAULTS"
 
+             ;; PCOUNTERs
+             "FASTBIG-INCF-PCOUNTER-OR-FIXNUM"
+             "INCF-PCOUNTER"
+             "INCF-PCOUNTER-OR-FIXNUM"
+             "MAKE-PCOUNTER"             
+             "PCOUNTER"
+             "PCOUNTER->INTEGER"
+             "PCOUNTER-OR-FIXNUM->INTEGER"
+             "PCOUNTER-P"
+
              ;; miscellaneous non-standard but handy user-level functions..
              "ASSQ" "DELQ" "MEMQ" "POSQ" "NEQ"
              "%FIND-PACKAGE-OR-LOSE" "FIND-UNDELETED-PACKAGE-OR-LOSE"

diff --git a/src/code/pcounter.lisp b/src/code/pcounter.lisp
new file mode 100644 (file)
index 0000000..cfd7421
--- /dev/null
+++ b/src/code/pcounter.lisp
@@ -0,0 +1,93 @@
+;;;; PCOUNTERs
+;;;;
+;;;; a PCOUNTER is used to represent an unsigned integer quantity which
+;;;; can grow bigger than a fixnum, but typically does so, if at all,
+;;;; in many small steps, where we don't want to cons on every step.
+;;;; Such quantities typically arise in profiling, e.g. 
+;;;; total system consing, time spent in a profiled function, and
+;;;; bytes consed in a profiled function are all examples of such
+;;;; quantities. The name is an abbreviation for "Profiling COUNTER".
+;;;;
+;;;; It's not one of my more brilliant names, if you have a better
+;;;; suggestion, I might be interested. -- WHN 2001-06-22
+
+(in-package "SB!IMPL")
+\f
+;;;; basic PCOUNTER stuff
+
+(/show0 "pcounter.lisp 16")
+
+(defstruct (pcounter (:copier nil))
+  (integer 0);; :type unsigned-byte)
+  (fixnum 0));; :type (and fixnum unsigned-byte)))
+
+(/show0 "pcounter.lisp 22")
+
+(declaim (ftype (function (pcounter unsigned-byte) pcounter) incf-pcounter))
+;;;(declaim (inline incf-pcounter)) ; FIXME: maybe inline when more stable
+(defun incf-pcounter (pcounter delta)
+  (aver (typep delta 'unsigned-byte))
+  (let ((sum (+ (pcounter-fixnum pcounter) delta)))
+    (aver (typep sum 'unsigned-byte))
+    ;;(declare (type unsigned-byte sum))
+    (cond ((typep sum 'fixnum)
+          (setf (pcounter-fixnum pcounter) sum))
+         (t
+          (incf (pcounter-integer pcounter) sum)
+          (setf (pcounter-fixnum pcounter) 0))))
+  pcounter)
+
+(/show0 "pcounter.lisp 36")
+
+(declaim (ftype (function (pcounter) integer) pcounter->integer))
+;;;(declaim (inline pcounter->integer)) ; FIXME: maybe inline when more stable
+(defun pcounter->integer (pcounter)
+  (+ (pcounter-integer pcounter)
+     (pcounter-fixnum pcounter)))
+\f
+;;;; operations on (OR PCOUNTER FIXNUM)
+;;;;
+;;;; When we don't want to cons a PCOUNTER unless we're forced to, we
+;;;; start with a FIXNUM counter and only create a PCOUNTER if the
+;;;; FIXNUM overflows.
+
+(/show0 "pcounter.lisp 50")
+
+(declaim (ftype (function ((or pcounter fixnum) integer) (or pcounter fixnum)) %incf-pcounter-or-fixnum))
+;;;(declaim (inline %incf-pcounter-or-fixnum)) ; FIXME: maybe inline when more stable
+(defun %incf-pcounter-or-fixnum (x delta)
+  (etypecase x
+    (fixnum
+     (let ((sum (+ x delta)))
+       (if (typep sum 'fixnum)
+          sum
+          (make-pcounter :integer sum))))
+    (pcounter
+     (incf-pcounter x delta))))
+  
+(define-modify-macro incf-pcounter-or-fixnum (delta) %incf-pcounter-or-fixnum)
+
+(/show0 "pcounter.lisp 64")
+
+;;; Trade off space for execution time by handling the common fast
+;;; (TYPEP DELTA 'FIXNUM) case inline and only calling generic
+;;; arithmetic as a last resort.
+(defmacro fastbig-incf-pcounter-or-fixnum (x delta)
+  (let ((delta-sym (gensym "DELTA")))
+    `(let ((,delta-sym ,delta))
+       (aver (typep ,delta-sym 'unsigned-byte))
+       ;;(declare (type unsigned-byte ,delta-sym))
+       (if (typep ,delta-sym 'fixnum)
+          (incf-pcounter-or-fixnum ,x ,delta)
+          (incf-pcounter-or-fixnum ,x ,delta)))))
+
+(/show0 "pcounter.lisp 80")
+
+(declaim (ftype (function ((or pcounter fixnum)) integer) pcounter-or-fixnum->integer))
+(declaim (maybe-inline pcounter-or-fixnum->integer))
+(defun pcounter-or-fixnum->integer (x)
+  (etypecase x
+    (fixnum x)
+    (pcounter (pcounter->integer x))))
+
+(/show0 "pcounter.lisp end")

diff --git a/src/code/profile.lisp b/src/code/profile.lisp
index 6c098bf..def7908 100644 (file)
--- a/src/code/profile.lisp
+++ b/src/code/profile.lisp
@@ -21,77 +21,6 @@
 (declaim (inline get-internal-ticks))
 (defun get-internal-ticks () (get-internal-run-time))
 \f
-;;;; PCOUNTER
-
-;;; a PCOUNTER is used to represent an unsigned integer quantity which
-;;; can grow bigger than a fixnum, but typically does so, if at all,
-;;; in many small steps, where we don't want to cons on every step.
-;;; (Total system consing, time spent in a profiled function, and
-;;; bytes consed in a profiled function are all examples of such
-;;; quantities.)
-(defstruct (pcounter (:copier nil))
-  (integer 0);; :type unsigned-byte)
-  (fixnum 0));; :type (and fixnum unsigned-byte)))
-
-;;;(declaim (ftype (function (pcounter unsigned-byte) pcounter) incf-pcounter))
-;;;(declaim (inline incf-pcounter)) ; FIXME: maybe inline when more stable
-(defun incf-pcounter (pcounter delta)
-  (aver (typep delta 'unsigned-byte))
-  (let ((sum (+ (pcounter-fixnum pcounter) delta)))
-    (aver (typep sum 'unsigned-byte))
-    ;;(declare (type unsigned-byte sum))
-    (cond ((typep sum 'fixnum)
-          (setf (pcounter-fixnum pcounter) sum))
-         (t
-          (incf (pcounter-integer pcounter) sum)
-          (setf (pcounter-fixnum pcounter) 0))))
-  pcounter)
-
-(declaim (ftype (function (pcounter) integer) pcounter->integer))
-;;;(declaim (inline pcounter->integer)) ; FIXME: maybe inline when more stable
-(defun pcounter->integer (pcounter)
-  (+ (pcounter-integer pcounter)
-     (pcounter-fixnum pcounter)))
-\f
-;;;; operations on (OR PCOUNTER FIXNUM)
-;;;;
-;;;; When we don't want to cons a PCOUNTER unless we're forced to, we
-;;;; start with a FIXNUM counter and only create a PCOUNTER if the
-;;;; FIXNUM overflows.
-
-(declaim (ftype (function ((or pcounter fixnum) integer) (or pcounter fixnum)) %incf-pcounter-or-fixnum))
-;;;(declaim (inline %incf-pcounter-or-fixnum)) ; FIXME: maybe inline when more stable
-(defun %incf-pcounter-or-fixnum (x delta)
-  (etypecase x
-    (fixnum
-     (let ((sum (+ x delta)))
-       (if (typep sum 'fixnum)
-          sum
-          (make-pcounter :integer sum))))
-    (pcounter
-     (incf-pcounter x delta))))
-  
-(define-modify-macro incf-pcounter-or-fixnum (delta) %incf-pcounter-or-fixnum)
-
-;;; Trade off space for execution time by handling the common fast
-;;; (TYPEP DELTA 'FIXNUM) case inline and only calling generic
-;;; arithmetic as a last resort.
-(defmacro fastbig-incf-pcounter-or-fixnum (x delta)
-  (let ((delta-sym (gensym "DELTA")))
-    `(let ((,delta-sym ,delta))
-       (aver (typep ,delta-sym 'unsigned-byte))
-       ;;(declare (type unsigned-byte ,delta-sym))
-       (if (typep ,delta-sym 'fixnum)
-          (incf-pcounter-or-fixnum ,x ,delta)
-          (incf-pcounter-or-fixnum ,x ,delta)))))
-
-(declaim (ftype (function ((or pcounter fixnum)) integer) pcounter-or-fixnum->integer))
-(declaim (maybe-inline pcounter-or-fixnum->integer))
-(defun pcounter-or-fixnum->integer (x)
-  (etypecase x
-    (fixnum x)
-    (pcounter (pcounter->integer x))))
-\f
 ;;;; implementation-dependent interfaces
 
 #|

diff --git a/stems-and-flags.lisp-expr b/stems-and-flags.lisp-expr
index a3a4d21..8d44b6a 100644 (file)
--- a/stems-and-flags.lisp-expr
+++ b/stems-and-flags.lisp-expr
@@ -127,6 +127,8 @@
  ;; accessors.)
  ("src/code/type-class")
 
+ ("src/code/pcounter" :not-host)
+
  ("src/code/lisp-stream" :not-host)
 
  ("src/code/sysmacs" :not-host)

diff --git a/version.lisp-expr b/version.lisp-expr
index 3545520..d7131b4 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.
 
-"0.6.12.37"
+"0.6.12.38"