X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fprofile.lisp;h=da4f0b656038d75ae8e2593c7720c83a531c39a8;hb=447788f1b408a8e9ec15ca822851dcd0bee52f82;hp=0e25d329452dd9d7874ed766a58b46cf0200e757;hpb=eaeb81412400357c49efb44bdb257576c872be05;p=sbcl.git

diff --git a/src/code/profile.lisp b/src/code/profile.lisp
index 0e25d32..da4f0b6 100644
--- a/src/code/profile.lisp
+++ b/src/code/profile.lisp
@@ -15,8 +15,6 @@
 ;;;; 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)
@@ -36,12 +34,11 @@
                ;; 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)
-                   (atomic-incf (counter-word counter))))))
+                 (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 +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,
@@ -58,8 +55,7 @@
 
 (defun counter-count (counter)
   (+ (counter-word counter)
-     (* (counter-overflow counter)
-        +most-positive-word+)))
+     (* (counter-overflow counter) (1+ most-positive-word))))
 
 ;;;; High resolution timer
 
@@ -372,11 +368,15 @@
                (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)))
@@ -401,13 +401,16 @@ Lisp process."
                                   :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<