-(defun get-internal-ticks () (get-internal-run-time))
-\f
-;;;; 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)))
-\f
-;;;; 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))))
-\f
-;;;; implementation-dependent interfaces
-
-#|
-;;; To avoid unnecessary consing in the "encapsulation" code, we want
-;;; find out the number of required arguments, and use &REST to
-;;; capture only non-required arguments. This function returns (VALUES
-;;; MIN-ARGS OPTIONALS-P), where MIN-ARGS is the number of required
-;;; arguments and OPTIONALS-P is true iff there are any non-required
-;;; arguments (such as &OPTIONAL, &REST, or &KEY).
-(declaim (ftype (function ((or symbol cons)) (values fixnum t)) fun-signature))
-(defun fun-signature (name)
- (let ((type (info :function :type name)))
- (cond ((not (function-type-p type))
- (values 0 t))
- (t
- (values (length (function-type-required type))
- (or (function-type-optional type)
- (function-type-keyp type)
- (function-type-rest type)))))))
-|#