Mercurial > emacs
comparison lisp/emacs-lisp/elp.el @ 8744:e1b824af0849
Update to 2.15.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Wed, 14 Sep 1994 20:21:36 +0000 |
parents | d1f0811de024 |
children | ebbea7d79174 |
comparison
equal
deleted
inserted
replaced
8743:03445a867bed | 8744:e1b824af0849 |
---|---|
1 ;;; elp.el --- Emacs Lisp Profiler | 1 ;;; elp.el --- Emacs Lisp Profiler |
2 | |
3 ;; Copyright (C) 1994 Free Software Foundation, Inc. | |
2 | 4 |
3 ;; Author: 1994 Barry A. Warsaw, Century Computing, Inc. <bwarsaw@cen.com> | 5 ;; Author: 1994 Barry A. Warsaw, Century Computing, Inc. <bwarsaw@cen.com> |
4 ;; Maintainer: bwarsaw@cen.com | 6 ;; Maintainer: bwarsaw@cen.com |
5 ;; Created: 26-Feb-1994 | 7 ;; Created: 26-Feb-1994 |
6 ;; Version: 2.11 | 8 ;; Version: 2.15 |
7 ;; Last Modified: 1994/06/06 22:38:07 | 9 ;; Last Modified: 1994/07/05 13:46:02 |
8 ;; Keywords: Emacs Lisp Profile Timing | 10 ;; Keywords: Emacs Lisp Profile Timing |
9 | 11 |
10 ;; Copyright (C) 1994 Barry A. Warsaw | 12 ;; This file is part of GNU Emacs. |
11 | 13 |
12 ;; This file is not yet part of GNU Emacs. | 14 ;; GNU Emacs is free software; you can redistribute it and/or modify |
13 ;; | |
14 ;; This program is free software; you can redistribute it and/or modify | |
15 ;; it under the terms of the GNU General Public License as published by | 15 ;; it under the terms of the GNU General Public License as published by |
16 ;; the Free Software Foundation; either version 2 of the License, or | 16 ;; the Free Software Foundation; either version 2, or (at your option) |
17 ;; (at your option) any later version. | 17 ;; any later version. |
18 ;; | 18 |
19 ;; This program is distributed in the hope that it will be useful, | 19 ;; GNU Emacs is distributed in the hope that it will be useful, |
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | 20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
22 ;; GNU General Public License for more details. | 22 ;; GNU General Public License for more details. |
23 ;; | 23 |
24 ;; You should have received a copy of the GNU General Public License | 24 ;; You should have received a copy of the GNU General Public License |
25 ;; along with this program; if not, write to the Free Software | 25 ;; along with GNU Emacs; see the file COPYING. If not, write to |
26 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. | 26 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. |
27 | |
28 ;; LCD Archive Entry: | |
29 ;; elp|Barry A. Warsaw|tools-help@anthem.nlm.nih.gov| | |
30 ;; Emacs Lisp Profiler| | |
31 ;; 1994/06/06 22:38:07|2.11|~/misc/elp.el.Z| | |
32 | 27 |
33 ;;; Commentary: | 28 ;;; Commentary: |
34 ;; | 29 ;; |
35 ;; This program is based on the only two existing Emacs Lisp profilers | 30 ;; This program is based on the only two existing Emacs Lisp profilers |
36 ;; that I'm aware of, Boaz Ben-Zvi's profile.el, and Root Boy Jim's | 31 ;; that I'm aware of, Boaz Ben-Zvi's profile.el, and Root Boy Jim's |
37 ;; profiler.el. Both were written for Emacs 18 and both were pretty | 32 ;; profiler.el. Both were written for Emacs 18 and both were pretty |
38 ;; good first shots at profiling, but I found that they didn't provide | 33 ;; good first shots at profiling, but I found that they didn't provide |
39 ;; the functionality or interface that I wanted. So I wrote this. | 34 ;; the functionality or interface that I wanted. So I wrote this. |
40 ;; I've tested elp in Lucid Emacs 19.9 and in Emacs 19.22. There's no | 35 ;; I've tested elp in Lucid Emacs 19.9 and Emacs 19.22. There's no |
41 ;; point in even trying to make this work with Emacs 18. | 36 ;; point in even trying to make this work with Emacs 18. |
42 | 37 |
43 ;; Unlike previous profilers, elp uses Emacs 19's built-in function | 38 ;; Unlike previous profilers, elp uses Emacs 19's built-in function |
44 ;; current-time to return interval times. This obviates the need for | 39 ;; current-time to return interval times. This obviates the need for |
45 ;; both an external C program and Emacs processes to communicate with | 40 ;; both an external C program and Emacs processes to communicate with |
65 ;; Here is a list of the interactive commands you can use: | 60 ;; Here is a list of the interactive commands you can use: |
66 ;; elp-instrument-function | 61 ;; elp-instrument-function |
67 ;; elp-restore-function | 62 ;; elp-restore-function |
68 ;; elp-instrument-list | 63 ;; elp-instrument-list |
69 ;; elp-restore-list | 64 ;; elp-restore-list |
65 ;; elp-instrument-package | |
70 ;; elp-restore-all | 66 ;; elp-restore-all |
71 ;; elp-reset-function | 67 ;; elp-reset-function |
72 ;; elp-reset-list | 68 ;; elp-reset-list |
73 ;; elp-reset-all | 69 ;; elp-reset-all |
74 ;; elp-results | 70 ;; elp-results |
78 ;; functions, set elp-function-list to the list of symbols, then call | 74 ;; functions, set elp-function-list to the list of symbols, then call |
79 ;; elp-instrument-list. This hacks the functions so that profiling | 75 ;; elp-instrument-list. This hacks the functions so that profiling |
80 ;; information is recorded whenever they are called. To print out the | 76 ;; information is recorded whenever they are called. To print out the |
81 ;; current results, use elp-results. With elp-reset-after-results set | 77 ;; current results, use elp-results. With elp-reset-after-results set |
82 ;; to non-nil, profiling information will be reset whenever the | 78 ;; to non-nil, profiling information will be reset whenever the |
83 ;; results are displayed, but you can reset all profiling info with | 79 ;; results are displayed. You can also reset all profiling info at any |
84 ;; elp-reset-all. | 80 ;; time with elp-reset-all. |
81 ;; | |
82 ;; You can also instrument all functions in a package, provided that | |
83 ;; the package follows the GNU coding standard of a common textural | |
84 ;; prefix. elp-instrument-package does this. | |
85 ;; | 85 ;; |
86 ;; If you want to sort the results, set elp-sort-by-function to some | 86 ;; If you want to sort the results, set elp-sort-by-function to some |
87 ;; predicate function. The three most obvious choices are predefined: | 87 ;; predicate function. The three most obvious choices are predefined: |
88 ;; elp-sort-by-call-count, elp-sort-by-average-time, and | 88 ;; elp-sort-by-call-count, elp-sort-by-average-time, and |
89 ;; elp-sort-by-total-time. | 89 ;; elp-sort-by-total-time. Also, you can prune from the output |
90 ;; display, all functions that have been called fewer than a given | |
91 ;; number of times by setting elp-report-limit to that number. | |
90 ;; | 92 ;; |
91 ;; Elp can instrument byte-compiled functions just as easily as | 93 ;; Elp can instrument byte-compiled functions just as easily as |
92 ;; interpreted functions. However, when you redefine a function (e.g. | 94 ;; interpreted functions, but it cannot instrument macros. However, |
93 ;; with eval-defun), you'll need to re-instrument it with | 95 ;; when you redefine a function (e.g. with eval-defun), you'll need |
94 ;; elp-instrument-function. Re-instrumenting resets profiling | 96 ;; to re-instrument it with elp-instrument-function. Re-instrumenting |
95 ;; information for that function. Elp can also handle interactive | 97 ;; resets profiling information for that function. Elp can also |
96 ;; functions (i.e. commands), but of course any time spent idling for | 98 ;; handle interactive functions (i.e. commands), but of course any |
97 ;; user prompts will show up in the timing results. | 99 ;; time spent idling for user prompts will show up in the timing |
100 ;; results. | |
98 ;; | 101 ;; |
99 ;; You can also designate a `master' function. Profiling times will | 102 ;; You can also designate a `master' function. Profiling times will |
100 ;; be gathered for instrumented functions only during execution of | 103 ;; be gathered for instrumented functions only during execution of |
101 ;; this master function. Thus, if you have some defuns like: | 104 ;; this master function. Thus, if you have some defuns like: |
102 ;; | 105 ;; |
140 \"element of LIST\" is really a 4 element vector where element 0 is | 143 \"element of LIST\" is really a 4 element vector where element 0 is |
141 the call count, element 1 is the total time spent in the function, | 144 the call count, element 1 is the total time spent in the function, |
142 element 2 is the average time spent in the function, and element 3 is | 145 element 2 is the average time spent in the function, and element 3 is |
143 the symbol's name string.") | 146 the symbol's name string.") |
144 | 147 |
148 (defvar elp-report-limit nil | |
149 "*Prevents some functions from being displayed in the results buffer. | |
150 If a number, no function that has been called fewer than that number | |
151 of times will be displayed in the output buffer. If nil, all | |
152 functions will be displayed.") | |
153 | |
145 | 154 |
146 ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ | 155 ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ |
147 ;; end user configuration variables | 156 ;; end user configuration variables |
148 | 157 |
149 | 158 |
150 (defconst elp-version "2.11" | 159 (defconst elp-version "2.15" |
151 "ELP version number.") | 160 "ELP version number.") |
152 | 161 |
153 (defconst elp-help-address "tools-help@anthem.nlm.nih.gov" | 162 (defconst elp-help-address "tools-help@anthem.nlm.nih.gov" |
154 "Address accepting submissions of bug reports and questions.") | 163 "Address accepting submissions of bug reports and questions.") |
155 | 164 |
176 (interactive "aFunction to instrument: ") | 185 (interactive "aFunction to instrument: ") |
177 ;; TBD what should we do if the function is already instrumented??? | 186 ;; TBD what should we do if the function is already instrumented??? |
178 (let* ((funguts (symbol-function funsym)) | 187 (let* ((funguts (symbol-function funsym)) |
179 (infovec (vector 0 0 funguts)) | 188 (infovec (vector 0 0 funguts)) |
180 (newguts '(lambda (&rest args)))) | 189 (newguts '(lambda (&rest args)))) |
190 ;; we cannot profile macros | |
191 (and (eq (car-safe funguts) 'macro) | |
192 (error "ELP cannot profile macro %s" funsym)) | |
181 ;; put rest of newguts together | 193 ;; put rest of newguts together |
182 (if (commandp funsym) | 194 (if (commandp funsym) |
183 (setq newguts (append newguts '((interactive))))) | 195 (setq newguts (append newguts '((interactive))))) |
184 (setq newguts (append newguts (list | 196 (setq newguts (append newguts (list |
185 (list 'elp-wrapper | 197 (list 'elp-wrapper |
253 "Instrument for profiling, all functions in `elp-function-list'. | 265 "Instrument for profiling, all functions in `elp-function-list'. |
254 Use optional LIST if provided instead." | 266 Use optional LIST if provided instead." |
255 (interactive "PList of functions to instrument: ") | 267 (interactive "PList of functions to instrument: ") |
256 (let ((list (or list elp-function-list))) | 268 (let ((list (or list elp-function-list))) |
257 (mapcar 'elp-instrument-function list))) | 269 (mapcar 'elp-instrument-function list))) |
270 | |
271 (defun elp-instrument-package (prefix) | |
272 "Instrument for profiling, all functions which start with PREFIX. | |
273 For example, to instrument all ELP functions, do the following: | |
274 | |
275 \\[elp-instrument-package] RET elp- RET" | |
276 (interactive "sPrefix of package to instrument: ") | |
277 (elp-instrument-list | |
278 (mapcar 'intern (all-completions prefix obarray | |
279 (function | |
280 (lambda (sym) | |
281 (and (fboundp sym) | |
282 (not (eq (car-safe | |
283 (symbol-function sym)) | |
284 'macro))))))))) | |
258 | 285 |
259 (defun elp-restore-list (&optional list) | 286 (defun elp-restore-list (&optional list) |
260 "Restore the original definitions for all functions in `elp-function-list'. | 287 "Restore the original definitions for all functions in `elp-function-list'. |
261 Use optional LIST if provided instead." | 288 Use optional LIST if provided instead." |
262 (interactive "PList of functions to restore: ") | 289 (interactive "PList of functions to restore: ") |
386 (let* ((cc (aref resultvec 0)) | 413 (let* ((cc (aref resultvec 0)) |
387 (tt (aref resultvec 1)) | 414 (tt (aref resultvec 1)) |
388 (at (aref resultvec 2)) | 415 (at (aref resultvec 2)) |
389 (symname (aref resultvec 3)) | 416 (symname (aref resultvec 3)) |
390 callcnt totaltime avetime) | 417 callcnt totaltime avetime) |
391 (insert symname) | |
392 (insert-char 32 (+ elp-field-len (- (length symname)) 2)) | |
393 (setq callcnt (number-to-string cc) | 418 (setq callcnt (number-to-string cc) |
394 totaltime (number-to-string tt) | 419 totaltime (number-to-string tt) |
395 avetime (number-to-string at)) | 420 avetime (number-to-string at)) |
396 ;; print stuff out, formatting it nicely | 421 ;; possibly prune the results |
397 (insert callcnt) | 422 (if (and elp-report-limit |
398 (insert-char 32 (+ elp-cc-len (- (length callcnt)) 2)) | 423 (numberp elp-report-limit) |
399 (if (> (length totaltime) elp-et-len) | 424 (< cc elp-report-limit)) |
400 (insert (substring totaltime 0 elp-et-len) " ") | 425 nil |
401 (insert totaltime) | 426 (insert symname) |
402 (insert-char 32 (+ elp-et-len (- (length totaltime)) 2))) | 427 (insert-char 32 (+ elp-field-len (- (length symname)) 2)) |
403 (if (> (length avetime) elp-at-len) | 428 ;; print stuff out, formatting it nicely |
404 (insert (substring avetime 0 elp-at-len)) | 429 (insert callcnt) |
405 (insert avetime)) | 430 (insert-char 32 (+ elp-cc-len (- (length callcnt)) 2)) |
406 (insert "\n"))) | 431 (if (> (length totaltime) elp-et-len) |
432 (insert (substring totaltime 0 elp-et-len) " ") | |
433 (insert totaltime) | |
434 (insert-char 32 (+ elp-et-len (- (length totaltime)) 2))) | |
435 (if (> (length avetime) elp-at-len) | |
436 (insert (substring avetime 0 elp-at-len)) | |
437 (insert avetime)) | |
438 (insert "\n")))) | |
407 | 439 |
408 (defun elp-results () | 440 (defun elp-results () |
409 "Display current profiling results. | 441 "Display current profiling results. |
410 If `elp-reset-after-results' is non-nil, then current profiling | 442 If `elp-reset-after-results' is non-nil, then current profiling |
411 information for all instrumented functions are reset after results are | 443 information for all instrumented functions are reset after results are |
482 (and | 514 (and |
483 (y-or-n-p "Do you want to submit a report on elp? ") | 515 (y-or-n-p "Do you want to submit a report on elp? ") |
484 (require 'reporter) | 516 (require 'reporter) |
485 (reporter-submit-bug-report | 517 (reporter-submit-bug-report |
486 elp-help-address (concat "elp " elp-version) | 518 elp-help-address (concat "elp " elp-version) |
487 '(elp-reset-after-results | 519 '(elp-report-limit |
520 elp-reset-after-results | |
488 elp-sort-by-function)))) | 521 elp-sort-by-function)))) |
489 | 522 |
490 | 523 |
491 (provide 'elp) | 524 (provide 'elp) |
525 | |
492 ;; elp.el ends here | 526 ;; elp.el ends here |
493 |