0.7.13.3
[sbcl.git] / 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")