The GC changes require a full build from scratch, you cannot load this file over the existing gc in your life image.
I like the patches but couldn't actually run them right now. Martin rif wrote on Mon, Oct 28, 2002 at 03:27:14PM -0500: > > 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~%" >
