Fix default-directory in changeset diffs after vc-print-log
[emacs.git] / lisp / emacs-lisp / elp.el
Commit [+]AuthorDateLineData
231d8498 Stefan Monnier2012-11-12 15:43:43 -05001;;; elp.el --- Emacs Lisp Profiler -*- lexical-binding: t -*-
20f5d145 Richard M. Stallman1994-09-14 09:03:27 +00002
7e09ef09 Paul Eggert2015-01-01 14:26:41 -08003;; Copyright (C) 1994-1995, 1997-1998, 2001-2015 Free Software
ab422c4d Paul Eggert2013-01-01 09:11:05 +00004;; Foundation, Inc.
c0fd04c8 Richard M. Stallman1994-09-14 20:21:36 +00005
60370d40 Pavel Janík2001-07-15 19:53:53 +00006;; Author: Barry A. Warsaw
34dc21db Glenn Morris2014-02-09 17:34:22 -08007;; Maintainer: emacs-devel@gnu.org
60370d40
PJ
Pavel Janík2001-07-15 19:53:53 +00008;; Created: 26-Feb-1994
9;; Keywords: debugging lisp tools
20f5d145 Richard M. Stallman1994-09-14 09:03:27 +000010
c0fd04c8 Richard M. Stallman1994-09-14 20:21:36 +000011;; This file is part of GNU Emacs.
20f5d145 Richard M. Stallman1994-09-14 09:03:27 +000012
d6cba7ae Glenn Morris2008-05-06 03:21:21 +000013;; GNU Emacs is free software: you can redistribute it and/or modify
20f5d145 Richard M. Stallman1994-09-14 09:03:27 +000014;; it under the terms of the GNU General Public License as published by
d6cba7ae
GM
Glenn Morris2008-05-06 03:21:21 +000015;; the Free Software Foundation, either version 3 of the License, or
16;; (at your option) any later version.
c0fd04c8
RS
Richard M. Stallman1994-09-14 20:21:36 +000017
18;; GNU Emacs is distributed in the hope that it will be useful,
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +000019;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
20f5d145 Richard M. Stallman1994-09-14 09:03:27 +000022
c0fd04c8 Richard M. Stallman1994-09-14 20:21:36 +000023;; You should have received a copy of the GNU General Public License
d6cba7ae Glenn Morris2008-05-06 03:21:21 +000024;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +000025
26;;; Commentary:
27;;
b96bffd7
RS
Richard M. Stallman1994-12-29 00:11:46 +000028;; If you want to profile a bunch of functions, set elp-function-list
29;; to the list of symbols, then do a M-x elp-instrument-list. This
30;; hacks those functions so that profiling information is recorded
31;; whenever they are called. To print out the current results, use
9b267eba
RS
Richard M. Stallman1997-04-12 19:14:18 +000032;; M-x elp-results. If you want output to go to standard-output
33;; instead of a separate buffer, setq elp-use-standard-output to
34;; non-nil. With elp-reset-after-results set to non-nil, profiling
35;; information will be reset whenever the results are displayed. You
36;; can also reset all profiling info at any time with M-x
37;; elp-reset-all.
c0fd04c8
RS
Richard M. Stallman1994-09-14 20:21:36 +000038;;
39;; You can also instrument all functions in a package, provided that
f2f22d26 Richard M. Stallman2001-12-27 03:23:50 +000040;; the package follows the GNU coding standard of a common textual
b96bffd7 Richard M. Stallman1994-12-29 00:11:46 +000041;; prefix. Use M-x elp-instrument-package for this.
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +000042;;
43;; If you want to sort the results, set elp-sort-by-function to some
44;; predicate function. The three most obvious choices are predefined:
45;; elp-sort-by-call-count, elp-sort-by-average-time, and
b96bffd7
RS
Richard M. Stallman1994-12-29 00:11:46 +000046;; elp-sort-by-total-time. Also, you can prune from the output, all
47;; functions that have been called fewer than a given number of times
48;; by setting elp-report-limit.
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +000049;;
50;; Elp can instrument byte-compiled functions just as easily as
c0fd04c8 Richard M. Stallman1994-09-14 20:21:36 +000051;; interpreted functions, but it cannot instrument macros. However,
5fe4899a Richard M. Stallman1994-12-24 04:27:01 +000052;; when you redefine a function (e.g. with eval-defun), you'll need to
b96bffd7
RS
Richard M. Stallman1994-12-29 00:11:46 +000053;; re-instrument it with M-x elp-instrument-function. This will also
54;; reset profiling information for that function. Elp can handle
55;; interactive functions (i.e. commands), but of course any time spent
56;; idling for user prompts will show up in the timing results.
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +000057;;
58;; You can also designate a `master' function. Profiling times will
59;; be gathered for instrumented functions only during execution of
60;; this master function. Thus, if you have some defuns like:
61;;
62;; (defun foo () (do-something-time-intensive))
63;; (defun bar () (foo))
64;; (defun baz () (bar) (foo))
65;;
66;; and you want to find out the amount of time spent in bar and foo,
5fe4899a Richard M. Stallman1994-12-24 04:27:01 +000067;; but only during execution of bar, make bar the master. The call of
b96bffd7
RS
Richard M. Stallman1994-12-29 00:11:46 +000068;; foo from baz will not add to foo's total timing sums. Use M-x
69;; elp-set-master and M-x elp-unset-master to utilize this feature.
70;; Only one master function can be set at a time.
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +000071
72;; You can restore any function's original function definition with
73;; elp-restore-function. The other instrument, restore, and reset
74;; functions are provided for symmetry.
75
5b689f60
RS
Richard M. Stallman1994-12-26 15:49:29 +000076;; Here is a list of variable you can use to customize elp:
77;; elp-function-list
78;; elp-reset-after-results
79;; elp-sort-by-function
80;; elp-report-limit
81;;
82;; Here is a list of the interactive commands you can use:
83;; elp-instrument-function
84;; elp-restore-function
85;; elp-instrument-list
86;; elp-restore-list
87;; elp-instrument-package
88;; elp-restore-all
89;; elp-reset-function
90;; elp-reset-list
91;; elp-reset-all
92;; elp-set-master
93;; elp-unset-master
94;; elp-results
5b689f60 Richard M. Stallman1994-12-26 15:49:29 +000095
b96bffd7
RS
Richard M. Stallman1994-12-29 00:11:46 +000096;; Note that there are plenty of factors that could make the times
97;; reported unreliable, including the accuracy and granularity of your
98;; system clock, and the overhead spent in lisp calculating and
99;; recording the intervals. I figure the latter is pretty constant,
100;; so while the times may not be entirely accurate, I think they'll
101;; give you a good feel for the relative amount of work spent in the
102;; various lisp routines you are profiling. Note further that times
103;; are calculated using wall-clock time, so other system load will
9b267eba Richard M. Stallman1997-04-12 19:14:18 +0000104;; affect accuracy too.
b96bffd7 Richard M. Stallman1994-12-29 00:11:46 +0000105
5b689f60
RS
Richard M. Stallman1994-12-26 15:49:29 +0000106;;; Background:
107
d83cce6d
RS
Richard M. Stallman1997-04-21 23:48:34 +0000108;; This program was inspired by the only two existing Emacs Lisp
109;; profilers that I'm aware of, Boaz Ben-Zvi's profile.el, and Root
110;; Boy Jim's profiler.el. Both were written for Emacs 18 and both were
111;; pretty good first shots at profiling, but I found that they didn't
112;; provide the functionality or interface that I wanted, so I wrote
113;; this. I've tested elp in XEmacs 19 and Emacs 19. There's no point
114;; in even trying to make this work with Emacs 18.
5b689f60
RS
Richard M. Stallman1994-12-26 15:49:29 +0000115
116;; Unlike previous profilers, elp uses Emacs 19's built-in function
117;; current-time to return interval times. This obviates the need for
118;; both an external C program and Emacs processes to communicate with
b96bffd7 Richard M. Stallman1994-12-29 00:11:46 +0000119;; such a program, and thus simplifies the package as a whole.
5fe4899a Richard M. Stallman1994-12-24 04:27:01 +0000120
9b267eba
RS
Richard M. Stallman1997-04-12 19:14:18 +0000121;; TBD:
122;; Make this act like a real profiler, so that it records time spent
123;; in all branches of execution.
124
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000125;;; Code:
126
231d8498 Stefan Monnier2012-11-12 15:43:43 -0500127(eval-when-compile (require 'cl-lib))
20f5d145 Richard M. Stallman1994-09-14 09:03:27 +0000128\f
d83cce6d Richard M. Stallman1997-04-21 23:48:34 +0000129;; start of user configuration variables
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000130;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
131
9e5b444e Richard M. Stallman1997-04-12 19:31:00 +0000132(defgroup elp nil
667ab8c4 Juanma Barranquero2005-07-04 02:44:09 +0000133 "Emacs Lisp Profiler."
9e5b444e Richard M. Stallman1997-04-12 19:31:00 +0000134 :group 'lisp)
20f5d145 Richard M. Stallman1994-09-14 09:03:27 +0000135
9e5b444e Richard M. Stallman1997-04-12 19:31:00 +0000136(defcustom elp-function-list nil
cb711556 Glenn Morris2009-07-22 02:45:34 +0000137 "List of functions to profile.
9e5b444e
RS
Richard M. Stallman1997-04-12 19:31:00 +0000138Used by the command `elp-instrument-list'."
139 :type '(repeat function)
140 :group 'elp)
141
142(defcustom elp-reset-after-results t
cb711556 Glenn Morris2009-07-22 02:45:34 +0000143 "Non-nil means reset all profiling info after results are displayed.
9e5b444e
RS
Richard M. Stallman1997-04-12 19:31:00 +0000144Results are displayed with the `elp-results' command."
145 :type 'boolean
146 :group 'elp)
20f5d145 Richard M. Stallman1994-09-14 09:03:27 +0000147
9e5b444e Richard M. Stallman1997-04-12 19:31:00 +0000148(defcustom elp-sort-by-function 'elp-sort-by-total-time
cb711556 Glenn Morris2009-07-22 02:45:34 +0000149 "Non-nil specifies ELP results sorting function.
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000150These functions are currently available:
151
231d8498
SM
Stefan Monnier2012-11-12 15:43:43 -0500152 `elp-sort-by-call-count' -- sort by the highest call count
153 `elp-sort-by-total-time' -- sort by the highest total time
154 `elp-sort-by-average-time' -- sort by the highest average times
20f5d145 Richard M. Stallman1994-09-14 09:03:27 +0000155
1cc5b8f8
JB
Juanma Barranquero2007-10-31 12:09:33 +0000156You can write your own sort function. It should adhere to the
157interface specified by the PREDICATE argument for `sort'.
158Each \"element of LIST\" is really a 4 element vector where element 0 is
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000159the call count, element 1 is the total time spent in the function,
160element 2 is the average time spent in the function, and element 3 is
9e5b444e
RS
Richard M. Stallman1997-04-12 19:31:00 +0000161the symbol's name string."
162 :type 'function
163 :group 'elp)
20f5d145 Richard M. Stallman1994-09-14 09:03:27 +0000164
9e5b444e Richard M. Stallman1997-04-12 19:31:00 +0000165(defcustom elp-report-limit 1
cb711556 Glenn Morris2009-07-22 02:45:34 +0000166 "Prevent some functions from being displayed in the results buffer.
c0fd04c8
RS
Richard M. Stallman1994-09-14 20:21:36 +0000167If a number, no function that has been called fewer than that number
168of times will be displayed in the output buffer. If nil, all
9e5b444e
RS
Richard M. Stallman1997-04-12 19:31:00 +0000169functions will be displayed."
170 :type '(choice integer
231d8498 Stefan Monnier2012-11-12 15:43:43 -0500171 (const :tag "Show All" nil))
9e5b444e Richard M. Stallman1997-04-12 19:31:00 +0000172 :group 'elp)
c0fd04c8 Richard M. Stallman1994-09-14 20:21:36 +0000173
9e5b444e Richard M. Stallman1997-04-12 19:31:00 +0000174(defcustom elp-use-standard-output nil
cb711556 Glenn Morris2009-07-22 02:45:34 +0000175 "If non-nil, output to `standard-output' instead of a buffer."
9e5b444e
RS
Richard M. Stallman1997-04-12 19:31:00 +0000176 :type 'boolean
177 :group 'elp)
9b267eba Richard M. Stallman1997-04-12 19:14:18 +0000178
9e5b444e Richard M. Stallman1997-04-12 19:31:00 +0000179(defcustom elp-recycle-buffers-p t
cb711556 Glenn Morris2009-07-22 02:45:34 +0000180 "If nil, don't recycle the `elp-results-buffer'.
9b267eba Richard M. Stallman1997-04-12 19:14:18 +0000181In other words, a new unique buffer is create every time you run
9e5b444e
RS
Richard M. Stallman1997-04-12 19:31:00 +0000182\\[elp-results]."
183 :type 'boolean
184 :group 'elp)
9b267eba Richard M. Stallman1997-04-12 19:14:18 +0000185
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000186
187;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
9b267eba Richard M. Stallman1997-04-12 19:14:18 +0000188;; end of user configuration variables
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000189
190\f
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000191(defvar elp-results-buffer "*ELP Profiling Results*"
192 "Buffer name for outputting profiling results.")
193
194(defconst elp-timer-info-property 'elp-info
195 "ELP information property name.")
196
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000197(defvar elp-record-p t
198 "Controls whether functions should record times or not.
199This variable is set by the master function.")
200
201(defvar elp-master nil
202 "Master function symbol.")
203
5848fe5c Stefan Monnier2001-11-17 00:58:21 +0000204(defvar elp-not-profilable
d9532403 Stefan Monnier2005-11-28 21:55:15 +0000205 ;; First, the functions used inside each instrumented function:
231d8498 Stefan Monnier2012-11-12 15:43:43 -0500206 '(called-interactively-p
d9532403
SM
Stefan Monnier2005-11-28 21:55:15 +0000207 ;; Then the functions used by the above functions. I used
208 ;; (delq nil (mapcar (lambda (x) (and (symbolp x) (fboundp x) x))
209 ;; (aref (symbol-function 'elp-wrapper) 2)))
210 ;; to help me find this list.
30194d4d
CY
Chong Yidong2009-09-12 01:40:11 +0000211 error call-interactively apply current-time
212 ;; Andreas Politz reports problems profiling these (Bug#4233):
213 + byte-code-function-p functionp byte-code subrp
214 indirect-function fboundp)
5848fe5c
SM
Stefan Monnier2001-11-17 00:58:21 +0000215 "List of functions that cannot be profiled.
216Those functions are used internally by the profiling code and profiling
217them would thus lead to infinite recursion.")
218
d9532403
SM
Stefan Monnier2005-11-28 21:55:15 +0000219(defun elp-profilable-p (fun)
220 (and (symbolp fun)
221 (fboundp fun)
222 (not (or (memq fun elp-not-profilable)
223 (keymapp fun)
231d8498
SM
Stefan Monnier2012-11-12 15:43:43 -0500224 (autoloadp (symbol-function fun)) ;FIXME: Why not just load it?
225 (special-form-p fun)))))
5848fe5c Stefan Monnier2001-11-17 00:58:21 +0000226
231d8498 Stefan Monnier2012-11-12 15:43:43 -0500227(defconst elp--advice-name 'ELP-instrumentation\ )
d83cce6d Richard M. Stallman1997-04-21 23:48:34 +0000228\f
62f91105 Richard M. Stallman1994-09-14 20:24:21 +0000229;;;###autoload
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000230(defun elp-instrument-function (funsym)
231 "Instrument FUNSYM for profiling.
232FUNSYM must be a symbol of a defined function."
233 (interactive "aFunction to instrument: ")
231d8498 Stefan Monnier2012-11-12 15:43:43 -0500234 (let* ((infovec (vector 0 0)))
d9532403
SM
Stefan Monnier2005-11-28 21:55:15 +0000235 ;; We cannot profile functions used internally during profiling.
236 (unless (elp-profilable-p funsym)
237 (error "ELP cannot profile the function: %s" funsym))
231d8498 Stefan Monnier2012-11-12 15:43:43 -0500238 ;; The info vector data structure is a 2 element vector. The 0th
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000239 ;; element is the call-count, i.e. the total number of times this
240 ;; function has been entered. This value is bumped up on entry to
241 ;; the function so that non-local exists are still recorded. TBD:
242 ;; I haven't tested non-local exits at all, so no guarantees.
243 ;;
3103f8b6 Paul Eggert2011-06-30 17:30:18 -0700244 ;; The 1st element is the total amount of time in seconds that has
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000245 ;; been spent inside this function. This number is added to on
246 ;; function exit.
20f5d145 Richard M. Stallman1994-09-14 09:03:27 +0000247
231d8498 Stefan Monnier2012-11-12 15:43:43 -0500248 ;; Put the info vector on the property list.
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000249 (put funsym elp-timer-info-property infovec)
250
cebf1b97 Gerd Moellmann2001-05-17 13:58:14 +0000251 ;; Set the symbol's new profiling function definition to run
231d8498
SM
Stefan Monnier2012-11-12 15:43:43 -0500252 ;; ELP wrapper.
253 (advice-add funsym :around (elp--make-wrapper funsym)
cb3a1380 Stefan Monnier2013-12-12 14:47:11 -0500254 `((name . ,elp--advice-name) (depth . -99)))))
231d8498
SM
Stefan Monnier2012-11-12 15:43:43 -0500255
256(defun elp--instrumented-p (sym)
257 (advice-member-p elp--advice-name sym))
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000258
259(defun elp-restore-function (funsym)
260 "Restore an instrumented function to its original definition.
261Argument FUNSYM is the symbol of a defined function."
231d8498
SM
Stefan Monnier2012-11-12 15:43:43 -0500262 (interactive
263 (list
264 (intern
265 (completing-read "Function to restore: " obarray
266 #'elp--instrumented-p t))))
267 ;; If the function was the master, reset the master.
268 (if (eq funsym elp-master)
269 (setq elp-master nil
270 elp-record-p t))
271
272 ;; Zap the properties.
273 (put funsym elp-timer-info-property nil)
274
275 (advice-remove funsym elp--advice-name))
20f5d145 Richard M. Stallman1994-09-14 09:03:27 +0000276
62f91105 Richard M. Stallman1994-09-14 20:24:21 +0000277;;;###autoload
20f5d145 Richard M. Stallman1994-09-14 09:03:27 +0000278(defun elp-instrument-list (&optional list)
edad5f97
CY
Chong Yidong2008-11-24 15:09:02 +0000279 "Instrument, for profiling, all functions in `elp-function-list'.
280Use optional LIST if provided instead.
281If called interactively, read LIST using the minibuffer."
231d8498 Stefan Monnier2012-11-12 15:43:43 -0500282 (interactive "PList of functions to instrument: ") ;FIXME: Doesn't work?!
edad5f97 Chong Yidong2008-11-24 15:09:02 +0000283 (unless (listp list)
19dd6a6c Juanma Barranquero2008-11-24 18:23:53 +0000284 (signal 'wrong-type-argument (list 'listp list)))
231d8498 Stefan Monnier2012-11-12 15:43:43 -0500285 (mapcar #'elp-instrument-function (or list elp-function-list)))
20f5d145 Richard M. Stallman1994-09-14 09:03:27 +0000286
62f91105 Richard M. Stallman1994-09-14 20:24:21 +0000287;;;###autoload
c0fd04c8
RS
Richard M. Stallman1994-09-14 20:21:36 +0000288(defun elp-instrument-package (prefix)
289 "Instrument for profiling, all functions which start with PREFIX.
290For example, to instrument all ELP functions, do the following:
291
292 \\[elp-instrument-package] RET elp- RET"
d9532403
SM
Stefan Monnier2005-11-28 21:55:15 +0000293 (interactive
294 (list (completing-read "Prefix of package to instrument: "
295 obarray 'elp-profilable-p)))
940cf42e Eli Zaretskii2001-05-14 17:52:12 +0000296 (if (zerop (length prefix))
60370d40 Pavel Janík2001-07-15 19:53:53 +0000297 (error "Instrumenting all Emacs functions would render Emacs unusable"))
c0fd04c8 Richard M. Stallman1994-09-14 20:21:36 +0000298 (elp-instrument-list
d83cce6d
RS
Richard M. Stallman1997-04-21 23:48:34 +0000299 (mapcar
300 'intern
d9532403 Stefan Monnier2005-11-28 21:55:15 +0000301 (all-completions prefix obarray 'elp-profilable-p))))
c0fd04c8 Richard M. Stallman1994-09-14 20:21:36 +0000302
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000303(defun elp-restore-list (&optional list)
304 "Restore the original definitions for all functions in `elp-function-list'.
305Use optional LIST if provided instead."
231d8498
SM
Stefan Monnier2012-11-12 15:43:43 -0500306 (interactive "PList of functions to restore: ") ;FIXME: Doesn't work!?
307 (mapcar #'elp-restore-function (or list elp-function-list)))
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000308
309(defun elp-restore-all ()
1cc5b8f8 Juanma Barranquero2007-10-31 12:09:33 +0000310 "Restore the original definitions of all functions being profiled."
20f5d145 Richard M. Stallman1994-09-14 09:03:27 +0000311 (interactive)
231d8498 Stefan Monnier2012-11-12 15:43:43 -0500312 (mapatoms #'elp-restore-function))
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000313\f
314(defun elp-reset-function (funsym)
315 "Reset the profiling information for FUNSYM."
316 (interactive "aFunction to reset: ")
317 (let ((info (get funsym elp-timer-info-property)))
318 (or info
60370d40 Pavel Janík2001-07-15 19:53:53 +0000319 (error "%s is not instrumented for profiling" funsym))
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000320 (aset info 0 0) ;reset call counter
321 (aset info 1 0.0) ;reset total time
322 ;; don't muck with aref 2 as that is the old symbol definition
323 ))
324
325(defun elp-reset-list (&optional list)
326 "Reset the profiling information for all functions in `elp-function-list'.
327Use optional LIST if provided instead."
231d8498 Stefan Monnier2012-11-12 15:43:43 -0500328 (interactive "PList of functions to reset: ") ;FIXME: Doesn't work!?
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000329 (let ((list (or list elp-function-list)))
330 (mapcar 'elp-reset-function list)))
331
332(defun elp-reset-all ()
333 "Reset the profiling information for all functions being profiled."
334 (interactive)
231d8498
SM
Stefan Monnier2012-11-12 15:43:43 -0500335 (mapatoms (lambda (sym)
336 (if (get sym elp-timer-info-property)
337 (elp-reset-function sym)))))
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000338
339(defun elp-set-master (funsym)
340 "Set the master function for profiling."
231d8498
SM
Stefan Monnier2012-11-12 15:43:43 -0500341 (interactive
342 (list
343 (intern
344 (completing-read "Master function: " obarray
345 #'elp--instrumented-p
346 t nil nil (if elp-master (symbol-name elp-master))))))
347 ;; When there's a master function, recording is turned off by default.
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000348 (setq elp-master funsym
349 elp-record-p nil)
231d8498
SM
Stefan Monnier2012-11-12 15:43:43 -0500350 ;; Make sure master function is instrumented.
351 (or (elp--instrumented-p funsym)
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000352 (elp-instrument-function funsym)))
353
354(defun elp-unset-master ()
1cc5b8f8 Juanma Barranquero2007-10-31 12:09:33 +0000355 "Unset the master function."
5fe4899a Richard M. Stallman1994-12-24 04:27:01 +0000356 (interactive)
231d8498 Stefan Monnier2012-11-12 15:43:43 -0500357 ;; When there's no master function, recording is turned on by default.
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000358 (setq elp-master nil
359 elp-record-p t))
360
361\f
9b267eba Richard M. Stallman1997-04-12 19:14:18 +0000362(defsubst elp-elapsed-time (start end)
3103f8b6 Paul Eggert2011-06-30 17:30:18 -0700363 (float-time (time-subtract end start)))
20f5d145 Richard M. Stallman1994-09-14 09:03:27 +0000364
231d8498
SM
Stefan Monnier2012-11-12 15:43:43 -0500365(defun elp--make-wrapper (funsym)
366 "Make the piece of advice that instruments FUNSYM."
367 (lambda (func &rest args)
368 "This function has been instrumented for profiling by the ELP.
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000369ELP is the Emacs Lisp Profiler. To restore the function to its
370original definition, use \\[elp-restore-function] or \\[elp-restore-all]."
231d8498
SM
Stefan Monnier2012-11-12 15:43:43 -0500371 ;; turn on recording if this is the master function
372 (if (and elp-master
373 (eq funsym elp-master))
374 (setq elp-record-p t))
375 ;; get info vector and original function symbol
376 (let* ((info (get funsym elp-timer-info-property))
377 result)
378 (or func
379 (error "%s is not instrumented for profiling" funsym))
380 (if (not elp-record-p)
381 ;; when not recording, just call the original function symbol
382 ;; and return the results.
383 (setq result (apply func args))
384 ;; we are recording times
385 (let (enter-time exit-time)
386 ;; increment the call-counter
387 (cl-incf (aref info 0))
9b267eba
RS
Richard M. Stallman1997-04-12 19:14:18 +0000388 (setq enter-time (current-time)
389 result (apply func args)
231d8498
SM
Stefan Monnier2012-11-12 15:43:43 -0500390 exit-time (current-time))
391 ;; calculate total time in function
392 (cl-incf (aref info 1) (elp-elapsed-time enter-time exit-time))
393 ))
394 ;; turn off recording if this is the master function
395 (if (and elp-master
396 (eq funsym elp-master))
397 (setq elp-record-p nil))
398 result)))
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000399
400\f
401;; shut the byte-compiler up
402(defvar elp-field-len nil)
403(defvar elp-cc-len nil)
404(defvar elp-at-len nil)
405(defvar elp-et-len nil)
406
407(defun elp-sort-by-call-count (vec1 vec2)
408 ;; sort by highest call count. See `sort'.
409 (>= (aref vec1 0) (aref vec2 0)))
410
411(defun elp-sort-by-total-time (vec1 vec2)
412 ;; sort by highest total time spent in function. See `sort'.
413 (>= (aref vec1 1) (aref vec2 1)))
414
415(defun elp-sort-by-average-time (vec1 vec2)
416 ;; sort by highest average time spent in function. See `sort'.
417 (>= (aref vec1 2) (aref vec2 2)))
418
5fe4899a
RS
Richard M. Stallman1994-12-24 04:27:01 +0000419(defsubst elp-pack-number (number width)
420 ;; pack the NUMBER string into WIDTH characters, watching out for
421 ;; very small or large numbers
422 (if (<= (length number) width)
423 number
424 ;; check for very large or small numbers
425 (if (string-match "^\\(.*\\)\\(e[+-].*\\)$" number)
426 (concat (substring
d9532403 Stefan Monnier2005-11-28 21:55:15 +0000427 (match-string 1 number)
5fe4899a
RS
Richard M. Stallman1994-12-24 04:27:01 +0000428 0
429 (- width (match-end 2) (- (match-beginning 2)) 3))
430 "..."
d9532403
SM
Stefan Monnier2005-11-28 21:55:15 +0000431 (match-string 2 number))
432 (substring number 0 width))))
5fe4899a Richard M. Stallman1994-12-24 04:27:01 +0000433
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000434(defun elp-output-result (resultvec)
435 ;; output the RESULTVEC into the results buffer. RESULTVEC is a 4 or
436 ;; more element vector where aref 0 is the call count, aref 1 is the
437 ;; total time spent in the function, aref 2 is the average time
438 ;; spent in the function, and aref 3 is the symbol's string
439 ;; name. All other elements in the vector are ignored.
440 (let* ((cc (aref resultvec 0))
441 (tt (aref resultvec 1))
442 (at (aref resultvec 2))
443 (symname (aref resultvec 3))
444 callcnt totaltime avetime)
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000445 (setq callcnt (number-to-string cc)
446 totaltime (number-to-string tt)
447 avetime (number-to-string at))
c0fd04c8
RS
Richard M. Stallman1994-09-14 20:21:36 +0000448 ;; possibly prune the results
449 (if (and elp-report-limit
450 (numberp elp-report-limit)
451 (< cc elp-report-limit))
452 nil
2b8d823f Masatake YAMATO2004-08-19 07:52:01 +0000453 (elp-output-insert-symname symname)
c0fd04c8
RS
Richard M. Stallman1994-09-14 20:21:36 +0000454 (insert-char 32 (+ elp-field-len (- (length symname)) 2))
455 ;; print stuff out, formatting it nicely
456 (insert callcnt)
457 (insert-char 32 (+ elp-cc-len (- (length callcnt)) 2))
5fe4899a
RS
Richard M. Stallman1994-12-24 04:27:01 +0000458 (let ((ttstr (elp-pack-number totaltime elp-et-len))
459 (atstr (elp-pack-number avetime elp-at-len)))
460 (insert ttstr)
461 (insert-char 32 (+ elp-et-len (- (length ttstr)) 2))
462 (insert atstr))
c0fd04c8 Richard M. Stallman1994-09-14 20:21:36 +0000463 (insert "\n"))))
20f5d145 Richard M. Stallman1994-09-14 09:03:27 +0000464
2b8d823f
MY
Masatake YAMATO2004-08-19 07:52:01 +0000465(defvar elp-results-symname-map
466 (let ((map (make-sparse-keymap)))
d9532403 Stefan Monnier2005-11-28 21:55:15 +0000467 (define-key map [mouse-2] 'elp-results-jump-to-definition)
53112453 Stefan Monnier2009-01-31 17:00:54 +0000468 (define-key map [follow-link] 'mouse-face)
2b8d823f
MY
Masatake YAMATO2004-08-19 07:52:01 +0000469 (define-key map "\C-m" 'elp-results-jump-to-definition)
470 map)
471 "Keymap used on the function name column." )
472
d9532403 Stefan Monnier2005-11-28 21:55:15 +0000473(defun elp-results-jump-to-definition (&optional event)
2b8d823f Masatake YAMATO2004-08-19 07:52:01 +0000474 "Jump to the definition of the function under the point."
d9532403
SM
Stefan Monnier2005-11-28 21:55:15 +0000475 (interactive (list last-nonmenu-event))
476 (if event (posn-set-point (event-end event)))
2b8d823f
MY
Masatake YAMATO2004-08-19 07:52:01 +0000477 (find-function (get-text-property (point) 'elp-symname)))
478
479(defun elp-output-insert-symname (symname)
480 ;; Insert SYMNAME with text properties.
481 (insert (propertize symname
482 'elp-symname (intern symname)
483 'keymap elp-results-symname-map
484 'mouse-face 'highlight
2764748c Dan Nicolaescu2009-06-23 05:54:33 +0000485 'face 'link
d9532403 Stefan Monnier2005-11-28 21:55:15 +0000486 'help-echo "mouse-2 or RET jumps to definition")))
2b8d823f Masatake YAMATO2004-08-19 07:52:01 +0000487
62f91105 Richard M. Stallman1994-09-14 20:24:21 +0000488;;;###autoload
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000489(defun elp-results ()
490 "Display current profiling results.
491If `elp-reset-after-results' is non-nil, then current profiling
1cc5b8f8 Juanma Barranquero2007-10-31 12:09:33 +0000492information for all instrumented functions is reset after results are
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000493displayed."
494 (interactive)
495 (let ((curbuf (current-buffer))
9b267eba
RS
Richard M. Stallman1997-04-12 19:14:18 +0000496 (resultsbuf (if elp-recycle-buffers-p
497 (get-buffer-create elp-results-buffer)
498 (generate-new-buffer elp-results-buffer))))
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000499 (set-buffer resultsbuf)
500 (erase-buffer)
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000501 ;; get the length of the longest function name being profiled
502 (let* ((longest 0)
503 (title "Function Name")
504 (titlelen (length title))
505 (elp-field-len titlelen)
506 (cc-header "Call Count")
507 (elp-cc-len (length cc-header))
508 (et-header "Elapsed Time")
509 (elp-et-len (length et-header))
510 (at-header "Average Time")
511 (elp-at-len (length at-header))
231d8498 Stefan Monnier2012-11-12 15:43:43 -0500512 (resvec '())
20f5d145 Richard M. Stallman1994-09-14 09:03:27 +0000513 ) ; end let*
231d8498
SM
Stefan Monnier2012-11-12 15:43:43 -0500514 (mapatoms
515 (lambda (funsym)
516 (when (elp--instrumented-p funsym)
517 (let* ((info (get funsym elp-timer-info-property))
518 (symname (format "%s" funsym))
519 (cc (aref info 0))
520 (tt (aref info 1)))
521 (if (not info)
522 (insert "No profiling information found for: "
523 symname)
524 (setq longest (max longest (length symname)))
525 (push
526 (vector cc tt (if (zerop cc)
527 0.0 ;avoid arithmetic div-by-zero errors
528 (/ (float tt) (float cc)))
529 symname)
530 resvec))))))
1fb7205b
NR
Nick Roberts2007-12-31 23:23:39 +0000531 ;; If printing to stdout, insert the header so it will print.
532 ;; Otherwise use header-line-format.
533 (setq elp-field-len (max titlelen longest))
534 (if (or elp-use-standard-output noninteractive)
231d8498
SM
Stefan Monnier2012-11-12 15:43:43 -0500535 (progn
536 (insert title)
537 (if (> longest titlelen)
538 (progn
539 (insert-char 32 (- longest titlelen))))
540 (insert " " cc-header " " et-header " " at-header "\n")
541 (insert-char ?= elp-field-len)
542 (insert " ")
543 (insert-char ?= elp-cc-len)
544 (insert " ")
545 (insert-char ?= elp-et-len)
546 (insert " ")
547 (insert-char ?= elp-at-len)
548 (insert "\n"))
549 (let ((column 0))
550 (setq header-line-format
551 (mapconcat
552 (lambda (title)
553 (prog1
554 (concat
555 (propertize " "
556 'display (list 'space :align-to column)
557 'face 'fixed-pitch)
558 title)
559 (setq column (+ column 2
560 (if (= column 0)
561 elp-field-len
562 (length title))))))
563 (list title cc-header et-header at-header) ""))))
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000564 ;; if sorting is enabled, then sort the results list. in either
565 ;; case, call elp-output-result to output the result in the
566 ;; buffer
567 (if elp-sort-by-function
568 (setq resvec (sort resvec elp-sort-by-function)))
9eaacc84 Juanma Barranquero2007-09-26 00:14:17 +0000569 (mapc 'elp-output-result resvec))
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000570 ;; now pop up results buffer
571 (set-buffer curbuf)
572 (pop-to-buffer resultsbuf)
9b267eba
RS
Richard M. Stallman1997-04-12 19:14:18 +0000573 ;; copy results to standard-output?
574 (if (or elp-use-standard-output noninteractive)
231d8498 Stefan Monnier2012-11-12 15:43:43 -0500575 (princ (buffer-substring (point-min) (point-max)))
1fb7205b Nick Roberts2007-12-31 23:23:39 +0000576 (goto-char (point-min)))
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000577 ;; reset profiling info if desired
578 (and elp-reset-after-results
579 (elp-reset-all))))
4edc4a39 Dave Love2000-10-31 12:05:34 +0000580
41a79faa
JB
Juanma Barranquero2007-10-31 12:46:08 +0000581(defun elp-unload-function ()
582 "Unload the Emacs Lisp Profiler."
583 (elp-restore-all)
584 ;; continue standard unloading
585 nil)
20f5d145
RS
Richard M. Stallman1994-09-14 09:03:27 +0000586\f
587(provide 'elp)
5b689f60 Richard M. Stallman1994-12-26 15:49:29 +0000588
60370d40 Pavel Janík2001-07-15 19:53:53 +0000589;;; elp.el ends here