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