0.8.9.17:

	merged Zach Beane's patch for PROFILE output formatting
		(from sbcl-devel 03 Apr 2004)

diff --git a/NEWS b/NEWS
index c080720..6e9cdc2 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2371,6 +2371,8 @@ changes in sbcl-0.8.10 relative to sbcl-0.8.9:
     the test case to Dave Roberts)
   * bug fix: multidimensional simple arrays loaded from FASLs had fill
     pointers.  (reported by Sean Ross)
+  * bug fix: PROFILE output is printed nicely even for large numerical
+       values. (thanks to Zach Beane)
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/src/code/profile.lisp b/src/code/profile.lisp
index 8229b1c..729be4f 100644 (file)
--- a/src/code/profile.lisp
+++ b/src/code/profile.lisp
@@ -383,30 +383,69 @@ Lisp process."
          (sort time-info-list
                #'>=
                :key #'time-info-seconds))
+    (print-profile-table time-info-list)
 
-    (format *trace-output*
-           "~&  seconds  |  consed   |  calls  |  sec/call  |  name~@
-              ------------------------------------------------------~%")
+    (when no-call-name-list
+      (format *trace-output*
+             "~%These functions were not called:~%~{~<~%~:; ~S~>~}~%"
+             (sort no-call-name-list #'string<
+                   :key (lambda (name)
+                          (symbol-name (fun-name-block-name name))))))
+
+    (values)))
+
+
+(defun print-profile-table (time-info-list)
+  (let ((total-seconds 0.0)
+        (total-consed 0)
+        (total-calls 0)
+        (seconds-width (length "seconds"))
+        (consed-width (length "consed"))
+        (calls-width (length "calls"))
+        (sec/call-width 10)
+        (name-width 6))
+    (dolist (time-info time-info-list)
+      (incf total-seconds (time-info-seconds time-info))
+      (incf total-consed (time-info-consing time-info))
+      (incf total-calls (time-info-calls time-info)))
+    (setf seconds-width (max (length (format nil "~10,3F" total-seconds))
+                             seconds-width)
+          calls-width (max (length (format nil "~:D" total-calls))
+                           calls-width)
+          consed-width (max (length (format nil "~:D" total-consed))
+                            consed-width))
+
+    (flet ((dashes ()
+             (dotimes (i (+ seconds-width consed-width calls-width
+                            sec/call-width name-width
+                            (* 5 3)))
+               (write-char #\- *trace-output*))
+             (terpri *trace-output*)))
+      (format *trace-output* "~&~@{ ~v:@<~A~>~^|~}~%"
+              seconds-width "seconds"
+              (1+ consed-width) "consed"
+              (1+ calls-width) "calls"
+              (1+ sec/call-width) "sec/call"
+              (1+ name-width) "name")
+
+      (dashes)
 
-    (let ((total-time 0.0)
-         (total-consed 0)
-         (total-calls 0))
       (dolist (time-info time-info-list)
-       (incf total-time (time-info-seconds time-info))
-       (incf total-calls (time-info-calls time-info))
-       (incf total-consed (time-info-consing time-info))
-       (format *trace-output*
-               "~10,3F | ~9:D | ~7:D | ~10,6F | ~S~%"
-               (time-info-seconds time-info)
-               (time-info-consing time-info)
-               (time-info-calls time-info)
-               (/ (time-info-seconds time-info)
-                  (float (time-info-calls time-info)))
-               (time-info-name time-info)))
-      (format *trace-output*
-             "------------------------------------------------------~@
-             ~10,3F | ~9:D | ~7:D |        | Total~%"
-             total-time total-consed total-calls)
+        (format *trace-output* "~v,3F | ~v:D | ~v:D | ~10,6F | ~S~%"
+                seconds-width (time-info-seconds time-info)
+                consed-width (time-info-consing time-info)
+                calls-width (time-info-calls time-info)
+                (/ (time-info-seconds time-info)
+                   (float (time-info-calls time-info)))
+                (time-info-name time-info)))
+
+      (dashes)
+
+      (format *trace-output* "~v,3F | ~v:D | ~v:D |            | Total~%"
+                seconds-width total-seconds
+                consed-width total-consed
+                calls-width total-calls)
+
       (format *trace-output*
              "~%estimated total profiling overhead: ~4,2F seconds~%"
              (* (overhead-total *overhead*) (float total-calls)))
@@ -414,16 +453,8 @@ Lisp process."
              "~&overhead estimation parameters:~%  ~Ss/call, ~Ss total profiling, ~Ss internal profiling~%"
              (overhead-call *overhead*)
              (overhead-total *overhead*)
-             (overhead-internal *overhead*)))
+             (overhead-internal *overhead*)))))
 
-    (when no-call-name-list
-      (format *trace-output*
-             "~%These functions were not called:~%~{~<~%~:; ~S~>~}~%"
-             (sort no-call-name-list #'string<
-                   :key (lambda (name)
-                          (symbol-name (fun-name-block-name name))))))
-
-    (values)))
 \f
 ;;;; overhead estimation
 

diff --git a/version.lisp-expr b/version.lisp-expr
index fd665fb..4b60512 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.9.16"
+"0.8.9.17"