From f3af39f1a29391c2cc9f3308bc0a9ea6d39fb8eb Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Sat, 23 Jun 2001 16:26:55 +0000 Subject: [PATCH] 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 --- package-data-list.lisp-expr | 10 +++++ src/code/pcounter.lisp | 93 +++++++++++++++++++++++++++++++++++++++++++ src/code/profile.lisp | 71 --------------------------------- stems-and-flags.lisp-expr | 2 + version.lisp-expr | 2 +- 5 files changed, 106 insertions(+), 72 deletions(-) create mode 100644 src/code/pcounter.lisp diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 351bae9..72e02f0 100644 --- 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 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") + +;;;; 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))) + +;;;; 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 --- 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)) -;;;; 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))) - -;;;; 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)))) - ;;;; implementation-dependent interfaces #| diff --git a/stems-and-flags.lisp-expr b/stems-and-flags.lisp-expr index a3a4d21..8d44b6a 100644 --- 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 --- 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" -- 1.7.10.4