X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fprofile.lisp;h=c4d275049edee64a5058550bce5f5b8550cc9a1a;hb=12a0ad4e13fd09f7809d0eb9066498c447674fbb;hp=59929eb316cf60910dda45737b1a86798bc58bb0;hpb=348b22c7d9a2b1973252ea4f9778c188abc6a5fa;p=sbcl.git

diff --git a/src/code/profile.lisp b/src/code/profile.lisp
index 59929eb..c4d2750 100644
--- a/src/code/profile.lisp
+++ b/src/code/profile.lisp
@@ -370,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)))
@@ -399,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<