1.0.46.18: terser C-STRING unparsing

[sbcl.git] / src / code / profile.lisp

diff --git a/src/code/profile.lisp b/src/code/profile.lisp
index 0e25d32..c4d2750 100644 (file)
--- a/src/code/profile.lisp
+++ b/src/code/profile.lisp
@@ -37,11 +37,10 @@
                ;; overflow.
                (let ((prev (atomic-incf (counter-word counter) d)))
                  (when (< (logand +most-positive-word+ (+ prev d)) prev)
-                   (%incf-overflow)
-                   (atomic-incf (counter-word counter))))))
+                   (%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 +57,7 @@
 
 (defun counter-count (counter)
   (+ (counter-word counter)
-     (* (counter-overflow counter)
-        +most-positive-word+)))
+     (* (counter-overflow counter) (1+ +most-positive-word+))))
 \f
 ;;;; High resolution timer
 
@@ -372,11 +370,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 +403,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<