>>>>> "Raymond" == Raymond Toy <[EMAIL PROTECTED]> writes:
>>>>> "Raymond" == Raymond Toy <[EMAIL PROTECTED]> writes:
>>>>> "rif" == rif <[EMAIL PROTECTED]> writes:
rif> Type-error in KERNEL::OBJECT-NOT-TYPE-ERROR-HANDLER:
rif> 4145112608 is not of type (UNSIGNED-BYTE 29)
Raymond> Here is a patch to profile.lisp that allows larger consing to happen.
Raymond> It's based on Martin's idea of using 2 fixnums to hold the consing
Raymond> values.
Raymond> This seems to work for me. If you can, try it out and let me know how
Raymond> it goes.
Raymond> Let's try that again, as a text file.
Hey, where'd my text/plain attachment go?
One more time, but no attachment---just plain text.
Oh, this patch also changes the output of report-time so that all of
the columns line up neatly, no matter how long they get.
Ray
--- profile.lisp Wed May 1 13:43:37 2002
+++ new-profile.lisp Mon Oct 28 09:22:59 2002
@@ -95,7 +95,45 @@
;;; since the beginning of time.
#+cmu
-(defmacro total-consing () '(the consing-type (ext:get-bytes-consed)))
+(defmacro total-consing ()
+ '(ext:get-bytes-consed))
+
+(eval-when (compile load eval)
+;; Some macros to implement a very simple "bignum" package consisting
+;; of 2 fixnums. This is intended to extend the range of the consing
+;; for profiling without adding lots of extra consing to the profiling
+;; routines.
+(defconstant +fixnum-bits+
+ #.(integer-length most-positive-fixnum)
+ "The number of bits in a fixnum")
+
+(defmacro dfix-add ((a-hi a-lo) (b-hi b-lo))
+ ;; Add the 2 fixnums and return the sum as two values
+ (let ((hi (gensym))
+ (lo (gensym)))
+ `(let ((,hi (+ ,a-hi ,b-hi))
+ (,lo (+ ,a-lo ,b-lo)))
+ (if (<= ,lo most-positive-fixnum)
+ (values ,hi ,lo)
+ (values (+ ,hi 1)
+ (ldb (byte (integer-length most-positive-fixnum) 0)
+ ,lo))))))
+(defmacro dfix-sub ((a-hi a-lo) (b-hi b-lo))
+ ;; Subtract 2 fixnums and return the difference as two values
+ (let ((hi (gensym))
+ (lo (gensym)))
+ `(let ((,hi (- ,a-hi ,b-hi))
+ (,lo (- ,a-lo ,b-lo)))
+ (if (>= ,lo)
+ (values ,hi ,lo)
+ (values (- ,hi 1)
+ (+ ,lo #.(1+ most-positive-fixnum)))))))
+
+(defmacro dfix-incf ((res-hi res-lo) (a-hi a-lo))
+ ;; Like incf, except for pairs of fixnum
+ `(multiple-value-setq (,res-hi ,res-lo)
+ (dfix-add (,res-hi ,res-lo) (,a-hi ,a-lo))))
+)
#-cmu
(progn
@@ -180,9 +218,10 @@
;;;
(defvar *enclosed-time* 0)
(defvar *enclosed-consing* 0)
+(defvar *enclosed-consing-hi* 0)
(defvar *enclosed-profilings* 0)
(declaim (type time-type *enclosed-time*))
-(declaim (type consing-type *enclosed-consing*))
+(declaim (type consing-type *enclosed-consing* *enclosed-consing-hi*))
(declaim (fixnum *enclosed-profilings*))
@@ -226,10 +265,11 @@
(let* ((time 0)
(count 0)
(consed 0)
+ (consed-hi 0)
(profile 0)
(callers ())
(old-definition (fdefinition name)))
- (declare (type time-type time) (type consing-type consed)
+ (declare (type time-type time) (type consing-type consed consed-hi)
(fixnum count))
(pushnew name *timed-functions*)
@@ -262,15 +302,19 @@
(setq callers current)
(return))))))
- (let ((time-inc 0) (cons-inc 0) (profile-inc 0))
+ (let ((time-inc 0)
+ (cons-inc 0)
+ (cons-inc-hi 0)
+ (profile-inc 0))
(declare (type time-type time-inc)
- (type consing-type cons-inc)
+ (type consing-type cons-inc cons-inc-hi)
(fixnum profile-inc))
(multiple-value-prog1
(let ((start-time (quickly-get-time))
(start-consed (total-consing))
(*enclosed-time* 0)
(*enclosed-consing* 0)
+ (*enclosed-consing-hi* 0)
(*enclosed-profilings* 0))
(multiple-value-prog1
,(if optionals-p
@@ -290,7 +334,11 @@
(- (quickly-get-time) start-time)
#+BSD
(max (- (quickly-get-time) start-time) 0))
- (setq cons-inc (- (total-consing) start-consed))
+ (multiple-value-setq (cons-inc-hi cons-inc)
+ (let ((diff (- (total-consing) start-consed)))
+ (values (ash diff #.(- (integer-length
+most-positive-fixnum)))
+ (ldb (byte 29 0) diff))))
+
(setq profile-inc *enclosed-profilings*)
(incf time
(the time-type
@@ -298,12 +346,18 @@
(- time-inc *enclosed-time*)
#+BSD
(max (- time-inc *enclosed-time*) 0)))
- (incf consed
- (the consing-type
- (- cons-inc *enclosed-consing*)))
+ ;; consed = consed + (- cons-inc *enclosed-consing*)
+ (multiple-value-bind (dhi dlo)
+ (dfix-sub (cons-inc-hi cons-inc)
+ (*enclosed-consing-hi* *enclosed-consing*))
+
+ (dfix-incf (consed-hi consed) (dhi dlo)))
+
(incf profile profile-inc)))
(incf *enclosed-time* time-inc)
- (incf *enclosed-consing* cons-inc)
+ ;; *enclosed-consing* = *enclosed-consing + cons-inc
+ (dfix-incf (*enclosed-consing-hi* *enclosed-consing*)
+ (cons-inc-hi cons-inc))
(incf *enclosed-profilings*
(the fixnum (1+ profile-inc)))))))
@@ -314,12 +368,14 @@
:new-definition (fdefinition name)
:read-time
#'(lambda ()
- (values count time consed profile callers))
+ (let ((total-cons (+ consed (ash consed-hi 30))))
+ (values count time total-cons profile callers)))
:reset-time
#'(lambda ()
(setq count 0)
(setq time 0)
(setq consed 0)
+ (setq consed-hi 0)
(setq profile 0)
(setq callers ())
t)))))))
@@ -474,6 +530,67 @@
(if (minusp compensated) 0.0 compensated)))
+#+nil
+(defun compute-widths (info)
+ (let ((total-time (reduce #'+ info :key #'time-info-time))
+ (total-cons (reduce #'+ info :key #'time-info-consing))
+ (total-calls (reduce #'+ info :key #'time-info-calls))
+ (max-time/call
+ (reduce #'max info :key #'(lambda (x)
+ (/ (time-info-time x)
+ (float (time-info-calls x))))))
+ (cons-length 0))
+ (setq cons-length (ceiling (log total-cons 10)))
+ (incf cons-length (floor (log total-cons 10) 3))
+ (values total-time
+ total-cons
+ total-calls
+ (+ 3 (max 7 (ceiling (log total-time 10))))
+ (max 9 cons-length)
+ (max 7 (ceiling (log total-calls 10)))
+ (+ 5 (max 5 (ceiling (log max-time/call 10)))))))
+
+;; 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 for
+ ;; log10(x) 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*)
@@ -488,7 +605,7 @@
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 +618,29 @@
(setq info (sort info #'>= :key #'time-info-time))
- (format *trace-output*
- "~& Seconds | Consed | Calls | Sec/Call | Name:~@
- ------------------------------------------------------~%")
-
- (let ((total-time 0.0)
- (total-consed 0)
- (total-calls 0))
+ (multiple-value-bind (total-time total-consed total-calls
+ time-width cons-width calls-width
+ time/call-width)
+ (compute-widths info)
+
+ (format *trace-output*
+ "~& ~V@A| ~V@A | ~V@A | ~V@A | Name:~@
+ ------------------------------------------------------~%"
+ time-width "Seconds"
+ cons-width "Consed"
+ calls-width "Calls"
+ time/call-width "Sec/Call")
+
(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)))
@@ -528,8 +652,11 @@
(terpri *trace-output*))))
(format *trace-output*
"------------------------------------------------------~@
- ~10,3F | ~9:D | ~7:D | | Total~%"
- total-time total-consed total-calls)
+ ~V,3F | ~V:D | ~V:D | ~VA | Total~%"
+ 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~%"
