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