I'm not sure how to proceed. Once I apply the patch to the file, what do I have to do next to get it incorporated into my runing Lisp? Speaking similarly, I'm using 18c (from the stable debian package), what's the best way to update this? Do I want to recompile cmucl, and if so, how do I do that?
rif > >>>>> "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~%"
