| 1 | ;;; elp.el --- Emacs Lisp Profiler |
| 2 | |
| 3 | ;; Copyright (C) 1994, 1995, 1997, 1998, 2001, 2002, 2003, 2004, |
| 4 | ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
| 5 | |
| 6 | ;; Author: Barry A. Warsaw |
| 7 | ;; Maintainer: FSF |
| 8 | ;; Created: 26-Feb-1994 |
| 9 | ;; Keywords: debugging lisp tools |
| 10 | |
| 11 | ;; This file is part of GNU Emacs. |
| 12 | |
| 13 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
| 14 | ;; it under the terms of the GNU General Public License as published by |
| 15 | ;; the Free Software Foundation, either version 3 of the License, or |
| 16 | ;; (at your option) any later version. |
| 17 | |
| 18 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 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. |
| 22 | |
| 23 | ;; You should have received a copy of the GNU General Public License |
| 24 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
| 25 | |
| 26 | ;;; Commentary: |
| 27 | ;; |
| 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 |
| 32 | ;; 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. |
| 38 | ;; |
| 39 | ;; You can also instrument all functions in a package, provided that |
| 40 | ;; the package follows the GNU coding standard of a common textual |
| 41 | ;; prefix. Use M-x elp-instrument-package for this. |
| 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 |
| 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. |
| 49 | ;; |
| 50 | ;; Elp can instrument byte-compiled functions just as easily as |
| 51 | ;; interpreted functions, but it cannot instrument macros. However, |
| 52 | ;; when you redefine a function (e.g. with eval-defun), you'll need to |
| 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. |
| 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, |
| 67 | ;; but only during execution of bar, make bar the master. The call of |
| 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. |
| 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 | |
| 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 | |
| 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 |
| 104 | ;; affect accuracy too. |
| 105 | |
| 106 | ;;; Background: |
| 107 | |
| 108 | ;; 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. |
| 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 |
| 119 | ;; such a program, and thus simplifies the package as a whole. |
| 120 | |
| 121 | ;; TBD: |
| 122 | ;; Make this act like a real profiler, so that it records time spent |
| 123 | ;; in all branches of execution. |
| 124 | |
| 125 | ;;; Code: |
| 126 | |
| 127 | \f |
| 128 | ;; start of user configuration variables |
| 129 | ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv |
| 130 | |
| 131 | (defgroup elp nil |
| 132 | "Emacs Lisp Profiler." |
| 133 | :group 'lisp) |
| 134 | |
| 135 | (defcustom elp-function-list nil |
| 136 | "*List of functions to profile. |
| 137 | Used by the command `elp-instrument-list'." |
| 138 | :type '(repeat function) |
| 139 | :group 'elp) |
| 140 | |
| 141 | (defcustom elp-reset-after-results t |
| 142 | "*Non-nil means reset all profiling info after results are displayed. |
| 143 | Results are displayed with the `elp-results' command." |
| 144 | :type 'boolean |
| 145 | :group 'elp) |
| 146 | |
| 147 | (defcustom elp-sort-by-function 'elp-sort-by-total-time |
| 148 | "*Non-nil specifies ELP results sorting function. |
| 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 | |
| 155 | You can write your own sort function. It should adhere to the |
| 156 | interface specified by the PREDICATE argument for `sort'. |
| 157 | Each \"element of LIST\" is really a 4 element vector where element 0 is |
| 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 |
| 160 | the symbol's name string." |
| 161 | :type 'function |
| 162 | :group 'elp) |
| 163 | |
| 164 | (defcustom elp-report-limit 1 |
| 165 | "*Prevent some functions from being displayed in the results buffer. |
| 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 |
| 168 | functions will be displayed." |
| 169 | :type '(choice integer |
| 170 | (const :tag "Show All" nil)) |
| 171 | :group 'elp) |
| 172 | |
| 173 | (defcustom elp-use-standard-output nil |
| 174 | "*If non-nil, output to `standard-output' instead of a buffer." |
| 175 | :type 'boolean |
| 176 | :group 'elp) |
| 177 | |
| 178 | (defcustom elp-recycle-buffers-p t |
| 179 | "*If nil, don't recycle the `elp-results-buffer'. |
| 180 | In other words, a new unique buffer is create every time you run |
| 181 | \\[elp-results]." |
| 182 | :type 'boolean |
| 183 | :group 'elp) |
| 184 | |
| 185 | |
| 186 | ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ |
| 187 | ;; end of user configuration variables |
| 188 | |
| 189 | \f |
| 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 | |
| 206 | (defvar elp-not-profilable |
| 207 | ;; First, the functions used inside each instrumented function: |
| 208 | '(elp-wrapper called-interactively-p |
| 209 | ;; Then the functions used by the above functions. I used |
| 210 | ;; (delq nil (mapcar (lambda (x) (and (symbolp x) (fboundp x) x)) |
| 211 | ;; (aref (symbol-function 'elp-wrapper) 2))) |
| 212 | ;; to help me find this list. |
| 213 | error call-interactively apply current-time) |
| 214 | "List of functions that cannot be profiled. |
| 215 | Those functions are used internally by the profiling code and profiling |
| 216 | them would thus lead to infinite recursion.") |
| 217 | |
| 218 | (defun elp-profilable-p (fun) |
| 219 | (and (symbolp fun) |
| 220 | (fboundp fun) |
| 221 | (not (or (memq fun elp-not-profilable) |
| 222 | (keymapp fun) |
| 223 | (memq (car-safe (symbol-function fun)) '(autoload macro)) |
| 224 | (condition-case nil |
| 225 | (when (subrp (indirect-function fun)) |
| 226 | (eq 'unevalled |
| 227 | (cdr (subr-arity (indirect-function fun))))) |
| 228 | (error nil)))))) |
| 229 | |
| 230 | \f |
| 231 | ;;;###autoload |
| 232 | (defun elp-instrument-function (funsym) |
| 233 | "Instrument FUNSYM for profiling. |
| 234 | FUNSYM must be a symbol of a defined function." |
| 235 | (interactive "aFunction to instrument: ") |
| 236 | ;; restore the function. this is necessary to avoid infinite |
| 237 | ;; recursion of already instrumented functions (i.e. elp-wrapper |
| 238 | ;; calling elp-wrapper ad infinitum). it is better to simply |
| 239 | ;; restore the function than to throw an error. this will work |
| 240 | ;; properly in the face of eval-defun because if the function was |
| 241 | ;; redefined, only the timer info will be nil'd out since |
| 242 | ;; elp-restore-function is smart enough not to trash the new |
| 243 | ;; definition. |
| 244 | (elp-restore-function funsym) |
| 245 | (let* ((funguts (symbol-function funsym)) |
| 246 | (infovec (vector 0 0 funguts)) |
| 247 | (newguts '(lambda (&rest args)))) |
| 248 | ;; we cannot profile macros |
| 249 | (and (eq (car-safe funguts) 'macro) |
| 250 | (error "ELP cannot profile macro: %s" funsym)) |
| 251 | ;; TBD: at some point it might be better to load the autoloaded |
| 252 | ;; function instead of throwing an error. if we do this, then we |
| 253 | ;; probably want elp-instrument-package to be updated with the |
| 254 | ;; newly loaded list of functions. i'm not sure it's smart to do |
| 255 | ;; the autoload here, since that could have side effects, and |
| 256 | ;; elp-instrument-function is similar (in my mind) to defun-ish |
| 257 | ;; type functionality (i.e. it shouldn't execute the function). |
| 258 | (and (eq (car-safe funguts) 'autoload) |
| 259 | (error "ELP cannot profile autoloaded function: %s" funsym)) |
| 260 | ;; We cannot profile functions used internally during profiling. |
| 261 | (unless (elp-profilable-p funsym) |
| 262 | (error "ELP cannot profile the function: %s" funsym)) |
| 263 | ;; put rest of newguts together |
| 264 | (if (commandp funsym) |
| 265 | (setq newguts (append newguts '((interactive))))) |
| 266 | (setq newguts (append newguts `((elp-wrapper |
| 267 | (quote ,funsym) |
| 268 | ,(when (commandp funsym) |
| 269 | '(called-interactively-p)) |
| 270 | args)))) |
| 271 | ;; to record profiling times, we set the symbol's function |
| 272 | ;; definition so that it runs the elp-wrapper function with the |
| 273 | ;; function symbol as an argument. We place the old function |
| 274 | ;; definition on the info vector. |
| 275 | ;; |
| 276 | ;; The info vector data structure is a 3 element vector. The 0th |
| 277 | ;; element is the call-count, i.e. the total number of times this |
| 278 | ;; function has been entered. This value is bumped up on entry to |
| 279 | ;; the function so that non-local exists are still recorded. TBD: |
| 280 | ;; I haven't tested non-local exits at all, so no guarantees. |
| 281 | ;; |
| 282 | ;; The 1st element is the total amount of time in usecs that have |
| 283 | ;; been spent inside this function. This number is added to on |
| 284 | ;; function exit. |
| 285 | ;; |
| 286 | ;; The 2nd element is the old function definition list. This gets |
| 287 | ;; funcall'd in between start/end time retrievals. I believe that |
| 288 | ;; this lets us profile even byte-compiled functions. |
| 289 | |
| 290 | ;; put the info vector on the property list |
| 291 | (put funsym elp-timer-info-property infovec) |
| 292 | |
| 293 | ;; Set the symbol's new profiling function definition to run |
| 294 | ;; elp-wrapper. |
| 295 | (let ((advice-info (get funsym 'ad-advice-info))) |
| 296 | (if advice-info |
| 297 | (progn |
| 298 | ;; If function is advised, don't let Advice change |
| 299 | ;; its definition from under us during the `fset'. |
| 300 | (put funsym 'ad-advice-info nil) |
| 301 | (fset funsym newguts) |
| 302 | (put funsym 'ad-advice-info advice-info)) |
| 303 | (fset funsym newguts))) |
| 304 | |
| 305 | ;; add this function to the instrumentation list |
| 306 | (unless (memq funsym elp-all-instrumented-list) |
| 307 | (push funsym elp-all-instrumented-list)))) |
| 308 | |
| 309 | (defun elp-restore-function (funsym) |
| 310 | "Restore an instrumented function to its original definition. |
| 311 | Argument FUNSYM is the symbol of a defined function." |
| 312 | (interactive "aFunction to restore: ") |
| 313 | (let ((info (get funsym elp-timer-info-property))) |
| 314 | ;; delete the function from the all instrumented list |
| 315 | (setq elp-all-instrumented-list |
| 316 | (delq funsym elp-all-instrumented-list)) |
| 317 | |
| 318 | ;; if the function was the master, reset the master |
| 319 | (if (eq funsym elp-master) |
| 320 | (setq elp-master nil |
| 321 | elp-record-p t)) |
| 322 | |
| 323 | ;; zap the properties |
| 324 | (put funsym elp-timer-info-property nil) |
| 325 | |
| 326 | ;; restore the original function definition, but if the function |
| 327 | ;; wasn't instrumented do nothing. we do this after the above |
| 328 | ;; because its possible the function got un-instrumented due to |
| 329 | ;; circumstances beyond our control. Also, check to make sure |
| 330 | ;; that the current function symbol points to elp-wrapper. If |
| 331 | ;; not, then the user probably did an eval-defun, or loaded a |
| 332 | ;; byte-compiled version, while the function was instrumented and |
| 333 | ;; we don't want to destroy the new definition. can it ever be |
| 334 | ;; the case that a lisp function can be compiled instrumented? |
| 335 | (and info |
| 336 | (functionp funsym) |
| 337 | (not (byte-code-function-p (symbol-function funsym))) |
| 338 | (assq 'elp-wrapper (symbol-function funsym)) |
| 339 | (fset funsym (aref info 2))))) |
| 340 | |
| 341 | ;;;###autoload |
| 342 | (defun elp-instrument-list (&optional list) |
| 343 | "Instrument for profiling, all functions in `elp-function-list'. |
| 344 | Use optional LIST if provided instead." |
| 345 | (interactive "PList of functions to instrument: ") |
| 346 | (let ((list (or list elp-function-list))) |
| 347 | (mapcar 'elp-instrument-function list))) |
| 348 | |
| 349 | ;;;###autoload |
| 350 | (defun elp-instrument-package (prefix) |
| 351 | "Instrument for profiling, all functions which start with PREFIX. |
| 352 | For example, to instrument all ELP functions, do the following: |
| 353 | |
| 354 | \\[elp-instrument-package] RET elp- RET" |
| 355 | (interactive |
| 356 | (list (completing-read "Prefix of package to instrument: " |
| 357 | obarray 'elp-profilable-p))) |
| 358 | (if (zerop (length prefix)) |
| 359 | (error "Instrumenting all Emacs functions would render Emacs unusable")) |
| 360 | (elp-instrument-list |
| 361 | (mapcar |
| 362 | 'intern |
| 363 | (all-completions prefix obarray 'elp-profilable-p)))) |
| 364 | |
| 365 | (defun elp-restore-list (&optional list) |
| 366 | "Restore the original definitions for all functions in `elp-function-list'. |
| 367 | Use optional LIST if provided instead." |
| 368 | (interactive "PList of functions to restore: ") |
| 369 | (let ((list (or list elp-function-list))) |
| 370 | (mapcar 'elp-restore-function list))) |
| 371 | |
| 372 | (defun elp-restore-all () |
| 373 | "Restore the original definitions of all functions being profiled." |
| 374 | (interactive) |
| 375 | (elp-restore-list elp-all-instrumented-list)) |
| 376 | |
| 377 | \f |
| 378 | (defun elp-reset-function (funsym) |
| 379 | "Reset the profiling information for FUNSYM." |
| 380 | (interactive "aFunction to reset: ") |
| 381 | (let ((info (get funsym elp-timer-info-property))) |
| 382 | (or info |
| 383 | (error "%s is not instrumented for profiling" funsym)) |
| 384 | (aset info 0 0) ;reset call counter |
| 385 | (aset info 1 0.0) ;reset total time |
| 386 | ;; don't muck with aref 2 as that is the old symbol definition |
| 387 | )) |
| 388 | |
| 389 | (defun elp-reset-list (&optional list) |
| 390 | "Reset the profiling information for all functions in `elp-function-list'. |
| 391 | Use optional LIST if provided instead." |
| 392 | (interactive "PList of functions to reset: ") |
| 393 | (let ((list (or list elp-function-list))) |
| 394 | (mapcar 'elp-reset-function list))) |
| 395 | |
| 396 | (defun elp-reset-all () |
| 397 | "Reset the profiling information for all functions being profiled." |
| 398 | (interactive) |
| 399 | (elp-reset-list elp-all-instrumented-list)) |
| 400 | |
| 401 | (defun elp-set-master (funsym) |
| 402 | "Set the master function for profiling." |
| 403 | (interactive "aMaster function: ") |
| 404 | ;; when there's a master function, recording is turned off by |
| 405 | ;; default |
| 406 | (setq elp-master funsym |
| 407 | elp-record-p nil) |
| 408 | ;; make sure master function is instrumented |
| 409 | (or (memq funsym elp-all-instrumented-list) |
| 410 | (elp-instrument-function funsym))) |
| 411 | |
| 412 | (defun elp-unset-master () |
| 413 | "Unset the master function." |
| 414 | (interactive) |
| 415 | ;; when there's no master function, recording is turned on by default. |
| 416 | (setq elp-master nil |
| 417 | elp-record-p t)) |
| 418 | |
| 419 | \f |
| 420 | (defsubst elp-elapsed-time (start end) |
| 421 | (+ (* (- (car end) (car start)) 65536.0) |
| 422 | (- (car (cdr end)) (car (cdr start))) |
| 423 | (/ (- (car (cdr (cdr end))) (car (cdr (cdr start)))) 1000000.0))) |
| 424 | |
| 425 | (defun elp-wrapper (funsym interactive-p args) |
| 426 | "This function has been instrumented for profiling by the ELP. |
| 427 | ELP is the Emacs Lisp Profiler. To restore the function to its |
| 428 | original definition, use \\[elp-restore-function] or \\[elp-restore-all]." |
| 429 | ;; turn on recording if this is the master function |
| 430 | (if (and elp-master |
| 431 | (eq funsym elp-master)) |
| 432 | (setq elp-record-p t)) |
| 433 | ;; get info vector and original function symbol |
| 434 | (let* ((info (get funsym elp-timer-info-property)) |
| 435 | (func (aref info 2)) |
| 436 | result) |
| 437 | (or func |
| 438 | (error "%s is not instrumented for profiling" funsym)) |
| 439 | (if (not elp-record-p) |
| 440 | ;; when not recording, just call the original function symbol |
| 441 | ;; and return the results. |
| 442 | (setq result |
| 443 | (if interactive-p |
| 444 | (call-interactively func) |
| 445 | (apply func args))) |
| 446 | ;; we are recording times |
| 447 | (let (enter-time exit-time) |
| 448 | ;; increment the call-counter |
| 449 | (aset info 0 (1+ (aref info 0))) |
| 450 | ;; now call the old symbol function, checking to see if it |
| 451 | ;; should be called interactively. make sure we return the |
| 452 | ;; correct value |
| 453 | (if interactive-p |
| 454 | (setq enter-time (current-time) |
| 455 | result (call-interactively func) |
| 456 | exit-time (current-time)) |
| 457 | (setq enter-time (current-time) |
| 458 | result (apply func args) |
| 459 | exit-time (current-time))) |
| 460 | ;; calculate total time in function |
| 461 | (aset info 1 (+ (aref info 1) (elp-elapsed-time enter-time exit-time))) |
| 462 | )) |
| 463 | ;; turn off recording if this is the master function |
| 464 | (if (and elp-master |
| 465 | (eq funsym elp-master)) |
| 466 | (setq elp-record-p nil)) |
| 467 | result)) |
| 468 | |
| 469 | \f |
| 470 | ;; shut the byte-compiler up |
| 471 | (defvar elp-field-len nil) |
| 472 | (defvar elp-cc-len nil) |
| 473 | (defvar elp-at-len nil) |
| 474 | (defvar elp-et-len nil) |
| 475 | |
| 476 | (defun elp-sort-by-call-count (vec1 vec2) |
| 477 | ;; sort by highest call count. See `sort'. |
| 478 | (>= (aref vec1 0) (aref vec2 0))) |
| 479 | |
| 480 | (defun elp-sort-by-total-time (vec1 vec2) |
| 481 | ;; sort by highest total time spent in function. See `sort'. |
| 482 | (>= (aref vec1 1) (aref vec2 1))) |
| 483 | |
| 484 | (defun elp-sort-by-average-time (vec1 vec2) |
| 485 | ;; sort by highest average time spent in function. See `sort'. |
| 486 | (>= (aref vec1 2) (aref vec2 2))) |
| 487 | |
| 488 | (defsubst elp-pack-number (number width) |
| 489 | ;; pack the NUMBER string into WIDTH characters, watching out for |
| 490 | ;; very small or large numbers |
| 491 | (if (<= (length number) width) |
| 492 | number |
| 493 | ;; check for very large or small numbers |
| 494 | (if (string-match "^\\(.*\\)\\(e[+-].*\\)$" number) |
| 495 | (concat (substring |
| 496 | (match-string 1 number) |
| 497 | 0 |
| 498 | (- width (match-end 2) (- (match-beginning 2)) 3)) |
| 499 | "..." |
| 500 | (match-string 2 number)) |
| 501 | (substring number 0 width)))) |
| 502 | |
| 503 | (defun elp-output-result (resultvec) |
| 504 | ;; output the RESULTVEC into the results buffer. RESULTVEC is a 4 or |
| 505 | ;; more element vector where aref 0 is the call count, aref 1 is the |
| 506 | ;; total time spent in the function, aref 2 is the average time |
| 507 | ;; spent in the function, and aref 3 is the symbol's string |
| 508 | ;; name. All other elements in the vector are ignored. |
| 509 | (let* ((cc (aref resultvec 0)) |
| 510 | (tt (aref resultvec 1)) |
| 511 | (at (aref resultvec 2)) |
| 512 | (symname (aref resultvec 3)) |
| 513 | callcnt totaltime avetime) |
| 514 | (setq callcnt (number-to-string cc) |
| 515 | totaltime (number-to-string tt) |
| 516 | avetime (number-to-string at)) |
| 517 | ;; possibly prune the results |
| 518 | (if (and elp-report-limit |
| 519 | (numberp elp-report-limit) |
| 520 | (< cc elp-report-limit)) |
| 521 | nil |
| 522 | (elp-output-insert-symname symname) |
| 523 | (insert-char 32 (+ elp-field-len (- (length symname)) 2)) |
| 524 | ;; print stuff out, formatting it nicely |
| 525 | (insert callcnt) |
| 526 | (insert-char 32 (+ elp-cc-len (- (length callcnt)) 2)) |
| 527 | (let ((ttstr (elp-pack-number totaltime elp-et-len)) |
| 528 | (atstr (elp-pack-number avetime elp-at-len))) |
| 529 | (insert ttstr) |
| 530 | (insert-char 32 (+ elp-et-len (- (length ttstr)) 2)) |
| 531 | (insert atstr)) |
| 532 | (insert "\n")))) |
| 533 | |
| 534 | (defvar elp-results-symname-map |
| 535 | (let ((map (make-sparse-keymap))) |
| 536 | (define-key map [mouse-2] 'elp-results-jump-to-definition) |
| 537 | (define-key map "\C-m" 'elp-results-jump-to-definition) |
| 538 | map) |
| 539 | "Keymap used on the function name column." ) |
| 540 | |
| 541 | (defun elp-results-jump-to-definition (&optional event) |
| 542 | "Jump to the definition of the function under the point." |
| 543 | (interactive (list last-nonmenu-event)) |
| 544 | (if event (posn-set-point (event-end event))) |
| 545 | (find-function (get-text-property (point) 'elp-symname))) |
| 546 | |
| 547 | (defun elp-output-insert-symname (symname) |
| 548 | ;; Insert SYMNAME with text properties. |
| 549 | (insert (propertize symname |
| 550 | 'elp-symname (intern symname) |
| 551 | 'keymap elp-results-symname-map |
| 552 | 'mouse-face 'highlight |
| 553 | 'help-echo "mouse-2 or RET jumps to definition"))) |
| 554 | |
| 555 | ;;;###autoload |
| 556 | (defun elp-results () |
| 557 | "Display current profiling results. |
| 558 | If `elp-reset-after-results' is non-nil, then current profiling |
| 559 | information for all instrumented functions is reset after results are |
| 560 | displayed." |
| 561 | (interactive) |
| 562 | (let ((curbuf (current-buffer)) |
| 563 | (resultsbuf (if elp-recycle-buffers-p |
| 564 | (get-buffer-create elp-results-buffer) |
| 565 | (generate-new-buffer elp-results-buffer)))) |
| 566 | (set-buffer resultsbuf) |
| 567 | (erase-buffer) |
| 568 | ;; get the length of the longest function name being profiled |
| 569 | (let* ((longest 0) |
| 570 | (title "Function Name") |
| 571 | (titlelen (length title)) |
| 572 | (elp-field-len titlelen) |
| 573 | (cc-header "Call Count") |
| 574 | (elp-cc-len (length cc-header)) |
| 575 | (et-header "Elapsed Time") |
| 576 | (elp-et-len (length et-header)) |
| 577 | (at-header "Average Time") |
| 578 | (elp-at-len (length at-header)) |
| 579 | (resvec |
| 580 | (mapcar |
| 581 | (function |
| 582 | (lambda (funsym) |
| 583 | (let* ((info (get funsym elp-timer-info-property)) |
| 584 | (symname (format "%s" funsym)) |
| 585 | (cc (aref info 0)) |
| 586 | (tt (aref info 1))) |
| 587 | (if (not info) |
| 588 | (insert "No profiling information found for: " |
| 589 | symname) |
| 590 | (setq longest (max longest (length symname))) |
| 591 | (vector cc tt (if (zerop cc) |
| 592 | 0.0 ;avoid arithmetic div-by-zero errors |
| 593 | (/ (float tt) (float cc))) |
| 594 | symname))))) |
| 595 | elp-all-instrumented-list)) |
| 596 | ) ; end let* |
| 597 | ;; If printing to stdout, insert the header so it will print. |
| 598 | ;; Otherwise use header-line-format. |
| 599 | (setq elp-field-len (max titlelen longest)) |
| 600 | (if (or elp-use-standard-output noninteractive) |
| 601 | (progn |
| 602 | (insert title) |
| 603 | (if (> longest titlelen) |
| 604 | (progn |
| 605 | (insert-char 32 (- longest titlelen)))) |
| 606 | (insert " " cc-header " " et-header " " at-header "\n") |
| 607 | (insert-char ?= elp-field-len) |
| 608 | (insert " ") |
| 609 | (insert-char ?= elp-cc-len) |
| 610 | (insert " ") |
| 611 | (insert-char ?= elp-et-len) |
| 612 | (insert " ") |
| 613 | (insert-char ?= elp-at-len) |
| 614 | (insert "\n")) |
| 615 | (let ((column 0)) |
| 616 | (setq header-line-format |
| 617 | (mapconcat |
| 618 | (lambda (title) |
| 619 | (prog1 |
| 620 | (concat |
| 621 | (propertize " " |
| 622 | 'display (list 'space :align-to column) |
| 623 | 'face 'fixed-pitch) |
| 624 | title) |
| 625 | (setq column (+ column 1 |
| 626 | (if (= column 0) |
| 627 | elp-field-len |
| 628 | (length title)))))) |
| 629 | (list title cc-header et-header at-header) "")))) |
| 630 | ;; if sorting is enabled, then sort the results list. in either |
| 631 | ;; case, call elp-output-result to output the result in the |
| 632 | ;; buffer |
| 633 | (if elp-sort-by-function |
| 634 | (setq resvec (sort resvec elp-sort-by-function))) |
| 635 | (mapc 'elp-output-result resvec)) |
| 636 | ;; now pop up results buffer |
| 637 | (set-buffer curbuf) |
| 638 | (pop-to-buffer resultsbuf) |
| 639 | ;; copy results to standard-output? |
| 640 | (if (or elp-use-standard-output noninteractive) |
| 641 | (princ (buffer-substring (point-min) (point-max))) |
| 642 | (goto-char (point-min))) |
| 643 | ;; reset profiling info if desired |
| 644 | (and elp-reset-after-results |
| 645 | (elp-reset-all)))) |
| 646 | |
| 647 | (defun elp-unload-function () |
| 648 | "Unload the Emacs Lisp Profiler." |
| 649 | (elp-restore-all) |
| 650 | ;; continue standard unloading |
| 651 | nil) |
| 652 | \f |
| 653 | (provide 'elp) |
| 654 | |
| 655 | ;; arch-tag: c4eef311-9b3e-4bb2-8a54-3485d41b4eb1 |
| 656 | ;;; elp.el ends here |