;;;; Thread safe, and reasonably fast: in common case increment is just an
;;;; ATOMIC-INCF, in overflow case grab a lock and increment overflow counter.
-(defconstant +most-positive-word+ (1- (expt 2 sb-vm:n-word-bits)))
-
(declaim (inline make-counter))
(defstruct (counter (:constructor make-counter) (:copier nil))
(word 0 :type sb-vm:word)
;; 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)
+ (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+))
+ (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,
(defun counter-count (counter)
(+ (counter-word counter)
- (* (counter-overflow counter) (1+ +most-positive-word+))))
+ (* (counter-overflow counter) (1+ most-positive-word))))
\f
;;;; High resolution timer
(float profile)))))
(max raw-compensated 0.0)))
-(defun report ()
- "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."
+(defun report (&key limit (print-no-call-list t))
+ "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.
+
+If LIMIT is set to an integer, only the top LIMIT results are
+reported. If PRINT-NO-CALL-LIST is T (the default) then a list of
+uncalled profiled functions are listed."
(unless (boundp '*overhead*)
(setf *overhead*
(compute-overhead)))
:gc-run-time gc-run-time)
time-info-list))))
- (setf time-info-list
- (sort time-info-list
- #'>=
- :key #'time-info-seconds))
- (print-profile-table time-info-list)
+ (let ((times
+ (sort time-info-list
+ #'>=
+ :key #'time-info-seconds)))
+ (print-profile-table
+ (if (and limit (> (length times) limit))
+ (subseq times 0 limit)
+ times)))
- (when no-call-name-list
+ (when (and print-no-call-list no-call-name-list)
(format *trace-output*
"~%These functions were not called:~%~{~<~%~:; ~S~>~}~%"
(sort no-call-name-list #'string<