Fix disassembly of non-compiled lexical functions (bug#21377)
[emacs.git] / lisp / profiler.el
blobf28bbfe2768b088886c4a353ec6741c44d84d22a
1 ;;; profiler.el --- UI and helper functions for Emacs's native profiler -*- lexical-binding: t -*-
3 ;; Copyright (C) 2012-2015 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 <http://www.gnu.org/licenses/>.
23 ;;; Commentary:
25 ;; See Info node `(elisp)Profiling'.
27 ;;; Code:
29 (require 'cl-lib)
30 (require 'pcase)
32 (defgroup profiler nil
33 "Emacs profiler."
34 :group 'lisp
35 :version "24.3"
36 :prefix "profiler-")
38 (defconst profiler-version "24.3")
40 (defcustom profiler-sampling-interval 1000000
41 "Default sampling interval in nanoseconds."
42 :type 'integer
43 :group 'profiler)
46 ;;; Utilities
48 (defun profiler-ensure-string (object)
49 (cond ((stringp object)
50 object)
51 ((symbolp object)
52 (symbol-name object))
53 ((numberp object)
54 (number-to-string object))
56 (format "%s" object))))
58 (defun profiler-format-percent (number divisor)
59 (format "%d%%" (floor (* 100.0 number) divisor)))
61 (defun profiler-format-number (number)
62 "Format NUMBER in human readable string."
63 (if (and (integerp number) (> number 0))
64 (cl-loop with i = (% (1+ (floor (log number 10))) 3)
65 for c in (append (number-to-string number) nil)
66 if (= i 0)
67 collect ?, into s
68 and do (setq i 3)
69 collect c into s
70 do (cl-decf i)
71 finally return
72 (apply 'string (if (eq (car s) ?,) (cdr s) s)))
73 (profiler-ensure-string number)))
75 (defun profiler-format (fmt &rest args)
76 (cl-loop for (width align subfmt) in fmt
77 for arg in args
78 for str = (cond
79 ((consp subfmt)
80 (apply 'profiler-format subfmt arg))
81 ((stringp subfmt)
82 (format subfmt arg))
83 ((and (symbolp subfmt)
84 (fboundp subfmt))
85 (funcall subfmt arg))
87 (profiler-ensure-string arg)))
88 for len = (length str)
89 if (< width len)
90 collect (progn (put-text-property (max 0 (- width 2)) len
91 'invisible 'profiler str)
92 str) into frags
93 else
94 collect
95 (let ((padding (make-string (max 0 (- width len)) ?\s)))
96 (cl-ecase align
97 (left (concat str padding))
98 (right (concat padding str))))
99 into frags
100 finally return (apply #'concat frags)))
103 ;;; Entries
105 (defun profiler-format-entry (entry)
106 "Format ENTRY in human readable string. ENTRY would be a
107 function name of a function itself."
108 (cond ((memq (car-safe entry) '(closure lambda))
109 (format "#<lambda 0x%x>" (sxhash entry)))
110 ((byte-code-function-p entry)
111 (format "#<compiled 0x%x>" (sxhash entry)))
112 ((or (subrp entry) (symbolp entry) (stringp entry))
113 (format "%s" entry))
115 (format "#<unknown 0x%x>" (sxhash entry)))))
117 (defun profiler-fixup-entry (entry)
118 (if (symbolp entry)
119 entry
120 (profiler-format-entry entry)))
123 ;;; Backtraces
125 (defun profiler-fixup-backtrace (backtrace)
126 (apply 'vector (mapcar 'profiler-fixup-entry backtrace)))
129 ;;; Logs
131 ;; The C code returns the log in the form of a hash-table where the keys are
132 ;; vectors (of size profiler-max-stack-depth, holding truncated
133 ;; backtraces, where the first element is the top of the stack) and
134 ;; the values are integers (which count how many times this backtrace
135 ;; has been seen, multiplied by a "weight factor" which is either the
136 ;; sampling-interval or the memory being allocated).
138 (defun profiler-compare-logs (log1 log2)
139 "Compare LOG1 with LOG2 and return diff."
140 (let ((newlog (make-hash-table :test 'equal)))
141 ;; Make a copy of `log1' into `newlog'.
142 (maphash (lambda (backtrace count) (puthash backtrace count newlog))
143 log1)
144 (maphash (lambda (backtrace count)
145 (puthash backtrace (- (gethash backtrace log1 0) count)
146 newlog))
147 log2)
148 newlog))
150 (defun profiler-fixup-log (log)
151 (let ((newlog (make-hash-table :test 'equal)))
152 (maphash (lambda (backtrace count)
153 (puthash (profiler-fixup-backtrace backtrace)
154 count newlog))
155 log)
156 newlog))
159 ;;; Profiles
161 (cl-defstruct (profiler-profile (:type vector)
162 (:constructor profiler-make-profile))
163 (tag 'profiler-profile)
164 (version profiler-version)
165 ;; - `type' has a value indicating the kind of profile (`memory' or `cpu').
166 ;; - `log' indicates the profile log.
167 ;; - `timestamp' has a value giving the time when the profile was obtained.
168 ;; - `diff-p' indicates if this profile represents a diff between two profiles.
169 type log timestamp diff-p)
171 (defun profiler-compare-profiles (profile1 profile2)
172 "Compare PROFILE1 with PROFILE2 and return diff."
173 (unless (eq (profiler-profile-type profile1)
174 (profiler-profile-type profile2))
175 (error "Can't compare different type of profiles"))
176 (profiler-make-profile
177 :type (profiler-profile-type profile1)
178 :timestamp (current-time)
179 :diff-p t
180 :log (profiler-compare-logs
181 (profiler-profile-log profile1)
182 (profiler-profile-log profile2))))
184 (defun profiler-fixup-profile (profile)
185 "Fixup PROFILE so that the profile could be serialized into file."
186 (profiler-make-profile
187 :type (profiler-profile-type profile)
188 :timestamp (profiler-profile-timestamp profile)
189 :diff-p (profiler-profile-diff-p profile)
190 :log (profiler-fixup-log (profiler-profile-log profile))))
192 (defun profiler-write-profile (profile filename &optional confirm)
193 "Write PROFILE into file FILENAME."
194 (with-temp-buffer
195 (let (print-level print-length)
196 (print (profiler-fixup-profile profile)
197 (current-buffer)))
198 (write-file filename confirm)))
200 (defun profiler-read-profile (filename)
201 "Read profile from file FILENAME."
202 ;; FIXME: tag and version check
203 (with-temp-buffer
204 (insert-file-contents filename)
205 (goto-char (point-min))
206 (read (current-buffer))))
208 (defun profiler-running-p (&optional mode)
209 "Return non-nil if the profiler is running.
210 Optional argument MODE means only check for the specified mode (cpu or mem)."
211 (cond ((eq mode 'cpu) (and (fboundp 'profiler-cpu-running-p)
212 (profiler-cpu-running-p)))
213 ((eq mode 'mem) (profiler-memory-running-p))
214 (t (or (profiler-running-p 'cpu)
215 (profiler-running-p 'mem)))))
217 (defun profiler-cpu-profile ()
218 "Return CPU profile."
219 (when (profiler-running-p 'cpu)
220 (profiler-make-profile
221 :type 'cpu
222 :timestamp (current-time)
223 :log (profiler-cpu-log))))
225 (defun profiler-memory-profile ()
226 "Return memory profile."
227 (when (profiler-memory-running-p)
228 (profiler-make-profile
229 :type 'memory
230 :timestamp (current-time)
231 :log (profiler-memory-log))))
234 ;;; Calltrees
236 (cl-defstruct (profiler-calltree (:constructor profiler-make-calltree))
237 entry
238 (count 0) (count-percent "")
239 parent children)
241 (defun profiler-calltree-leaf-p (tree)
242 (null (profiler-calltree-children tree)))
244 (defun profiler-calltree-count< (a b)
245 (cond ((eq (profiler-calltree-entry a) t) t)
246 ((eq (profiler-calltree-entry b) t) nil)
247 (t (< (profiler-calltree-count a)
248 (profiler-calltree-count b)))))
250 (defun profiler-calltree-count> (a b)
251 (not (profiler-calltree-count< a b)))
253 (defun profiler-calltree-depth (tree)
254 (let ((d 0))
255 (while (setq tree (profiler-calltree-parent tree))
256 (cl-incf d))
259 (defun profiler-calltree-find (tree entry)
260 "Return a child tree of ENTRY under TREE."
261 (let (result (children (profiler-calltree-children tree)))
262 (while (and children (null result))
263 (let ((child (car children)))
264 (when (function-equal (profiler-calltree-entry child) entry)
265 (setq result child))
266 (setq children (cdr children))))
267 result))
269 (defun profiler-calltree-walk (calltree function)
270 (funcall function calltree)
271 (dolist (child (profiler-calltree-children calltree))
272 (profiler-calltree-walk child function)))
274 (defun profiler-calltree-build-1 (tree log &optional reverse)
275 ;; This doesn't try to stitch up partial backtraces together.
276 ;; We still use it for reverse calltrees, but for forward calltrees, we use
277 ;; profiler-calltree-build-unified instead now.
278 (maphash
279 (lambda (backtrace count)
280 (let ((node tree)
281 (max (length backtrace)))
282 (dotimes (i max)
283 (let ((entry (aref backtrace (if reverse i (- max i 1)))))
284 (when entry
285 (let ((child (profiler-calltree-find node entry)))
286 (unless child
287 (setq child (profiler-make-calltree
288 :entry entry :parent node))
289 (push child (profiler-calltree-children node)))
290 (cl-incf (profiler-calltree-count child) count)
291 (setq node child)))))))
292 log))
295 (define-hash-table-test 'profiler-function-equal #'function-equal
296 (lambda (f) (cond
297 ((byte-code-function-p f) (aref f 1))
298 ((eq (car-safe f) 'closure) (cddr f))
299 (t f))))
301 (defun profiler-calltree-build-unified (tree log)
302 ;; Let's try to unify all those partial backtraces into a single
303 ;; call tree. First, we record in fun-map all the functions that appear
304 ;; in `log' and where they appear.
305 (let ((fun-map (make-hash-table :test 'profiler-function-equal))
306 (parent-map (make-hash-table :test 'eq))
307 (leftover-tree (profiler-make-calltree
308 :entry (intern "...") :parent tree)))
309 (push leftover-tree (profiler-calltree-children tree))
310 (maphash
311 (lambda (backtrace _count)
312 (let ((max (length backtrace)))
313 ;; Don't record the head elements in there, since we want to use this
314 ;; fun-map to find parents of partial backtraces, but parents only
315 ;; make sense if they have something "above".
316 (dotimes (i (1- max))
317 (let ((f (aref backtrace i)))
318 (when f
319 (push (cons i backtrace) (gethash f fun-map)))))))
320 log)
321 ;; Then, for each partial backtrace, try to find a parent backtrace
322 ;; (i.e. a backtrace that describes (part of) the truncated part of
323 ;; the partial backtrace). For a partial backtrace like "[f3 f2 f1]" (f3
324 ;; is deeper), any backtrace that includes f1 could be a parent; and indeed
325 ;; the counts of this partial backtrace could each come from a different
326 ;; parent backtrace (some of which may not even be in `log'). So we should
327 ;; consider each backtrace that includes f1 and give it some percentage of
328 ;; `count'. But we can't know for sure what percentage to give to each
329 ;; possible parent.
330 ;; The "right" way might be to give a percentage proportional to the counts
331 ;; already registered for that parent, or some such statistical principle.
332 ;; But instead, we will give all our counts to a single "best
333 ;; matching" parent. So let's look for the best matching parent, and store
334 ;; the result in parent-map.
335 ;; Using the "best matching parent" is important also to try and avoid
336 ;; stitching together backtraces that can't possibly go together.
337 ;; For example, when the head is `apply' (or `mapcar', ...), we want to
338 ;; make sure we don't just use any parent that calls `apply', since most of
339 ;; them would never, in turn, cause apply to call the subsequent function.
340 (maphash
341 (lambda (backtrace _count)
342 (let* ((max (1- (length backtrace)))
343 (head (aref backtrace max))
344 (best-parent nil)
345 (best-match (1+ max))
346 (parents (gethash head fun-map)))
347 (pcase-dolist (`(,i . ,parent) parents)
348 (when t ;; (<= (- max i) best-match) ;Else, it can't be better.
349 (let ((match max)
350 (imatch i))
351 (cl-assert (>= match imatch))
352 (cl-assert (function-equal (aref backtrace max)
353 (aref parent i)))
354 (while (progn
355 (cl-decf imatch) (cl-decf match)
356 (when (> imatch 0)
357 (function-equal (aref backtrace match)
358 (aref parent imatch)))))
359 (when (< match best-match)
360 (cl-assert (<= (- max i) best-match))
361 ;; Let's make sure this parent is not already our child: we
362 ;; don't want cycles here!
363 (let ((valid t)
364 (tmp-parent parent))
365 (while (setq tmp-parent
366 (if (eq tmp-parent backtrace)
367 (setq valid nil)
368 (cdr (gethash tmp-parent parent-map)))))
369 (when valid
370 (setq best-match match)
371 (setq best-parent (cons i parent))))))))
372 (puthash backtrace best-parent parent-map)))
373 log)
374 ;; Now we have a single parent per backtrace, so we have a unified tree.
375 ;; Let's build the actual call-tree from it.
376 (maphash
377 (lambda (backtrace count)
378 (let ((node tree)
379 (parents (list (cons -1 backtrace)))
380 (tmp backtrace)
381 (max (length backtrace)))
382 (while (setq tmp (gethash tmp parent-map))
383 (push tmp parents)
384 (setq tmp (cdr tmp)))
385 (when (aref (cdar parents) (1- max))
386 (cl-incf (profiler-calltree-count leftover-tree) count)
387 (setq node leftover-tree))
388 (pcase-dolist (`(,i . ,parent) parents)
389 (let ((j (1- max)))
390 (while (> j i)
391 (let ((f (aref parent j)))
392 (cl-decf j)
393 (when f
394 (let ((child (profiler-calltree-find node f)))
395 (unless child
396 (setq child (profiler-make-calltree
397 :entry f :parent node))
398 (push child (profiler-calltree-children node)))
399 (cl-incf (profiler-calltree-count child) count)
400 (setq node child)))))))))
401 log)))
403 (defun profiler-calltree-compute-percentages (tree)
404 (let ((total-count 0))
405 ;; FIXME: the memory profiler's total wraps around all too easily!
406 (dolist (child (profiler-calltree-children tree))
407 (cl-incf total-count (profiler-calltree-count child)))
408 (unless (zerop total-count)
409 (profiler-calltree-walk
410 tree (lambda (node)
411 (setf (profiler-calltree-count-percent node)
412 (profiler-format-percent (profiler-calltree-count node)
413 total-count)))))))
415 (cl-defun profiler-calltree-build (log &key reverse)
416 (let ((tree (profiler-make-calltree)))
417 (if reverse
418 (profiler-calltree-build-1 tree log reverse)
419 (profiler-calltree-build-unified tree log))
420 (profiler-calltree-compute-percentages tree)
421 tree))
423 (defun profiler-calltree-sort (tree predicate)
424 (let ((children (profiler-calltree-children tree)))
425 (setf (profiler-calltree-children tree) (sort children predicate))
426 (dolist (child (profiler-calltree-children tree))
427 (profiler-calltree-sort child predicate))))
430 ;;; Report rendering
432 (defcustom profiler-report-closed-mark "+"
433 "An indicator of closed calltrees."
434 :type 'string
435 :group 'profiler)
437 (defcustom profiler-report-open-mark "-"
438 "An indicator of open calltrees."
439 :type 'string
440 :group 'profiler)
442 (defcustom profiler-report-leaf-mark " "
443 "An indicator of calltree leaves."
444 :type 'string
445 :group 'profiler)
447 (defvar profiler-report-cpu-line-format
448 '((50 left)
449 (24 right ((19 right)
450 (5 right)))))
452 (defvar profiler-report-memory-line-format
453 '((55 left)
454 (19 right ((14 right profiler-format-number)
455 (5 right)))))
457 (defvar-local profiler-report-profile nil
458 "The current profile.")
460 (defvar-local profiler-report-reversed nil
461 "True if calltree is rendered in bottom-up. Do not touch this
462 variable directly.")
464 (defvar-local profiler-report-order nil
465 "The value can be `ascending' or `descending'. Do not touch
466 this variable directly.")
468 (defun profiler-report-make-entry-part (entry)
469 (let ((string (cond
470 ((eq entry t)
471 "Others")
472 ((and (symbolp entry)
473 (fboundp entry))
474 (propertize (symbol-name entry)
475 'face 'link
476 'mouse-face 'highlight
477 'help-echo "\
478 mouse-2: jump to definition\n\
479 RET: expand or collapse"))
481 (profiler-format-entry entry)))))
482 (propertize string 'profiler-entry entry)))
484 (defun profiler-report-make-name-part (tree)
485 (let* ((entry (profiler-calltree-entry tree))
486 (depth (profiler-calltree-depth tree))
487 (indent (make-string (* (1- depth) 1) ?\s))
488 (mark (if (profiler-calltree-leaf-p tree)
489 profiler-report-leaf-mark
490 profiler-report-closed-mark))
491 (entry (profiler-report-make-entry-part entry)))
492 (format "%s%s %s" indent mark entry)))
494 (defun profiler-report-header-line-format (fmt &rest args)
495 (let* ((header (apply #'profiler-format fmt args))
496 (escaped (replace-regexp-in-string "%" "%%" header)))
497 (concat " " escaped)))
499 (defun profiler-report-line-format (tree)
500 (let ((diff-p (profiler-profile-diff-p profiler-report-profile))
501 (name-part (profiler-report-make-name-part tree))
502 (count (profiler-calltree-count tree))
503 (count-percent (profiler-calltree-count-percent tree)))
504 (profiler-format (cl-ecase (profiler-profile-type profiler-report-profile)
505 (cpu profiler-report-cpu-line-format)
506 (memory profiler-report-memory-line-format))
507 name-part
508 (if diff-p
509 (list (if (> count 0)
510 (format "+%s" count)
511 count)
513 (list count count-percent)))))
515 (defun profiler-report-insert-calltree (tree)
516 (let ((line (profiler-report-line-format tree)))
517 (insert (propertize (concat line "\n") 'calltree tree))))
519 (defun profiler-report-insert-calltree-children (tree)
520 (mapc #'profiler-report-insert-calltree
521 (profiler-calltree-children tree)))
524 ;;; Report mode
526 (defvar profiler-report-mode-map
527 (let ((map (make-sparse-keymap)))
528 (define-key map "n" 'profiler-report-next-entry)
529 (define-key map "p" 'profiler-report-previous-entry)
530 ;; I find it annoying more than helpful to not be able to navigate
531 ;; normally with the cursor keys. --Stef
532 ;; (define-key map [down] 'profiler-report-next-entry)
533 ;; (define-key map [up] 'profiler-report-previous-entry)
534 (define-key map "\r" 'profiler-report-toggle-entry)
535 (define-key map "\t" 'profiler-report-toggle-entry)
536 (define-key map "i" '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."
696 (interactive "P")
697 (or (profiler-report-expand-entry arg)
698 (profiler-report-collapse-entry)))
700 (defun profiler-report-find-entry (&optional event)
701 "Find entry at point."
702 (interactive (list last-nonmenu-event))
703 (with-current-buffer
704 (if event (window-buffer (posn-window (event-start event)))
705 (current-buffer))
706 (and event (setq event (event-end event))
707 (posn-set-point event))
708 (let ((tree (profiler-report-calltree-at-point)))
709 (when tree
710 (let ((entry (profiler-calltree-entry tree)))
711 (find-function entry))))))
713 (defun profiler-report-describe-entry ()
714 "Describe entry at point."
715 (interactive)
716 (let ((tree (profiler-report-calltree-at-point)))
717 (when tree
718 (let ((entry (profiler-calltree-entry tree)))
719 (require 'help-fns)
720 (describe-function entry)))))
722 (cl-defun profiler-report-render-calltree-1
723 (profile &key reverse (order 'descending))
724 (let ((calltree (profiler-calltree-build
725 (profiler-profile-log profile)
726 :reverse reverse)))
727 (setq header-line-format
728 (cl-ecase (profiler-profile-type profile)
729 (cpu
730 (profiler-report-header-line-format
731 profiler-report-cpu-line-format
732 "Function" (list "CPU samples" "%")))
733 (memory
734 (profiler-report-header-line-format
735 profiler-report-memory-line-format
736 "Function" (list "Bytes" "%")))))
737 (let ((predicate (cl-ecase order
738 (ascending #'profiler-calltree-count<)
739 (descending #'profiler-calltree-count>))))
740 (profiler-calltree-sort calltree predicate))
741 (let ((inhibit-read-only t))
742 (erase-buffer)
743 (profiler-report-insert-calltree-children calltree)
744 (goto-char (point-min))
745 (profiler-report-move-to-entry))))
747 (defun profiler-report-rerender-calltree ()
748 (profiler-report-render-calltree-1 profiler-report-profile
749 :reverse profiler-report-reversed
750 :order profiler-report-order))
752 (defun profiler-report-render-calltree ()
753 "Render calltree view."
754 (interactive)
755 (setq profiler-report-reversed nil)
756 (profiler-report-rerender-calltree))
758 (defun profiler-report-render-reversed-calltree ()
759 "Render reversed calltree view."
760 (interactive)
761 (setq profiler-report-reversed t)
762 (profiler-report-rerender-calltree))
764 (defun profiler-report-ascending-sort ()
765 "Sort calltree view in ascending order."
766 (interactive)
767 (setq profiler-report-order 'ascending)
768 (profiler-report-rerender-calltree))
770 (defun profiler-report-descending-sort ()
771 "Sort calltree view in descending order."
772 (interactive)
773 (setq profiler-report-order 'descending)
774 (profiler-report-rerender-calltree))
776 (defun profiler-report-profile (profile)
777 (switch-to-buffer (profiler-report-setup-buffer profile)))
779 (defun profiler-report-profile-other-window (profile)
780 (switch-to-buffer-other-window (profiler-report-setup-buffer profile)))
782 (defun profiler-report-profile-other-frame (profile)
783 (switch-to-buffer-other-frame (profiler-report-setup-buffer profile)))
785 (defun profiler-report-compare-profile (buffer)
786 "Compare the current profile with another."
787 (interactive (list (read-buffer "Compare to: ")))
788 (let* ((profile1 (with-current-buffer buffer profiler-report-profile))
789 (profile2 profiler-report-profile)
790 (diff-profile (profiler-compare-profiles profile1 profile2)))
791 (profiler-report-profile diff-profile)))
793 (defun profiler-report-write-profile (filename &optional confirm)
794 "Write the current profile into file FILENAME."
795 (interactive
796 (list (read-file-name "Write profile: " default-directory)
797 (not current-prefix-arg)))
798 (profiler-write-profile profiler-report-profile
799 filename
800 confirm))
803 ;;; Profiler commands
805 ;;;###autoload
806 (defun profiler-start (mode)
807 "Start/restart profilers.
808 MODE can be one of `cpu', `mem', or `cpu+mem'.
809 If MODE is `cpu' or `cpu+mem', time-based profiler will be started.
810 Also, if MODE is `mem' or `cpu+mem', then memory profiler will be started."
811 (interactive
812 (list (if (not (fboundp 'profiler-cpu-start)) 'mem
813 (intern (completing-read "Mode (default cpu): "
814 '("cpu" "mem" "cpu+mem")
815 nil t nil nil "cpu")))))
816 (cl-ecase mode
817 (cpu
818 (profiler-cpu-start profiler-sampling-interval)
819 (message "CPU profiler started"))
820 (mem
821 (profiler-memory-start)
822 (message "Memory profiler started"))
823 (cpu+mem
824 (profiler-cpu-start profiler-sampling-interval)
825 (profiler-memory-start)
826 (message "CPU and memory profiler started"))))
828 (defun profiler-stop ()
829 "Stop started profilers. Profiler logs will be kept."
830 (interactive)
831 (let ((cpu (if (fboundp 'profiler-cpu-stop) (profiler-cpu-stop)))
832 (mem (profiler-memory-stop)))
833 (message "%s profiler stopped"
834 (cond ((and mem cpu) "CPU and memory")
835 (mem "Memory")
836 (cpu "CPU")
837 (t "No")))))
839 (defun profiler-reset ()
840 "Reset profiler logs."
841 (interactive)
842 (when (fboundp 'profiler-cpu-log)
843 (ignore (profiler-cpu-log)))
844 (ignore (profiler-memory-log))
847 (defun profiler-report-cpu ()
848 (let ((profile (profiler-cpu-profile)))
849 (when profile
850 (profiler-report-profile-other-window profile))))
852 (defun profiler-report-memory ()
853 (let ((profile (profiler-memory-profile)))
854 (when profile
855 (profiler-report-profile-other-window profile))))
857 (defun profiler-report ()
858 "Report profiling results."
859 (interactive)
860 (profiler-report-cpu)
861 (profiler-report-memory))
863 ;;;###autoload
864 (defun profiler-find-profile (filename)
865 "Open profile FILENAME."
866 (interactive
867 (list (read-file-name "Find profile: " default-directory)))
868 (profiler-report-profile (profiler-read-profile filename)))
870 ;;;###autoload
871 (defun profiler-find-profile-other-window (filename)
872 "Open profile FILENAME."
873 (interactive
874 (list (read-file-name "Find profile: " default-directory)))
875 (profiler-report-profile-other-window (profiler-read-profile filename)))
877 ;;;###autoload
878 (defun profiler-find-profile-other-frame (filename)
879 "Open profile FILENAME."
880 (interactive
881 (list (read-file-name "Find profile: " default-directory)))
882 (profiler-report-profile-other-frame(profiler-read-profile filename)))
885 ;;; Profiling helpers
887 ;; (cl-defmacro with-cpu-profiling ((&key sampling-interval) &rest body)
888 ;; `(unwind-protect
889 ;; (progn
890 ;; (ignore (profiler-cpu-log))
891 ;; (profiler-cpu-start ,sampling-interval)
892 ;; ,@body)
893 ;; (profiler-cpu-stop)
894 ;; (profiler--report-cpu)))
896 ;; (defmacro with-memory-profiling (&rest body)
897 ;; `(unwind-protect
898 ;; (progn
899 ;; (ignore (profiler-memory-log))
900 ;; (profiler-memory-start)
901 ;; ,@body)
902 ;; (profiler-memory-stop)
903 ;; (profiler--report-memory)))
905 (provide 'profiler)
906 ;;; profiler.el ends here