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 16")
  22
  23 (defstruct (pcounter (:copier nil))
  24   (integer 0 :type unsigned-byte)
  25   (fixnum 0 :type (and fixnum unsigned-byte)))
  26
  27 (/show0 "pcounter.lisp 22")
  28
  29 (declaim (maybe-inline incf-pcounter))
  30 (defun incf-pcounter (pcounter delta)
  31   (aver (typep delta 'unsigned-byte))
  32   (let ((sum (+ (pcounter-fixnum pcounter) delta)))
  33     (cond ((typep sum 'fixnum)
  34            (setf (pcounter-fixnum pcounter) sum))
  35           (t
  36            (incf (pcounter-integer pcounter) sum)
  37            (setf (pcounter-fixnum pcounter) 0))))
  38   pcounter)
  39
  40 (/show0 "pcounter.lisp 36")
  41
  42 ;;;(declaim (inline pcounter->integer)) ; FIXME: maybe inline when more stable
  43 (defun pcounter->integer (pcounter)
  44   (+ (pcounter-integer pcounter)
  45      (pcounter-fixnum pcounter)))
  46 \f
  47 ;;;; operations on (OR PCOUNTER FIXNUM)
  48 ;;;;
  49 ;;;; When we don't want to cons a PCOUNTER unless we're forced to, we
  50 ;;;; start with a FIXNUM counter and only create a PCOUNTER if the
  51 ;;;; FIXNUM overflows.
  52
  53 (/show0 "pcounter.lisp 50")
  54
  55 (declaim (inline %incf-pcounter-or-fixnum))
  56 (defun %incf-pcounter-or-fixnum (x delta)
  57   (etypecase x
  58     (fixnum
  59      (let ((sum (+ x delta)))
  60        (if (typep sum 'fixnum)
  61            sum
  62            (make-pcounter :integer sum))))
  63     (pcounter
  64      (incf-pcounter x delta))))
  65
  66 (define-modify-macro incf-pcounter-or-fixnum (delta) %incf-pcounter-or-fixnum)
  67
  68 (/show0 "pcounter.lisp 64")
  69
  70 ;;; Trade off space for execution time by handling the common fast
  71 ;;; (TYPEP DELTA 'FIXNUM) case inline and only calling generic
  72 ;;; arithmetic as a last resort.
  73 (defmacro fastbig-incf-pcounter-or-fixnum (x delta)
  74   (let ((delta-sym (gensym "DELTA")))
  75     `(let ((,delta-sym ,delta))
  76        (aver (typep ,delta-sym 'unsigned-byte))
  77        ;;(declare (type unsigned-byte ,delta-sym))
  78        (if (typep ,delta-sym 'fixnum)
  79            (incf-pcounter-or-fixnum ,x ,delta)
  80            (incf-pcounter-or-fixnum ,x ,delta)))))
  81
  82 (/show0 "pcounter.lisp 80")
  83
  84 (declaim (maybe-inline pcounter-or-fixnum->integer))
  85 (defun pcounter-or-fixnum->integer (x)
  86   (etypecase x
  87     (fixnum x)
  88     (pcounter (pcounter->integer x))))
  89
  90 (/show0 "pcounter.lisp end")