Tweak previous change
[bpt/emacs.git] / lisp / profiler.el
CommitLineData
c2d7786e
TM
1;;; profiler.el --- UI and helper functions for Emacs's native profiler -*- lexical-binding: t -*-
2
ab422c4d 3;; Copyright (C) 2012-2013 Free Software Foundation, Inc.
c2d7786e
TM
4
5;; Author: Tomohiro Matsuyama <tomo@cx4a.org>
6;; Keywords: lisp
7
b011a6e8
GM
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software: you can redistribute it and/or modify
c2d7786e
TM
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation, either version 3 of the License, or
13;; (at your option) any later version.
14
b011a6e8 15;; GNU Emacs is distributed in the hope that it will be useful,
c2d7786e
TM
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
b011a6e8 21;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
c2d7786e
TM
22
23;;; Commentary:
24
114d4d84 25;; See Info node `(elisp)Profiling'.
c2d7786e
TM
26
27;;; Code:
28
c22bac2c 29(require 'cl-lib)
c2d7786e
TM
30
31(defgroup profiler nil
32 "Emacs profiler."
33 :group 'lisp
d1a1c7e6 34 :version "24.3"
c2d7786e
TM
35 :prefix "profiler-")
36
c22bac2c
TM
37(defconst profiler-version "24.3")
38
b3ecad33
PE
39(defcustom profiler-sampling-interval 1000000
40 "Default sampling interval in nanoseconds."
3d80c99f
SM
41 :type 'integer
42 :group 'profiler)
43
c22bac2c 44\f
c2d7786e
TM
45;;; Utilities
46
47(defun profiler-ensure-string (object)
0efc778b
TM
48 (cond ((stringp object)
49 object)
50 ((symbolp object)
51 (symbol-name object))
52 ((numberp object)
53 (number-to-string object))
54 (t
55 (format "%s" object))))
c2d7786e 56
c22bac2c
TM
57(defun profiler-format-percent (number divisor)
58 (concat (number-to-string (/ (* number 100) divisor)) "%"))
59
60(defun profiler-format-number (number)
61 "Format NUMBER in human readable string."
62 (if (and (integerp number) (> number 0))
7a65a0b2 63 (cl-loop with i = (% (1+ (floor (log number 10))) 3)
c22bac2c
TM
64 for c in (append (number-to-string number) nil)
65 if (= i 0)
66 collect ?, into s
67 and do (setq i 3)
68 collect c into s
69 do (cl-decf i)
70 finally return
71 (apply 'string (if (eq (car s) ?,) (cdr s) s)))
72 (profiler-ensure-string number)))
73
c2d7786e 74(defun profiler-format (fmt &rest args)
b02baf7f
TM
75 (cl-loop for (width align subfmt) in fmt
76 for arg in args
12b3895d
TM
77 for str = (cond
78 ((consp subfmt)
79 (apply 'profiler-format subfmt arg))
80 ((stringp subfmt)
81 (format subfmt arg))
82 ((and (symbolp subfmt)
83 (fboundp subfmt))
84 (funcall subfmt arg))
85 (t
86 (profiler-ensure-string arg)))
b02baf7f
TM
87 for len = (length str)
88 if (< width len)
89 collect (substring str 0 width) into frags
90 else
91 collect
92 (let ((padding (make-string (- width len) ?\s)))
93 (cl-ecase align
94 (left (concat str padding))
95 (right (concat padding str))))
96 into frags
97 finally return (apply #'concat frags)))
c2d7786e 98
12b3895d 99\f
0efc778b
TM
100;;; Entries
101
c22bac2c 102(defun profiler-format-entry (entry)
0efc778b
TM
103 "Format ENTRY in human readable string. ENTRY would be a
104function name of a function itself."
3d80c99f
SM
105 (cond ((memq (car-safe entry) '(closure lambda))
106 (format "#<lambda 0x%x>" (sxhash entry)))
107 ((byte-code-function-p entry)
0efc778b 108 (format "#<compiled 0x%x>" (sxhash entry)))
3d80c99f
SM
109 ((or (subrp entry) (symbolp entry) (stringp entry))
110 (format "%s" entry))
0efc778b
TM
111 (t
112 (format "#<unknown 0x%x>" (sxhash entry)))))
12b3895d 113
c22bac2c
TM
114(defun profiler-fixup-entry (entry)
115 (if (symbolp entry)
116 entry
117 (profiler-format-entry entry)))
118
119\f
120;;; Backtraces
121
122(defun profiler-fixup-backtrace (backtrace)
123 (apply 'vector (mapcar 'profiler-fixup-entry backtrace)))
124
125\f
126;;; Logs
c2d7786e 127
3d80c99f
SM
128;; The C code returns the log in the form of a hash-table where the keys are
129;; vectors (of size profiler-max-stack-depth, holding truncated
130;; backtraces, where the first element is the top of the stack) and
131;; the values are integers (which count how many times this backtrace
132;; has been seen, multiplied by a "weight factor" which is either the
c22bac2c
TM
133;; sampling-interval or the memory being allocated).
134
135(defun profiler-compare-logs (log1 log2)
136 "Compare LOG1 with LOG2 and return diff."
3d80c99f
SM
137 (let ((newlog (make-hash-table :test 'equal)))
138 ;; Make a copy of `log1' into `newlog'.
139 (maphash (lambda (backtrace count) (puthash backtrace count newlog))
140 log1)
3d80c99f 141 (maphash (lambda (backtrace count)
c22bac2c
TM
142 (puthash backtrace (- (gethash backtrace log1 0) count)
143 newlog))
3d80c99f
SM
144 log2)
145 newlog))
c2d7786e 146
c22bac2c 147(defun profiler-fixup-log (log)
3d80c99f
SM
148 (let ((newlog (make-hash-table :test 'equal)))
149 (maphash (lambda (backtrace count)
c22bac2c 150 (puthash (profiler-fixup-backtrace backtrace)
3d80c99f
SM
151 count newlog))
152 log)
153 newlog))
0efc778b 154
c22bac2c
TM
155\f
156;;; Profiles
157
158(cl-defstruct (profiler-profile (:type vector)
159 (:constructor profiler-make-profile))
160 (tag 'profiler-profile)
161 (version profiler-version)
162 ;; - `type' has a value indicating the kind of profile (`memory' or `cpu').
163 ;; - `log' indicates the profile log.
164 ;; - `timestamp' has a value giving the time when the profile was obtained.
165 ;; - `diff-p' indicates if this profile represents a diff between two profiles.
166 type log timestamp diff-p)
167
168(defun profiler-compare-profiles (profile1 profile2)
169 "Compare PROFILE1 with PROFILE2 and return diff."
170 (unless (eq (profiler-profile-type profile1)
171 (profiler-profile-type profile2))
172 (error "Can't compare different type of profiles"))
173 (profiler-make-profile
174 :type (profiler-profile-type profile1)
175 :timestamp (current-time)
176 :diff-p t
177 :log (profiler-compare-logs
178 (profiler-profile-log profile1)
179 (profiler-profile-log profile2))))
180
181(defun profiler-fixup-profile (profile)
182 "Fixup PROFILE so that the profile could be serialized into file."
183 (profiler-make-profile
184 :type (profiler-profile-type profile)
185 :timestamp (profiler-profile-timestamp profile)
186 :diff-p (profiler-profile-diff-p profile)
187 :log (profiler-fixup-log (profiler-profile-log profile))))
188
189(defun profiler-write-profile (profile filename &optional confirm)
190 "Write PROFILE into file FILENAME."
0efc778b
TM
191 (with-temp-buffer
192 (let (print-level print-length)
c22bac2c
TM
193 (print (profiler-fixup-profile profile)
194 (current-buffer)))
0efc778b 195 (write-file filename confirm)))
c2d7786e 196
c22bac2c
TM
197(defun profiler-read-profile (filename)
198 "Read profile from file FILENAME."
199 ;; FIXME: tag and version check
0efc778b
TM
200 (with-temp-buffer
201 (insert-file-contents filename)
202 (goto-char (point-min))
203 (read (current-buffer))))
c2d7786e 204
15df6fa4
GM
205(defun profiler-running-p (&optional mode)
206 "Return non-nil if the profiler is running.
207Optional argument MODE means only check for the specified mode (cpu or mem)."
208 (cond ((eq mode 'cpu) (and (fboundp 'profiler-cpu-running-p)
209 (profiler-cpu-running-p)))
210 ((eq mode 'mem) (profiler-memory-running-p))
211 (t (or (profiler-running-p 'cpu)
212 (profiler-running-p 'mem)))))
213
c22bac2c
TM
214(defun profiler-cpu-profile ()
215 "Return CPU profile."
15df6fa4 216 (when (profiler-running-p 'cpu)
c22bac2c
TM
217 (profiler-make-profile
218 :type 'cpu
219 :timestamp (current-time)
220 :log (profiler-cpu-log))))
221
222(defun profiler-memory-profile ()
223 "Return memory profile."
224 (when (profiler-memory-running-p)
225 (profiler-make-profile
226 :type 'memory
227 :timestamp (current-time)
228 :log (profiler-memory-log))))
229
0efc778b 230\f
c22bac2c 231;;; Calltrees
c2d7786e 232
b02baf7f 233(cl-defstruct (profiler-calltree (:constructor profiler-make-calltree))
c2d7786e 234 entry
0efc778b 235 (count 0) (count-percent "")
c2d7786e
TM
236 parent children)
237
238(defun profiler-calltree-leaf-p (tree)
239 (null (profiler-calltree-children tree)))
240
241(defun profiler-calltree-count< (a b)
242 (cond ((eq (profiler-calltree-entry a) t) t)
243 ((eq (profiler-calltree-entry b) t) nil)
244 (t (< (profiler-calltree-count a)
245 (profiler-calltree-count b)))))
246
247(defun profiler-calltree-count> (a b)
248 (not (profiler-calltree-count< a b)))
249
c2d7786e
TM
250(defun profiler-calltree-depth (tree)
251 (let ((parent (profiler-calltree-parent tree)))
252 (if (null parent)
253 0
254 (1+ (profiler-calltree-depth parent)))))
255
256(defun profiler-calltree-find (tree entry)
0efc778b 257 "Return a child tree of ENTRY under TREE."
0efc778b 258 (let (result (children (profiler-calltree-children tree)))
3d80c99f 259 ;; FIXME: Use `assoc'.
0efc778b
TM
260 (while (and children (null result))
261 (let ((child (car children)))
3d80c99f 262 (when (equal (profiler-calltree-entry child) entry)
0efc778b
TM
263 (setq result child))
264 (setq children (cdr children))))
265 result))
266
3d80c99f
SM
267(defun profiler-calltree-walk (calltree function)
268 (funcall function calltree)
c2d7786e 269 (dolist (child (profiler-calltree-children calltree))
3d80c99f 270 (profiler-calltree-walk child function)))
c2d7786e
TM
271
272(defun profiler-calltree-build-1 (tree log &optional reverse)
3a880af4
SM
273 ;; FIXME: Do a better job of reconstructing a complete call-tree
274 ;; when the backtraces have been truncated. Ideally, we should be
275 ;; able to reduce profiler-max-stack-depth to 3 or 4 and still
276 ;; get a meaningful call-tree.
3d80c99f
SM
277 (maphash
278 (lambda (backtrace count)
c22bac2c
TM
279 (let ((node tree)
280 (max (length backtrace)))
281 (dotimes (i max)
282 (let ((entry (aref backtrace (if reverse i (- max i 1)))))
283 (when entry
284 (let ((child (profiler-calltree-find node entry)))
285 (unless child
286 (setq child (profiler-make-calltree
287 :entry entry :parent node))
288 (push child (profiler-calltree-children node)))
289 (cl-incf (profiler-calltree-count child) count)
290 (setq node child)))))))
3d80c99f 291 log))
0efc778b 292
c2d7786e 293(defun profiler-calltree-compute-percentages (tree)
3d80c99f 294 (let ((total-count 0))
ad942b63 295 ;; FIXME: the memory profiler's total wraps around all too easily!
c2d7786e 296 (dolist (child (profiler-calltree-children tree))
3d80c99f
SM
297 (cl-incf total-count (profiler-calltree-count child)))
298 (unless (zerop total-count)
299 (profiler-calltree-walk
300 tree (lambda (node)
301 (setf (profiler-calltree-count-percent node)
302 (profiler-format-percent (profiler-calltree-count node)
303 total-count)))))))
c2d7786e 304
b02baf7f 305(cl-defun profiler-calltree-build (log &key reverse)
c2d7786e
TM
306 (let ((tree (profiler-make-calltree)))
307 (profiler-calltree-build-1 tree log reverse)
308 (profiler-calltree-compute-percentages tree)
309 tree))
310
311(defun profiler-calltree-sort (tree predicate)
312 (let ((children (profiler-calltree-children tree)))
313 (setf (profiler-calltree-children tree) (sort children predicate))
314 (dolist (child (profiler-calltree-children tree))
315 (profiler-calltree-sort child predicate))))
316
317\f
c2d7786e
TM
318;;; Report rendering
319
320(defcustom profiler-report-closed-mark "+"
321 "An indicator of closed calltrees."
322 :type 'string
323 :group 'profiler)
324
325(defcustom profiler-report-open-mark "-"
326 "An indicator of open calltrees."
327 :type 'string
328 :group 'profiler)
329
330(defcustom profiler-report-leaf-mark " "
331 "An indicator of calltree leaves."
332 :type 'string
333 :group 'profiler)
334
c22bac2c 335(defvar profiler-report-cpu-line-format
b3ecad33
PE
336 '((50 left)
337 (24 right ((19 right)
c2d7786e
TM
338 (5 right)))))
339
340(defvar profiler-report-memory-line-format
12b3895d 341 '((55 left)
c22bac2c 342 (19 right ((14 right profiler-format-number)
c2d7786e
TM
343 (5 right)))))
344
c22bac2c
TM
345(defvar-local profiler-report-profile nil
346 "The current profile.")
0efc778b 347
3d80c99f 348(defvar-local profiler-report-reversed nil
0efc778b
TM
349 "True if calltree is rendered in bottom-up. Do not touch this
350variable directly.")
351
3d80c99f 352(defvar-local profiler-report-order nil
0efc778b
TM
353 "The value can be `ascending' or `descending'. Do not touch
354this variable directly.")
c2d7786e
TM
355
356(defun profiler-report-make-entry-part (entry)
0efc778b
TM
357 (let ((string (cond
358 ((eq entry t)
359 "Others")
0efc778b
TM
360 ((and (symbolp entry)
361 (fboundp entry))
362 (propertize (symbol-name entry)
363 'face 'link
364 'mouse-face 'highlight
d069271c
EZ
365 'help-echo "\
366mouse-2: jump to definition\n\
367RET: expand or collapse"))
0efc778b 368 (t
c22bac2c 369 (profiler-format-entry entry)))))
3d80c99f 370 (propertize string 'profiler-entry entry)))
c2d7786e
TM
371
372(defun profiler-report-make-name-part (tree)
373 (let* ((entry (profiler-calltree-entry tree))
374 (depth (profiler-calltree-depth tree))
375 (indent (make-string (* (1- depth) 2) ?\s))
376 (mark (if (profiler-calltree-leaf-p tree)
377 profiler-report-leaf-mark
378 profiler-report-closed-mark))
379 (entry (profiler-report-make-entry-part entry)))
380 (format "%s%s %s" indent mark entry)))
381
382(defun profiler-report-header-line-format (fmt &rest args)
383 (let* ((header (apply 'profiler-format fmt args))
384 (escaped (replace-regexp-in-string "%" "%%" header)))
385 (concat " " escaped)))
386
387(defun profiler-report-line-format (tree)
c22bac2c 388 (let ((diff-p (profiler-profile-diff-p profiler-report-profile))
c2d7786e 389 (name-part (profiler-report-make-name-part tree))
c2d7786e
TM
390 (count (profiler-calltree-count tree))
391 (count-percent (profiler-calltree-count-percent tree)))
c22bac2c
TM
392 (profiler-format (cl-ecase (profiler-profile-type profiler-report-profile)
393 (cpu profiler-report-cpu-line-format)
3d80c99f
SM
394 (memory profiler-report-memory-line-format))
395 name-part
396 (if diff-p
397 (list (if (> count 0)
398 (format "+%s" count)
399 count)
400 "")
401 (list count count-percent)))))
c2d7786e
TM
402
403(defun profiler-report-insert-calltree (tree)
404 (let ((line (profiler-report-line-format tree)))
405 (insert (propertize (concat line "\n") 'calltree tree))))
406
407(defun profiler-report-insert-calltree-children (tree)
408 (mapc 'profiler-report-insert-calltree
409 (profiler-calltree-children tree)))
410
411\f
c2d7786e
TM
412;;; Report mode
413
414(defvar profiler-report-mode-map
415 (let ((map (make-sparse-keymap)))
416 (define-key map "n" 'profiler-report-next-entry)
417 (define-key map "p" 'profiler-report-previous-entry)
3d80c99f
SM
418 ;; I find it annoying more than helpful to not be able to navigate
419 ;; normally with the cursor keys. --Stef
420 ;; (define-key map [down] 'profiler-report-next-entry)
421 ;; (define-key map [up] 'profiler-report-previous-entry)
c2d7786e
TM
422 (define-key map "\r" 'profiler-report-toggle-entry)
423 (define-key map "\t" 'profiler-report-toggle-entry)
424 (define-key map "i" 'profiler-report-toggle-entry)
425 (define-key map "f" 'profiler-report-find-entry)
426 (define-key map "j" 'profiler-report-find-entry)
427 (define-key map [mouse-2] 'profiler-report-find-entry)
428 (define-key map "d" 'profiler-report-describe-entry)
429 (define-key map "C" 'profiler-report-render-calltree)
430 (define-key map "B" 'profiler-report-render-reversed-calltree)
431 (define-key map "A" 'profiler-report-ascending-sort)
432 (define-key map "D" 'profiler-report-descending-sort)
c22bac2c
TM
433 (define-key map "=" 'profiler-report-compare-profile)
434 (define-key map (kbd "C-x C-w") 'profiler-report-write-profile)
b0636be7
GM
435 (easy-menu-define profiler-report-menu map "Menu for Profiler Report mode."
436 '("Profiler"
437 ["Next Entry" profiler-report-next-entry :active t
438 :help "Move to next entry"]
439 ["Previous Entry" profiler-report-previous-entry :active t
440 :help "Move to previous entry"]
441 "--"
442 ["Toggle Entry" profiler-report-toggle-entry
443 :active (profiler-report-calltree-at-point)
444 :help "Expand or collapse the current entry"]
445 ["Find Entry" profiler-report-find-entry
446 ;; FIXME should deactivate if not on a known function.
447 :active (profiler-report-calltree-at-point)
448 :help "Find the definition of the current entry"]
449 ["Describe Entry" profiler-report-describe-entry
450 :active (profiler-report-calltree-at-point)
451 :help "Show the documentation of the current entry"]
452 "--"
453 ["Show Calltree" profiler-report-render-calltree
454 :active profiler-report-reversed
455 :help "Show calltree view"]
456 ["Show Reversed Calltree" profiler-report-render-reversed-calltree
457 :active (not profiler-report-reversed)
458 :help "Show reversed calltree view"]
459 ["Sort Ascending" profiler-report-ascending-sort
460 :active (not (eq profiler-report-order 'ascending))
461 :help "Sort calltree view in ascending order"]
462 ["Sort Descending" profiler-report-descending-sort
463 :active (not (eq profiler-report-order 'descending))
464 :help "Sort calltree view in descending order"]
465 "--"
466 ["Compare Profile..." profiler-report-compare-profile :active t
467 :help "Compare current profile with another"]
468 ["Write Profile..." profiler-report-write-profile :active t
15df6fa4
GM
469 :help "Write current profile to a file"]
470 "--"
ed746aa7
GM
471 ["Start Profiler" profiler-start :active (not (profiler-running-p))
472 :help "Start profiling"]
15df6fa4
GM
473 ["Stop Profiler" profiler-stop :active (profiler-running-p)
474 :help "Stop profiling"]
475 ["New Report" profiler-report :active (profiler-running-p)
476 :help "Make a new report"]))
b0636be7
GM
477 map)
478 "Keymap for `profiler-report-mode'.")
c2d7786e 479
c22bac2c 480(defun profiler-report-make-buffer-name (profile)
3d80c99f 481 (format "*%s-Profiler-Report %s*"
c22bac2c
TM
482 (cl-ecase (profiler-profile-type profile) (cpu 'CPU) (memory 'Memory))
483 (format-time-string "%Y-%m-%d %T" (profiler-profile-timestamp profile))))
c2d7786e 484
c22bac2c
TM
485(defun profiler-report-setup-buffer-1 (profile)
486 "Make a buffer for PROFILE and return it."
487 (let* ((buf-name (profiler-report-make-buffer-name profile))
c2d7786e
TM
488 (buffer (get-buffer-create buf-name)))
489 (with-current-buffer buffer
490 (profiler-report-mode)
c22bac2c 491 (setq profiler-report-profile profile
c2d7786e
TM
492 profiler-report-reversed nil
493 profiler-report-order 'descending))
494 buffer))
495
c22bac2c
TM
496(defun profiler-report-setup-buffer (profile)
497 "Make a buffer for PROFILE with rendering the profile and
498return it."
499 (let ((buffer (profiler-report-setup-buffer-1 profile)))
500 (with-current-buffer buffer
501 (profiler-report-render-calltree))
502 buffer))
503
c2d7786e
TM
504(define-derived-mode profiler-report-mode special-mode "Profiler-Report"
505 "Profiler Report Mode."
c2d7786e
TM
506 (setq buffer-read-only t
507 buffer-undo-list t
508 truncate-lines t))
509
510\f
c2d7786e
TM
511;;; Report commands
512
c22bac2c
TM
513(defun profiler-report-calltree-at-point (&optional point)
514 (get-text-property (or point (point)) 'calltree))
c2d7786e
TM
515
516(defun profiler-report-move-to-entry ()
c22bac2c
TM
517 (let ((point (next-single-property-change
518 (line-beginning-position) 'profiler-entry)))
c2d7786e
TM
519 (if point
520 (goto-char point)
521 (back-to-indentation))))
522
523(defun profiler-report-next-entry ()
0efc778b 524 "Move cursor to next entry."
c2d7786e
TM
525 (interactive)
526 (forward-line)
527 (profiler-report-move-to-entry))
528
529(defun profiler-report-previous-entry ()
0efc778b 530 "Move cursor to previous entry."
c2d7786e
TM
531 (interactive)
532 (forward-line -1)
533 (profiler-report-move-to-entry))
534
535(defun profiler-report-expand-entry ()
0efc778b 536 "Expand entry at point."
c2d7786e
TM
537 (interactive)
538 (save-excursion
539 (beginning-of-line)
540 (when (search-forward (concat profiler-report-closed-mark " ")
541 (line-end-position) t)
542 (let ((tree (profiler-report-calltree-at-point)))
543 (when tree
3d80c99f 544 (let ((inhibit-read-only t))
c2d7786e
TM
545 (replace-match (concat profiler-report-open-mark " "))
546 (forward-line)
547 (profiler-report-insert-calltree-children tree)
548 t))))))
549
550(defun profiler-report-collapse-entry ()
735135f9 551 "Collapse entry at point."
c2d7786e
TM
552 (interactive)
553 (save-excursion
554 (beginning-of-line)
555 (when (search-forward (concat profiler-report-open-mark " ")
556 (line-end-position) t)
557 (let* ((tree (profiler-report-calltree-at-point))
558 (depth (profiler-calltree-depth tree))
559 (start (line-beginning-position 2))
560 d)
561 (when tree
3d80c99f 562 (let ((inhibit-read-only t))
c2d7786e
TM
563 (replace-match (concat profiler-report-closed-mark " "))
564 (while (and (eq (forward-line) 0)
565 (let ((child (get-text-property (point) 'calltree)))
566 (and child
567 (numberp (setq d (profiler-calltree-depth child)))))
568 (> d depth)))
569 (delete-region start (line-beginning-position)))))
570 t)))
571
572(defun profiler-report-toggle-entry ()
0efc778b
TM
573 "Expand entry at point if the tree is collapsed,
574otherwise collapse."
c2d7786e
TM
575 (interactive)
576 (or (profiler-report-expand-entry)
577 (profiler-report-collapse-entry)))
578
579(defun profiler-report-find-entry (&optional event)
0efc778b 580 "Find entry at point."
c2d7786e 581 (interactive (list last-nonmenu-event))
b0636be7
GM
582 (with-current-buffer
583 (if event (window-buffer (posn-window (event-start event)))
584 (current-buffer))
585 (and event (setq event (event-end event))
586 (posn-set-point event))
587 (let ((tree (profiler-report-calltree-at-point)))
588 (when tree
589 (let ((entry (profiler-calltree-entry tree)))
590 (find-function entry))))))
c2d7786e
TM
591
592(defun profiler-report-describe-entry ()
0efc778b 593 "Describe entry at point."
c2d7786e
TM
594 (interactive)
595 (let ((tree (profiler-report-calltree-at-point)))
596 (when tree
597 (let ((entry (profiler-calltree-entry tree)))
598 (require 'help-fns)
599 (describe-function entry)))))
600
3d80c99f 601(cl-defun profiler-report-render-calltree-1
c22bac2c
TM
602 (profile &key reverse (order 'descending))
603 (let ((calltree (profiler-calltree-build
604 (profiler-profile-log profile)
605 :reverse reverse)))
3d80c99f 606 (setq header-line-format
c22bac2c 607 (cl-ecase (profiler-profile-type profile)
3d80c99f 608 (cpu
c2d7786e 609 (profiler-report-header-line-format
c22bac2c 610 profiler-report-cpu-line-format
b3ecad33 611 "Function" (list "CPU samples" "%")))
3d80c99f 612 (memory
c2d7786e
TM
613 (profiler-report-header-line-format
614 profiler-report-memory-line-format
3d80c99f
SM
615 "Function" (list "Bytes" "%")))))
616 (let ((predicate (cl-ecase order
617 (ascending #'profiler-calltree-count<)
618 (descending #'profiler-calltree-count>))))
619 (profiler-calltree-sort calltree predicate))
620 (let ((inhibit-read-only t))
c2d7786e
TM
621 (erase-buffer)
622 (profiler-report-insert-calltree-children calltree)
623 (goto-char (point-min))
624 (profiler-report-move-to-entry))))
625
626(defun profiler-report-rerender-calltree ()
c22bac2c 627 (profiler-report-render-calltree-1 profiler-report-profile
c2d7786e
TM
628 :reverse profiler-report-reversed
629 :order profiler-report-order))
630
631(defun profiler-report-render-calltree ()
0efc778b 632 "Render calltree view."
c2d7786e
TM
633 (interactive)
634 (setq profiler-report-reversed nil)
635 (profiler-report-rerender-calltree))
636
637(defun profiler-report-render-reversed-calltree ()
0efc778b 638 "Render reversed calltree view."
c2d7786e
TM
639 (interactive)
640 (setq profiler-report-reversed t)
641 (profiler-report-rerender-calltree))
642
643(defun profiler-report-ascending-sort ()
644 "Sort calltree view in ascending order."
645 (interactive)
646 (setq profiler-report-order 'ascending)
647 (profiler-report-rerender-calltree))
648
649(defun profiler-report-descending-sort ()
650 "Sort calltree view in descending order."
651 (interactive)
652 (setq profiler-report-order 'descending)
653 (profiler-report-rerender-calltree))
654
c22bac2c
TM
655(defun profiler-report-profile (profile)
656 (switch-to-buffer (profiler-report-setup-buffer profile)))
657
658(defun profiler-report-profile-other-window (profile)
659 (switch-to-buffer-other-window (profiler-report-setup-buffer profile)))
660
661(defun profiler-report-profile-other-frame (profile)
662 (switch-to-buffer-other-frame (profiler-report-setup-buffer profile)))
c2d7786e 663
c22bac2c
TM
664(defun profiler-report-compare-profile (buffer)
665 "Compare the current profile with another."
c2d7786e 666 (interactive (list (read-buffer "Compare to: ")))
c22bac2c
TM
667 (let* ((profile1 (with-current-buffer buffer profiler-report-profile))
668 (profile2 profiler-report-profile)
669 (diff-profile (profiler-compare-profiles profile1 profile2)))
670 (profiler-report-profile diff-profile)))
c2d7786e 671
c22bac2c
TM
672(defun profiler-report-write-profile (filename &optional confirm)
673 "Write the current profile into file FILENAME."
c2d7786e 674 (interactive
c22bac2c 675 (list (read-file-name "Write profile: " default-directory)
c2d7786e 676 (not current-prefix-arg)))
c22bac2c
TM
677 (profiler-write-profile profiler-report-profile
678 filename
679 confirm))
c2d7786e
TM
680
681\f
c2d7786e
TM
682;;; Profiler commands
683
c2d7786e
TM
684;;;###autoload
685(defun profiler-start (mode)
3d80c99f
SM
686 "Start/restart profilers.
687MODE can be one of `cpu', `mem', or `cpu+mem'.
688If MODE is `cpu' or `cpu+mem', time-based profiler will be started.
689Also, if MODE is `mem' or `cpu+mem', then memory profiler will be started."
c2d7786e 690 (interactive
234148bf
SM
691 (list (if (not (fboundp 'profiler-cpu-start)) 'mem
692 (intern (completing-read "Mode (default cpu): "
693 '("cpu" "mem" "cpu+mem")
694 nil t nil nil "cpu")))))
b02baf7f 695 (cl-ecase mode
c2d7786e 696 (cpu
c22bac2c 697 (profiler-cpu-start profiler-sampling-interval)
c2d7786e 698 (message "CPU profiler started"))
a4924b14 699 (mem
6521894d 700 (profiler-memory-start)
c2d7786e 701 (message "Memory profiler started"))
a4924b14 702 (cpu+mem
c22bac2c 703 (profiler-cpu-start profiler-sampling-interval)
6521894d 704 (profiler-memory-start)
c2d7786e
TM
705 (message "CPU and memory profiler started"))))
706
707(defun profiler-stop ()
0efc778b 708 "Stop started profilers. Profiler logs will be kept."
c2d7786e 709 (interactive)
234148bf
SM
710 (let ((cpu (if (fboundp 'profiler-cpu-stop) (profiler-cpu-stop)))
711 (mem (profiler-memory-stop)))
712 (message "%s profiler stopped"
713 (cond ((and mem cpu) "CPU and memory")
714 (mem "Memory")
715 (cpu "CPU")
716 (t "No")))))
c2d7786e
TM
717
718(defun profiler-reset ()
c22bac2c 719 "Reset profiler logs."
c2d7786e 720 (interactive)
234148bf
SM
721 (when (fboundp 'profiler-cpu-log)
722 (ignore (profiler-cpu-log)))
6521894d 723 (ignore (profiler-memory-log))
c2d7786e
TM
724 t)
725
c22bac2c
TM
726(defun profiler-report-cpu ()
727 (let ((profile (profiler-cpu-profile)))
728 (when profile
729 (profiler-report-profile-other-window profile))))
ce56157e 730
c22bac2c
TM
731(defun profiler-report-memory ()
732 (let ((profile (profiler-memory-profile)))
733 (when profile
734 (profiler-report-profile-other-window profile))))
c2d7786e 735
ce56157e 736(defun profiler-report ()
0efc778b 737 "Report profiling results."
ce56157e 738 (interactive)
c22bac2c
TM
739 (profiler-report-cpu)
740 (profiler-report-memory))
741
742;;;###autoload
743(defun profiler-find-profile (filename)
744 "Open profile FILENAME."
745 (interactive
746 (list (read-file-name "Find profile: " default-directory)))
747 (profiler-report-profile (profiler-read-profile filename)))
748
749;;;###autoload
750(defun profiler-find-profile-other-window (filename)
751 "Open profile FILENAME."
752 (interactive
753 (list (read-file-name "Find profile: " default-directory)))
754 (profiler-report-profile-other-window (profiler-read-profile filename)))
ce56157e 755
c2d7786e 756;;;###autoload
c22bac2c
TM
757(defun profiler-find-profile-other-frame (filename)
758 "Open profile FILENAME."
c2d7786e 759 (interactive
c22bac2c
TM
760 (list (read-file-name "Find profile: " default-directory)))
761 (profiler-report-profile-other-frame(profiler-read-profile filename)))
c2d7786e 762
ce56157e 763\f
ce56157e
TM
764;;; Profiling helpers
765
c22bac2c 766;; (cl-defmacro with-cpu-profiling ((&key sampling-interval) &rest body)
3a880af4
SM
767;; `(unwind-protect
768;; (progn
769;; (ignore (profiler-cpu-log))
c22bac2c 770;; (profiler-cpu-start ,sampling-interval)
3a880af4
SM
771;; ,@body)
772;; (profiler-cpu-stop)
773;; (profiler--report-cpu)))
774
775;; (defmacro with-memory-profiling (&rest body)
776;; `(unwind-protect
777;; (progn
778;; (ignore (profiler-memory-log))
779;; (profiler-memory-start)
780;; ,@body)
781;; (profiler-memory-stop)
782;; (profiler--report-memory)))
ce56157e 783
c2d7786e
TM
784(provide 'profiler)
785;;; profiler.el ends here