Skip to content
Snippets Groups Projects
Commit f97082a2 authored by rtoy's avatar rtoy
Browse files

Compute column widths so the columns of the profile report line up

neatly.  (Currently only for the time report, not space report.)
parent 2bf5d5f4
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/profile.lisp,v 1.37 2003/06/16 13:07:19 gerd Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/profile.lisp,v 1.38 2004/05/04 14:29:13 rtoy Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -555,14 +555,21 @@ this, the functions are listed. If NIL, then always list the functions.") ...@@ -555,14 +555,21 @@ this, the functions are listed. If NIL, then always list the functions.")
(if (minusp compensated) 0.0 compensated))) (if (minusp compensated) 0.0 compensated)))
;; Compute and return the total time, total cons, total-calls, and the (defstruct width-info
;; width of the field needed to hold the total time, total cons, cons
;; total-calls, and the max time/call. calls
(defun compute-totals-and-widths (info) time
time/call
cons/call)
;; Compute and return the width of the field needed to hold the total
;; time, total cons, total-calls, and the max time/call.
(defun compute-widths (info)
(let ((total-time 0) (let ((total-time 0)
(total-cons 0) (total-cons 0)
(total-calls 0) (total-calls 0)
(max-time/call 0)) (max-time/call 0)
(max-cons/call 0))
;; Find the total time, total consing, total calls, and the max ;; Find the total time, total consing, total calls, and the max
;; time/call ;; time/call
(dolist (item info) (dolist (item info)
...@@ -571,7 +578,10 @@ this, the functions are listed. If NIL, then always list the functions.") ...@@ -571,7 +578,10 @@ this, the functions are listed. If NIL, then always list the functions.")
(incf total-cons (time-info-consing item)) (incf total-cons (time-info-consing item))
(incf total-calls (time-info-calls item)) (incf total-calls (time-info-calls item))
(setf max-time/call (max max-time/call (setf max-time/call (max max-time/call
(/ time (float (time-info-calls item))))))) (/ time (float (time-info-calls item)))))
(setf max-cons/call (max max-cons/call
(/ (time-info-consing item)
(float (time-info-calls item)))))))
;; Figure out the width needed for total-time, total-cons, ;; Figure out the width needed for total-time, total-cons,
;; total-calls and the max-time/call. The total-cons is more ;; total-calls and the max-time/call. The total-cons is more
...@@ -585,15 +595,19 @@ this, the functions are listed. If NIL, then always list the functions.") ...@@ -585,15 +595,19 @@ this, the functions are listed. If NIL, then always list the functions.")
(if (zerop x) (if (zerop x)
0.0 0.0
(log x 10)))) (log x 10))))
(let ((cons-length (ceiling (safe-log10 total-cons)))) (let ((cons-length (ceiling (safe-log10 total-cons)))
(calls-length (ceiling (safe-log10 total-calls)))
(cons/call-len (ceiling (safe-log10 max-cons/call))))
;; Adjust these to include the number of commas that will be
;; printed.
(incf cons-length (floor (safe-log10 total-cons) 3)) (incf cons-length (floor (safe-log10 total-cons) 3))
(values total-time (incf calls-length (floor (safe-log10 total-calls) 3))
total-cons (incf cons/call-len (floor (safe-log10 max-cons/call) 3))
total-calls (make-width-info :cons (max 9 cons-length)
(+ 3 (max 7 (ceiling (safe-log10 total-time)))) :calls (max 7 calls-length)
(max 9 cons-length) :time (+ 4 (ceiling (safe-log10 total-time)))
(max 7 (ceiling (safe-log10 total-calls))) :time/call (+ 6 (max 2 (ceiling (safe-log10 max-time/call))))
(+ 5 (max 5 (ceiling (safe-log10 max-time/call))))))))) :cons/call (max 8 cons/call-len))))))
(defstruct (time-info (defstruct (time-info
(:constructor make-time-info (:constructor make-time-info
...@@ -610,35 +624,53 @@ this, the functions are listed. If NIL, then always list the functions.") ...@@ -610,35 +624,53 @@ this, the functions are listed. If NIL, then always list the functions.")
(consed 0) (consed 0)
(calls 0)) (calls 0))
(defun report-times-time (time action) (defun report-times-time (time action &optional field-widths)
(case action (multiple-value-bind (time-width cons-width calls-width time/call-width cons/call-width)
(:head (if field-widths
(format *trace-output* (values (width-info-time field-widths)
"~& Consed | Calls | Secs | Sec/Call | Bytes/C. | Name:~@ (width-info-cons field-widths)
-----------------------------------------------------------------------~%") (width-info-calls field-widths)
(return-from report-times-time)) (width-info-time/call field-widths)
(width-info-cons/call field-widths))
(:tail (values 9 9 7 10 10))
(format *trace-output* (case action
"-------------------------------------------------------------------~@ (:head
~11:D |~10:D |~10,3F | | | Total~%" (format *trace-output*
(time-totals-consed time) (time-totals-calls time) "~&~V@A | ~V@A | ~V@A | ~V@A | ~V@A | Name:~@
(time-totals-time time))) -----------------------------------------------------------------------~%"
(:sort (sort time #'>= :key #'time-info-time)) cons-width "Consed"
(:one-function calls-width "Calls"
(format *trace-output* time-width "Secs"
"~11:D |~10:D |~10,3F |~10,5F |~10:D | ~S~%" time/call-width "Sec/Call"
(floor (time-info-consing time)) cons/call-width "Bytes/C."
(time-info-calls time) )
(time-info-time time) (return-from report-times-time))
(/ (time-info-time time) (float (time-info-calls time)))
(round (:tail
(/ (time-info-consing time) (float (time-info-calls time)))) (format *trace-output*
(time-info-name time))) "-------------------------------------------------------------------~@
(t ~V:D | ~V:D | ~V,3F | ~V:A | ~V:A | Total~%"
(error "Unknown action for profiler report: ~s" action)))) cons-width (time-totals-consed time)
calls-width (time-totals-calls time)
(defun report-times-space (time action) time-width (time-totals-time time)
time/call-width ""
cons/call-width ""))
(:sort (sort time #'>= :key #'time-info-time))
(:one-function
(format *trace-output*
"~V:D | ~V:D | ~V,3F | ~V,5F | ~V:D | ~S~%"
cons-width (floor (time-info-consing time))
calls-width (time-info-calls time)
time-width (time-info-time time)
time/call-width (/ (time-info-time time) (float (time-info-calls time)))
cons/call-width
(round
(/ (time-info-consing time) (float (time-info-calls time))))
(time-info-name time)))
(t
(error "Unknown action for profiler report: ~s" action)))))
(defun report-times-space (time action &optional field-widths)
(case action (case action
(:head (:head
(format *trace-output* (format *trace-output*
...@@ -673,7 +705,8 @@ this, the functions are listed. If NIL, then always list the functions.") ...@@ -673,7 +705,8 @@ this, the functions are listed. If NIL, then always list the functions.")
(unless (boundp '*call-overhead*) (unless (boundp '*call-overhead*)
(compute-time-overhead)) (compute-time-overhead))
(let ((info ()) (let ((info ())
(no-call ())) (no-call ())
(widths ()))
(dolist (name names) (dolist (name names)
(let ((pinfo (pi-or-lose name))) (let ((pinfo (pi-or-lose name)))
(multiple-value-bind (calls time consing consing-w/c profile callers) (multiple-value-bind (calls time consing consing-w/c profile callers)
...@@ -690,7 +723,9 @@ this, the functions are listed. If NIL, then always list the functions.") ...@@ -690,7 +723,9 @@ this, the functions are listed. If NIL, then always list the functions.")
(setq info (funcall printfunction info :sort)) (setq info (funcall printfunction info :sort))
(funcall printfunction nil :head) (setf widths (compute-widths info))
(funcall printfunction nil :head widths)
(let ((totals (make-time-totals))) (let ((totals (make-time-totals)))
(dolist (time info) (dolist (time info)
...@@ -698,7 +733,7 @@ this, the functions are listed. If NIL, then always list the functions.") ...@@ -698,7 +733,7 @@ this, the functions are listed. If NIL, then always list the functions.")
(incf (time-totals-calls totals) (time-info-calls time)) (incf (time-totals-calls totals) (time-info-calls time))
(incf (time-totals-consed totals) (time-info-consing time)) (incf (time-totals-consed totals) (time-info-consing time))
(funcall printfunction time :one-function) (funcall printfunction time :one-function widths)
(let ((callers (time-info-callers time)) (let ((callers (time-info-callers time))
(*print-readably* nil)) (*print-readably* nil))
...@@ -708,7 +743,7 @@ this, the functions are listed. If NIL, then always list the functions.") ...@@ -708,7 +743,7 @@ this, the functions are listed. If NIL, then always list the functions.")
(print-caller-info (car x) *trace-output*) (print-caller-info (car x) *trace-output*)
(terpri *trace-output*)) (terpri *trace-output*))
(terpri *trace-output*)))) (terpri *trace-output*))))
(funcall printfunction totals :tail)) (funcall printfunction totals :tail widths))
(when no-call (when no-call
(setf *no-calls* no-call) (setf *no-calls* no-call)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment