<html><body style="word-wrap: break-word; -webkit-nbsp-mode: space; -webkit-line-break: after-white-space; ">Taoufik,<div><br></div><div>I really like this idea, but unfortunately the code as written didn't work for me.</div><div><br></div><div>I first created a couple of test functions:</div><div><br></div><div><div>(defun test-factorial (n)</div><div> (if (<= n 1) </div><div> 1</div><div> (* n (test-factorial (1- n)))))</div><div><br></div><div>(defun test-profile ()</div><div> (with-profiler (test-factorial)</div><div> (dotimes (i 1000)</div><div> (test-factorial (random 50)))))</div><div><br></div><div>but on executing the test-profile function the macro-expansion caused the following:</div><div><br></div><div><div>(test-profile)</div><div>;Compiler warnings :</div><div>; In an anonymous lambda form inside (CCL::TRACED TEST-FACTORIAL): Undeclared free variable *PROFILER* (2 references)</div><div>; In an anonymous lambda form inside (CCL::TRACED TEST-FACTORIAL): Undeclared free variable *PROFILER* (2 references)</div><div>profiling (TEST-FACTORIAL)</div><div>> Error: Unbound variable: *PROFILER*</div><div>> While executing: (:INTERNAL (CCL::TRACED TEST-FACTORIAL)), in process Listener(6).</div><div>> Type cmd-. to abort, cmd-\ for a list of available restarts.</div><div>> Type :? for other options.</div><div>1 > </div><div><br></div><div>This is caused by the use of the ` form for the trace-0 argument calls which effectively hides the let declaration of *profiler* because you are passing a list that contains the unevaluated lambda form to trace rather than passing a list that contains the function that results from evaluation of that form within the scope of the let. Even if we fixed just that problem, this code would also create new anonymous :before and :after functions for each symbol being profiled when in fact you only need one for each hash-table.</div></div></div><div><br></div><div>So I modified your code a bit to define the functions just once and to eliminate some of the ` forms which caused problems:</div><div><br></div><div><div>(defmacro with-profiler (syms &rest body)</div><div> `(let ((*profile-hash* (make-hash-table :test #'equal)))</div><div> (flet ((before-trace (f &rest vals)</div><div> (declare (ignore vals))</div><div> (multiple-value-bind (last count elapsed) (values-list (gethash f *profile-hash*))</div><div> (declare (ignore last))</div><div> (setf (gethash f *profile-hash*) (list (get-real-time) (+ 1 count) elapsed))))</div><div> (after-trace (f &rest vals)</div><div> (declare (ignore vals))</div><div> (multiple-value-bind (last count elapsed) (values-list (gethash f *profile-hash*))</div><div> (let ((tim (get-real-time)))</div><div> (setf (gethash f *profile-hash*) (list tim count (+ elapsed (- tim last))))))))</div><div> (dolist (s ',syms)</div><div> (setf (gethash s *profile-hash*) '(nil 0 0))</div><div> (CCL::%UNTRACE-0 (list s))</div><div> (CCL::%TRACE-0 (list (list s :before #'before-trace :after #'after-trace))</div><div> 'NIL))</div><div> (format t "~%profiling ~A~%" (trace))</div><div> (let ((elapsed (get-real-time)))</div><div> (eval '(progn ,@body))</div><div> (format t "total elapsed time ~10,3F seconds~%" (/ (- (get-real-time) elapsed) 1000000000)))</div><div> (dolist (s ',syms)</div><div> (CCL::%UNTRACE-0 (list s))</div><div> (let ((lst nil) (total 0))</div><div> (maphash #'(lambda (k v) </div><div> (incf total (/ (third v) 1000000000))</div><div> (push (list k (second v) (third v)) lst))</div><div> *profile-hash*)</div><div> (format t "~35A ~8A ~14A~%" "Function" "Count" "Elapsed")</div><div> (dolist (e (sort lst #'(lambda (e f) (< (third e) (third f)))))</div><div> (format t "~30S ~10d ~10,3F ~5,2F%~%"</div><div> (first e) (second e) (/ (third e) 1000000000) (* 100 (/ (/ (third e) 1000000000) total)))))))))</div><div><br></div><div>Using this code everything worked fine:</div><div><br></div><div><div>? (test-profile)</div><div><br></div><div>profiling (TEST-FACTORIAL)</div><div>total elapsed time 0.021 seconds</div><div>Function Count Elapsed </div><div>TEST-FACTORIAL 1000 0.011 100.00%</div><div>NIL</div><div><br></div></div><div><br></div><div>Regards,</div><div><br></div><div>Paul</div><div><br></div><div><br></div></div><div><div><div>On Nov 19, 2009, at 9:54 AM, Taoufik Dachraoui wrote:</div><br class="Apple-interchange-newline"><blockquote type="cite"><div style="word-wrap: break-word; -webkit-nbsp-mode: space; -webkit-line-break: after-white-space; ">The elapsed time is in nanoseconds; in the new version of with-profiler the times are in<div>seconds.<div><br></div><div>I modified the with-profiler macro to sort the elapsed times and added a column to show the percentage of the elapsed times :</div><div><br></div><div><div>(defmacro with-profiler (syms &rest body)</div><div> `(let ((*profiler* (make-hash-table :test #'equal)))</div><div> (dolist (s ',syms)</div><div> (setf (gethash `,s *profiler*) '(nil 0 0))</div><div> (CCL::%UNTRACE-0 `(,s))</div><div> (CCL::%TRACE-0 `((,s :before #'(lambda (f &rest vals)</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> (declare (ignore vals))</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> (multiple-value-bind (last count elapsed) (values-list (gethash f *profiler*))</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> (declare (ignore last))</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> (setf (gethash f *profiler*) (list (get-real-time) (+ 1 count) elapsed))))</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> :after #'(lambda (f &rest vals)</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> (declare (ignore vals))</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> (multiple-value-bind (last count elapsed) (values-list (gethash f *profiler*))</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> (let ((tim (get-real-time)))</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> (setf (gethash f *profiler*) (list tim count (+ elapsed (- tim last)))))))))</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> 'NIL))</div><div> (format t "~%profiling ~A~%" (trace))</div><div> (let ((elapsed (get-real-time)))</div><div> (eval '(progn ,@body))</div><div> (format t "total elapsed time ~10,3F seconds~%" (/ (- (get-real-time) elapsed) 1000000000)))</div><div> (dolist (s ',syms)</div><div> (CCL::%UNTRACE-0 `(,s)))</div><div> (let ((lst nil) (total 0))</div><div> (maphash #'(lambda (k v) </div><div><span class="Apple-tab-span" style="white-space:pre"> </span> (incf total (/ (third v) 1000000000))</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> (push (list k (second v) (third v)) lst))</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> *profiler*)</div><div> (format t "~35A ~8A ~14A~%" "Function" "Count" "Elapsed")</div><div> (dolist (e (sort lst #'(lambda (e f) (< (third e) (third f)))))</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>(format t "~30S ~10d ~10,3F ~5,2F%~%"</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>(first e) (second e) (/ (third e) 1000000000) (* 100 (/ (/ (third e) 1000000000) total)))))</div><div> ))</div><div><br></div><div>Output example:</div><div><br></div><div><div>total elapsed time 1.159 seconds</div><div>Function Count Elapsed </div><div>SEND-MESSAGE-TO-WINDOW 0 0.000 0.00</div><div>LEFT-LAYOUT 0 0.000 0.00</div><div>RROW-LAYOUT 0 0.000 0.00</div><div>RIGHT-LAYOUT 0 0.000 0.00</div><div>RCOLUMN-LAYOUT 0 0.000 0.00</div><div>GET-EVENT-HANDLER 0 0.000 0.00</div><div>%LIST 4 0.000 0.01</div><div>CENTER-LAYOUT 4 0.000 0.01</div><div>%LIST-SYMBOLS 12 0.000 0.03</div><div>%GET-VFIELDS 1 0.000 0.06</div><div>%GEN-FLET-VFIELDS 4 0.001 0.07</div><div>%FLET-VFIELDS 1 0.001 0.08</div><div>%VFIELDS 1 0.001 0.08</div><div>DESTROY-CONTEXT 1 0.001 0.08</div><div>XCREATEWINDOW 69 0.001 0.09</div><div>%EVAL 20 0.001 0.09</div><div>%SPLIT-ARGS 254 0.003 0.34</div><div>RESIZE-WINDOW 69 0.003 0.37</div><div>COLUMN-LAYOUT 11 0.005 0.65</div><div>SPLIT-ARGS 254 0.008 1.05</div><div>ROW-LAYOUT 16 0.008 1.13</div><div>CLIP 27 0.023 3.06</div><div>GETA 19185 0.172 23.17</div><div>CREATE-WINDOW 69 0.253 34.02</div><div>CREATE-CONTEXT 69 0.264 35.60</div><div>NIL</div><div>?</div><div><br></div></div><div>Taoufik</div><div><div>On Nov 19, 2009, at 4:44 PM, Alexander Repenning wrote:</div><br class="Apple-interchange-newline"><blockquote type="cite"><div style="word-wrap: break-word; -webkit-nbsp-mode: space; -webkit-line-break: after-white-space; ">looks great to me. It seems to use similar functions as the timer code I pointed to in my previous post but includes a nice profilers wrap up macro. I suggest to use time formatting functions similar to the code I pointed to because it is not clear what "elapsed=268738" really means. Just a detail.<div><br></div><div>best, Alex</div><div><br><div><div>On Nov 19, 2009, at 7:24 AM, Taoufik Dachraoui wrote:</div><br class="Apple-interchange-newline"><blockquote type="cite"><div>Hi,<br><br>I created a macro with-profiler and would like to know the <br>disadvantages of this solution<br>compared to others:<br><br>; i took the following 2 functions from ccl-1.4/tools/advice-profiler/ <br>profiler.lisp<br>; the with-profiler can be modified to return cpu-time, user-time and <br>real-time used<br>; by all profiled functions<br><br>(defun mach-timespec->nanoseconds (ts)<br> "Convert the given typespec structure into nanoseconds."<br> (+ (* 1000000000 (pref ts :mach_timespec.tv_sec))<br> (pref ts :mach_timespec.tv_nsec)))<br><br>(defun get-real-time ()<br> (let ((clock-port (make-record :clock_serv_t)))<br> (#_host_get_clock_service (#_mach_host_self) #$REALTIME_CLOCK <br>clock-port)<br> (ccl:rlet ((ts :mach_timespec))<br><span class="Apple-tab-span" style="white-space:pre"> </span> (#_clock_get_time (%get-ptr clock-port) ts)<br><span class="Apple-tab-span" style="white-space:pre"> </span> (mach-timespec->nanoseconds ts))))<br><br>(defmacro with-profiler (syms &rest body)<br> `(let ((*profiler* (make-hash-table :test #'equal)))<br> (dolist (s ',syms)<br> (setf (gethash `,s *profiler*) '(nil 0 0))<br> (CCL::%UNTRACE-0 `(,s))<br> (CCL::%TRACE-0 `((,s :before #'(lambda (f &rest vals)<br><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span> (declare (ignore vals))<br><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span> (multiple-value-bind (last count elapsed) (values-list <br>(gethash f *profiler*))<br><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span> (declare (ignore last))<br><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span> (setf (gethash f *profiler*) (list (get-real-time) (+ 1 count) <br>elapsed))))<br><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span> :after #'(lambda (f &rest vals)<br><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span> (declare (ignore vals))<br><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span> (multiple-value-bind (last count elapsed) (values-list <br>(gethash f *profiler*))<br><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span> (let ((tim (get-real-time)))<br><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span> (setf (gethash f *profiler*) (list tim count (+ elapsed (- tim <br>last)))))))))<br><span class="Apple-tab-span" style="white-space:pre"> </span><span class="Apple-tab-span" style="white-space:pre"> </span> 'NIL))<br> (format t "~%profiling ~A~%" (trace))<br> (let ((elapsed (get-real-time)))<br> (eval '(progn ,@body))<br> (format t "total elapsed time ~S~%" (- (get-real-time) elapsed)))<br> (dolist (s ',syms)<br> (CCL::%UNTRACE-0 `(,s)))<br> (maphash #'(lambda (k v) (format t "function=~S count=~S <br>elapsed=~S~%" k (second v) (third v))) *profiler*)))<br><br>Tests:<br><br>? (defun fact (n) (if (= 0 n) 1 (* n (fact (- n 1)))))<br>? (defun f () (sleep 1))<br>? (defmacro foo () (progn (f) ''foo))<br>? (with-profiler (f fact)<br><span class="Apple-tab-span" style="white-space:pre"> </span>(dotimes (i 10)<br><span class="Apple-tab-span" style="white-space:pre"> </span> (f)<br><span class="Apple-tab-span" style="white-space:pre"> </span> (foo)<br><span class="Apple-tab-span" style="white-space:pre"> </span> (fact (random 100))))<br><br>profiling (FACT F)<br>total elapsed time 11003452329<br>function=FACT count=10 elapsed=268738<br>function=F count=11 elapsed=11001194423<br>NIL<br>?<br><br>Any comments on this method of profiling lisp functions are welcome<br><br>Kind regards<br>Taoufik<br><br>On Nov 18, 2009, at 5:57 PM, Matt Tenenbaum wrote:<br><br><blockquote type="cite"><br></blockquote><blockquote type="cite">Norvig's classic "Paradigms of Artificial Intelligence Programming"<br></blockquote><blockquote type="cite">has a section on instrumentation in chapter 9, including code for<br></blockquote><blockquote type="cite">profiling in a manner analogous to TRACE. In looking quickly, this<br></blockquote><blockquote type="cite">code doesn't seem to be included in the distributed source for the<br></blockquote><blockquote type="cite">book (<a href="http://norvig.com/paip/README.html">http://norvig.com/paip/README.html</a>), but you might find that<br></blockquote><blockquote type="cite">chapter helpful.<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">Cheers,<br></blockquote><blockquote type="cite">-mt<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">On Wed, Nov 18, 2009 at 8:36 AM, Taoufik Dachraoui<br></blockquote><blockquote type="cite"><<a href="mailto:taoufik.dachraoui@wanadoo.fr">taoufik.dachraoui@wanadoo.fr</a>> wrote:<br></blockquote><blockquote type="cite"><blockquote type="cite">Hi<br></blockquote></blockquote><blockquote type="cite"><blockquote type="cite"><br></blockquote></blockquote><blockquote type="cite"><blockquote type="cite">How do I profile lisp program to know how much time each called<br></blockquote></blockquote><blockquote type="cite"><blockquote type="cite">function takes<br></blockquote></blockquote><blockquote type="cite"><blockquote type="cite"><br></blockquote></blockquote><blockquote type="cite"><blockquote type="cite">Regards<br></blockquote></blockquote><blockquote type="cite"><blockquote type="cite">Taoufik<br></blockquote></blockquote><blockquote type="cite"><blockquote type="cite"><br></blockquote></blockquote><blockquote type="cite"><blockquote type="cite"><br></blockquote></blockquote><blockquote type="cite"><blockquote type="cite"><br></blockquote></blockquote><blockquote type="cite"><blockquote type="cite">_______________________________________________<br></blockquote></blockquote><blockquote type="cite"><blockquote type="cite">Openmcl-devel mailing list<br></blockquote></blockquote><blockquote type="cite"><blockquote type="cite"><a href="mailto:Openmcl-devel@clozure.com">Openmcl-devel@clozure.com</a><br></blockquote></blockquote><blockquote type="cite"><blockquote type="cite"><a href="http://clozure.com/mailman/listinfo/openmcl-devel">http://clozure.com/mailman/listinfo/openmcl-devel</a><br></blockquote></blockquote><blockquote type="cite"><blockquote type="cite"><br></blockquote></blockquote><blockquote type="cite"><br></blockquote><br><br><br>_______________________________________________<br>Openmcl-devel mailing list<br><a href="mailto:Openmcl-devel@clozure.com">Openmcl-devel@clozure.com</a><br><a href="http://clozure.com/mailman/listinfo/openmcl-devel">http://clozure.com/mailman/listinfo/openmcl-devel</a><br></div></blockquote></div><br><div> <span class="Apple-style-span" style="font-size: 12px; "><div style="margin-top: 0px; margin-right: 0px; margin-bottom: 0px; margin-left: 0px; "><font face="Helvetica" size="3" style="font: 12.0px Helvetica">Prof. Alexander Repenning</font></div><div style="margin-top: 0px; margin-right: 0px; margin-bottom: 0px; margin-left: 0px; "><br class="khtml-block-placeholder"></div><div style="margin-top: 0px; margin-right: 0px; margin-bottom: 0px; margin-left: 0px; ">University of Colorado</div><div style="margin-top: 0px; margin-right: 0px; margin-bottom: 0px; margin-left: 0px; ">Computer Science Department</div><div style="margin-top: 0px; margin-right: 0px; margin-bottom: 0px; margin-left: 0px; ">Boulder, CO 80309-430</div><div style="margin-top: 0px; margin-right: 0px; margin-bottom: 0px; margin-left: 0px; "><br class="khtml-block-placeholder"></div><div style="margin-top: 0px; margin-right: 0px; margin-bottom: 0px; margin-left: 0px; "><font face="Helvetica" size="3" style="font: 12.0px Helvetica">vCard: <a href="http://www.cs.colorado.edu/~ralex/AlexanderRepenning.vcf">http://www.cs.colorado.edu/~ralex/AlexanderRepenning.vcf</a></font></div><br class="Apple-interchange-newline"></span> </div> <br></div></div></blockquote></div><br></div></div></div>_______________________________________________<br>Openmcl-devel mailing list<br><a href="mailto:Openmcl-devel@clozure.com">Openmcl-devel@clozure.com</a><br>http://clozure.com/mailman/listinfo/openmcl-devel<br></blockquote></div><br></div></body></html>