From 9fdadb9c0af47d7a2a8b3bb72de52f605d18865d Mon Sep 17 00:00:00 2001 From: toy <toy> Date: Wed, 30 Oct 2002 18:05:47 +0000 Subject: [PATCH] Make the profile report print everything in neat, uniform columns even when the individual entries vary greatly in length. --- code/profile.lisp | 92 ++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 76 insertions(+), 16 deletions(-) diff --git a/code/profile.lisp b/code/profile.lisp index 9cb0ccf21..deecb6701 100644 --- a/code/profile.lisp +++ b/code/profile.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/profile.lisp,v 1.21 2002/05/01 17:43:37 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/profile.lisp,v 1.22 2002/10/30 18:05:47 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -474,11 +474,53 @@ this, the functions are listed. If NIL, then always list the functions.") (if (minusp compensated) 0.0 compensated))) +;; Compute and return the total time, total cons, total-calls, and the +;; width of the field needed to hold the total time, total cons, +;; total-calls, and the max time/call. +(defun compute-totals-and-widths (info) + (let ((total-time 0) + (total-cons 0) + (total-calls 0) + (max-time/call 0)) + ;; Find the total time, total consing, total calls, and the max + ;; time/call + (dolist (item info) + (let ((time (time-info-time item))) + (incf total-time time) + (incf total-cons (time-info-consing item)) + (incf total-calls (time-info-calls item)) + (setf max-time/call (max max-time/call + (/ time (float (time-info-calls item))))))) + + ;; Figure out the width needed for total-time, total-cons, + ;; total-calls and the max-time/call. The total-cons is more + ;; complicated because we print the consing with comma + ;; separators. For total-time, we assume a default of "~10,3F"; + ;; for total-calls, "~7D"; for time/call, "~10,5F". This is where + ;; the constants come from. + (flet ((safe-log10 (x) + ;; log base 10 of x, but any non-positive value of x, 0 + ;; is ok for what we want. + (if (zerop x) + 0.0 + (log x 10)))) + (let ((cons-length (ceiling (safe-log10 total-cons)))) + (incf cons-length (floor (safe-log10 total-cons) 3)) + (values total-time + total-cons + total-calls + (+ 3 (max 7 (ceiling (safe-log10 total-time)))) + (max 9 cons-length) + (max 7 (ceiling (safe-log10 total-calls))) + (+ 5 (max 5 (ceiling (safe-log10 max-time/call))))))))) + (defun %report-times (names) (declare (optimize (speed 0))) (unless (boundp '*call-overhead*) (compute-time-overhead)) - (let ((info ())) + (let ((info ()) + (ext:*gc-verbose* nil) + separator) (setf *no-calls* nil) (dolist (name names) (let ((pinfo (profile-info-or-lose name))) @@ -488,7 +530,7 @@ this, the functions are listed. If NIL, then always list the functions.") PROFILE it again to record calls to the new definition." name)) (multiple-value-bind - (calls time consing profile callers) + (calls time consing profile callers) (funcall (profile-info-read-time pinfo)) (if (zerop calls) (push name *no-calls*) @@ -501,22 +543,36 @@ this, the functions are listed. If NIL, then always list the functions.") (setq info (sort info #'>= :key #'time-info-time)) - (format *trace-output* - "~& Seconds | Consed | Calls | Sec/Call | Name:~@ - ------------------------------------------------------~%") + (multiple-value-bind (total-time total-consed total-calls + time-width cons-width calls-width + time/call-width) + (compute-totals-and-widths info) + + ;; Create the separator string of the appropriate length. The + ;; 11 is for the column spacing and the 10 is for a reasonable + ;; length for the name of the function. + (setf separator (make-string (+ 11 10 time-width cons-width calls-width + time/call-width) + :initial-element #\-)) + (format *trace-output* + "~&~V@A | ~V@A | ~V@A | ~V@A | Name:~@ + ~A~%" + time-width "Seconds" + cons-width "Consed" + calls-width "Calls" + time/call-width "Sec/Call" + separator) - (let ((total-time 0.0) - (total-consed 0) - (total-calls 0)) (dolist (time info) - (incf total-time (time-info-time time)) - (incf total-calls (time-info-calls time)) - (incf total-consed (time-info-consing time)) (format *trace-output* - "~10,3F | ~9:D | ~7:D | ~10,5F | ~S~%" + "~V,3F | ~V:D | ~V:D | ~V,5F | ~S~%" + time-width (time-info-time time) + cons-width (time-info-consing time) + calls-width (time-info-calls time) + time/call-width (/ (time-info-time time) (float (time-info-calls time))) (time-info-name time)) (let ((callers (time-info-callers time))) @@ -527,9 +583,13 @@ this, the functions are listed. If NIL, then always list the functions.") (terpri *trace-output*)) (terpri *trace-output*)))) (format *trace-output* - "------------------------------------------------------~@ - ~10,3F | ~9:D | ~7:D | | Total~%" - total-time total-consed total-calls) + "~A~@ + ~V,3F | ~V:D | ~V:D | ~VA | Total~%" + separator + time-width total-time + cons-width total-consed + calls-width total-calls + time/call-width " ") (format *trace-output* "~%Estimated total profiling overhead: ~4,2F seconds~%" -- GitLab