Allow 'browse-url-emacs' to fetch URL in the selected window
[emacs.git] / lisp / profiler.el
blobeaeb69793fb60c29a701d7cc19e2e7604d951c40
1 ;;; profiler.el --- UI and helper functions for Emacs's native profiler -*- lexical-binding: t -*-
3 ;; Copyright (C) 2012-2018 Free Software Foundation, Inc.
5 ;; Author: Tomohiro Matsuyama <tomo@cx4a.org>
6 ;; Keywords: lisp
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
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.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
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.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
23 ;;; Commentary:
25 ;; See Info node `(elisp)Profiling'.
27 ;;; Code:
29 (require 'cl-lib)
31 (defgroup profiler nil
32 "Emacs profiler."
33 :group 'lisp
34 :version "24.3"
35 :prefix "profiler-")
37 (defconst profiler-version "24.3")
39 (defcustom profiler-sampling-interval 1000000
40 "Default sampling interval in nanoseconds."
41 :type 'integer
42 :group 'profiler)
45 ;;; Utilities
47 (defun profiler-ensure-string (object)
48 (cond ((stringp object)
49 object)
50 ((symbolp object)
51 (symbol-name object))
52 ((numberp object)
53 (number-to-string object))
55 (format "%s" object))))
57 (defun profiler-format-percent (number divisor)
58 (format "%d%%" (floor (* 100.0 number) divisor)))
60 (defun profiler-format-number (number)
61 "Format NUMBER in human readable string."
62 (if (and (integerp number) (> number 0))
63 (cl-loop with i = (% (1+ (floor (log number 10))) 3)
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)))
74 (defun profiler-format (fmt &rest args)
75 (cl-loop for (width align subfmt) in fmt
76 for arg in args
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))
86 (profiler-ensure-string arg)))
87 for len = (length str)
88 if (< width len)
89 collect (progn (put-text-property (max 0 (- width 2)) len
90 'invisible 'profiler str)
91 str) into frags
92 else
93 collect
94 (let ((padding (make-string (max 0 (- width len)) ?\s)))
95 (cl-ecase align
96 (left (concat str padding))
97 (right (concat padding str))))
98 into frags
99 finally return (apply #'concat frags)))
102 ;;; Entries
104 (defun profiler-format-entry (entry)
105 "Format ENTRY in human readable string. ENTRY would be a
106 function name of a function itself."
107 (cond ((memq (car-safe entry) '(closure lambda))
108 (format "#<lambda 0x%x>" (sxhash entry)))
109 ((byte-code-function-p entry)
110 (format "#<compiled 0x%x>" (sxhash entry)))
111 ((or (subrp entry) (symbolp entry) (stringp entry))
112 (format "%s" entry))
114 (format "#<unknown 0x%x>" (sxhash entry)))))
116 (defun profiler-fixup-entry (entry)
117 (if (symbolp entry)
118 entry
119 (profiler-format-entry entry)))
122 ;;; Backtraces
124 (defun profiler-fixup-backtrace (backtrace)
125 (apply 'vector (mapcar 'profiler-fixup-entry backtrace)))
128 ;;; Logs
130 ;; The C code returns the log in the form of a hash-table where the keys are
131 ;; vectors (of size profiler-max-stack-depth, holding truncated
132 ;; backtraces, where the first element is the top of the stack) and
133 ;; the values are integers (which count how many times this backtrace
134 ;; has been seen, multiplied by a "weight factor" which is either the
135 ;; sampling-interval or the memory being allocated).
137 (defun profiler-compare-logs (log1 log2)
138 "Compare LOG1 with LOG2 and return diff."
139 (let ((newlog (make-hash-table :test 'equal)))
140 ;; Make a copy of `log1' into `newlog'.
141 (maphash (lambda (backtrace count) (puthash backtrace count newlog))
142 log1)
143 (maphash (lambda (backtrace count)
144 (puthash backtrace (- (gethash backtrace log1 0) count)
145 newlog))
146 log2)
147 newlog))
149 (defun profiler-fixup-log (log)
150 (let ((newlog (make-hash-table :test 'equal)))
151 (maphash (lambda (backtrace count)
152 (puthash (profiler-fixup-backtrace backtrace)
153 count newlog))
154 log)
155 newlog))
158 ;;; Profiles
160 (cl-defstruct (profiler-profile (:type vector)
161 (:constructor profiler-make-profile))
162 (tag 'profiler-profile)
163 (version profiler-version)
164 ;; - `type' has a value indicating the kind of profile (`memory' or `cpu').
165 ;; - `log' indicates the profile log.
166 ;; - `timestamp' has a value giving the time when the profile was obtained.
167 ;; - `diff-p' indicates if this profile represents a diff between two profiles.
168 type log timestamp diff-p)
170 (defun profiler-compare-profiles (profile1 profile2)
171 "Compare PROFILE1 with PROFILE2 and return diff."
172 (unless (eq (profiler-profile-type profile1)
173 (profiler-profile-type profile2))
174 (error "Can't compare different type of profiles"))
175 (profiler-make-profile
176 :type (profiler-profile-type profile1)
177 :timestamp (current-time)
178 :diff-p t
179 :log (profiler-compare-logs
180 (profiler-profile-log profile1)
181 (profiler-profile-log profile2))))
183 (defun profiler-fixup-profile (profile)
184 "Fixup PROFILE so that the profile could be serialized into file."
185 (profiler-make-profile
186 :type (profiler-profile-type profile)
187 :timestamp (profiler-profile-timestamp profile)
188 :diff-p (profiler-profile-diff-p profile)
189 :log (profiler-fixup-log (profiler-profile-log profile))))
191 (defun profiler-write-profile (profile filename &optional confirm)
192 "Write PROFILE into file FILENAME."
193 (with-temp-buffer
194 (let (print-level print-length)
195 (print (profiler-fixup-profile profile)
196 (current-buffer)))
197 (write-file filename confirm)))
199 (defun profiler-read-profile (filename)
200 "Read profile from file FILENAME."
201 ;; FIXME: tag and version check
202 (with-temp-buffer
203 (insert-file-contents filename)
204 (goto-char (point-min))
205 (read (current-buffer))))
207 (defun profiler-running-p (&optional mode)
208 "Return non-nil if the profiler is running.
209 Optional argument MODE means only check for the specified mode (cpu or mem)."
210 (cond ((eq mode 'cpu) (and (fboundp 'profiler-cpu-running-p)
211 (profiler-cpu-running-p)))
212 ((eq mode 'mem) (profiler-memory-running-p))
213 (t (or (profiler-running-p 'cpu)
214 (profiler-running-p 'mem)))))
216 (defun profiler-cpu-profile ()
217 "Return CPU profile."
218 (when (profiler-running-p 'cpu)
219 (profiler-make-profile
220 :type 'cpu
221 :timestamp (current-time)
222 :log (profiler-cpu-log))))
224 (defun profiler-memory-profile ()
225 "Return memory profile."
226 (when (profiler-memory-running-p)
227 (profiler-make-profile
228 :type 'memory
229 :timestamp (current-time)
230 :log (profiler-memory-log))))
233 ;;; Calltrees
235 (cl-defstruct (profiler-calltree (:constructor profiler-make-calltree))
236 entry
237 (count 0) (count-percent "")
238 parent children)
240 (defun profiler-calltree-leaf-p (tree)
241 (null (profiler-calltree-children tree)))
243 (defun profiler-calltree-count< (a b)
244 (cond ((eq (profiler-calltree-entry a) t) t)
245 ((eq (profiler-calltree-entry b) t) nil)
246 (t (< (profiler-calltree-count a)
247 (profiler-calltree-count b)))))
249 (defun profiler-calltree-count> (a b)
250 (not (profiler-calltree-count< a b)))
252 (defun profiler-calltree-depth (tree)
253 (let ((d 0))
254 (while (setq tree (profiler-calltree-parent tree))
255 (cl-incf d))
258 (defun profiler-calltree-find (tree entry)
259 "Return a child tree of ENTRY under TREE."
260 (let (result (children (profiler-calltree-children tree)))
261 (while (and children (null result))
262 (let ((child (car children)))
263 (when (function-equal (profiler-calltree-entry child) entry)
264 (setq result child))
265 (setq children (cdr children))))
266 result))
268 (defun profiler-calltree-walk (calltree function)
269 (funcall function calltree)
270 (dolist (child (profiler-calltree-children calltree))
271 (profiler-calltree-walk child function)))
273 (defun profiler-calltree-build-1 (tree log &optional reverse)
274 ;; This doesn't try to stitch up partial backtraces together.
275 ;; We still use it for reverse calltrees, but for forward calltrees, we use
276 ;; profiler-calltree-build-unified instead now.
277 (maphash
278 (lambda (backtrace count)
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)))))))
291 log))
294 (define-hash-table-test 'profiler-function-equal #'function-equal
295 (lambda (f) (cond
296 ((byte-code-function-p f) (aref f 1))
297 ((eq (car-safe f) 'closure) (cddr f))
298 (t f))))
300 (defun profiler-calltree-build-unified (tree log)
301 ;; Let's try to unify all those partial backtraces into a single
302 ;; call tree. First, we record in fun-map all the functions that appear
303 ;; in `log' and where they appear.
304 (let ((fun-map (make-hash-table :test 'profiler-function-equal))
305 (parent-map (make-hash-table :test 'eq))
306 (leftover-tree (profiler-make-calltree
307 :entry (intern "...") :parent tree)))
308 (push leftover-tree (profiler-calltree-children tree))
309 (maphash
310 (lambda (backtrace _count)
311 (let ((max (length backtrace)))
312 ;; Don't record the head elements in there, since we want to use this
313 ;; fun-map to find parents of partial backtraces, but parents only
314 ;; make sense if they have something "above".
315 (dotimes (i (1- max))
316 (let ((f (aref backtrace i)))
317 (when f
318 (push (cons i backtrace) (gethash f fun-map)))))))
319 log)
320 ;; Then, for each partial backtrace, try to find a parent backtrace
321 ;; (i.e. a backtrace that describes (part of) the truncated part of
322 ;; the partial backtrace). For a partial backtrace like "[f3 f2 f1]" (f3
323 ;; is deeper), any backtrace that includes f1 could be a parent; and indeed
324 ;; the counts of this partial backtrace could each come from a different
325 ;; parent backtrace (some of which may not even be in `log'). So we should
326 ;; consider each backtrace that includes f1 and give it some percentage of
327 ;; `count'. But we can't know for sure what percentage to give to each
328 ;; possible parent.
329 ;; The "right" way might be to give a percentage proportional to the counts
330 ;; already registered for that parent, or some such statistical principle.
331 ;; But instead, we will give all our counts to a single "best
332 ;; matching" parent. So let's look for the best matching parent, and store
333 ;; the result in parent-map.
334 ;; Using the "best matching parent" is important also to try and avoid
335 ;; stitching together backtraces that can't possibly go together.
336 ;; For example, when the head is `apply' (or `mapcar', ...), we want to
337 ;; make sure we don't just use any parent that calls `apply', since most of
338 ;; them would never, in turn, cause apply to call the subsequent function.
339 (maphash
340 (lambda (backtrace _count)
341 (let* ((max (1- (length backtrace)))
342 (head (aref backtrace max))
343 (best-parent nil)
344 (best-match (1+ max))
345 (parents (gethash head fun-map)))
346 (pcase-dolist (`(,i . ,parent) parents)
347 (when t ;; (<= (- max i) best-match) ;Else, it can't be better.
348 (let ((match max)
349 (imatch i))
350 (cl-assert (>= match imatch))
351 (cl-assert (function-equal (aref backtrace max)
352 (aref parent i)))
353 (while (progn
354 (cl-decf imatch) (cl-decf match)
355 (when (> imatch 0)
356 (function-equal (aref backtrace match)
357 (aref parent imatch)))))
358 (when (< match best-match)
359 (cl-assert (<= (- max i) best-match))
360 ;; Let's make sure this parent is not already our child: we
361 ;; don't want cycles here!
362 (let ((valid t)
363 (tmp-parent parent))
364 (while (setq tmp-parent
365 (if (eq tmp-parent backtrace)
366 (setq valid nil)
367 (cdr (gethash tmp-parent parent-map)))))
368 (when valid
369 (setq best-match match)
370 (setq best-parent (cons i parent))))))))
371 (puthash backtrace best-parent parent-map)))
372 log)
373 ;; Now we have a single parent per backtrace, so we have a unified tree.
374 ;; Let's build the actual call-tree from it.
375 (maphash
376 (lambda (backtrace count)
377 (let ((node tree)
378 (parents (list (cons -1 backtrace)))
379 (tmp backtrace)
380 (max (length backtrace)))
381 (while (setq tmp (gethash tmp parent-map))
382 (push tmp parents)
383 (setq tmp (cdr tmp)))
384 (when (aref (cdar parents) (1- max))
385 (cl-incf (profiler-calltree-count leftover-tree) count)
386 (setq node leftover-tree))
387 (pcase-dolist (`(,i . ,parent) parents)
388 (let ((j (1- max)))
389 (while (> j i)
390 (let ((f (aref parent j)))
391 (cl-decf j)
392 (when f
393 (let ((child (profiler-calltree-find node f)))
394 (unless child
395 (setq child (profiler-make-calltree
396 :entry f :parent node))
397 (push child (profiler-calltree-children node)))
398 (cl-incf (profiler-calltree-count child) count)
399 (setq node child)))))))))
400 log)))
402 (defun profiler-calltree-compute-percentages (tree)
403 (let ((total-count 0))
404 ;; FIXME: the memory profiler's total wraps around all too easily!
405 (dolist (child (profiler-calltree-children tree))
406 (cl-incf total-count (profiler-calltree-count child)))
407 (unless (zerop total-count)
408 (profiler-calltree-walk
409 tree (lambda (node)
410 (setf (profiler-calltree-count-percent node)
411 (profiler-format-percent (profiler-calltree-count node)
412 total-count)))))))
414 (cl-defun profiler-calltree-build (log &key reverse)
415 (let ((tree (profiler-make-calltree)))
416 (if reverse
417 (profiler-calltree-build-1 tree log reverse)
418 (profiler-calltree-build-unified tree log))
419 (profiler-calltree-compute-percentages tree)
420 tree))
422 (defun profiler-calltree-sort (tree predicate)
423 (let ((children (profiler-calltree-children tree)))
424 (setf (profiler-calltree-children tree) (sort children predicate))
425 (dolist (child (profiler-calltree-children tree))
426 (profiler-calltree-sort child predicate))))
429 ;;; Report rendering
431 (defcustom profiler-report-closed-mark "+"
432 "An indicator of closed calltrees."
433 :type 'string
434 :group 'profiler)
436 (defcustom profiler-report-open-mark "-"
437 "An indicator of open calltrees."
438 :type 'string
439 :group 'profiler)
441 (defcustom profiler-report-leaf-mark " "
442 "An indicator of calltree leaves."
443 :type 'string
444 :group 'profiler)
446 (defvar profiler-report-cpu-line-format
447 '((50 left)
448 (24 right ((19 right)
449 (5 right)))))
451 (defvar profiler-report-memory-line-format
452 '((55 left)
453 (19 right ((14 right profiler-format-number)
454 (5 right)))))
456 (defvar-local profiler-report-profile nil
457 "The current profile.")
459 (defvar-local profiler-report-reversed nil
460 "True if calltree is rendered in bottom-up. Do not touch this
461 variable directly.")
463 (defvar-local profiler-report-order nil
464 "The value can be `ascending' or `descending'. Do not touch
465 this variable directly.")
467 (defun profiler-report-make-entry-part (entry)
468 (let ((string (cond
469 ((eq entry t)
470 "Others")
471 ((and (symbolp entry)
472 (fboundp entry))
473 (propertize (symbol-name entry)
474 'face 'link
475 'mouse-face 'highlight
476 'help-echo "\
477 mouse-2: jump to definition\n\
478 RET: expand or collapse"))
480 (profiler-format-entry entry)))))
481 (propertize string 'profiler-entry entry)))
483 (defun profiler-report-make-name-part (tree)
484 (let* ((entry (profiler-calltree-entry tree))
485 (depth (profiler-calltree-depth tree))
486 (indent (make-string (* (1- depth) 1) ?\s))
487 (mark (if (profiler-calltree-leaf-p tree)
488 profiler-report-leaf-mark
489 profiler-report-closed-mark))
490 (entry (profiler-report-make-entry-part entry)))
491 (format "%s%s %s" indent mark entry)))
493 (defun profiler-report-header-line-format (fmt &rest args)
494 (let* ((header (apply #'profiler-format fmt args))
495 (escaped (replace-regexp-in-string "%" "%%" header)))
496 (concat " " escaped)))
498 (defun profiler-report-line-format (tree)
499 (let ((diff-p (profiler-profile-diff-p profiler-report-profile))
500 (name-part (profiler-report-make-name-part tree))
501 (count (profiler-calltree-count tree))
502 (count-percent (profiler-calltree-count-percent tree)))
503 (profiler-format (cl-ecase (profiler-profile-type profiler-report-profile)
504 (cpu profiler-report-cpu-line-format)
505 (memory profiler-report-memory-line-format))
506 name-part
507 (if diff-p
508 (list (if (> count 0)
509 (format "+%s" count)
510 count)
512 (list count count-percent)))))
514 (defun profiler-report-insert-calltree (tree)
515 (let ((line (profiler-report-line-format tree)))
516 (insert (propertize (concat line "\n") 'calltree tree))))
518 (defun profiler-report-insert-calltree-children (tree)
519 (mapc #'profiler-report-insert-calltree
520 (profiler-calltree-children tree)))
523 ;;; Report mode
525 (defvar profiler-report-mode-map
526 (let ((map (make-sparse-keymap)))
527 (define-key map "n" 'profiler-report-next-entry)
528 (define-key map "p" 'profiler-report-previous-entry)
529 ;; I find it annoying more than helpful to not be able to navigate
530 ;; normally with the cursor keys. --Stef
531 ;; (define-key map [down] 'profiler-report-next-entry)
532 ;; (define-key map [up] 'profiler-report-previous-entry)
533 (define-key map "\r" 'profiler-report-toggle-entry)
534 (define-key map "\t" 'profiler-report-toggle-entry)
535 (define-key map "i" 'profiler-report-toggle-entry)
536 (define-key map [mouse-1] 'profiler-report-toggle-entry)
537 (define-key map "f" 'profiler-report-find-entry)
538 (define-key map "j" 'profiler-report-find-entry)
539 (define-key map [mouse-2] 'profiler-report-find-entry)
540 (define-key map "d" 'profiler-report-describe-entry)
541 (define-key map "C" 'profiler-report-render-calltree)
542 (define-key map "B" 'profiler-report-render-reversed-calltree)
543 (define-key map "A" 'profiler-report-ascending-sort)
544 (define-key map "D" 'profiler-report-descending-sort)
545 (define-key map "=" 'profiler-report-compare-profile)
546 (define-key map (kbd "C-x C-w") 'profiler-report-write-profile)
547 (easy-menu-define profiler-report-menu map "Menu for Profiler Report mode."
548 '("Profiler"
549 ["Next Entry" profiler-report-next-entry :active t
550 :help "Move to next entry"]
551 ["Previous Entry" profiler-report-previous-entry :active t
552 :help "Move to previous entry"]
553 "--"
554 ["Toggle Entry" profiler-report-toggle-entry
555 :active (profiler-report-calltree-at-point)
556 :help "Expand or collapse the current entry"]
557 ["Find Entry" profiler-report-find-entry
558 ;; FIXME should deactivate if not on a known function.
559 :active (profiler-report-calltree-at-point)
560 :help "Find the definition of the current entry"]
561 ["Describe Entry" profiler-report-describe-entry
562 :active (profiler-report-calltree-at-point)
563 :help "Show the documentation of the current entry"]
564 "--"
565 ["Show Calltree" profiler-report-render-calltree
566 :active profiler-report-reversed
567 :help "Show calltree view"]
568 ["Show Reversed Calltree" profiler-report-render-reversed-calltree
569 :active (not profiler-report-reversed)
570 :help "Show reversed calltree view"]
571 ["Sort Ascending" profiler-report-ascending-sort
572 :active (not (eq profiler-report-order 'ascending))
573 :help "Sort calltree view in ascending order"]
574 ["Sort Descending" profiler-report-descending-sort
575 :active (not (eq profiler-report-order 'descending))
576 :help "Sort calltree view in descending order"]
577 "--"
578 ["Compare Profile..." profiler-report-compare-profile :active t
579 :help "Compare current profile with another"]
580 ["Write Profile..." profiler-report-write-profile :active t
581 :help "Write current profile to a file"]
582 "--"
583 ["Start Profiler" profiler-start :active (not (profiler-running-p))
584 :help "Start profiling"]
585 ["Stop Profiler" profiler-stop :active (profiler-running-p)
586 :help "Stop profiling"]
587 ["New Report" profiler-report :active (profiler-running-p)
588 :help "Make a new report"]))
589 map)
590 "Keymap for `profiler-report-mode'.")
592 (defun profiler-report-make-buffer-name (profile)
593 (format "*%s-Profiler-Report %s*"
594 (cl-ecase (profiler-profile-type profile) (cpu 'CPU) (memory 'Memory))
595 (format-time-string "%Y-%m-%d %T" (profiler-profile-timestamp profile))))
597 (defun profiler-report-setup-buffer-1 (profile)
598 "Make a buffer for PROFILE and return it."
599 (let* ((buf-name (profiler-report-make-buffer-name profile))
600 (buffer (get-buffer-create buf-name)))
601 (with-current-buffer buffer
602 (profiler-report-mode)
603 (setq profiler-report-profile profile
604 profiler-report-reversed nil
605 profiler-report-order 'descending))
606 buffer))
608 (defun profiler-report-setup-buffer (profile)
609 "Make a buffer for PROFILE with rendering the profile and
610 return it."
611 (let ((buffer (profiler-report-setup-buffer-1 profile)))
612 (with-current-buffer buffer
613 (profiler-report-render-calltree))
614 buffer))
616 (define-derived-mode profiler-report-mode special-mode "Profiler-Report"
617 "Profiler Report Mode."
618 (add-to-invisibility-spec '(profiler . t))
619 (setq buffer-read-only t
620 buffer-undo-list t
621 truncate-lines t))
624 ;;; Report commands
626 (defun profiler-report-calltree-at-point (&optional point)
627 (get-text-property (or point (point)) 'calltree))
629 (defun profiler-report-move-to-entry ()
630 (let ((point (next-single-property-change
631 (line-beginning-position) 'profiler-entry)))
632 (if point
633 (goto-char point)
634 (back-to-indentation))))
636 (defun profiler-report-next-entry ()
637 "Move cursor to next entry."
638 (interactive)
639 (forward-line)
640 (profiler-report-move-to-entry))
642 (defun profiler-report-previous-entry ()
643 "Move cursor to previous entry."
644 (interactive)
645 (forward-line -1)
646 (profiler-report-move-to-entry))
648 (defun profiler-report-expand-entry (&optional full)
649 "Expand entry at point.
650 With a prefix argument, expand the whole subtree."
651 (interactive "P")
652 (save-excursion
653 (beginning-of-line)
654 (when (search-forward (concat profiler-report-closed-mark " ")
655 (line-end-position) t)
656 (let ((tree (profiler-report-calltree-at-point)))
657 (when tree
658 (let ((inhibit-read-only t))
659 (replace-match (concat profiler-report-open-mark " "))
660 (forward-line)
661 (let ((first (point))
662 (last (copy-marker (point) t)))
663 (profiler-report-insert-calltree-children tree)
664 (when full
665 (goto-char first)
666 (while (< (point) last)
667 (profiler-report-expand-entry)
668 (forward-line 1))))
669 t))))))
671 (defun profiler-report-collapse-entry ()
672 "Collapse entry at point."
673 (interactive)
674 (save-excursion
675 (beginning-of-line)
676 (when (search-forward (concat profiler-report-open-mark " ")
677 (line-end-position) t)
678 (let* ((tree (profiler-report-calltree-at-point))
679 (depth (profiler-calltree-depth tree))
680 (start (line-beginning-position 2))
682 (when tree
683 (let ((inhibit-read-only t))
684 (replace-match (concat profiler-report-closed-mark " "))
685 (while (and (eq (forward-line) 0)
686 (let ((child (get-text-property (point) 'calltree)))
687 (and child
688 (numberp (setq d (profiler-calltree-depth child)))))
689 (> d depth)))
690 (delete-region start (line-beginning-position)))))
691 t)))
693 (defun profiler-report-toggle-entry (&optional arg)
694 "Expand entry at point if the tree is collapsed,
695 otherwise collapse. With prefix argument, expand all subentries
696 below entry at point."
697 (interactive "P")
698 (or (profiler-report-expand-entry arg)
699 (profiler-report-collapse-entry)))
701 (defun profiler-report-find-entry (&optional event)
702 "Find entry at point."
703 (interactive (list last-nonmenu-event))
704 (with-current-buffer
705 (if event (window-buffer (posn-window (event-start event)))
706 (current-buffer))
707 (and event (setq event (event-end event))
708 (posn-set-point event))
709 (let ((tree (profiler-report-calltree-at-point)))
710 (when tree
711 (let ((entry (profiler-calltree-entry tree)))
712 (find-function entry))))))
714 (defun profiler-report-describe-entry ()
715 "Describe entry at point."
716 (interactive)
717 (let ((tree (profiler-report-calltree-at-point)))
718 (when tree
719 (let ((entry (profiler-calltree-entry tree)))
720 (require 'help-fns)
721 (describe-function entry)))))
723 (cl-defun profiler-report-render-calltree-1
724 (profile &key reverse (order 'descending))
725 (let ((calltree (profiler-calltree-build
726 (profiler-profile-log profile)
727 :reverse reverse)))
728 (setq header-line-format
729 (cl-ecase (profiler-profile-type profile)
730 (cpu
731 (profiler-report-header-line-format
732 profiler-report-cpu-line-format
733 "Function" (list "CPU samples" "%")))
734 (memory
735 (profiler-report-header-line-format
736 profiler-report-memory-line-format
737 "Function" (list "Bytes" "%")))))
738 (let ((predicate (cl-ecase order
739 (ascending #'profiler-calltree-count<)
740 (descending #'profiler-calltree-count>))))
741 (profiler-calltree-sort calltree predicate))
742 (let ((inhibit-read-only t))
743 (erase-buffer)
744 (profiler-report-insert-calltree-children calltree)
745 (goto-char (point-min))
746 (profiler-report-move-to-entry))))
748 (defun profiler-report-rerender-calltree ()
749 (profiler-report-render-calltree-1 profiler-report-profile
750 :reverse profiler-report-reversed
751 :order profiler-report-order))
753 (defun profiler-report-render-calltree ()
754 "Render calltree view."
755 (interactive)
756 (setq profiler-report-reversed nil)
757 (profiler-report-rerender-calltree))
759 (defun profiler-report-render-reversed-calltree ()
760 "Render reversed calltree view."
761 (interactive)
762 (setq profiler-report-reversed t)
763 (profiler-report-rerender-calltree))
765 (defun profiler-report-ascending-sort ()
766 "Sort calltree view in ascending order."
767 (interactive)
768 (setq profiler-report-order 'ascending)
769 (profiler-report-rerender-calltree))
771 (defun profiler-report-descending-sort ()
772 "Sort calltree view in descending order."
773 (interactive)
774 (setq profiler-report-order 'descending)
775 (profiler-report-rerender-calltree))
777 (defun profiler-report-profile (profile)
778 (switch-to-buffer (profiler-report-setup-buffer profile)))
780 (defun profiler-report-profile-other-window (profile)
781 (switch-to-buffer-other-window (profiler-report-setup-buffer profile)))
783 (defun profiler-report-profile-other-frame (profile)
784 (switch-to-buffer-other-frame (profiler-report-setup-buffer profile)))
786 (defun profiler-report-compare-profile (buffer)
787 "Compare the current profile with another."
788 (interactive (list (read-buffer "Compare to: ")))
789 (let* ((profile1 (with-current-buffer buffer profiler-report-profile))
790 (profile2 profiler-report-profile)
791 (diff-profile (profiler-compare-profiles profile1 profile2)))
792 (profiler-report-profile diff-profile)))
794 (defun profiler-report-write-profile (filename &optional confirm)
795 "Write the current profile into file FILENAME."
796 (interactive
797 (list (read-file-name "Write profile: " default-directory)
798 (not current-prefix-arg)))
799 (profiler-write-profile profiler-report-profile
800 filename
801 confirm))
804 ;;; Profiler commands
806 ;;;###autoload
807 (defun profiler-start (mode)
808 "Start/restart profilers.
809 MODE can be one of `cpu', `mem', or `cpu+mem'.
810 If MODE is `cpu' or `cpu+mem', time-based profiler will be started.
811 Also, if MODE is `mem' or `cpu+mem', then memory profiler will be started."
812 (interactive
813 (list (if (not (fboundp 'profiler-cpu-start)) 'mem
814 (intern (completing-read "Mode (default cpu): "
815 '("cpu" "mem" "cpu+mem")
816 nil t nil nil "cpu")))))
817 (cl-ecase mode
818 (cpu
819 (profiler-cpu-start profiler-sampling-interval)
820 (message "CPU profiler started"))
821 (mem
822 (profiler-memory-start)
823 (message "Memory profiler started"))
824 (cpu+mem
825 (profiler-cpu-start profiler-sampling-interval)
826 (profiler-memory-start)
827 (message "CPU and memory profiler started"))))
829 (defun profiler-stop ()
830 "Stop started profilers. Profiler logs will be kept."
831 (interactive)
832 (let ((cpu (if (fboundp 'profiler-cpu-stop) (profiler-cpu-stop)))
833 (mem (profiler-memory-stop)))
834 (message "%s profiler stopped"
835 (cond ((and mem cpu) "CPU and memory")
836 (mem "Memory")
837 (cpu "CPU")
838 (t "No")))))
840 (defun profiler-reset ()
841 "Reset profiler logs."
842 (interactive)
843 (when (fboundp 'profiler-cpu-log)
844 (ignore (profiler-cpu-log)))
845 (ignore (profiler-memory-log))
848 (defun profiler-report-cpu ()
849 (let ((profile (profiler-cpu-profile)))
850 (when profile
851 (profiler-report-profile-other-window profile))))
853 (defun profiler-report-memory ()
854 (let ((profile (profiler-memory-profile)))
855 (when profile
856 (profiler-report-profile-other-window profile))))
858 (defun profiler-report ()
859 "Report profiling results."
860 (interactive)
861 (profiler-report-cpu)
862 (profiler-report-memory))
864 ;;;###autoload
865 (defun profiler-find-profile (filename)
866 "Open profile FILENAME."
867 (interactive
868 (list (read-file-name "Find profile: " default-directory)))
869 (profiler-report-profile (profiler-read-profile filename)))
871 ;;;###autoload
872 (defun profiler-find-profile-other-window (filename)
873 "Open profile FILENAME."
874 (interactive
875 (list (read-file-name "Find profile: " default-directory)))
876 (profiler-report-profile-other-window (profiler-read-profile filename)))
878 ;;;###autoload
879 (defun profiler-find-profile-other-frame (filename)
880 "Open profile FILENAME."
881 (interactive
882 (list (read-file-name "Find profile: " default-directory)))
883 (profiler-report-profile-other-frame(profiler-read-profile filename)))
886 ;;; Profiling helpers
888 ;; (cl-defmacro with-cpu-profiling ((&key sampling-interval) &rest body)
889 ;; `(unwind-protect
890 ;; (progn
891 ;; (ignore (profiler-cpu-log))
892 ;; (profiler-cpu-start ,sampling-interval)
893 ;; ,@body)
894 ;; (profiler-cpu-stop)
895 ;; (profiler--report-cpu)))
897 ;; (defmacro with-memory-profiling (&rest body)
898 ;; `(unwind-protect
899 ;; (progn
900 ;; (ignore (profiler-memory-log))
901 ;; (profiler-memory-start)
902 ;; ,@body)
903 ;; (profiler-memory-stop)
904 ;; (profiler--report-memory)))
906 (provide 'profiler)
907 ;;; profiler.el ends here