src/code/pcounter.lisp

   1 ;;;; PCOUNTERs
   2 ;;;;
   3 ;;;; a PCOUNTER is used to represent an unsigned integer quantity which
   4 ;;;; can grow bigger than a fixnum, but typically does so, if at all,
   5 ;;;; in many small steps, where we don't want to cons on every step.
   6 ;;;; Such quantities typically arise in profiling, e.g.
   7 ;;;; total system consing, time spent in a profiled function, and
   8 ;;;; bytes consed in a profiled function are all examples of such
   9 ;;;; quantities. The name is an abbreviation for "Profiling COUNTER".
  10 ;;;;
  11 ;;;; (This isn't one of my more brilliant names, so if you have a
  12 ;;;; better suggestion, let me know. -- WHN 2001-06-22)
  13
  14 ;;; This stuff is implemented in the SB!PROFILE because the profiling
  15 ;;; code is currently the only code which wants to poke around in the
  16 ;;; implementation details.
  17 (in-package "SB!PROFILE")
  18 \f
  19 ;;;; basic PCOUNTER stuff
  20
  21 (/show0 "pcounter.lisp 21")
  22
  23 (declaim (maybe-inline incf-pcounter))
  24 (defun incf-pcounter (pcounter delta)
  25   (aver (typep delta 'unsigned-byte))
  26   (let ((sum (+ (pcounter-fixnum pcounter) delta)))
  27     (cond ((typep sum 'fixnum)
  28            (setf (pcounter-fixnum pcounter) sum))
  29           (t
  30            (incf (pcounter-integer pcounter) sum)
  31            (setf (pcounter-fixnum pcounter) 0))))
  32   pcounter)
  33
  34 (/show0 "pcounter.lisp 34")
  35
  36 ;;;(declaim (inline pcounter->integer)) ; FIXME: maybe inline when more stable
  37 (defun pcounter->integer (pcounter)
  38   (+ (pcounter-integer pcounter)
  39      (pcounter-fixnum pcounter)))
  40 \f
  41 ;;;; operations on (OR PCOUNTER FIXNUM)
  42 ;;;;
  43 ;;;; When we don't want to cons a PCOUNTER unless we're forced to, we
  44 ;;;; start with a FIXNUM counter and only create a PCOUNTER if the
  45 ;;;; FIXNUM overflows.
  46
  47 (/show0 "pcounter.lisp 47")
  48
  49 (declaim (inline %incf-pcounter-or-fixnum))
  50 (defun %incf-pcounter-or-fixnum (x delta)
  51   (etypecase x
  52     (fixnum
  53      (let ((sum (+ x delta)))
  54        (if (typep sum 'fixnum)
  55            sum
  56            (make-pcounter :integer sum))))
  57     (pcounter
  58      (incf-pcounter x delta))))
  59
  60 (define-modify-macro incf-pcounter-or-fixnum (delta) %incf-pcounter-or-fixnum)
  61
  62 (/show0 "pcounter.lisp 62")
  63
  64 ;;; Trade off space for execution time by handling the common fast
  65 ;;; (TYPEP DELTA 'FIXNUM) case inline and only calling generic
  66 ;;; arithmetic as a last resort.
  67 (defmacro fastbig-incf-pcounter-or-fixnum (x delta)
  68   (let ((delta-sym (gensym "DELTA")))
  69     `(let ((,delta-sym ,delta))
  70        (aver (typep ,delta-sym 'unsigned-byte))
  71        ;;(declare (type unsigned-byte ,delta-sym))
  72        (if (typep ,delta-sym 'fixnum)
  73            (incf-pcounter-or-fixnum ,x ,delta)
  74            (incf-pcounter-or-fixnum ,x ,delta)))))
  75
  76 (/show0 "pcounter.lisp 76")
  77
  78 (declaim (maybe-inline pcounter-or-fixnum->integer))
  79 (defun pcounter-or-fixnum->integer (x)
  80   (etypecase x
  81     (fixnum x)
  82     (pcounter (pcounter->integer x))))
  83
  84 (/show0 "pcounter.lisp end")