diff --git a/code/profile.lisp b/code/profile.lisp
index 4511e9e10f35ea7c462e519b85d9cc8d72348576..56dd147e328e7cf29a368582d21b88b9a366f0e4 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.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.")
     (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)
+(defstruct width-info
+  cons
+  calls
+  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)
 	(total-cons 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
     ;; time/call
     (dolist (item info)
@@ -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-calls (time-info-calls item))
 	(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,
     ;; 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.")
 	     (if (zerop x)
 		 0.0
 		 (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))
-	(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)))))))))
+	(incf calls-length (floor (safe-log10 total-calls) 3))
+	(incf cons/call-len (floor (safe-log10 max-cons/call) 3))
+	(make-width-info :cons (max 9 cons-length)
+			 :calls (max 7 calls-length)
+			 :time (+ 4 (ceiling (safe-log10 total-time)))
+			 :time/call (+ 6 (max 2 (ceiling (safe-log10 max-time/call))))
+			 :cons/call (max 8 cons/call-len))))))
 
 (defstruct (time-info
 	    (:constructor make-time-info
@@ -610,35 +624,53 @@ this, the functions are listed.  If NIL, then always list the functions.")
   (consed 0)
   (calls 0))
 
-(defun report-times-time (time action)
-  (case action
-    (:head
-     (format *trace-output*
-	     "~&  Consed    |   Calls   |    Secs   | Sec/Call  | Bytes/C.  | Name:~@
-	       -----------------------------------------------------------------------~%")
-     (return-from report-times-time))
-
-    (:tail
-     (format *trace-output*
-	     "-------------------------------------------------------------------~@
-	      ~11:D |~10:D |~10,3F |           |           | Total~%"
-	     (time-totals-consed time) (time-totals-calls time)
-	     (time-totals-time time)))
-    (:sort (sort time #'>= :key #'time-info-time))
-    (:one-function
-     (format *trace-output*
-	     "~11:D |~10:D |~10,3F |~10,5F |~10:D | ~S~%"
-	     (floor (time-info-consing time))
-	     (time-info-calls time)
-	     (time-info-time time)
-	     (/ (time-info-time time) (float (time-info-calls time)))
-	     (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)
+(defun report-times-time (time action &optional field-widths)
+  (multiple-value-bind (time-width cons-width calls-width time/call-width cons/call-width)
+      (if field-widths
+	  (values (width-info-time field-widths)
+		  (width-info-cons field-widths)
+		  (width-info-calls field-widths)
+		  (width-info-time/call field-widths)
+		  (width-info-cons/call field-widths))
+	  (values 9 9 7 10 10))
+    (case action
+      (:head
+       (format *trace-output*
+	       "~&~V@A | ~V@A | ~V@A | ~V@A | ~V@A | Name:~@
+	       -----------------------------------------------------------------------~%"
+	       cons-width "Consed"
+	       calls-width "Calls"
+	       time-width "Secs"
+	       time/call-width "Sec/Call"
+	       cons/call-width "Bytes/C."
+	       )
+       (return-from report-times-time))
+
+      (:tail
+       (format *trace-output*
+	       "-------------------------------------------------------------------~@
+	      ~V:D | ~V:D | ~V,3F | ~V:A | ~V:A | Total~%"
+	       cons-width (time-totals-consed time)
+	       calls-width (time-totals-calls time)
+	       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
     (:head
      (format *trace-output*
@@ -673,7 +705,8 @@ this, the functions are listed.  If NIL, then always list the functions.")
   (unless (boundp '*call-overhead*)
     (compute-time-overhead))
   (let ((info ())
-	(no-call ()))
+	(no-call ())
+	(widths ()))
     (dolist (name names)
       (let ((pinfo (pi-or-lose name)))
 	(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.")
     
     (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)))
       (dolist (time info)
@@ -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-consed totals) (time-info-consing time))
 
-	(funcall printfunction time :one-function)
+	(funcall printfunction time :one-function widths)
 
 	(let ((callers (time-info-callers time))
 	      (*print-readably* nil))
@@ -708,7 +743,7 @@ this, the functions are listed.  If NIL, then always list the functions.")
 	      (print-caller-info (car x) *trace-output*)
 	      (terpri *trace-output*))
 	    (terpri *trace-output*))))
-      (funcall printfunction totals :tail))
+      (funcall printfunction totals :tail widths))
     
     (when no-call
       (setf *no-calls* no-call)