Mercurial > emacs
annotate lisp/emacs-lisp/elp.el @ 112453:06719a229a46 default tip
* calc/calc.el (calc-default-power-reference-level)
(calc-default-field-reference-level): New variables.
* calc/calc-units.el (math-standard-units): Add dB and Np.
(math-logunits): New variable.
(math-extract-logunits, math-logcombine, calcFunc-luplus)
(calcFunc-luminus, calc-luplus, calc-luminus, math-logunit-level)
(calcFunc-fieldlevel, calcFunc-powerlevel, calc-level): New
functions.
(math-find-base-units-rec): Add entry for ln(10).
* calc/calc-help.el (calc-u-prefix-help): Add logarithmic help.
(calc-ul-prefix-help): New function.
* calc/calc-ext.el (calc-init-extensions): Autoload new units
functions. Add keybindings for new units functions.
author | Jay Belanger <jay.p.belanger@gmail.com> |
---|---|
date | Sun, 23 Jan 2011 23:08:04 -0600 |
parents | ef719132ddfa |
children |
rev | line source |
---|---|
8735 | 1 ;;; elp.el --- Emacs Lisp Profiler |
2 | |
64751
5b1a238fcbb4
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64085
diff
changeset
|
3 ;; Copyright (C) 1994, 1995, 1997, 1998, 2001, 2002, 2003, 2004, |
112218
376148b31b5e
Add 2011 to FSF/AIST copyright years.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
4 ;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. |
8744 | 5 |
38414
67b464da13ec
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
37785
diff
changeset
|
6 ;; Author: Barry A. Warsaw |
67b464da13ec
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
37785
diff
changeset
|
7 ;; Maintainer: FSF |
67b464da13ec
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
37785
diff
changeset
|
8 ;; Created: 26-Feb-1994 |
67b464da13ec
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
37785
diff
changeset
|
9 ;; Keywords: debugging lisp tools |
8735 | 10 |
8744 | 11 ;; This file is part of GNU Emacs. |
8735 | 12 |
94655
90a2847062be
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
13 ;; GNU Emacs is free software: you can redistribute it and/or modify |
8735 | 14 ;; it under the terms of the GNU General Public License as published by |
94655
90a2847062be
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
15 ;; the Free Software Foundation, either version 3 of the License, or |
90a2847062be
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
16 ;; (at your option) any later version. |
8744 | 17 |
18 ;; GNU Emacs is distributed in the hope that it will be useful, | |
8735 | 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. | |
8744 | 22 |
8735 | 23 ;; You should have received a copy of the GNU General Public License |
94655
90a2847062be
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
8735 | 25 |
26 ;;; Commentary: | |
27 ;; | |
10280 | 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 | |
17419
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
32 ;; 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
|
33 ;; 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
|
34 ;; 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
|
35 ;; 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
|
36 ;; 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
|
37 ;; elp-reset-all. |
8744 | 38 ;; |
39 ;; You can also instrument all functions in a package, provided that | |
42348 | 40 ;; the package follows the GNU coding standard of a common textual |
10280 | 41 ;; prefix. Use M-x elp-instrument-package for this. |
8735 | 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 | |
10280 | 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. | |
8735 | 49 ;; |
50 ;; Elp can instrument byte-compiled functions just as easily as | |
8744 | 51 ;; 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
|
52 ;; when you redefine a function (e.g. with eval-defun), you'll need to |
10280 | 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. | |
8735 | 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, | |
10234
170c4c188d4f
(elp-pack-number): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8745
diff
changeset
|
67 ;; but only during execution of bar, make bar the master. The call of |
10280 | 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. | |
8735 | 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 | |
10263 | 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 | |
95 | |
10280 | 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 | |
17419
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
104 ;; affect accuracy too. |
10280 | 105 |
10263 | 106 ;;; Background: |
107 | |
17527
2f06477dce5d
(elp-report-limit): Change prompt string.
Richard M. Stallman <rms@gnu.org>
parents:
17424
diff
changeset
|
108 ;; 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
|
109 ;; 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
|
110 ;; 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
|
111 ;; 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
|
112 ;; 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
|
113 ;; 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
|
114 ;; in even trying to make this work with Emacs 18. |
10263 | 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 | |
10280 | 119 ;; 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
|
120 |
17419
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
121 ;; TBD: |
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
122 ;; 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
|
123 ;; in all branches of execution. |
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
124 |
8735 | 125 ;;; Code: |
126 | |
127 | |
17527
2f06477dce5d
(elp-report-limit): Change prompt string.
Richard M. Stallman <rms@gnu.org>
parents:
17424
diff
changeset
|
128 ;; start of user configuration variables |
8735 | 129 ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv |
130 | |
17423
43e483167dd3
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
17420
diff
changeset
|
131 (defgroup elp nil |
64030
c2d80c96de71
(elp): Finish `defgroup' description with period.
Juanma Barranquero <lekktu@gmail.com>
parents:
58008
diff
changeset
|
132 "Emacs Lisp Profiler." |
17423
43e483167dd3
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
17420
diff
changeset
|
133 :group 'lisp) |
8735 | 134 |
17423
43e483167dd3
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
17420
diff
changeset
|
135 (defcustom elp-function-list nil |
104024
cce8d50c4566
Remove leading * from defcustom docs.
Glenn Morris <rgm@gnu.org>
parents:
103552
diff
changeset
|
136 "List of functions to profile. |
17423
43e483167dd3
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
17420
diff
changeset
|
137 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
|
138 :type '(repeat function) |
43e483167dd3
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
17420
diff
changeset
|
139 :group 'elp) |
43e483167dd3
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
17420
diff
changeset
|
140 |
43e483167dd3
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
17420
diff
changeset
|
141 (defcustom elp-reset-after-results t |
104024
cce8d50c4566
Remove leading * from defcustom docs.
Glenn Morris <rgm@gnu.org>
parents:
103552
diff
changeset
|
142 "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
|
143 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
|
144 :type 'boolean |
43e483167dd3
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
17420
diff
changeset
|
145 :group 'elp) |
8735 | 146 |
17423
43e483167dd3
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
17420
diff
changeset
|
147 (defcustom elp-sort-by-function 'elp-sort-by-total-time |
104024
cce8d50c4566
Remove leading * from defcustom docs.
Glenn Morris <rgm@gnu.org>
parents:
103552
diff
changeset
|
148 "Non-nil specifies ELP results sorting function. |
8735 | 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 | |
79287
8a5d09fbdaa1
(elp-report-limit, elp-restore-all, elp-unset-master, elp-results): Fix typos.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
155 You can write your own sort function. It should adhere to the |
8a5d09fbdaa1
(elp-report-limit, elp-restore-all, elp-unset-master, elp-results): Fix typos.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
156 interface specified by the PREDICATE argument for `sort'. |
8a5d09fbdaa1
(elp-report-limit, elp-restore-all, elp-unset-master, elp-results): Fix typos.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
157 Each \"element of LIST\" is really a 4 element vector where element 0 is |
8735 | 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 | |
17423
43e483167dd3
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
17420
diff
changeset
|
160 the symbol's name string." |
43e483167dd3
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
17420
diff
changeset
|
161 :type 'function |
43e483167dd3
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
17420
diff
changeset
|
162 :group 'elp) |
8735 | 163 |
17423
43e483167dd3
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
17420
diff
changeset
|
164 (defcustom elp-report-limit 1 |
104024
cce8d50c4566
Remove leading * from defcustom docs.
Glenn Morris <rgm@gnu.org>
parents:
103552
diff
changeset
|
165 "Prevent some functions from being displayed in the results buffer. |
8744 | 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 | |
17423
43e483167dd3
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
17420
diff
changeset
|
168 functions will be displayed." |
43e483167dd3
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
17420
diff
changeset
|
169 :type '(choice integer |
17527
2f06477dce5d
(elp-report-limit): Change prompt string.
Richard M. Stallman <rms@gnu.org>
parents:
17424
diff
changeset
|
170 (const :tag "Show All" nil)) |
17423
43e483167dd3
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
17420
diff
changeset
|
171 :group 'elp) |
8744 | 172 |
17423
43e483167dd3
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
17420
diff
changeset
|
173 (defcustom elp-use-standard-output nil |
104024
cce8d50c4566
Remove leading * from defcustom docs.
Glenn Morris <rgm@gnu.org>
parents:
103552
diff
changeset
|
174 "If non-nil, output to `standard-output' instead of a buffer." |
17423
43e483167dd3
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
17420
diff
changeset
|
175 :type 'boolean |
43e483167dd3
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
17420
diff
changeset
|
176 :group 'elp) |
17419
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
177 |
17423
43e483167dd3
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
17420
diff
changeset
|
178 (defcustom elp-recycle-buffers-p t |
104024
cce8d50c4566
Remove leading * from defcustom docs.
Glenn Morris <rgm@gnu.org>
parents:
103552
diff
changeset
|
179 "If nil, don't recycle the `elp-results-buffer'. |
17419
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
180 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
|
181 \\[elp-results]." |
43e483167dd3
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
17420
diff
changeset
|
182 :type 'boolean |
43e483167dd3
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
17420
diff
changeset
|
183 :group 'elp) |
17419
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
184 |
8735 | 185 |
186 ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ | |
17419
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
187 ;; end of user configuration variables |
8735 | 188 |
189 | |
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 | |
41177
830a17080380
(elp-not-profilable): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
38414
diff
changeset
|
206 (defvar elp-not-profilable |
67188
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
207 ;; First, the functions used inside each instrumented function: |
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
208 '(elp-wrapper called-interactively-p |
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
209 ;; Then the functions used by the above functions. I used |
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
210 ;; (delq nil (mapcar (lambda (x) (and (symbolp x) (fboundp x) x)) |
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
211 ;; (aref (symbol-function 'elp-wrapper) 2))) |
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
212 ;; to help me find this list. |
104973
cc423a84dd77
* emacs-lisp/elp.el (elp-not-profilable): Add more functions (Bug#4233).
Chong Yidong <cyd@stupidchicken.com>
parents:
104024
diff
changeset
|
213 error call-interactively apply current-time |
cc423a84dd77
* emacs-lisp/elp.el (elp-not-profilable): Add more functions (Bug#4233).
Chong Yidong <cyd@stupidchicken.com>
parents:
104024
diff
changeset
|
214 ;; Andreas Politz reports problems profiling these (Bug#4233): |
cc423a84dd77
* emacs-lisp/elp.el (elp-not-profilable): Add more functions (Bug#4233).
Chong Yidong <cyd@stupidchicken.com>
parents:
104024
diff
changeset
|
215 + byte-code-function-p functionp byte-code subrp |
cc423a84dd77
* emacs-lisp/elp.el (elp-not-profilable): Add more functions (Bug#4233).
Chong Yidong <cyd@stupidchicken.com>
parents:
104024
diff
changeset
|
216 indirect-function fboundp) |
41177
830a17080380
(elp-not-profilable): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
38414
diff
changeset
|
217 "List of functions that cannot be profiled. |
830a17080380
(elp-not-profilable): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
38414
diff
changeset
|
218 Those functions are used internally by the profiling code and profiling |
830a17080380
(elp-not-profilable): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
38414
diff
changeset
|
219 them would thus lead to infinite recursion.") |
830a17080380
(elp-not-profilable): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
38414
diff
changeset
|
220 |
67188
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
221 (defun elp-profilable-p (fun) |
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
222 (and (symbolp fun) |
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
223 (fboundp fun) |
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
224 (not (or (memq fun elp-not-profilable) |
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
225 (keymapp fun) |
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
226 (memq (car-safe (symbol-function fun)) '(autoload macro)) |
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
227 (condition-case nil |
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
228 (when (subrp (indirect-function fun)) |
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
229 (eq 'unevalled |
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
230 (cdr (subr-arity (indirect-function fun))))) |
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
231 (error nil)))))) |
41177
830a17080380
(elp-not-profilable): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
38414
diff
changeset
|
232 |
17527
2f06477dce5d
(elp-report-limit): Change prompt string.
Richard M. Stallman <rms@gnu.org>
parents:
17424
diff
changeset
|
233 |
8745 | 234 ;;;###autoload |
8735 | 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: ") | |
17419
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
239 ;; restore the function. this is necessary to avoid infinite |
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
240 ;; recursion of already instrumented functions (i.e. elp-wrapper |
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
241 ;; 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
|
242 ;; 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
|
243 ;; 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
|
244 ;; 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
|
245 ;; 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
|
246 ;; definition. |
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
247 (elp-restore-function funsym) |
8735 | 248 (let* ((funguts (symbol-function funsym)) |
249 (infovec (vector 0 0 funguts)) | |
250 (newguts '(lambda (&rest args)))) | |
8744 | 251 ;; we cannot profile macros |
252 (and (eq (car-safe funguts) 'macro) | |
17419
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
253 (error "ELP cannot profile macro: %s" funsym)) |
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
254 ;; 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
|
255 ;; 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
|
256 ;; 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
|
257 ;; 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
|
258 ;; 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
|
259 ;; 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
|
260 ;; 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
|
261 (and (eq (car-safe funguts) 'autoload) |
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
262 (error "ELP cannot profile autoloaded function: %s" funsym)) |
67188
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
263 ;; We cannot profile functions used internally during profiling. |
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
264 (unless (elp-profilable-p funsym) |
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
265 (error "ELP cannot profile the function: %s" funsym)) |
8735 | 266 ;; put rest of newguts together |
267 (if (commandp funsym) | |
268 (setq newguts (append newguts '((interactive))))) | |
41177
830a17080380
(elp-not-profilable): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
38414
diff
changeset
|
269 (setq newguts (append newguts `((elp-wrapper |
830a17080380
(elp-not-profilable): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
38414
diff
changeset
|
270 (quote ,funsym) |
830a17080380
(elp-not-profilable): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
38414
diff
changeset
|
271 ,(when (commandp funsym) |
105371
0769a73f1d18
* image-mode.el (image-toggle-display):
Juanma Barranquero <lekktu@gmail.com>
parents:
104973
diff
changeset
|
272 '(called-interactively-p 'any)) |
41177
830a17080380
(elp-not-profilable): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
38414
diff
changeset
|
273 args)))) |
8735 | 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 ;; | |
285 ;; The 1st element is the total amount of time in usecs that have | |
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 | |
37785
908fb90452ba
(elp-instrument-function): Handle advised
Gerd Moellmann <gerd@gnu.org>
parents:
37730
diff
changeset
|
296 ;; 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
|
297 ;; elp-wrapper. |
908fb90452ba
(elp-instrument-function): Handle advised
Gerd Moellmann <gerd@gnu.org>
parents:
37730
diff
changeset
|
298 (let ((advice-info (get funsym 'ad-advice-info))) |
908fb90452ba
(elp-instrument-function): Handle advised
Gerd Moellmann <gerd@gnu.org>
parents:
37730
diff
changeset
|
299 (if advice-info |
908fb90452ba
(elp-instrument-function): Handle advised
Gerd Moellmann <gerd@gnu.org>
parents:
37730
diff
changeset
|
300 (progn |
908fb90452ba
(elp-instrument-function): Handle advised
Gerd Moellmann <gerd@gnu.org>
parents:
37730
diff
changeset
|
301 ;; If function is advised, don't let Advice change |
908fb90452ba
(elp-instrument-function): Handle advised
Gerd Moellmann <gerd@gnu.org>
parents:
37730
diff
changeset
|
302 ;; its definition from under us during the `fset'. |
908fb90452ba
(elp-instrument-function): Handle advised
Gerd Moellmann <gerd@gnu.org>
parents:
37730
diff
changeset
|
303 (put funsym 'ad-advice-info nil) |
908fb90452ba
(elp-instrument-function): Handle advised
Gerd Moellmann <gerd@gnu.org>
parents:
37730
diff
changeset
|
304 (fset funsym newguts) |
908fb90452ba
(elp-instrument-function): Handle advised
Gerd Moellmann <gerd@gnu.org>
parents:
37730
diff
changeset
|
305 (put funsym 'ad-advice-info advice-info)) |
908fb90452ba
(elp-instrument-function): Handle advised
Gerd Moellmann <gerd@gnu.org>
parents:
37730
diff
changeset
|
306 (fset funsym newguts))) |
8735 | 307 |
308 ;; add this function to the instrumentation list | |
41177
830a17080380
(elp-not-profilable): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
38414
diff
changeset
|
309 (unless (memq funsym elp-all-instrumented-list) |
830a17080380
(elp-not-profilable): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
38414
diff
changeset
|
310 (push funsym elp-all-instrumented-list)))) |
8735 | 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 | |
17419
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
334 ;; 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
|
335 ;; byte-compiled version, while the function was instrumented and |
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
336 ;; 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
|
337 ;; the case that a lisp function can be compiled instrumented? |
8735 | 338 (and info |
17420
782c3dac70b1
(elp-functionp): Definitions deleted; use functionp.
Richard M. Stallman <rms@gnu.org>
parents:
17419
diff
changeset
|
339 (functionp funsym) |
29211
88e33ac31c14
(elp-restore-function): Don't use obsolete byte-code-function-p.
Dave Love <fx@gnu.org>
parents:
21172
diff
changeset
|
340 (not (byte-code-function-p (symbol-function funsym))) |
8735 | 341 (assq 'elp-wrapper (symbol-function funsym)) |
342 (fset funsym (aref info 2))))) | |
343 | |
8745 | 344 ;;;###autoload |
8735 | 345 (defun elp-instrument-list (&optional list) |
99872
7784aa29294b
(elp-instrument-list): Check argument type explicitly. Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents:
94655
diff
changeset
|
346 "Instrument, for profiling, all functions in `elp-function-list'. |
7784aa29294b
(elp-instrument-list): Check argument type explicitly. Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents:
94655
diff
changeset
|
347 Use optional LIST if provided instead. |
7784aa29294b
(elp-instrument-list): Check argument type explicitly. Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents:
94655
diff
changeset
|
348 If called interactively, read LIST using the minibuffer." |
8735 | 349 (interactive "PList of functions to instrument: ") |
99872
7784aa29294b
(elp-instrument-list): Check argument type explicitly. Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents:
94655
diff
changeset
|
350 (unless (listp list) |
99878
684861183d28
* emacs-lisp/elp.el (elp-instrument-list): Fix 2nd arg of `signal'.
Juanma Barranquero <lekktu@gmail.com>
parents:
99872
diff
changeset
|
351 (signal 'wrong-type-argument (list 'listp list))) |
8735 | 352 (let ((list (or list elp-function-list))) |
353 (mapcar 'elp-instrument-function list))) | |
354 | |
8745 | 355 ;;;###autoload |
8744 | 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" | |
67188
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
361 (interactive |
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
362 (list (completing-read "Prefix of package to instrument: " |
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
363 obarray 'elp-profilable-p))) |
37730
76d0f25cf1a3
(elp-instrument-package): Don't allow empty prefixes.
Eli Zaretskii <eliz@gnu.org>
parents:
33128
diff
changeset
|
364 (if (zerop (length prefix)) |
38414
67b464da13ec
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
37785
diff
changeset
|
365 (error "Instrumenting all Emacs functions would render Emacs unusable")) |
8744 | 366 (elp-instrument-list |
17527
2f06477dce5d
(elp-report-limit): Change prompt string.
Richard M. Stallman <rms@gnu.org>
parents:
17424
diff
changeset
|
367 (mapcar |
2f06477dce5d
(elp-report-limit): Change prompt string.
Richard M. Stallman <rms@gnu.org>
parents:
17424
diff
changeset
|
368 'intern |
67188
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
369 (all-completions prefix obarray 'elp-profilable-p)))) |
8744 | 370 |
8735 | 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 () | |
79287
8a5d09fbdaa1
(elp-report-limit, elp-restore-all, elp-unset-master, elp-results): Fix typos.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
379 "Restore the original definitions of all functions being profiled." |
8735 | 380 (interactive) |
381 (elp-restore-list elp-all-instrumented-list)) | |
382 | |
383 | |
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 | |
38414
67b464da13ec
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
37785
diff
changeset
|
389 (error "%s is not instrumented for profiling" funsym)) |
8735 | 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 () | |
79287
8a5d09fbdaa1
(elp-report-limit, elp-restore-all, elp-unset-master, elp-results): Fix typos.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
419 "Unset the master function." |
10234
170c4c188d4f
(elp-pack-number): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8745
diff
changeset
|
420 (interactive) |
8735 | 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 | |
17419
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
426 (defsubst elp-elapsed-time (start end) |
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
427 (+ (* (- (car end) (car start)) 65536.0) |
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
428 (- (car (cdr end)) (car (cdr start))) |
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
429 (/ (- (car (cdr (cdr end))) (car (cdr (cdr start)))) 1000000.0))) |
8735 | 430 |
431 (defun elp-wrapper (funsym interactive-p args) | |
432 "This function has been instrumented for profiling by the ELP. | |
433 ELP is the Emacs Lisp Profiler. To restore the function to its | |
434 original definition, use \\[elp-restore-function] or \\[elp-restore-all]." | |
435 ;; turn on recording if this is the master function | |
436 (if (and elp-master | |
437 (eq funsym elp-master)) | |
438 (setq elp-record-p t)) | |
439 ;; get info vector and original function symbol | |
440 (let* ((info (get funsym elp-timer-info-property)) | |
441 (func (aref info 2)) | |
442 result) | |
443 (or func | |
38414
67b464da13ec
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
37785
diff
changeset
|
444 (error "%s is not instrumented for profiling" funsym)) |
8735 | 445 (if (not elp-record-p) |
446 ;; when not recording, just call the original function symbol | |
447 ;; and return the results. | |
448 (setq result | |
449 (if interactive-p | |
450 (call-interactively func) | |
451 (apply func args))) | |
452 ;; we are recording times | |
17419
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
453 (let (enter-time exit-time) |
8735 | 454 ;; increment the call-counter |
455 (aset info 0 (1+ (aref info 0))) | |
456 ;; now call the old symbol function, checking to see if it | |
457 ;; should be called interactively. make sure we return the | |
458 ;; correct value | |
17419
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
459 (if interactive-p |
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
460 (setq enter-time (current-time) |
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
461 result (call-interactively func) |
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
462 exit-time (current-time)) |
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
463 (setq enter-time (current-time) |
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
464 result (apply func args) |
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
465 exit-time (current-time))) |
8735 | 466 ;; calculate total time in function |
17419
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
467 (aset info 1 (+ (aref info 1) (elp-elapsed-time enter-time exit-time))) |
8735 | 468 )) |
469 ;; turn off recording if this is the master function | |
470 (if (and elp-master | |
471 (eq funsym elp-master)) | |
472 (setq elp-record-p nil)) | |
473 result)) | |
474 | |
475 | |
476 ;; shut the byte-compiler up | |
477 (defvar elp-field-len nil) | |
478 (defvar elp-cc-len nil) | |
479 (defvar elp-at-len nil) | |
480 (defvar elp-et-len nil) | |
481 | |
482 (defun elp-sort-by-call-count (vec1 vec2) | |
483 ;; sort by highest call count. See `sort'. | |
484 (>= (aref vec1 0) (aref vec2 0))) | |
485 | |
486 (defun elp-sort-by-total-time (vec1 vec2) | |
487 ;; sort by highest total time spent in function. See `sort'. | |
488 (>= (aref vec1 1) (aref vec2 1))) | |
489 | |
490 (defun elp-sort-by-average-time (vec1 vec2) | |
491 ;; sort by highest average time spent in function. See `sort'. | |
492 (>= (aref vec1 2) (aref vec2 2))) | |
493 | |
10234
170c4c188d4f
(elp-pack-number): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8745
diff
changeset
|
494 (defsubst elp-pack-number (number width) |
170c4c188d4f
(elp-pack-number): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8745
diff
changeset
|
495 ;; 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
|
496 ;; very small or large numbers |
170c4c188d4f
(elp-pack-number): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8745
diff
changeset
|
497 (if (<= (length number) width) |
170c4c188d4f
(elp-pack-number): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8745
diff
changeset
|
498 number |
170c4c188d4f
(elp-pack-number): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8745
diff
changeset
|
499 ;; check for very large or small numbers |
170c4c188d4f
(elp-pack-number): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8745
diff
changeset
|
500 (if (string-match "^\\(.*\\)\\(e[+-].*\\)$" number) |
170c4c188d4f
(elp-pack-number): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8745
diff
changeset
|
501 (concat (substring |
67188
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
502 (match-string 1 number) |
10234
170c4c188d4f
(elp-pack-number): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8745
diff
changeset
|
503 0 |
170c4c188d4f
(elp-pack-number): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8745
diff
changeset
|
504 (- width (match-end 2) (- (match-beginning 2)) 3)) |
170c4c188d4f
(elp-pack-number): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8745
diff
changeset
|
505 "..." |
67188
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
506 (match-string 2 number)) |
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
507 (substring number 0 width)))) |
10234
170c4c188d4f
(elp-pack-number): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8745
diff
changeset
|
508 |
8735 | 509 (defun elp-output-result (resultvec) |
510 ;; output the RESULTVEC into the results buffer. RESULTVEC is a 4 or | |
511 ;; more element vector where aref 0 is the call count, aref 1 is the | |
512 ;; total time spent in the function, aref 2 is the average time | |
513 ;; spent in the function, and aref 3 is the symbol's string | |
514 ;; name. All other elements in the vector are ignored. | |
515 (let* ((cc (aref resultvec 0)) | |
516 (tt (aref resultvec 1)) | |
517 (at (aref resultvec 2)) | |
518 (symname (aref resultvec 3)) | |
519 callcnt totaltime avetime) | |
520 (setq callcnt (number-to-string cc) | |
521 totaltime (number-to-string tt) | |
522 avetime (number-to-string at)) | |
8744 | 523 ;; possibly prune the results |
524 (if (and elp-report-limit | |
525 (numberp elp-report-limit) | |
526 (< cc elp-report-limit)) | |
527 nil | |
56711
eee6cc3fe45e
(elp-results-symname-map): New keymap.
Masatake YAMATO <jet@gyve.org>
parents:
52401
diff
changeset
|
528 (elp-output-insert-symname symname) |
8744 | 529 (insert-char 32 (+ elp-field-len (- (length symname)) 2)) |
530 ;; print stuff out, formatting it nicely | |
531 (insert callcnt) | |
532 (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
|
533 (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
|
534 (atstr (elp-pack-number avetime elp-at-len))) |
170c4c188d4f
(elp-pack-number): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8745
diff
changeset
|
535 (insert ttstr) |
170c4c188d4f
(elp-pack-number): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8745
diff
changeset
|
536 (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
|
537 (insert atstr)) |
8744 | 538 (insert "\n")))) |
8735 | 539 |
56711
eee6cc3fe45e
(elp-results-symname-map): New keymap.
Masatake YAMATO <jet@gyve.org>
parents:
52401
diff
changeset
|
540 (defvar elp-results-symname-map |
eee6cc3fe45e
(elp-results-symname-map): New keymap.
Masatake YAMATO <jet@gyve.org>
parents:
52401
diff
changeset
|
541 (let ((map (make-sparse-keymap))) |
67188
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
542 (define-key map [mouse-2] 'elp-results-jump-to-definition) |
101716
79f16674b60b
(elp-results-symname-map): Add follow-link.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
543 (define-key map [follow-link] 'mouse-face) |
56711
eee6cc3fe45e
(elp-results-symname-map): New keymap.
Masatake YAMATO <jet@gyve.org>
parents:
52401
diff
changeset
|
544 (define-key map "\C-m" 'elp-results-jump-to-definition) |
eee6cc3fe45e
(elp-results-symname-map): New keymap.
Masatake YAMATO <jet@gyve.org>
parents:
52401
diff
changeset
|
545 map) |
eee6cc3fe45e
(elp-results-symname-map): New keymap.
Masatake YAMATO <jet@gyve.org>
parents:
52401
diff
changeset
|
546 "Keymap used on the function name column." ) |
eee6cc3fe45e
(elp-results-symname-map): New keymap.
Masatake YAMATO <jet@gyve.org>
parents:
52401
diff
changeset
|
547 |
67188
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
548 (defun elp-results-jump-to-definition (&optional event) |
56711
eee6cc3fe45e
(elp-results-symname-map): New keymap.
Masatake YAMATO <jet@gyve.org>
parents:
52401
diff
changeset
|
549 "Jump to the definition of the function under the point." |
67188
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
550 (interactive (list last-nonmenu-event)) |
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
551 (if event (posn-set-point (event-end event))) |
56711
eee6cc3fe45e
(elp-results-symname-map): New keymap.
Masatake YAMATO <jet@gyve.org>
parents:
52401
diff
changeset
|
552 (find-function (get-text-property (point) 'elp-symname))) |
eee6cc3fe45e
(elp-results-symname-map): New keymap.
Masatake YAMATO <jet@gyve.org>
parents:
52401
diff
changeset
|
553 |
eee6cc3fe45e
(elp-results-symname-map): New keymap.
Masatake YAMATO <jet@gyve.org>
parents:
52401
diff
changeset
|
554 (defun elp-output-insert-symname (symname) |
eee6cc3fe45e
(elp-results-symname-map): New keymap.
Masatake YAMATO <jet@gyve.org>
parents:
52401
diff
changeset
|
555 ;; Insert SYMNAME with text properties. |
eee6cc3fe45e
(elp-results-symname-map): New keymap.
Masatake YAMATO <jet@gyve.org>
parents:
52401
diff
changeset
|
556 (insert (propertize symname |
eee6cc3fe45e
(elp-results-symname-map): New keymap.
Masatake YAMATO <jet@gyve.org>
parents:
52401
diff
changeset
|
557 'elp-symname (intern symname) |
eee6cc3fe45e
(elp-results-symname-map): New keymap.
Masatake YAMATO <jet@gyve.org>
parents:
52401
diff
changeset
|
558 'keymap elp-results-symname-map |
eee6cc3fe45e
(elp-results-symname-map): New keymap.
Masatake YAMATO <jet@gyve.org>
parents:
52401
diff
changeset
|
559 'mouse-face 'highlight |
103552
0d7c31bf0a29
(elp-output-insert-symname): Add a link face to make it obvious item
Dan Nicolaescu <dann@ics.uci.edu>
parents:
101716
diff
changeset
|
560 'face 'link |
67188
25c21897d6a9
(elp-not-profilable): Replace interactive-p with called-interactively-p.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64751
diff
changeset
|
561 'help-echo "mouse-2 or RET jumps to definition"))) |
56711
eee6cc3fe45e
(elp-results-symname-map): New keymap.
Masatake YAMATO <jet@gyve.org>
parents:
52401
diff
changeset
|
562 |
8745 | 563 ;;;###autoload |
8735 | 564 (defun elp-results () |
565 "Display current profiling results. | |
566 If `elp-reset-after-results' is non-nil, then current profiling | |
79287
8a5d09fbdaa1
(elp-report-limit, elp-restore-all, elp-unset-master, elp-results): Fix typos.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
567 information for all instrumented functions is reset after results are |
8735 | 568 displayed." |
569 (interactive) | |
570 (let ((curbuf (current-buffer)) | |
17419
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
571 (resultsbuf (if elp-recycle-buffers-p |
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
572 (get-buffer-create elp-results-buffer) |
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
573 (generate-new-buffer elp-results-buffer)))) |
8735 | 574 (set-buffer resultsbuf) |
575 (erase-buffer) | |
576 ;; get the length of the longest function name being profiled | |
577 (let* ((longest 0) | |
578 (title "Function Name") | |
579 (titlelen (length title)) | |
580 (elp-field-len titlelen) | |
581 (cc-header "Call Count") | |
582 (elp-cc-len (length cc-header)) | |
583 (et-header "Elapsed Time") | |
584 (elp-et-len (length et-header)) | |
585 (at-header "Average Time") | |
586 (elp-at-len (length at-header)) | |
587 (resvec | |
588 (mapcar | |
589 (function | |
590 (lambda (funsym) | |
591 (let* ((info (get funsym elp-timer-info-property)) | |
592 (symname (format "%s" funsym)) | |
593 (cc (aref info 0)) | |
594 (tt (aref info 1))) | |
595 (if (not info) | |
596 (insert "No profiling information found for: " | |
597 symname) | |
598 (setq longest (max longest (length symname))) | |
599 (vector cc tt (if (zerop cc) | |
600 0.0 ;avoid arithmetic div-by-zero errors | |
601 (/ (float tt) (float cc))) | |
602 symname))))) | |
603 elp-all-instrumented-list)) | |
604 ) ; end let* | |
87511
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
605 ;; If printing to stdout, insert the header so it will print. |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
606 ;; Otherwise use header-line-format. |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
607 (setq elp-field-len (max titlelen longest)) |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
608 (if (or elp-use-standard-output noninteractive) |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
609 (progn |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
610 (insert title) |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
611 (if (> longest titlelen) |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
612 (progn |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
613 (insert-char 32 (- longest titlelen)))) |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
614 (insert " " cc-header " " et-header " " at-header "\n") |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
615 (insert-char ?= elp-field-len) |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
616 (insert " ") |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
617 (insert-char ?= elp-cc-len) |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
618 (insert " ") |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
619 (insert-char ?= elp-et-len) |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
620 (insert " ") |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
621 (insert-char ?= elp-at-len) |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
622 (insert "\n")) |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
623 (let ((column 0)) |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
624 (setq header-line-format |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
625 (mapconcat |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
626 (lambda (title) |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
627 (prog1 |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
628 (concat |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
629 (propertize " " |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
630 'display (list 'space :align-to column) |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
631 'face 'fixed-pitch) |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
632 title) |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
633 (setq column (+ column 1 |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
634 (if (= column 0) |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
635 elp-field-len |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
636 (length title)))))) |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
637 (list title cc-header et-header at-header) "")))) |
8735 | 638 ;; if sorting is enabled, then sort the results list. in either |
639 ;; case, call elp-output-result to output the result in the | |
640 ;; buffer | |
641 (if elp-sort-by-function | |
642 (setq resvec (sort resvec elp-sort-by-function))) | |
84900
38183e606be5
(elp-results): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
643 (mapc 'elp-output-result resvec)) |
8735 | 644 ;; now pop up results buffer |
645 (set-buffer curbuf) | |
646 (pop-to-buffer resultsbuf) | |
17419
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
647 ;; copy results to standard-output? |
c9f73399244c
(elp-functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14858
diff
changeset
|
648 (if (or elp-use-standard-output noninteractive) |
87511
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
649 (princ (buffer-substring (point-min) (point-max))) |
b8ae06eabc33
(elp-results): Use header-line-format for header. Move point to the start of
Nick Roberts <nickrob@snap.net.nz>
parents:
85973
diff
changeset
|
650 (goto-char (point-min))) |
8735 | 651 ;; reset profiling info if desired |
652 (and elp-reset-after-results | |
653 (elp-reset-all)))) | |
33095 | 654 |
85833
efa76b2f6668
(elp-unload-hook): Remove function and variable.
Juanma Barranquero <lekktu@gmail.com>
parents:
84900
diff
changeset
|
655 (defun elp-unload-function () |
efa76b2f6668
(elp-unload-hook): Remove function and variable.
Juanma Barranquero <lekktu@gmail.com>
parents:
84900
diff
changeset
|
656 "Unload the Emacs Lisp Profiler." |
efa76b2f6668
(elp-unload-hook): Remove function and variable.
Juanma Barranquero <lekktu@gmail.com>
parents:
84900
diff
changeset
|
657 (elp-restore-all) |
efa76b2f6668
(elp-unload-hook): Remove function and variable.
Juanma Barranquero <lekktu@gmail.com>
parents:
84900
diff
changeset
|
658 ;; continue standard unloading |
efa76b2f6668
(elp-unload-hook): Remove function and variable.
Juanma Barranquero <lekktu@gmail.com>
parents:
84900
diff
changeset
|
659 nil) |
8735 | 660 |
661 (provide 'elp) | |
10263 | 662 |
38414
67b464da13ec
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
37785
diff
changeset
|
663 ;;; elp.el ends here |