+
+;;;; COUNTER object
+;;;;
+;;;; Thread safe, and reasonably fast: in common case increment is just an
+;;;; ATOMIC-INCF, in overflow case grab a lock and increment overflow counter.
+
+(declaim (inline make-counter))
+(defstruct (counter (:constructor make-counter) (:copier nil))
+ (word 0 :type sb-vm:word)
+ (overflow 0 :type unsigned-byte))
+
+(defun incf-counter (counter delta)
+ ;; When running multi-threaded we can easily get negative numbers for the
+ ;; cons-counter. Don't count them at all.
+ (when (plusp delta)
+ (labels ((%incf-overflow (&optional (n 1))
+ ;; Overflow-counter can run into bignums... so we need to loop
+ ;; around CAS till the increment succeeds.
+ (loop for old = (counter-overflow counter)
+ until (eq old (compare-and-swap (counter-overflow counter)
+ old (+ old n)))))
+ (%incf (d)
+ ;; Increment the word-sized counter. If it overflows, record the
+ ;; overflow.
+ (let ((prev (atomic-incf (counter-word counter) d)))
+ (when (< (logand most-positive-word (+ prev d)) prev)
+ (%incf-overflow)))))
+ ;; DELTA can potentially be a bignum -- cut it down to word-size.
+ (unless (typep delta 'sb-vm:word)
+ (multiple-value-bind (n r) (truncate delta (1+ most-positive-word))
+ (%incf-overflow n)
+ (setf delta r)))
+ ;; ATOMIC-INCF can at most handle SIGNED-WORD: if DELTA doesn't fit that,
+ ;; DELTA/2 will.
+ (if (typep delta 'sb-vm:signed-word)
+ (%incf delta)
+ ;; ...and if delta is still too big, split it into four parts: they
+ ;; are guaranteed to fit into a signed word.
+ (multiple-value-bind (n r) (truncate delta 2)
+ (%incf n)
+ (%incf n)
+ (%incf r)))))
+ counter)
+
+(defun counter-count (counter)
+ (+ (counter-word counter)
+ (* (counter-overflow counter) (1+ most-positive-word))))
+\f
+;;;; High resolution timer
+
+;;; FIXME: High resolution this is not. Build a microsecond-accuracy version
+;;; on top of unix-getrusage, maybe.