Commit | Line | Data |
---|---|---|
20f5d145 RS |
1 | ;;; elp.el --- Emacs Lisp Profiler |
2 | ||
ab422c4d PE |
3 | ;; Copyright (C) 1994-1995, 1997-1998, 2001-2013 Free Software |
4 | ;; Foundation, Inc. | |
c0fd04c8 | 5 | |
60370d40 PJ |
6 | ;; Author: Barry A. Warsaw |
7 | ;; Maintainer: FSF | |
8 | ;; Created: 26-Feb-1994 | |
9 | ;; Keywords: debugging lisp tools | |
20f5d145 | 10 | |
c0fd04c8 | 11 | ;; This file is part of GNU Emacs. |
20f5d145 | 12 | |
d6cba7ae | 13 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
20f5d145 | 14 | ;; it under the terms of the GNU General Public License as published by |
d6cba7ae GM |
15 | ;; the Free Software Foundation, either version 3 of the License, or |
16 | ;; (at your option) any later version. | |
c0fd04c8 RS |
17 | |
18 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
20f5d145 RS |
19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
21 | ;; GNU General Public License for more details. | |
20f5d145 | 22 | |
c0fd04c8 | 23 | ;; You should have received a copy of the GNU General Public License |
d6cba7ae | 24 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
20f5d145 RS |
25 | |
26 | ;;; Commentary: | |
27 | ;; | |
b96bffd7 RS |
28 | ;; If you want to profile a bunch of functions, set elp-function-list |
29 | ;; to the list of symbols, then do a M-x elp-instrument-list. This | |
30 | ;; hacks those functions so that profiling information is recorded | |
31 | ;; whenever they are called. To print out the current results, use | |
9b267eba RS |
32 | ;; M-x elp-results. If you want output to go to standard-output |
33 | ;; instead of a separate buffer, setq elp-use-standard-output to | |
34 | ;; non-nil. With elp-reset-after-results set to non-nil, profiling | |
35 | ;; information will be reset whenever the results are displayed. You | |
36 | ;; can also reset all profiling info at any time with M-x | |
37 | ;; elp-reset-all. | |
c0fd04c8 RS |
38 | ;; |
39 | ;; You can also instrument all functions in a package, provided that | |
f2f22d26 | 40 | ;; the package follows the GNU coding standard of a common textual |
b96bffd7 | 41 | ;; prefix. Use M-x elp-instrument-package for this. |
20f5d145 RS |
42 | ;; |
43 | ;; If you want to sort the results, set elp-sort-by-function to some | |
44 | ;; predicate function. The three most obvious choices are predefined: | |
45 | ;; elp-sort-by-call-count, elp-sort-by-average-time, and | |
b96bffd7 RS |
46 | ;; elp-sort-by-total-time. Also, you can prune from the output, all |
47 | ;; functions that have been called fewer than a given number of times | |
48 | ;; by setting elp-report-limit. | |
20f5d145 RS |
49 | ;; |
50 | ;; Elp can instrument byte-compiled functions just as easily as | |
c0fd04c8 | 51 | ;; interpreted functions, but it cannot instrument macros. However, |
5fe4899a | 52 | ;; when you redefine a function (e.g. with eval-defun), you'll need to |
b96bffd7 RS |
53 | ;; re-instrument it with M-x elp-instrument-function. This will also |
54 | ;; reset profiling information for that function. Elp can handle | |
55 | ;; interactive functions (i.e. commands), but of course any time spent | |
56 | ;; idling for user prompts will show up in the timing results. | |
20f5d145 RS |
57 | ;; |
58 | ;; You can also designate a `master' function. Profiling times will | |
59 | ;; be gathered for instrumented functions only during execution of | |
60 | ;; this master function. Thus, if you have some defuns like: | |
61 | ;; | |
62 | ;; (defun foo () (do-something-time-intensive)) | |
63 | ;; (defun bar () (foo)) | |
64 | ;; (defun baz () (bar) (foo)) | |
65 | ;; | |
66 | ;; and you want to find out the amount of time spent in bar and foo, | |
5fe4899a | 67 | ;; but only during execution of bar, make bar the master. The call of |
b96bffd7 RS |
68 | ;; foo from baz will not add to foo's total timing sums. Use M-x |
69 | ;; elp-set-master and M-x elp-unset-master to utilize this feature. | |
70 | ;; Only one master function can be set at a time. | |
20f5d145 RS |
71 | |
72 | ;; You can restore any function's original function definition with | |
73 | ;; elp-restore-function. The other instrument, restore, and reset | |
74 | ;; functions are provided for symmetry. | |
75 | ||
5b689f60 RS |
76 | ;; Here is a list of variable you can use to customize elp: |
77 | ;; elp-function-list | |
78 | ;; elp-reset-after-results | |
79 | ;; elp-sort-by-function | |
80 | ;; elp-report-limit | |
81 | ;; | |
82 | ;; Here is a list of the interactive commands you can use: | |
83 | ;; elp-instrument-function | |
84 | ;; elp-restore-function | |
85 | ;; elp-instrument-list | |
86 | ;; elp-restore-list | |
87 | ;; elp-instrument-package | |
88 | ;; elp-restore-all | |
89 | ;; elp-reset-function | |
90 | ;; elp-reset-list | |
91 | ;; elp-reset-all | |
92 | ;; elp-set-master | |
93 | ;; elp-unset-master | |
94 | ;; elp-results | |
5b689f60 | 95 | |
b96bffd7 RS |
96 | ;; Note that there are plenty of factors that could make the times |
97 | ;; reported unreliable, including the accuracy and granularity of your | |
98 | ;; system clock, and the overhead spent in lisp calculating and | |
99 | ;; recording the intervals. I figure the latter is pretty constant, | |
100 | ;; so while the times may not be entirely accurate, I think they'll | |
101 | ;; give you a good feel for the relative amount of work spent in the | |
102 | ;; various lisp routines you are profiling. Note further that times | |
103 | ;; are calculated using wall-clock time, so other system load will | |
9b267eba | 104 | ;; affect accuracy too. |
b96bffd7 | 105 | |
5b689f60 RS |
106 | ;;; Background: |
107 | ||
d83cce6d RS |
108 | ;; This program was inspired by the only two existing Emacs Lisp |
109 | ;; profilers that I'm aware of, Boaz Ben-Zvi's profile.el, and Root | |
110 | ;; Boy Jim's profiler.el. Both were written for Emacs 18 and both were | |
111 | ;; pretty good first shots at profiling, but I found that they didn't | |
112 | ;; provide the functionality or interface that I wanted, so I wrote | |
113 | ;; this. I've tested elp in XEmacs 19 and Emacs 19. There's no point | |
114 | ;; in even trying to make this work with Emacs 18. | |
5b689f60 RS |
115 | |
116 | ;; Unlike previous profilers, elp uses Emacs 19's built-in function | |
117 | ;; current-time to return interval times. This obviates the need for | |
118 | ;; both an external C program and Emacs processes to communicate with | |
b96bffd7 | 119 | ;; such a program, and thus simplifies the package as a whole. |
5fe4899a | 120 | |
9b267eba RS |
121 | ;; TBD: |
122 | ;; Make this act like a real profiler, so that it records time spent | |
123 | ;; in all branches of execution. | |
124 | ||
20f5d145 RS |
125 | ;;; Code: |
126 | ||
127 | \f | |
d83cce6d | 128 | ;; start of user configuration variables |
20f5d145 RS |
129 | ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv |
130 | ||
9e5b444e | 131 | (defgroup elp nil |
667ab8c4 | 132 | "Emacs Lisp Profiler." |
9e5b444e | 133 | :group 'lisp) |
20f5d145 | 134 | |
9e5b444e | 135 | (defcustom elp-function-list nil |
cb711556 | 136 | "List of functions to profile. |
9e5b444e RS |
137 | Used by the command `elp-instrument-list'." |
138 | :type '(repeat function) | |
139 | :group 'elp) | |
140 | ||
141 | (defcustom elp-reset-after-results t | |
cb711556 | 142 | "Non-nil means reset all profiling info after results are displayed. |
9e5b444e RS |
143 | Results are displayed with the `elp-results' command." |
144 | :type 'boolean | |
145 | :group 'elp) | |
20f5d145 | 146 | |
9e5b444e | 147 | (defcustom elp-sort-by-function 'elp-sort-by-total-time |
cb711556 | 148 | "Non-nil specifies ELP results sorting function. |
20f5d145 RS |
149 | These functions are currently available: |
150 | ||
151 | elp-sort-by-call-count -- sort by the highest call count | |
152 | elp-sort-by-total-time -- sort by the highest total time | |
153 | elp-sort-by-average-time -- sort by the highest average times | |
154 | ||
1cc5b8f8 JB |
155 | You can write your own sort function. It should adhere to the |
156 | interface specified by the PREDICATE argument for `sort'. | |
157 | Each \"element of LIST\" is really a 4 element vector where element 0 is | |
20f5d145 RS |
158 | the call count, element 1 is the total time spent in the function, |
159 | element 2 is the average time spent in the function, and element 3 is | |
9e5b444e RS |
160 | the symbol's name string." |
161 | :type 'function | |
162 | :group 'elp) | |
20f5d145 | 163 | |
9e5b444e | 164 | (defcustom elp-report-limit 1 |
cb711556 | 165 | "Prevent some functions from being displayed in the results buffer. |
c0fd04c8 RS |
166 | If a number, no function that has been called fewer than that number |
167 | of times will be displayed in the output buffer. If nil, all | |
9e5b444e RS |
168 | functions will be displayed." |
169 | :type '(choice integer | |
d83cce6d | 170 | (const :tag "Show All" nil)) |
9e5b444e | 171 | :group 'elp) |
c0fd04c8 | 172 | |
9e5b444e | 173 | (defcustom elp-use-standard-output nil |
cb711556 | 174 | "If non-nil, output to `standard-output' instead of a buffer." |
9e5b444e RS |
175 | :type 'boolean |
176 | :group 'elp) | |
9b267eba | 177 | |
9e5b444e | 178 | (defcustom elp-recycle-buffers-p t |
cb711556 | 179 | "If nil, don't recycle the `elp-results-buffer'. |
9b267eba | 180 | In other words, a new unique buffer is create every time you run |
9e5b444e RS |
181 | \\[elp-results]." |
182 | :type 'boolean | |
183 | :group 'elp) | |
9b267eba | 184 | |
20f5d145 RS |
185 | |
186 | ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ | |
9b267eba | 187 | ;; end of user configuration variables |
20f5d145 RS |
188 | |
189 | \f | |
20f5d145 RS |
190 | (defvar elp-results-buffer "*ELP Profiling Results*" |
191 | "Buffer name for outputting profiling results.") | |
192 | ||
193 | (defconst elp-timer-info-property 'elp-info | |
194 | "ELP information property name.") | |
195 | ||
196 | (defvar elp-all-instrumented-list nil | |
197 | "List of all functions currently being instrumented.") | |
198 | ||
199 | (defvar elp-record-p t | |
200 | "Controls whether functions should record times or not. | |
201 | This variable is set by the master function.") | |
202 | ||
203 | (defvar elp-master nil | |
204 | "Master function symbol.") | |
205 | ||
5848fe5c | 206 | (defvar elp-not-profilable |
d9532403 SM |
207 | ;; First, the functions used inside each instrumented function: |
208 | '(elp-wrapper called-interactively-p | |
209 | ;; Then the functions used by the above functions. I used | |
210 | ;; (delq nil (mapcar (lambda (x) (and (symbolp x) (fboundp x) x)) | |
211 | ;; (aref (symbol-function 'elp-wrapper) 2))) | |
212 | ;; to help me find this list. | |
30194d4d CY |
213 | error call-interactively apply current-time |
214 | ;; Andreas Politz reports problems profiling these (Bug#4233): | |
215 | + byte-code-function-p functionp byte-code subrp | |
216 | indirect-function fboundp) | |
5848fe5c SM |
217 | "List of functions that cannot be profiled. |
218 | Those functions are used internally by the profiling code and profiling | |
219 | them would thus lead to infinite recursion.") | |
220 | ||
d9532403 SM |
221 | (defun elp-profilable-p (fun) |
222 | (and (symbolp fun) | |
223 | (fboundp fun) | |
224 | (not (or (memq fun elp-not-profilable) | |
225 | (keymapp fun) | |
226 | (memq (car-safe (symbol-function fun)) '(autoload macro)) | |
227 | (condition-case nil | |
228 | (when (subrp (indirect-function fun)) | |
229 | (eq 'unevalled | |
230 | (cdr (subr-arity (indirect-function fun))))) | |
231 | (error nil)))))) | |
5848fe5c | 232 | |
d83cce6d | 233 | \f |
62f91105 | 234 | ;;;###autoload |
20f5d145 RS |
235 | (defun elp-instrument-function (funsym) |
236 | "Instrument FUNSYM for profiling. | |
237 | FUNSYM must be a symbol of a defined function." | |
238 | (interactive "aFunction to instrument: ") | |
9b267eba RS |
239 | ;; restore the function. this is necessary to avoid infinite |
240 | ;; recursion of already instrumented functions (i.e. elp-wrapper | |
241 | ;; calling elp-wrapper ad infinitum). it is better to simply | |
242 | ;; restore the function than to throw an error. this will work | |
243 | ;; properly in the face of eval-defun because if the function was | |
244 | ;; redefined, only the timer info will be nil'd out since | |
245 | ;; elp-restore-function is smart enough not to trash the new | |
246 | ;; definition. | |
247 | (elp-restore-function funsym) | |
20f5d145 RS |
248 | (let* ((funguts (symbol-function funsym)) |
249 | (infovec (vector 0 0 funguts)) | |
250 | (newguts '(lambda (&rest args)))) | |
c0fd04c8 RS |
251 | ;; we cannot profile macros |
252 | (and (eq (car-safe funguts) 'macro) | |
9b267eba RS |
253 | (error "ELP cannot profile macro: %s" funsym)) |
254 | ;; TBD: at some point it might be better to load the autoloaded | |
255 | ;; function instead of throwing an error. if we do this, then we | |
256 | ;; probably want elp-instrument-package to be updated with the | |
257 | ;; newly loaded list of functions. i'm not sure it's smart to do | |
258 | ;; the autoload here, since that could have side effects, and | |
259 | ;; elp-instrument-function is similar (in my mind) to defun-ish | |
260 | ;; type functionality (i.e. it shouldn't execute the function). | |
7abaf5cc | 261 | (and (autoloadp funguts) |
9b267eba | 262 | (error "ELP cannot profile autoloaded function: %s" funsym)) |
d9532403 SM |
263 | ;; We cannot profile functions used internally during profiling. |
264 | (unless (elp-profilable-p funsym) | |
265 | (error "ELP cannot profile the function: %s" funsym)) | |
20f5d145 RS |
266 | ;; put rest of newguts together |
267 | (if (commandp funsym) | |
268 | (setq newguts (append newguts '((interactive))))) | |
5848fe5c SM |
269 | (setq newguts (append newguts `((elp-wrapper |
270 | (quote ,funsym) | |
271 | ,(when (commandp funsym) | |
12a3c28c | 272 | '(called-interactively-p 'any)) |
5848fe5c | 273 | args)))) |
20f5d145 RS |
274 | ;; to record profiling times, we set the symbol's function |
275 | ;; definition so that it runs the elp-wrapper function with the | |
276 | ;; function symbol as an argument. We place the old function | |
277 | ;; definition on the info vector. | |
278 | ;; | |
279 | ;; The info vector data structure is a 3 element vector. The 0th | |
280 | ;; element is the call-count, i.e. the total number of times this | |
281 | ;; function has been entered. This value is bumped up on entry to | |
282 | ;; the function so that non-local exists are still recorded. TBD: | |
283 | ;; I haven't tested non-local exits at all, so no guarantees. | |
284 | ;; | |
3103f8b6 | 285 | ;; The 1st element is the total amount of time in seconds that has |
20f5d145 RS |
286 | ;; been spent inside this function. This number is added to on |
287 | ;; function exit. | |
288 | ;; | |
289 | ;; The 2nd element is the old function definition list. This gets | |
290 | ;; funcall'd in between start/end time retrievals. I believe that | |
291 | ;; this lets us profile even byte-compiled functions. | |
292 | ||
293 | ;; put the info vector on the property list | |
294 | (put funsym elp-timer-info-property infovec) | |
295 | ||
cebf1b97 GM |
296 | ;; Set the symbol's new profiling function definition to run |
297 | ;; elp-wrapper. | |
298 | (let ((advice-info (get funsym 'ad-advice-info))) | |
299 | (if advice-info | |
300 | (progn | |
301 | ;; If function is advised, don't let Advice change | |
302 | ;; its definition from under us during the `fset'. | |
303 | (put funsym 'ad-advice-info nil) | |
304 | (fset funsym newguts) | |
305 | (put funsym 'ad-advice-info advice-info)) | |
306 | (fset funsym newguts))) | |
20f5d145 RS |
307 | |
308 | ;; add this function to the instrumentation list | |
5848fe5c SM |
309 | (unless (memq funsym elp-all-instrumented-list) |
310 | (push funsym elp-all-instrumented-list)))) | |
20f5d145 RS |
311 | |
312 | (defun elp-restore-function (funsym) | |
313 | "Restore an instrumented function to its original definition. | |
314 | Argument FUNSYM is the symbol of a defined function." | |
315 | (interactive "aFunction to restore: ") | |
316 | (let ((info (get funsym elp-timer-info-property))) | |
317 | ;; delete the function from the all instrumented list | |
318 | (setq elp-all-instrumented-list | |
319 | (delq funsym elp-all-instrumented-list)) | |
320 | ||
321 | ;; if the function was the master, reset the master | |
322 | (if (eq funsym elp-master) | |
323 | (setq elp-master nil | |
324 | elp-record-p t)) | |
325 | ||
326 | ;; zap the properties | |
327 | (put funsym elp-timer-info-property nil) | |
328 | ||
329 | ;; restore the original function definition, but if the function | |
330 | ;; wasn't instrumented do nothing. we do this after the above | |
331 | ;; because its possible the function got un-instrumented due to | |
332 | ;; circumstances beyond our control. Also, check to make sure | |
333 | ;; that the current function symbol points to elp-wrapper. If | |
9b267eba RS |
334 | ;; not, then the user probably did an eval-defun, or loaded a |
335 | ;; byte-compiled version, while the function was instrumented and | |
336 | ;; we don't want to destroy the new definition. can it ever be | |
337 | ;; the case that a lisp function can be compiled instrumented? | |
20f5d145 | 338 | (and info |
b5ca6f92 | 339 | (functionp funsym) |
36172f49 | 340 | (not (byte-code-function-p (symbol-function funsym))) |
20f5d145 RS |
341 | (assq 'elp-wrapper (symbol-function funsym)) |
342 | (fset funsym (aref info 2))))) | |
343 | ||
62f91105 | 344 | ;;;###autoload |
20f5d145 | 345 | (defun elp-instrument-list (&optional list) |
edad5f97 CY |
346 | "Instrument, for profiling, all functions in `elp-function-list'. |
347 | Use optional LIST if provided instead. | |
348 | If called interactively, read LIST using the minibuffer." | |
20f5d145 | 349 | (interactive "PList of functions to instrument: ") |
edad5f97 | 350 | (unless (listp list) |
19dd6a6c | 351 | (signal 'wrong-type-argument (list 'listp list))) |
20f5d145 RS |
352 | (let ((list (or list elp-function-list))) |
353 | (mapcar 'elp-instrument-function list))) | |
354 | ||
62f91105 | 355 | ;;;###autoload |
c0fd04c8 RS |
356 | (defun elp-instrument-package (prefix) |
357 | "Instrument for profiling, all functions which start with PREFIX. | |
358 | For example, to instrument all ELP functions, do the following: | |
359 | ||
360 | \\[elp-instrument-package] RET elp- RET" | |
d9532403 SM |
361 | (interactive |
362 | (list (completing-read "Prefix of package to instrument: " | |
363 | obarray 'elp-profilable-p))) | |
940cf42e | 364 | (if (zerop (length prefix)) |
60370d40 | 365 | (error "Instrumenting all Emacs functions would render Emacs unusable")) |
c0fd04c8 | 366 | (elp-instrument-list |
d83cce6d RS |
367 | (mapcar |
368 | 'intern | |
d9532403 | 369 | (all-completions prefix obarray 'elp-profilable-p)))) |
c0fd04c8 | 370 | |
20f5d145 RS |
371 | (defun elp-restore-list (&optional list) |
372 | "Restore the original definitions for all functions in `elp-function-list'. | |
373 | Use optional LIST if provided instead." | |
374 | (interactive "PList of functions to restore: ") | |
375 | (let ((list (or list elp-function-list))) | |
376 | (mapcar 'elp-restore-function list))) | |
377 | ||
378 | (defun elp-restore-all () | |
1cc5b8f8 | 379 | "Restore the original definitions of all functions being profiled." |
20f5d145 RS |
380 | (interactive) |
381 | (elp-restore-list elp-all-instrumented-list)) | |
382 | ||
383 | \f | |
384 | (defun elp-reset-function (funsym) | |
385 | "Reset the profiling information for FUNSYM." | |
386 | (interactive "aFunction to reset: ") | |
387 | (let ((info (get funsym elp-timer-info-property))) | |
388 | (or info | |
60370d40 | 389 | (error "%s is not instrumented for profiling" funsym)) |
20f5d145 RS |
390 | (aset info 0 0) ;reset call counter |
391 | (aset info 1 0.0) ;reset total time | |
392 | ;; don't muck with aref 2 as that is the old symbol definition | |
393 | )) | |
394 | ||
395 | (defun elp-reset-list (&optional list) | |
396 | "Reset the profiling information for all functions in `elp-function-list'. | |
397 | Use optional LIST if provided instead." | |
398 | (interactive "PList of functions to reset: ") | |
399 | (let ((list (or list elp-function-list))) | |
400 | (mapcar 'elp-reset-function list))) | |
401 | ||
402 | (defun elp-reset-all () | |
403 | "Reset the profiling information for all functions being profiled." | |
404 | (interactive) | |
405 | (elp-reset-list elp-all-instrumented-list)) | |
406 | ||
407 | (defun elp-set-master (funsym) | |
408 | "Set the master function for profiling." | |
409 | (interactive "aMaster function: ") | |
410 | ;; when there's a master function, recording is turned off by | |
411 | ;; default | |
412 | (setq elp-master funsym | |
413 | elp-record-p nil) | |
414 | ;; make sure master function is instrumented | |
415 | (or (memq funsym elp-all-instrumented-list) | |
416 | (elp-instrument-function funsym))) | |
417 | ||
418 | (defun elp-unset-master () | |
1cc5b8f8 | 419 | "Unset the master function." |
5fe4899a | 420 | (interactive) |
20f5d145 RS |
421 | ;; when there's no master function, recording is turned on by default. |
422 | (setq elp-master nil | |
423 | elp-record-p t)) | |
424 | ||
425 | \f | |
9b267eba | 426 | (defsubst elp-elapsed-time (start end) |
3103f8b6 | 427 | (float-time (time-subtract end start))) |
20f5d145 RS |
428 | |
429 | (defun elp-wrapper (funsym interactive-p args) | |
430 | "This function has been instrumented for profiling by the ELP. | |
431 | ELP is the Emacs Lisp Profiler. To restore the function to its | |
432 | original definition, use \\[elp-restore-function] or \\[elp-restore-all]." | |
433 | ;; turn on recording if this is the master function | |
434 | (if (and elp-master | |
435 | (eq funsym elp-master)) | |
436 | (setq elp-record-p t)) | |
437 | ;; get info vector and original function symbol | |
438 | (let* ((info (get funsym elp-timer-info-property)) | |
439 | (func (aref info 2)) | |
440 | result) | |
441 | (or func | |
60370d40 | 442 | (error "%s is not instrumented for profiling" funsym)) |
20f5d145 RS |
443 | (if (not elp-record-p) |
444 | ;; when not recording, just call the original function symbol | |
445 | ;; and return the results. | |
446 | (setq result | |
447 | (if interactive-p | |
448 | (call-interactively func) | |
449 | (apply func args))) | |
450 | ;; we are recording times | |
9b267eba | 451 | (let (enter-time exit-time) |
20f5d145 RS |
452 | ;; increment the call-counter |
453 | (aset info 0 (1+ (aref info 0))) | |
454 | ;; now call the old symbol function, checking to see if it | |
455 | ;; should be called interactively. make sure we return the | |
456 | ;; correct value | |
9b267eba RS |
457 | (if interactive-p |
458 | (setq enter-time (current-time) | |
459 | result (call-interactively func) | |
460 | exit-time (current-time)) | |
461 | (setq enter-time (current-time) | |
462 | result (apply func args) | |
463 | exit-time (current-time))) | |
20f5d145 | 464 | ;; calculate total time in function |
9b267eba | 465 | (aset info 1 (+ (aref info 1) (elp-elapsed-time enter-time exit-time))) |
20f5d145 RS |
466 | )) |
467 | ;; turn off recording if this is the master function | |
468 | (if (and elp-master | |
469 | (eq funsym elp-master)) | |
470 | (setq elp-record-p nil)) | |
471 | result)) | |
472 | ||
473 | \f | |
474 | ;; shut the byte-compiler up | |
475 | (defvar elp-field-len nil) | |
476 | (defvar elp-cc-len nil) | |
477 | (defvar elp-at-len nil) | |
478 | (defvar elp-et-len nil) | |
479 | ||
480 | (defun elp-sort-by-call-count (vec1 vec2) | |
481 | ;; sort by highest call count. See `sort'. | |
482 | (>= (aref vec1 0) (aref vec2 0))) | |
483 | ||
484 | (defun elp-sort-by-total-time (vec1 vec2) | |
485 | ;; sort by highest total time spent in function. See `sort'. | |
486 | (>= (aref vec1 1) (aref vec2 1))) | |
487 | ||
488 | (defun elp-sort-by-average-time (vec1 vec2) | |
489 | ;; sort by highest average time spent in function. See `sort'. | |
490 | (>= (aref vec1 2) (aref vec2 2))) | |
491 | ||
5fe4899a RS |
492 | (defsubst elp-pack-number (number width) |
493 | ;; pack the NUMBER string into WIDTH characters, watching out for | |
494 | ;; very small or large numbers | |
495 | (if (<= (length number) width) | |
496 | number | |
497 | ;; check for very large or small numbers | |
498 | (if (string-match "^\\(.*\\)\\(e[+-].*\\)$" number) | |
499 | (concat (substring | |
d9532403 | 500 | (match-string 1 number) |
5fe4899a RS |
501 | 0 |
502 | (- width (match-end 2) (- (match-beginning 2)) 3)) | |
503 | "..." | |
d9532403 SM |
504 | (match-string 2 number)) |
505 | (substring number 0 width)))) | |
5fe4899a | 506 | |
20f5d145 RS |
507 | (defun elp-output-result (resultvec) |
508 | ;; output the RESULTVEC into the results buffer. RESULTVEC is a 4 or | |
509 | ;; more element vector where aref 0 is the call count, aref 1 is the | |
510 | ;; total time spent in the function, aref 2 is the average time | |
511 | ;; spent in the function, and aref 3 is the symbol's string | |
512 | ;; name. All other elements in the vector are ignored. | |
513 | (let* ((cc (aref resultvec 0)) | |
514 | (tt (aref resultvec 1)) | |
515 | (at (aref resultvec 2)) | |
516 | (symname (aref resultvec 3)) | |
517 | callcnt totaltime avetime) | |
20f5d145 RS |
518 | (setq callcnt (number-to-string cc) |
519 | totaltime (number-to-string tt) | |
520 | avetime (number-to-string at)) | |
c0fd04c8 RS |
521 | ;; possibly prune the results |
522 | (if (and elp-report-limit | |
523 | (numberp elp-report-limit) | |
524 | (< cc elp-report-limit)) | |
525 | nil | |
2b8d823f | 526 | (elp-output-insert-symname symname) |
c0fd04c8 RS |
527 | (insert-char 32 (+ elp-field-len (- (length symname)) 2)) |
528 | ;; print stuff out, formatting it nicely | |
529 | (insert callcnt) | |
530 | (insert-char 32 (+ elp-cc-len (- (length callcnt)) 2)) | |
5fe4899a RS |
531 | (let ((ttstr (elp-pack-number totaltime elp-et-len)) |
532 | (atstr (elp-pack-number avetime elp-at-len))) | |
533 | (insert ttstr) | |
534 | (insert-char 32 (+ elp-et-len (- (length ttstr)) 2)) | |
535 | (insert atstr)) | |
c0fd04c8 | 536 | (insert "\n")))) |
20f5d145 | 537 | |
2b8d823f MY |
538 | (defvar elp-results-symname-map |
539 | (let ((map (make-sparse-keymap))) | |
d9532403 | 540 | (define-key map [mouse-2] 'elp-results-jump-to-definition) |
53112453 | 541 | (define-key map [follow-link] 'mouse-face) |
2b8d823f MY |
542 | (define-key map "\C-m" 'elp-results-jump-to-definition) |
543 | map) | |
544 | "Keymap used on the function name column." ) | |
545 | ||
d9532403 | 546 | (defun elp-results-jump-to-definition (&optional event) |
2b8d823f | 547 | "Jump to the definition of the function under the point." |
d9532403 SM |
548 | (interactive (list last-nonmenu-event)) |
549 | (if event (posn-set-point (event-end event))) | |
2b8d823f MY |
550 | (find-function (get-text-property (point) 'elp-symname))) |
551 | ||
552 | (defun elp-output-insert-symname (symname) | |
553 | ;; Insert SYMNAME with text properties. | |
554 | (insert (propertize symname | |
555 | 'elp-symname (intern symname) | |
556 | 'keymap elp-results-symname-map | |
557 | 'mouse-face 'highlight | |
2764748c | 558 | 'face 'link |
d9532403 | 559 | 'help-echo "mouse-2 or RET jumps to definition"))) |
2b8d823f | 560 | |
62f91105 | 561 | ;;;###autoload |
20f5d145 RS |
562 | (defun elp-results () |
563 | "Display current profiling results. | |
564 | If `elp-reset-after-results' is non-nil, then current profiling | |
1cc5b8f8 | 565 | information for all instrumented functions is reset after results are |
20f5d145 RS |
566 | displayed." |
567 | (interactive) | |
568 | (let ((curbuf (current-buffer)) | |
9b267eba RS |
569 | (resultsbuf (if elp-recycle-buffers-p |
570 | (get-buffer-create elp-results-buffer) | |
571 | (generate-new-buffer elp-results-buffer)))) | |
20f5d145 RS |
572 | (set-buffer resultsbuf) |
573 | (erase-buffer) | |
20f5d145 RS |
574 | ;; get the length of the longest function name being profiled |
575 | (let* ((longest 0) | |
576 | (title "Function Name") | |
577 | (titlelen (length title)) | |
578 | (elp-field-len titlelen) | |
579 | (cc-header "Call Count") | |
580 | (elp-cc-len (length cc-header)) | |
581 | (et-header "Elapsed Time") | |
582 | (elp-et-len (length et-header)) | |
583 | (at-header "Average Time") | |
584 | (elp-at-len (length at-header)) | |
585 | (resvec | |
586 | (mapcar | |
587 | (function | |
588 | (lambda (funsym) | |
589 | (let* ((info (get funsym elp-timer-info-property)) | |
590 | (symname (format "%s" funsym)) | |
591 | (cc (aref info 0)) | |
592 | (tt (aref info 1))) | |
593 | (if (not info) | |
594 | (insert "No profiling information found for: " | |
595 | symname) | |
596 | (setq longest (max longest (length symname))) | |
597 | (vector cc tt (if (zerop cc) | |
598 | 0.0 ;avoid arithmetic div-by-zero errors | |
599 | (/ (float tt) (float cc))) | |
600 | symname))))) | |
601 | elp-all-instrumented-list)) | |
602 | ) ; end let* | |
1fb7205b NR |
603 | ;; If printing to stdout, insert the header so it will print. |
604 | ;; Otherwise use header-line-format. | |
605 | (setq elp-field-len (max titlelen longest)) | |
606 | (if (or elp-use-standard-output noninteractive) | |
607 | (progn | |
608 | (insert title) | |
609 | (if (> longest titlelen) | |
610 | (progn | |
611 | (insert-char 32 (- longest titlelen)))) | |
612 | (insert " " cc-header " " et-header " " at-header "\n") | |
613 | (insert-char ?= elp-field-len) | |
614 | (insert " ") | |
615 | (insert-char ?= elp-cc-len) | |
616 | (insert " ") | |
617 | (insert-char ?= elp-et-len) | |
618 | (insert " ") | |
619 | (insert-char ?= elp-at-len) | |
620 | (insert "\n")) | |
621 | (let ((column 0)) | |
622 | (setq header-line-format | |
623 | (mapconcat | |
624 | (lambda (title) | |
625 | (prog1 | |
626 | (concat | |
627 | (propertize " " | |
628 | 'display (list 'space :align-to column) | |
629 | 'face 'fixed-pitch) | |
630 | title) | |
509742cc | 631 | (setq column (+ column 2 |
1fb7205b NR |
632 | (if (= column 0) |
633 | elp-field-len | |
634 | (length title)))))) | |
635 | (list title cc-header et-header at-header) "")))) | |
20f5d145 RS |
636 | ;; if sorting is enabled, then sort the results list. in either |
637 | ;; case, call elp-output-result to output the result in the | |
638 | ;; buffer | |
639 | (if elp-sort-by-function | |
640 | (setq resvec (sort resvec elp-sort-by-function))) | |
9eaacc84 | 641 | (mapc 'elp-output-result resvec)) |
20f5d145 RS |
642 | ;; now pop up results buffer |
643 | (set-buffer curbuf) | |
644 | (pop-to-buffer resultsbuf) | |
9b267eba RS |
645 | ;; copy results to standard-output? |
646 | (if (or elp-use-standard-output noninteractive) | |
1fb7205b NR |
647 | (princ (buffer-substring (point-min) (point-max))) |
648 | (goto-char (point-min))) | |
20f5d145 RS |
649 | ;; reset profiling info if desired |
650 | (and elp-reset-after-results | |
651 | (elp-reset-all)))) | |
4edc4a39 | 652 | |
41a79faa JB |
653 | (defun elp-unload-function () |
654 | "Unload the Emacs Lisp Profiler." | |
655 | (elp-restore-all) | |
656 | ;; continue standard unloading | |
657 | nil) | |
20f5d145 RS |
658 | \f |
659 | (provide 'elp) | |
5b689f60 | 660 | |
60370d40 | 661 | ;;; elp.el ends here |