1 ;;; profiler.el --- UI and helper functions for Emacs's native profiler -*- lexical-binding: t -*-
3 ;; Copyright (C) 2012-2013 Free Software Foundation, Inc.
5 ;; Author: Tomohiro Matsuyama <tomo@cx4a.org>
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/>.
25 ;; See Info node `(elisp)Profiling'.
31 (defgroup profiler nil
37 (defconst profiler-version "24.3")
39 (defcustom profiler-sampling-interval 1000000
40 "Default sampling interval in nanoseconds."
47 (defun profiler-ensure-string (object)
48 (cond ((stringp object)
53 (number-to-string object))
55 (format "%s" object))))
57 (defun profiler-format-percent (number divisor)
58 (concat (number-to-string (/ (* number 100) 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)
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
79 (apply 'profiler-format subfmt arg))
82 ((and (symbolp subfmt)
86 (profiler-ensure-string arg)))
87 for len = (length str)
89 collect (substring str 0 width) into frags
92 (let ((padding (make-string (- width len) ?\s)))
94 (left (concat str padding))
95 (right (concat padding str))))
97 finally return (apply #'concat frags)))
102 (defun profiler-format-entry (entry)
103 "Format ENTRY in human readable string. ENTRY would be a
104 function name of a function itself."
105 (cond ((memq (car-safe entry) '(closure lambda))
106 (format "#<lambda 0x%x>" (sxhash entry)))
107 ((byte-code-function-p entry)
108 (format "#<compiled 0x%x>" (sxhash entry)))
109 ((or (subrp entry) (symbolp entry) (stringp entry))
112 (format "#<unknown 0x%x>" (sxhash entry)))))
114 (defun profiler-fixup-entry (entry)
117 (profiler-format-entry entry)))
122 (defun profiler-fixup-backtrace (backtrace)
123 (apply 'vector (mapcar 'profiler-fixup-entry backtrace)))
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
133 ;; sampling-interval or the memory being allocated).
135 (defun profiler-compare-logs (log1 log2)
136 "Compare LOG1 with LOG2 and return diff."
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))
141 (maphash (lambda (backtrace count)
142 (puthash backtrace (- (gethash backtrace log1 0) count)
147 (defun profiler-fixup-log (log)
148 (let ((newlog (make-hash-table :test 'equal)))
149 (maphash (lambda (backtrace count)
150 (puthash (profiler-fixup-backtrace backtrace)
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)
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)
177 :log (profiler-compare-logs
178 (profiler-profile-log profile1)
179 (profiler-profile-log profile2))))
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))))
189 (defun profiler-write-profile (profile filename &optional confirm)
190 "Write PROFILE into file FILENAME."
192 (let (print-level print-length)
193 (print (profiler-fixup-profile profile)
195 (write-file filename confirm)))
197 (defun profiler-read-profile (filename)
198 "Read profile from file FILENAME."
199 ;; FIXME: tag and version check
201 (insert-file-contents filename)
202 (goto-char (point-min))
203 (read (current-buffer))))
205 (defun profiler-running-p (&optional mode)
206 "Return non-nil if the profiler is running.
207 Optional 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)))))
214 (defun profiler-cpu-profile ()
215 "Return CPU profile."
216 (when (profiler-running-p 'cpu)
217 (profiler-make-profile
219 :timestamp (current-time)
220 :log (profiler-cpu-log))))
222 (defun profiler-memory-profile ()
223 "Return memory profile."
224 (when (profiler-memory-running-p)
225 (profiler-make-profile
227 :timestamp (current-time)
228 :log (profiler-memory-log))))
233 (cl-defstruct (profiler-calltree (:constructor profiler-make-calltree))
235 (count 0) (count-percent "")
238 (defun profiler-calltree-leaf-p (tree)
239 (null (profiler-calltree-children tree)))
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)))))
247 (defun profiler-calltree-count> (a b)
248 (not (profiler-calltree-count< a b)))
250 (defun profiler-calltree-depth (tree)
251 (let ((parent (profiler-calltree-parent tree)))
254 (1+ (profiler-calltree-depth parent)))))
256 (defun profiler-calltree-find (tree entry)
257 "Return a child tree of ENTRY under TREE."
258 (let (result (children (profiler-calltree-children tree)))
259 ;; FIXME: Use `assoc'.
260 (while (and children (null result))
261 (let ((child (car children)))
262 (when (equal (profiler-calltree-entry child) entry)
264 (setq children (cdr children))))
267 (defun profiler-calltree-walk (calltree function)
268 (funcall function calltree)
269 (dolist (child (profiler-calltree-children calltree))
270 (profiler-calltree-walk child function)))
272 (defun profiler-calltree-build-1 (tree log &optional reverse)
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.
278 (lambda (backtrace count)
280 (max (length backtrace)))
282 (let ((entry (aref backtrace (if reverse i (- max i 1)))))
284 (let ((child (profiler-calltree-find node entry)))
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)))))))
293 (defun profiler-calltree-compute-percentages (tree)
294 (let ((total-count 0))
295 ;; FIXME: the memory profiler's total wraps around all too easily!
296 (dolist (child (profiler-calltree-children tree))
297 (cl-incf total-count (profiler-calltree-count child)))
298 (unless (zerop total-count)
299 (profiler-calltree-walk
301 (setf (profiler-calltree-count-percent node)
302 (profiler-format-percent (profiler-calltree-count node)
305 (cl-defun profiler-calltree-build (log &key reverse)
306 (let ((tree (profiler-make-calltree)))
307 (profiler-calltree-build-1 tree log reverse)
308 (profiler-calltree-compute-percentages tree)
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))))
320 (defcustom profiler-report-closed-mark "+"
321 "An indicator of closed calltrees."
325 (defcustom profiler-report-open-mark "-"
326 "An indicator of open calltrees."
330 (defcustom profiler-report-leaf-mark " "
331 "An indicator of calltree leaves."
335 (defvar profiler-report-cpu-line-format
337 (24 right ((19 right)
340 (defvar profiler-report-memory-line-format
342 (19 right ((14 right profiler-format-number)
345 (defvar-local profiler-report-profile nil
346 "The current profile.")
348 (defvar-local profiler-report-reversed nil
349 "True if calltree is rendered in bottom-up. Do not touch this
352 (defvar-local profiler-report-order nil
353 "The value can be `ascending' or `descending'. Do not touch
354 this variable directly.")
356 (defun profiler-report-make-entry-part (entry)
360 ((and (symbolp entry)
362 (propertize (symbol-name entry)
364 'mouse-face 'highlight
366 mouse-2: jump to definition\n\
367 RET: expand or collapse"))
369 (profiler-format-entry entry)))))
370 (propertize string 'profiler-entry entry)))
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)))
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)))
387 (defun profiler-report-line-format (tree)
388 (let ((diff-p (profiler-profile-diff-p profiler-report-profile))
389 (name-part (profiler-report-make-name-part tree))
390 (count (profiler-calltree-count tree))
391 (count-percent (profiler-calltree-count-percent tree)))
392 (profiler-format (cl-ecase (profiler-profile-type profiler-report-profile)
393 (cpu profiler-report-cpu-line-format)
394 (memory profiler-report-memory-line-format))
397 (list (if (> count 0)
401 (list count count-percent)))))
403 (defun profiler-report-insert-calltree (tree)
404 (let ((line (profiler-report-line-format tree)))
405 (insert (propertize (concat line "\n") 'calltree tree))))
407 (defun profiler-report-insert-calltree-children (tree)
408 (mapc 'profiler-report-insert-calltree
409 (profiler-calltree-children tree)))
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)
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)
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)
433 (define-key map "=" 'profiler-report-compare-profile)
434 (define-key map (kbd "C-x C-w") 'profiler-report-write-profile)
435 (easy-menu-define profiler-report-menu map "Menu for Profiler Report mode."
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"]
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"]
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"]
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
469 :help "Write current profile to a file"]
471 ["Start Profiler" profiler-start :active (not (profiler-running-p))
472 :help "Start profiling"]
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"]))
478 "Keymap for `profiler-report-mode'.")
480 (defun profiler-report-make-buffer-name (profile)
481 (format "*%s-Profiler-Report %s*"
482 (cl-ecase (profiler-profile-type profile) (cpu 'CPU) (memory 'Memory))
483 (format-time-string "%Y-%m-%d %T" (profiler-profile-timestamp profile))))
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))
488 (buffer (get-buffer-create buf-name)))
489 (with-current-buffer buffer
490 (profiler-report-mode)
491 (setq profiler-report-profile profile
492 profiler-report-reversed nil
493 profiler-report-order 'descending))
496 (defun profiler-report-setup-buffer (profile)
497 "Make a buffer for PROFILE with rendering the profile and
499 (let ((buffer (profiler-report-setup-buffer-1 profile)))
500 (with-current-buffer buffer
501 (profiler-report-render-calltree))
504 (define-derived-mode profiler-report-mode special-mode "Profiler-Report"
505 "Profiler Report Mode."
506 (setq buffer-read-only t
513 (defun profiler-report-calltree-at-point (&optional point)
514 (get-text-property (or point (point)) 'calltree))
516 (defun profiler-report-move-to-entry ()
517 (let ((point (next-single-property-change
518 (line-beginning-position) 'profiler-entry)))
521 (back-to-indentation))))
523 (defun profiler-report-next-entry ()
524 "Move cursor to next entry."
527 (profiler-report-move-to-entry))
529 (defun profiler-report-previous-entry ()
530 "Move cursor to previous entry."
533 (profiler-report-move-to-entry))
535 (defun profiler-report-expand-entry ()
536 "Expand entry at point."
540 (when (search-forward (concat profiler-report-closed-mark " ")
541 (line-end-position) t)
542 (let ((tree (profiler-report-calltree-at-point)))
544 (let ((inhibit-read-only t))
545 (replace-match (concat profiler-report-open-mark " "))
547 (profiler-report-insert-calltree-children tree)
550 (defun profiler-report-collapse-entry ()
551 "Collapse entry at point."
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))
562 (let ((inhibit-read-only t))
563 (replace-match (concat profiler-report-closed-mark " "))
564 (while (and (eq (forward-line) 0)
565 (let ((child (get-text-property (point) 'calltree)))
567 (numberp (setq d (profiler-calltree-depth child)))))
569 (delete-region start (line-beginning-position)))))
572 (defun profiler-report-toggle-entry ()
573 "Expand entry at point if the tree is collapsed,
576 (or (profiler-report-expand-entry)
577 (profiler-report-collapse-entry)))
579 (defun profiler-report-find-entry (&optional event)
580 "Find entry at point."
581 (interactive (list last-nonmenu-event))
583 (if event (window-buffer (posn-window (event-start event)))
585 (and event (setq event (event-end event))
586 (posn-set-point event))
587 (let ((tree (profiler-report-calltree-at-point)))
589 (let ((entry (profiler-calltree-entry tree)))
590 (find-function entry))))))
592 (defun profiler-report-describe-entry ()
593 "Describe entry at point."
595 (let ((tree (profiler-report-calltree-at-point)))
597 (let ((entry (profiler-calltree-entry tree)))
599 (describe-function entry)))))
601 (cl-defun profiler-report-render-calltree-1
602 (profile &key reverse (order 'descending))
603 (let ((calltree (profiler-calltree-build
604 (profiler-profile-log profile)
606 (setq header-line-format
607 (cl-ecase (profiler-profile-type profile)
609 (profiler-report-header-line-format
610 profiler-report-cpu-line-format
611 "Function" (list "CPU samples" "%")))
613 (profiler-report-header-line-format
614 profiler-report-memory-line-format
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))
622 (profiler-report-insert-calltree-children calltree)
623 (goto-char (point-min))
624 (profiler-report-move-to-entry))))
626 (defun profiler-report-rerender-calltree ()
627 (profiler-report-render-calltree-1 profiler-report-profile
628 :reverse profiler-report-reversed
629 :order profiler-report-order))
631 (defun profiler-report-render-calltree ()
632 "Render calltree view."
634 (setq profiler-report-reversed nil)
635 (profiler-report-rerender-calltree))
637 (defun profiler-report-render-reversed-calltree ()
638 "Render reversed calltree view."
640 (setq profiler-report-reversed t)
641 (profiler-report-rerender-calltree))
643 (defun profiler-report-ascending-sort ()
644 "Sort calltree view in ascending order."
646 (setq profiler-report-order 'ascending)
647 (profiler-report-rerender-calltree))
649 (defun profiler-report-descending-sort ()
650 "Sort calltree view in descending order."
652 (setq profiler-report-order 'descending)
653 (profiler-report-rerender-calltree))
655 (defun profiler-report-profile (profile)
656 (switch-to-buffer (profiler-report-setup-buffer profile)))
658 (defun profiler-report-profile-other-window (profile)
659 (switch-to-buffer-other-window (profiler-report-setup-buffer profile)))
661 (defun profiler-report-profile-other-frame (profile)
662 (switch-to-buffer-other-frame (profiler-report-setup-buffer profile)))
664 (defun profiler-report-compare-profile (buffer)
665 "Compare the current profile with another."
666 (interactive (list (read-buffer "Compare to: ")))
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)))
672 (defun profiler-report-write-profile (filename &optional confirm)
673 "Write the current profile into file FILENAME."
675 (list (read-file-name "Write profile: " default-directory)
676 (not current-prefix-arg)))
677 (profiler-write-profile profiler-report-profile
682 ;;; Profiler commands
685 (defun profiler-start (mode)
686 "Start/restart profilers.
687 MODE can be one of `cpu', `mem', or `cpu+mem'.
688 If MODE is `cpu' or `cpu+mem', time-based profiler will be started.
689 Also, if MODE is `mem' or `cpu+mem', then memory profiler will be started."
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")))))
697 (profiler-cpu-start profiler-sampling-interval)
698 (message "CPU profiler started"))
700 (profiler-memory-start)
701 (message "Memory profiler started"))
703 (profiler-cpu-start profiler-sampling-interval)
704 (profiler-memory-start)
705 (message "CPU and memory profiler started"))))
707 (defun profiler-stop ()
708 "Stop started profilers. Profiler logs will be kept."
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")
718 (defun profiler-reset ()
719 "Reset profiler logs."
721 (when (fboundp 'profiler-cpu-log)
722 (ignore (profiler-cpu-log)))
723 (ignore (profiler-memory-log))
726 (defun profiler-report-cpu ()
727 (let ((profile (profiler-cpu-profile)))
729 (profiler-report-profile-other-window profile))))
731 (defun profiler-report-memory ()
732 (let ((profile (profiler-memory-profile)))
734 (profiler-report-profile-other-window profile))))
736 (defun profiler-report ()
737 "Report profiling results."
739 (profiler-report-cpu)
740 (profiler-report-memory))
743 (defun profiler-find-profile (filename)
744 "Open profile FILENAME."
746 (list (read-file-name "Find profile: " default-directory)))
747 (profiler-report-profile (profiler-read-profile filename)))
750 (defun profiler-find-profile-other-window (filename)
751 "Open profile FILENAME."
753 (list (read-file-name "Find profile: " default-directory)))
754 (profiler-report-profile-other-window (profiler-read-profile filename)))
757 (defun profiler-find-profile-other-frame (filename)
758 "Open profile FILENAME."
760 (list (read-file-name "Find profile: " default-directory)))
761 (profiler-report-profile-other-frame(profiler-read-profile filename)))
764 ;;; Profiling helpers
766 ;; (cl-defmacro with-cpu-profiling ((&key sampling-interval) &rest body)
769 ;; (ignore (profiler-cpu-log))
770 ;; (profiler-cpu-start ,sampling-interval)
772 ;; (profiler-cpu-stop)
773 ;; (profiler--report-cpu)))
775 ;; (defmacro with-memory-profiling (&rest body)
778 ;; (ignore (profiler-memory-log))
779 ;; (profiler-memory-start)
781 ;; (profiler-memory-stop)
782 ;; (profiler--report-memory)))
785 ;;; profiler.el ends here