Inherit FP modes for new threads on Windows.

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

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