;;; inline.
(defmacro fastbig- (x y)
(once-only ((x x) (y y))
- `(if (and (typep ,x 'fixnum)
- (typep ,y 'fixnum))
+ `(if (and (typep ,x '(and fixnum unsigned-byte))
+ (typep ,y '(and fixnum unsigned-byte)))
+ ;; special case: can use fixnum arithmetic and be guaranteed
+ ;; the result is also a fixnum
(- ,x ,y)
+ ;; general case
(- ,x ,y))))
(defmacro fastbig-1+ (x)
(once-only ((x x))
(let ((dticks 0)
(dconsing 0)
(inner-enclosed-profiles 0))
- ;;(declare (type unsigned-byte dticks dconsing))
- ;;(declare (type unsigned-byte inner-enclosed-profiles))
+ (declare (type unsigned-byte dticks dconsing))
+ (declare (type unsigned-byte inner-enclosed-profiles))
(aver (typep dticks 'unsigned-byte))
(aver (typep dconsing 'unsigned-byte))
(aver (typep inner-enclosed-profiles 'unsigned-byte))
(multiple-value-prog1
- (let ((start-ticks (get-internal-ticks))
- ;; KLUDGE: We add (THE UNSIGNED-BYTE ..) wrappers
- ;; around GET-BYTES-CONSED because as of
- ;; sbcl-0.6.4, at the time that the FTYPE of
- ;; GET-BYTES-CONSED is DECLAIMed, the
- ;; cross-compiler's type system isn't mature enough
- ;; to do anything about it. -- WHN 20000503
- (start-consing (the unsigned-byte (get-bytes-consed)))
- (*enclosed-ticks* 0)
- (*enclosed-consing* 0)
- (*enclosed-profiles* 0))
+ (let* ((start-ticks (get-internal-ticks))
+ (*enclosed-ticks* 0)
+ (*enclosed-consing* 0)
+ (*enclosed-profiles* 0)
+ (nbf-pcounter *n-bytes-freed-or-purified-pcounter*)
+ ;; Typically NBF-PCOUNTER will represent a bignum.
+ ;; In general we don't want to cons up a new
+ ;; bignum for every encapsulated call, so instead
+ ;; we keep track of the PCOUNTER internals, so
+ ;; that as long as we only cons small amounts,
+ ;; we'll almost always just do fixnum arithmetic.
+ ;; (And for encapsulated functions which cons
+ ;; large amounts, then we don't much care about a
+ ;; single extra consed bignum.)
+ (start-consing-integer (pcounter-integer nbf-pcounter))
+ (start-consing-fixnum (pcounter-fixnum nbf-pcounter)))
(declare (inline pcounter-or-fixnum->integer))
(multiple-value-prog1
(multiple-value-call encapsulated-fun
0
arg-count))
(let ((*computing-profiling-data-for* encapsulated-fun))
- (setf dticks (fastbig- (get-internal-ticks) start-ticks)
- dconsing (fastbig- (the unsigned-byte
- (get-bytes-consed))
- start-consing))
+ (setf dticks (fastbig- (get-internal-ticks) start-ticks))
+ (setf dconsing
+ (if (eq (pcounter-integer nbf-pcounter)
+ start-consing-integer)
+ (- (pcounter-fixnum nbf-pcounter)
+ start-consing-fixnum)
+ (- (get-bytes-consed)
+ (+ (pcounter-integer nbf-pcounter)
+ (pcounter-fixnum nbf-pcounter)))))
(setf inner-enclosed-profiles
(pcounter-or-fixnum->integer *enclosed-profiles*))
- (when (minusp dticks) ; REMOVEME
- (unprofile-all)
- (error "huh? (GET-INTERNAL-TICKS)=~S START-TICKS=~S"
- (get-internal-ticks) start-ticks))
- (aver (not (minusp dconsing))) ; REMOVEME
- (aver (not (minusp inner-enclosed-profiles))) ; REMOVEME
(let ((net-dticks (fastbig- dticks *enclosed-ticks*)))
- (when (minusp net-dticks) ; REMOVEME
- (unprofile-all)
- (error "huh? DTICKS=~S, *ENCLOSED-TICKS*=~S"
- dticks *enclosed-ticks*))
(fastbig-incf-pcounter-or-fixnum ticks net-dticks))
(let ((net-dconsing (fastbig- dconsing *enclosed-consing*)))
- (when (minusp net-dconsing) ; REMOVEME
- (unprofile-all)
- (error "huh? DCONSING=~S, *ENCLOSED-CONSING*=~S"
- dticks *enclosed-ticks*))
(fastbig-incf-pcounter-or-fixnum consing net-dconsing))
(fastbig-incf-pcounter-or-fixnum profiles
inner-enclosed-profiles))))
(max raw-compensated 0.0)))
(defun report ()
- "Report results from profiling. The results are
-approximately adjusted for profiling overhead, but when RAW is true
-the unadjusted results are reported. The compensation may be somewhat
-inaccurate when bignums are involved in runtime calculation, as in
-a very-long-running Lisp process."
+ "Report results from profiling. The results are approximately adjusted
+for profiling overhead. The compensation may be rather inaccurate when
+bignums are involved in runtime calculation, as in a very-long-running
+Lisp process."
(declare #.*optimize-external-despite-byte-compilation*)
(unless (boundp '*overhead*)
(setf *overhead*
;;;; overhead estimation
;;; We average the timing overhead over this many iterations.
-(defconstant +timer-overhead-iterations+
- 50 ; REMOVEME
- ;;50000
- )
+;;;
+;;; (This is a variable, not a constant, so that it can be set in
+;;; .sbclrc if desired. Right now, that's an unsupported extension
+;;; that I (WHN) use for my own experimentation, but it might
+;;; become supported someday. Comments?)
+(declaim (type unsigned-byte *timer-overhead-iterations*))
+(defvar *timer-overhead-iterations*
+ 500000)
;;; a dummy function that we profile to find profiling overhead
(declaim (notinline compute-overhead-aux))
;;; Return a newly computed OVERHEAD object.
(defun compute-overhead ()
+ (format *debug-io* "~&measuring PROFILE overhead..")
(flet ((frob ()
(let ((start (get-internal-ticks))
(fun (symbol-function 'compute-overhead-aux)))
- (dotimes (i +timer-overhead-iterations+)
+ (dotimes (i *timer-overhead-iterations*)
(funcall fun fun))
(/ (float (- (get-internal-ticks) start))
(float +ticks-per-second+)
- (float +timer-overhead-iterations+)))))
+ (float *timer-overhead-iterations*)))))
(let (;; Measure unprofiled calls to estimate call overhead.
(call-overhead (frob))
total-overhead
(setf internal-overhead
(/ (float time)
(float +ticks-per-second+)
- (float +timer-overhead-iterations+))))
+ (float *timer-overhead-iterations*))))
(unprofile compute-overhead-aux))
- (make-overhead :call call-overhead
- :total total-overhead
- :internal internal-overhead))))
+ (prog1
+ (make-overhead :call call-overhead
+ :total total-overhead
+ :internal internal-overhead)
+ (format *debug-io* "done~%")))))
;;; It would be bad to compute *OVERHEAD*, save it into a .core file,
-;;; then load old *OVERHEAD* value from the .core file into a
+;;; then load the old *OVERHEAD* value from the .core file into a
;;; different machine running at a different speed. We avoid this by
;;; erasing *CALL-OVERHEAD* whenever we save a .core file.
(pushnew (lambda ()