[Openmcl-devel] Profiling lisp code

Taoufik Dachraoui taoufik.dachraoui at wanadoo.fr
Fri Nov 20 06:52:34 PST 2009


Hi

I added a second profiler report with hierarchical details, any  
suggestions for
improvements or corrections are welcome:

(defmacro with-profiler (syms &rest body)
   `(let ((*profile-hash-1* (make-hash-table))
	 (*profile-hash-2* (make-hash-table :test #'equal))
	 (*profile-stack* nil))
      (flet ((before-trace (f &rest vals)
               (declare (ignore vals))
	      (let ((tim (get-real-time)))
		(multiple-value-bind (last count elapsed) (values-list (gethash f  
*profile-hash-1*))
		  (declare (ignore last))
		  (setf (gethash f *profile-hash-1*) (list tim (+ 1 count) elapsed)))
		(push f *profile-stack*)
		(multiple-value-bind (last count elapsed) (values-list (gethash  
*profile-stack* *profile-hash-2*))
		  (if (null last) (setf elapsed 0 count 0))
		  (setf (gethash *profile-stack* *profile-hash-2*) (list tim (+ 1  
count) elapsed)))))
             (after-trace (f &rest vals)
               (declare (ignore vals))
	      (let ((tim (get-real-time)))
		(multiple-value-bind (last count elapsed) (values-list (gethash f  
*profile-hash-1*))
                   (setf (gethash f *profile-hash-1*) (list tim count  
(+ elapsed (- tim last)))))
		(multiple-value-bind (last count elapsed) (values-list (gethash  
*profile-stack* *profile-hash-2*))
                   (setf (gethash *profile-stack* *profile-hash-2*)  
(list tim count (+ elapsed (- tim last)))))
		(pop *profile-stack*))))
        (dolist (s ',syms)
	 (format t "profiling ~S~%" s) (force-output t)
          (setf (gethash s *profile-hash-1*) '(nil 0 0))
          (CCL::%UNTRACE-0 (list s))
          (CCL::%TRACE-0 (list (list s :before #'before-trace :after  
#'after-trace))
                         'NIL))
        (format t "~%profiling ~A~%" (trace))
        (let ((total-elapsed (get-real-time)) (lst nil) (nano  
1000000000))
	 (eval '(progn , at body))
	 (setf total-elapsed (- (get-real-time) total-elapsed))
	 (format t "total elapsed time ~10,3F seconds~%" (/ total-elapsed  
nano))
	 (dolist (s ',syms)
	   (CCL::%UNTRACE-0 (list s)))
	 (maphash #'(lambda (k v)
		      (if (> (second v) 0)
			  (push (list k (second v) (third v)) lst)))
		  *profile-hash-1*)
	 (format t "~35A ~8A ~14A~%" "Function" "Count" "Elapsed")
	 (dolist (e (sort lst #'(lambda (e f) (< (third e) (third f)))))
	   (format t "~30S ~10d ~10,3F ~5,2F%~%"
		   (first e)
		   (second e)
		   (/ (third e) nano)
		   (* 100 (/ (third e) (if (= 0 total-elapsed) 1 total-elapsed)))
		   ))
	 (format t "~%total elapsed time ~10,3F seconds~%" (/ total-elapsed  
nano))
	 (setf lst nil)
	 (maphash #'(lambda (k v)
		      (if (> (second v) 0)
			  (push (list (reverse k) (second v) (third v)) lst)))
		  *profile-hash-2*)
	 (labels ((compare-list (l1 l2)
		    (if (null l1)
			t
			(if (null l2)
			    nil
			    (if (string< (string (car l1)) (string (car l2)))
				t
				(if (string> (string (car l1)) (string (car l2)))
				    nil
				    (compare-list (cdr l1) (cdr l2))))))))
	   (let ((prefix "") (times (make-hash-table)))
	     (setf (gethash 0 times) total-elapsed) ; level 0
	     (dolist (e (sort lst #'(lambda (e f) (compare-list (first e)  
(first f)))))
	       (setf (gethash (length (first e)) times) (third e))
	       (setf prefix (make-string (* 2 (length (first e))) :initial- 
element #\.))
	       (let ((elapsed (gethash (- (length (first e)) 1) times))) ;  
elapsed time of previous level
		 (format t "~A~S ~10,3F ~5,2F%~%" prefix
			 (car (last (first e)))
			 (/ (third e) nano)
			 (* 100 (/ (third e) (if (= 0 elapsed) 1 elapsed)))
			 )))))))))


Example of reports:

total elapsed time      0.847 seconds
Function                            Count    Elapsed
%LIST                                   4      0.000  0.01%
CENTER-LAYOUT                           4      0.000  0.01%
DESTROY-CONTEXT                         1      0.000  0.06%
%GET-VFIELDS                            1      0.001  0.08%
XCREATEWINDOW                          69      0.001  0.09%
%EVAL                                  18      0.001  0.11%
%LIST-SYMBOLS                          12      0.001  0.11%
%GEN-FLET-VFIELDS                       4      0.001  0.17%
%FLET-VFIELDS                           1      0.001  0.18%
%VFIELDS                                1      0.002  0.18%
COLUMN-LAYOUT                          11      0.002  0.27%
RESIZE-WINDOW                          69      0.002  0.29%
%SPLIT-ARGS                           272      0.003  0.36%
ROW-LAYOUT                             16      0.003  0.37%
SPLIT-ARGS                            272      0.010  1.13%
CLIP                                   27      0.013  1.52%
GETA                                 2479      0.027  3.14%
CREATE-WINDOW                          69      0.037  4.41%
CREATE-CONTEXT                         69      0.046  5.43%

total elapsed time      0.847 seconds
..%EVAL      0.001  0.13%
....%EVAL      0.001 97.22%
......%EVAL      0.001 88.97%
........%EVAL      0.001 80.29%
..........%EVAL      0.000  1.62%
..........%GET-VFIELDS      0.001 83.75%
............GETA      0.000  7.86%
............SPLIT-ARGS      0.000 60.71%
..............%SPLIT-ARGS      0.000 33.20%
..%VFIELDS      0.002  0.18%
....%FLET-VFIELDS      0.001 98.27%
......%GEN-FLET-VFIELDS      0.001 95.39%
........%LIST      0.000  3.62%
........%LIST-SYMBOLS      0.001 67.14%
..CENTER-LAYOUT      0.000  0.01%
..CLIP      0.013  1.52%
....GETA      0.001  6.60%
....RESIZE-WINDOW      0.001  8.26%
..COLUMN-LAYOUT      0.002  0.27%
....GETA      0.000  9.94%
..CREATE-CONTEXT      0.046  5.43%
....CREATE-WINDOW      0.037 81.25%
......GETA      0.016 43.95%
......XCREATEWINDOW      0.001  2.06%
....GETA      0.001  3.10%
..DESTROY-CONTEXT      0.000  0.06%
..GETA      0.007  0.86%
..RESIZE-WINDOW      0.001  0.16%
..ROW-LAYOUT      0.003  0.37%
....GETA      0.000 10.53%
..SPLIT-ARGS      0.009  1.08%
....%SPLIT-ARGS      0.003 31.65%
NIL
?



On Nov 19, 2009, at 7:41 PM, Paul Krueger wrote:

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

-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://lists.clozure.com/pipermail/openmcl-devel/attachments/20091120/2ccb4a61/attachment.htm>


More information about the Openmcl-devel mailing list