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