comparison lisp/utils/elp.el @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children b82b59fe008d
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; elp.el --- Emacs Lisp Profiler
2
3 ;; Copyright (C) 1994 Free Software Foundation, Inc.
4
5 ;; Author: 1994-1995 Barry A. Warsaw
6 ;; Maintainer: tools-help@merlin.cnri.reston.va.us
7 ;; Created: 26-Feb-1994
8 ;; Version: 2.32
9 ;; Last Modified: 1995/07/12 18:53:17
10 ;; Keywords: debugging lisp tools
11
12 ;; This file is part of GNU Emacs.
13
14 ;; GNU Emacs is free software; you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; any later version.
18
19 ;; GNU Emacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
23
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs; see the file COPYING. If not, write to
26 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
27
28 ;;; Synched up with: FSF 19.30.
29 ;;; In typical "What the hell?" fashion, the version distributed
30 ;;; with FSF 19.30 claims to be version 2.33 while ours is version 2.32,
31 ;;; but ours is actually more recent. Is this another example of
32 ;;; FSFmacs version corruption?
33
34 ;;; Commentary:
35 ;;
36 ;; If you want to profile a bunch of functions, set elp-function-list
37 ;; to the list of symbols, then do a M-x elp-instrument-list. This
38 ;; hacks those functions so that profiling information is recorded
39 ;; whenever they are called. To print out the current results, use
40 ;; M-x elp-results. If you want output to go to standard-output
41 ;; instead of a separate buffer, setq elp-use-standard-output to
42 ;; non-nil. With elp-reset-after-results set to non-nil, profiling
43 ;; information will be reset whenever the results are displayed. You
44 ;; can also reset all profiling info at any time with M-x
45 ;; elp-reset-all.
46 ;;
47 ;; You can also instrument all functions in a package, provided that
48 ;; the package follows the GNU coding standard of a common textural
49 ;; prefix. Use M-x elp-instrument-package for this.
50 ;;
51 ;; If you want to sort the results, set elp-sort-by-function to some
52 ;; predicate function. The three most obvious choices are predefined:
53 ;; elp-sort-by-call-count, elp-sort-by-average-time, and
54 ;; elp-sort-by-total-time. Also, you can prune from the output, all
55 ;; functions that have been called fewer than a given number of times
56 ;; by setting elp-report-limit.
57 ;;
58 ;; Elp can instrument byte-compiled functions just as easily as
59 ;; interpreted functions, but it cannot instrument macros. However,
60 ;; when you redefine a function (e.g. with eval-defun), you'll need to
61 ;; re-instrument it with M-x elp-instrument-function. This will also
62 ;; reset profiling information for that function. Elp can handle
63 ;; interactive functions (i.e. commands), but of course any time spent
64 ;; idling for user prompts will show up in the timing results.
65 ;;
66 ;; You can also designate a `master' function. Profiling times will
67 ;; be gathered for instrumented functions only during execution of
68 ;; this master function. Thus, if you have some defuns like:
69 ;;
70 ;; (defun foo () (do-something-time-intensive))
71 ;; (defun bar () (foo))
72 ;; (defun baz () (bar) (foo))
73 ;;
74 ;; and you want to find out the amount of time spent in bar and foo,
75 ;; but only during execution of bar, make bar the master. The call of
76 ;; foo from baz will not add to foo's total timing sums. Use M-x
77 ;; elp-set-master and M-x elp-unset-master to utilize this feature.
78 ;; Only one master function can be set at a time.
79
80 ;; You can restore any function's original function definition with
81 ;; elp-restore-function. The other instrument, restore, and reset
82 ;; functions are provided for symmetry.
83
84 ;; Note that there are plenty of factors that could make the times
85 ;; reported unreliable, including the accuracy and granularity of your
86 ;; system clock, and the overhead spent in lisp calculating and
87 ;; recording the intervals. The latter I figure is pretty constant
88 ;; so, while the times may not be entirely accurate, I think they'll
89 ;; give you a good feel for the relative amount of work spent in the
90 ;; various lisp routines you are profiling. Note further that times
91 ;; are calculated using wall-clock time, so other system load will
92 ;; affect accuracy too.
93
94 ;; Here is a list of variable you can use to customize elp:
95 ;; elp-function-list
96 ;; elp-reset-after-results
97 ;; elp-sort-by-function
98 ;; elp-report-limit
99 ;;
100 ;; Here is a list of the interactive commands you can use:
101 ;; elp-instrument-function
102 ;; elp-restore-function
103 ;; elp-instrument-list
104 ;; elp-restore-list
105 ;; elp-instrument-package
106 ;; elp-restore-all
107 ;; elp-reset-function
108 ;; elp-reset-list
109 ;; elp-reset-all
110 ;; elp-set-master
111 ;; elp-unset-master
112 ;; elp-results
113 ;; elp-submit-bug-report
114
115 ;; Note that there are plenty of factors that could make the times
116 ;; reported unreliable, including the accuracy and granularity of your
117 ;; system clock, and the overhead spent in lisp calculating and
118 ;; recording the intervals. I figure the latter is pretty constant,
119 ;; so while the times may not be entirely accurate, I think they'll
120 ;; give you a good feel for the relative amount of work spent in the
121 ;; various lisp routines you are profiling. Note further that times
122 ;; are calculated using wall-clock time, so other system load will
123 ;; affect accuracy too. You cannot profile anything longer than ~18
124 ;; hours since I throw away the most significant 16 bits of seconds
125 ;; returned by current-time: 2^16 == 65536 seconds == ~1092 minutes ==
126 ;; ~18 hours. I doubt you will ever want to profile stuff on the
127 ;; order of 18 hours anyway.
128
129 ;;; Background:
130 ;;
131 ;; This program was inspired by the only two existing Emacs Lisp
132 ;; profilers that I'm aware of, Boaz Ben-Zvi's profile.el, and Root
133 ;; Boy Jim's profiler.el. Both were written for Emacs 18 and both were
134 ;; pretty good first shots at profiling, but I found that they didn't
135 ;; provide the functionality or interface that I wanted, so I wrote
136 ;; this. I've tested elp in XEmacs 19 and Emacs 19. There's no point
137 ;; in even trying to make this work with Emacs 18.
138
139 ;; Unlike previous profilers, elp uses Emacs 19's built-in function
140 ;; current-time to return interval times. This obviates the need for
141 ;; both an external C program and Emacs processes to communicate with
142 ;; such a program, and thus simplifies the package as a whole.
143
144 ;; TBD:
145 ;; Make this act like a real profiler, so that it records time spent
146 ;; in all branches of execution.
147
148 ;; LCD Archive Entry:
149 ;; elp|Barry A. Warsaw|tools-help@merlin.cnri.reston.va.us|
150 ;; Emacs Lisp Profiler|
151 ;; 1995/07/12 18:53:17|2.32|~/misc/elp.el.Z|
152
153 ;;; Code:
154
155
156 ;; start of user configuration variables
157 ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
158
159 (defvar elp-function-list nil
160 "*List of functions to profile.
161 Used by the command `elp-instrument-list'.")
162
163 (defvar elp-reset-after-results t
164 "*Non-nil means reset all profiling info after results are displayed.
165 Results are displayed with the `elp-results' command.")
166
167 (defvar elp-sort-by-function 'elp-sort-by-total-time
168 "*Non-nil specifies elp results sorting function.
169 These functions are currently available:
170
171 elp-sort-by-call-count -- sort by the highest call count
172 elp-sort-by-total-time -- sort by the highest total time
173 elp-sort-by-average-time -- sort by the highest average times
174
175 You can write you're own sort function. It should adhere to the
176 interface specified by the PRED argument for the `sort' defun. Each
177 \"element of LIST\" is really a 4 element vector where element 0 is
178 the call count, element 1 is the total time spent in the function,
179 element 2 is the average time spent in the function, and element 3 is
180 the symbol's name string.")
181
182 (defvar elp-report-limit 1
183 "*Prevents some functions from being displayed in the results buffer.
184 If a number, no function that has been called fewer than that number
185 of times will be displayed in the output buffer. If nil, all
186 functions will be displayed.")
187
188 (defvar elp-use-standard-output nil
189 "*Non-nil says to output to `standard-output' instead of a buffer.")
190
191 (defvar elp-recycle-buffers-p t
192 "*Nil says to not recycle the `elp-results-buffer'.
193 In other words, a new unique buffer is create every time you run
194 \\[elp-results].")
195
196
197 ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
198 ;; end of user configuration variables
199
200
201 (defconst elp-version "2.32"
202 "ELP version number.")
203
204 (defconst elp-help-address "tools-help@merlin.cnri.reston.va.us"
205 "Address accepting submissions of bug reports and questions.")
206
207 (defvar elp-results-buffer "*ELP Profiling Results*"
208 "Buffer name for outputting profiling results.")
209
210 (defconst elp-timer-info-property 'elp-info
211 "ELP information property name.")
212
213 (defvar elp-all-instrumented-list nil
214 "List of all functions currently being instrumented.")
215
216 (defvar elp-record-p t
217 "Controls whether functions should record times or not.
218 This variable is set by the master function.")
219
220 (defvar elp-master nil
221 "Master function symbol.")
222
223
224 ;;;###autoload
225 (defun elp-instrument-function (funsym)
226 "Instrument FUNSYM for profiling.
227 FUNSYM must be a symbol of a defined function."
228 (interactive "aFunction to instrument: ")
229 ;; raise an error if the function is already instrumented
230 (and (get funsym elp-timer-info-property)
231 (error "Symbol `%s' is already instrumented for profiling." funsym))
232 (let* ((funguts (symbol-function funsym))
233 (infovec (vector 0 0 funguts))
234 (newguts '(lambda (&rest args))))
235 ;; we cannot profile macros
236 (and (eq (car-safe funguts) 'macro)
237 (error "ELP cannot profile macro %s" funsym))
238 ;; put rest of newguts together
239 (if (commandp funsym)
240 (setq newguts (append newguts '((interactive)))))
241 (setq newguts (append newguts (list
242 (list 'elp-wrapper
243 (list 'quote funsym)
244 (list 'and
245 '(interactive-p)
246 (not (not (commandp funsym))))
247 'args))))
248 ;; to record profiling times, we set the symbol's function
249 ;; definition so that it runs the elp-wrapper function with the
250 ;; function symbol as an argument. We place the old function
251 ;; definition on the info vector.
252 ;;
253 ;; The info vector data structure is a 3 element vector. The 0th
254 ;; element is the call-count, i.e. the total number of times this
255 ;; function has been entered. This value is bumped up on entry to
256 ;; the function so that non-local exists are still recorded. TBD:
257 ;; I haven't tested non-local exits at all, so no guarantees.
258 ;;
259 ;; The 1st element is the total amount of time in usecs that have
260 ;; been spent inside this function. This number is added to on
261 ;; function exit.
262 ;;
263 ;; The 2nd element is the old function definition list. This gets
264 ;; funcall'd in between start/end time retrievals. I believe that
265 ;; this lets us profile even byte-compiled functions.
266
267 ;; put the info vector on the property list
268 (put funsym elp-timer-info-property infovec)
269
270 ;; set the symbol's new profiling function definition to run
271 ;; elp-wrapper
272 (fset funsym newguts)
273
274 ;; add this function to the instrumentation list
275 (or (memq funsym elp-all-instrumented-list)
276 (setq elp-all-instrumented-list
277 (cons funsym elp-all-instrumented-list)))
278 ))
279
280 ;;;###autoload
281 (defun elp-restore-function (funsym)
282 "Restore an instrumented function to its original definition.
283 Argument FUNSYM is the symbol of a defined function."
284 (interactive "aFunction to restore: ")
285 (let ((info (get funsym elp-timer-info-property)))
286 ;; delete the function from the all instrumented list
287 (setq elp-all-instrumented-list
288 (delq funsym elp-all-instrumented-list))
289
290 ;; if the function was the master, reset the master
291 (if (eq funsym elp-master)
292 (setq elp-master nil
293 elp-record-p t))
294
295 ;; zap the properties
296 (put funsym elp-timer-info-property nil)
297
298 ;; restore the original function definition, but if the function
299 ;; wasn't instrumented do nothing. we do this after the above
300 ;; because its possible the function got un-instrumented due to
301 ;; circumstances beyond our control. Also, check to make sure
302 ;; that the current function symbol points to elp-wrapper. If
303 ;; not, then the user probably did an eval-defun while the
304 ;; function was instrumented and we don't want to destroy the new
305 ;; definition.
306 (and info
307 (assq 'elp-wrapper (symbol-function funsym))
308 (fset funsym (aref info 2)))))
309
310 ;;;###autoload
311 (defun elp-instrument-list (&optional list)
312 "Instrument for profiling, all functions in `elp-function-list'.
313 Use optional LIST if provided instead."
314 (interactive "PList of functions to instrument: ")
315 (let ((list (or list elp-function-list)))
316 (mapcar
317 (function
318 (lambda (funsym)
319 (condition-case nil
320 (elp-instrument-function funsym)
321 (error nil))))
322 list)))
323
324 ;;;###autoload
325 (defun elp-instrument-package (prefix)
326 "Instrument for profiling, all functions which start with PREFIX.
327 For example, to instrument all ELP functions, do the following:
328
329 \\[elp-instrument-package] RET elp- RET"
330 (interactive "sPrefix of package to instrument: ")
331 (elp-instrument-list
332 (mapcar 'intern (all-completions prefix obarray
333 (function
334 (lambda (sym)
335 (and (fboundp sym)
336 (not (eq (car-safe
337 (symbol-function sym))
338 'macro)))))))))
339
340 (defun elp-restore-list (&optional list)
341 "Restore the original definitions for all functions in `elp-function-list'.
342 Use optional LIST if provided instead."
343 (interactive "PList of functions to restore: ")
344 (let ((list (or list elp-function-list)))
345 (mapcar 'elp-restore-function list)))
346
347 (defun elp-restore-all ()
348 "Restores the original definitions of all functions being profiled."
349 (interactive)
350 (elp-restore-list elp-all-instrumented-list))
351
352
353 (defun elp-reset-function (funsym)
354 "Reset the profiling information for FUNSYM."
355 (interactive "aFunction to reset: ")
356 (let ((info (get funsym elp-timer-info-property)))
357 (or info
358 (error "%s is not instrumented for profiling." funsym))
359 (aset info 0 0) ;reset call counter
360 (aset info 1 0.0) ;reset total time
361 ;; don't muck with aref 2 as that is the old symbol definition
362 ))
363
364 (defun elp-reset-list (&optional list)
365 "Reset the profiling information for all functions in `elp-function-list'.
366 Use optional LIST if provided instead."
367 (interactive "PList of functions to reset: ")
368 (let ((list (or list elp-function-list)))
369 (mapcar 'elp-reset-function list)))
370
371 (defun elp-reset-all ()
372 "Reset the profiling information for all functions being profiled."
373 (interactive)
374 (elp-reset-list elp-all-instrumented-list))
375
376 (defun elp-set-master (funsym)
377 "Set the master function for profiling."
378 (interactive "aMaster function: ")
379 ;; when there's a master function, recording is turned off by
380 ;; default
381 (setq elp-master funsym
382 elp-record-p nil)
383 ;; make sure master function is instrumented
384 (or (memq funsym elp-all-instrumented-list)
385 (elp-instrument-function funsym)))
386
387 (defun elp-unset-master ()
388 "Unsets the master function."
389 (interactive)
390 ;; when there's no master function, recording is turned on by default.
391 (setq elp-master nil
392 elp-record-p t))
393
394
395 (defsubst elp-get-time ()
396 ;; get current time in seconds and microseconds. I throw away the
397 ;; most significant 16 bits of seconds since I doubt we'll ever want
398 ;; to profile lisp on the order of 18 hours. See notes at top of file.
399 (let ((now (current-time)))
400 (+ (float (nth 1 now)) (/ (float (nth 2 now)) 1000000.0))))
401
402 (defun elp-wrapper (funsym interactive-p args)
403 "This function has been instrumented for profiling by the ELP.
404 ELP is the Emacs Lisp Profiler. To restore the function to its
405 original definition, use \\[elp-restore-function] or \\[elp-restore-all]."
406 ;; turn on recording if this is the master function
407 (if (and elp-master
408 (eq funsym elp-master))
409 (setq elp-record-p t))
410 ;; get info vector and original function symbol
411 (let* ((info (get funsym elp-timer-info-property))
412 (func (aref info 2))
413 result)
414 (or func
415 (error "%s is not instrumented for profiling." funsym))
416 (if (not elp-record-p)
417 ;; when not recording, just call the original function symbol
418 ;; and return the results.
419 (setq result
420 (if interactive-p
421 (call-interactively func)
422 (apply func args)))
423 ;; we are recording times
424 (let ((enter-time (elp-get-time)))
425 ;; increment the call-counter
426 (aset info 0 (1+ (aref info 0)))
427 ;; now call the old symbol function, checking to see if it
428 ;; should be called interactively. make sure we return the
429 ;; correct value
430 (setq result
431 (if interactive-p
432 (call-interactively func)
433 (apply func args)))
434 ;; calculate total time in function
435 (aset info 1 (+ (aref info 1) (- (elp-get-time) enter-time)))
436 ))
437 ;; turn off recording if this is the master function
438 (if (and elp-master
439 (eq funsym elp-master))
440 (setq elp-record-p nil))
441 result))
442
443
444 ;; shut the byte-compiler up
445 (defvar elp-field-len nil)
446 (defvar elp-cc-len nil)
447 (defvar elp-at-len nil)
448 (defvar elp-et-len nil)
449
450 (defun elp-sort-by-call-count (vec1 vec2)
451 ;; sort by highest call count. See `sort'.
452 (>= (aref vec1 0) (aref vec2 0)))
453
454 (defun elp-sort-by-total-time (vec1 vec2)
455 ;; sort by highest total time spent in function. See `sort'.
456 (>= (aref vec1 1) (aref vec2 1)))
457
458 (defun elp-sort-by-average-time (vec1 vec2)
459 ;; sort by highest average time spent in function. See `sort'.
460 (>= (aref vec1 2) (aref vec2 2)))
461
462 (defsubst elp-pack-number (number width)
463 ;; pack the NUMBER string into WIDTH characters, watching out for
464 ;; very small or large numbers
465 (if (<= (length number) width)
466 number
467 ;; check for very large or small numbers
468 (if (string-match "^\\(.*\\)\\(e[+-].*\\)$" number)
469 (concat (substring
470 (substring number (match-beginning 1) (match-end 1))
471 0
472 (- width (match-end 2) (- (match-beginning 2)) 3))
473 "..."
474 (substring number (match-beginning 2) (match-end 2)))
475 (concat (substring number 0 width)))))
476
477 (defun elp-output-result (resultvec)
478 ;; output the RESULTVEC into the results buffer. RESULTVEC is a 4 or
479 ;; more element vector where aref 0 is the call count, aref 1 is the
480 ;; total time spent in the function, aref 2 is the average time
481 ;; spent in the function, and aref 3 is the symbol's string
482 ;; name. All other elements in the vector are ignored.
483 (let* ((cc (aref resultvec 0))
484 (tt (aref resultvec 1))
485 (at (aref resultvec 2))
486 (symname (aref resultvec 3))
487 callcnt totaltime avetime)
488 (setq callcnt (number-to-string cc)
489 totaltime (number-to-string tt)
490 avetime (number-to-string at))
491 ;; possibly prune the results
492 (if (and elp-report-limit
493 (numberp elp-report-limit)
494 (< cc elp-report-limit))
495 nil
496 (insert symname)
497 (insert-char 32 (+ elp-field-len (- (length symname)) 2))
498 ;; print stuff out, formatting it nicely
499 (insert callcnt)
500 (insert-char 32 (+ elp-cc-len (- (length callcnt)) 2))
501 (let ((ttstr (elp-pack-number totaltime elp-et-len))
502 (atstr (elp-pack-number avetime elp-at-len)))
503 (insert ttstr)
504 (insert-char 32 (+ elp-et-len (- (length ttstr)) 2))
505 (insert atstr))
506 (insert "\n"))))
507
508 ;;;###autoload
509 (defun elp-results ()
510 "Display current profiling results.
511 If `elp-reset-after-results' is non-nil, then current profiling
512 information for all instrumented functions are reset after results are
513 displayed."
514 (interactive)
515 (let ((curbuf (current-buffer))
516 (resultsbuf (if elp-recycle-buffers-p
517 (get-buffer-create elp-results-buffer)
518 (generate-new-buffer elp-results-buffer))))
519 (set-buffer resultsbuf)
520 (erase-buffer)
521 (beginning-of-buffer)
522 ;; get the length of the longest function name being profiled
523 (let* ((longest 0)
524 (title "Function Name")
525 (titlelen (length title))
526 (elp-field-len titlelen)
527 (cc-header "Call Count")
528 (elp-cc-len (length cc-header))
529 (et-header "Elapsed Time")
530 (elp-et-len (length et-header))
531 (at-header "Average Time")
532 (elp-at-len (length at-header))
533 (resvec
534 (mapcar
535 (function
536 (lambda (funsym)
537 (let* ((info (get funsym elp-timer-info-property))
538 (symname (format "%s" funsym))
539 (cc (aref info 0))
540 (tt (aref info 1)))
541 (if (not info)
542 (insert "No profiling information found for: "
543 symname)
544 (setq longest (max longest (length symname)))
545 (vector cc tt (if (zerop cc)
546 0.0 ;avoid arithmetic div-by-zero errors
547 (/ (float tt) (float cc)))
548 symname)))))
549 elp-all-instrumented-list))
550 ) ; end let*
551 (insert title)
552 (if (> longest titlelen)
553 (progn
554 (insert-char 32 (- longest titlelen))
555 (setq elp-field-len longest)))
556 (insert " " cc-header " " et-header " " at-header "\n")
557 (insert-char ?= elp-field-len)
558 (insert " ")
559 (insert-char ?= elp-cc-len)
560 (insert " ")
561 (insert-char ?= elp-et-len)
562 (insert " ")
563 (insert-char ?= elp-at-len)
564 (insert "\n")
565 ;; if sorting is enabled, then sort the results list. in either
566 ;; case, call elp-output-result to output the result in the
567 ;; buffer
568 (if elp-sort-by-function
569 (setq resvec (sort resvec elp-sort-by-function)))
570 (mapcar 'elp-output-result resvec))
571 ;; now pop up results buffer
572 (set-buffer curbuf)
573 (pop-to-buffer resultsbuf)
574 ;; copy results to standard-output?
575 (if (or elp-use-standard-output noninteractive)
576 (princ (buffer-substring (point-min) (point-max))))
577 ;; reset profiling info if desired
578 (and elp-reset-after-results
579 (elp-reset-all))))
580
581
582 (eval-when-compile
583 (require 'reporter))
584
585 ;;;###autoload
586 (defun elp-submit-bug-report ()
587 "Submit via mail, a bug report on elp."
588 (interactive)
589 (and
590 (y-or-n-p "Do you want to submit a report on elp? ")
591 (require 'reporter)
592 (reporter-submit-bug-report
593 elp-help-address (concat "elp " elp-version)
594 '(elp-report-limit
595 elp-reset-after-results
596 elp-sort-by-function))))
597
598
599 (provide 'elp)
600
601 ;; elp.el ends here