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 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.
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.
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/>.
29 (defgroup profiler nil
35 (defconst profiler-version
"24.3")
37 (defcustom profiler-sampling-interval
1000000
38 "Default sampling interval in nanoseconds."
45 (defun profiler-ensure-string (object)
46 (cond ((stringp object
)
51 (number-to-string object
))
53 (format "%s" object
))))
55 (defun profiler-format-percent (number divisor
)
56 (concat (number-to-string (/ (* number
100) divisor
)) "%"))
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
)
69 (apply 'string
(if (eq (car s
) ?
,) (cdr s
) s
)))
70 (profiler-ensure-string number
)))
72 (defun profiler-format (fmt &rest args
)
73 (cl-loop for
(width align subfmt
) in fmt
77 (apply 'profiler-format subfmt arg
))
80 ((and (symbolp subfmt
)
84 (profiler-ensure-string arg
)))
85 for len
= (length str
)
87 collect
(substring str
0 width
) into frags
90 (let ((padding (make-string (- width len
) ?\s
)))
92 (left (concat str padding
))
93 (right (concat padding str
))))
95 finally return
(apply #'concat frags
)))
100 (defun profiler-format-entry (entry)
101 "Format ENTRY in human readable string. ENTRY would be a
102 function name of a function itself."
103 (cond ((memq (car-safe entry
) '(closure lambda
))
104 (format "#<lambda 0x%x>" (sxhash entry
)))
105 ((byte-code-function-p entry
)
106 (format "#<compiled 0x%x>" (sxhash entry
)))
107 ((or (subrp entry
) (symbolp entry
) (stringp entry
))
110 (format "#<unknown 0x%x>" (sxhash entry
)))))
112 (defun profiler-fixup-entry (entry)
115 (profiler-format-entry entry
)))
120 (defun profiler-fixup-backtrace (backtrace)
121 (apply 'vector
(mapcar 'profiler-fixup-entry backtrace
)))
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
131 ;; sampling-interval or the memory being allocated).
133 (defun profiler-compare-logs (log1 log2
)
134 "Compare LOG1 with LOG2 and return diff."
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
))
139 (maphash (lambda (backtrace count
)
140 (puthash backtrace
(- (gethash backtrace log1
0) count
)
145 (defun profiler-fixup-log (log)
146 (let ((newlog (make-hash-table :test
'equal
)))
147 (maphash (lambda (backtrace count
)
148 (puthash (profiler-fixup-backtrace backtrace
)
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
)
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)
175 :log
(profiler-compare-logs
176 (profiler-profile-log profile1
)
177 (profiler-profile-log profile2
))))
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
))))
187 (defun profiler-write-profile (profile filename
&optional confirm
)
188 "Write PROFILE into file FILENAME."
190 (let (print-level print-length
)
191 (print (profiler-fixup-profile profile
)
193 (write-file filename confirm
)))
195 (defun profiler-read-profile (filename)
196 "Read profile from file FILENAME."
197 ;; FIXME: tag and version check
199 (insert-file-contents filename
)
200 (goto-char (point-min))
201 (read (current-buffer))))
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
210 :timestamp
(current-time)
211 :log
(profiler-cpu-log))))
213 (defun profiler-memory-profile ()
214 "Return memory profile."
215 (when (profiler-memory-running-p)
216 (profiler-make-profile
218 :timestamp
(current-time)
219 :log
(profiler-memory-log))))
224 (cl-defstruct (profiler-calltree (:constructor profiler-make-calltree
))
226 (count 0) (count-percent "")
229 (defun profiler-calltree-leaf-p (tree)
230 (null (profiler-calltree-children tree
)))
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
)))))
238 (defun profiler-calltree-count> (a b
)
239 (not (profiler-calltree-count< a b
)))
241 (defun profiler-calltree-depth (tree)
242 (let ((parent (profiler-calltree-parent tree
)))
245 (1+ (profiler-calltree-depth parent
)))))
247 (defun profiler-calltree-find (tree entry
)
248 "Return a child tree of ENTRY under TREE."
249 (let (result (children (profiler-calltree-children tree
)))
250 ;; FIXME: Use `assoc'.
251 (while (and children
(null result
))
252 (let ((child (car children
)))
253 (when (equal (profiler-calltree-entry child
) entry
)
255 (setq children
(cdr children
))))
258 (defun profiler-calltree-walk (calltree function
)
259 (funcall function calltree
)
260 (dolist (child (profiler-calltree-children calltree
))
261 (profiler-calltree-walk child function
)))
263 (defun profiler-calltree-build-1 (tree log
&optional reverse
)
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.
269 (lambda (backtrace count
)
271 (max (length backtrace
)))
273 (let ((entry (aref backtrace
(if reverse i
(- max i
1)))))
275 (let ((child (profiler-calltree-find node entry
)))
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
)))))))
284 (defun profiler-calltree-compute-percentages (tree)
285 (let ((total-count 0))
286 ;; FIXME: the memory profiler's total wraps around all too easily!
287 (dolist (child (profiler-calltree-children tree
))
288 (cl-incf total-count
(profiler-calltree-count child
)))
289 (unless (zerop total-count
)
290 (profiler-calltree-walk
292 (setf (profiler-calltree-count-percent node
)
293 (profiler-format-percent (profiler-calltree-count node
)
296 (cl-defun profiler-calltree-build (log &key reverse
)
297 (let ((tree (profiler-make-calltree)))
298 (profiler-calltree-build-1 tree log reverse
)
299 (profiler-calltree-compute-percentages tree
)
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
))))
311 (defcustom profiler-report-closed-mark
"+"
312 "An indicator of closed calltrees."
316 (defcustom profiler-report-open-mark
"-"
317 "An indicator of open calltrees."
321 (defcustom profiler-report-leaf-mark
" "
322 "An indicator of calltree leaves."
326 (defvar profiler-report-cpu-line-format
328 (24 right
((19 right
)
331 (defvar profiler-report-memory-line-format
333 (19 right
((14 right profiler-format-number
)
336 (defvar-local profiler-report-profile nil
337 "The current profile.")
339 (defvar-local profiler-report-reversed nil
340 "True if calltree is rendered in bottom-up. Do not touch this
343 (defvar-local profiler-report-order nil
344 "The value can be `ascending' or `descending'. Do not touch
345 this variable directly.")
347 (defun profiler-report-make-entry-part (entry)
351 ((and (symbolp entry
)
353 (propertize (symbol-name entry
)
355 'mouse-face
'highlight
357 mouse-2: jump to definition\n\
358 RET: expand or collapse"))
360 (profiler-format-entry entry
)))))
361 (propertize string
'profiler-entry entry
)))
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
)))
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
)))
378 (defun profiler-report-line-format (tree)
379 (let ((diff-p (profiler-profile-diff-p profiler-report-profile
))
380 (name-part (profiler-report-make-name-part tree
))
381 (count (profiler-calltree-count tree
))
382 (count-percent (profiler-calltree-count-percent tree
)))
383 (profiler-format (cl-ecase (profiler-profile-type profiler-report-profile
)
384 (cpu profiler-report-cpu-line-format
)
385 (memory profiler-report-memory-line-format
))
388 (list (if (> count
0)
392 (list count count-percent
)))))
394 (defun profiler-report-insert-calltree (tree)
395 (let ((line (profiler-report-line-format tree
)))
396 (insert (propertize (concat line
"\n") 'calltree tree
))))
398 (defun profiler-report-insert-calltree-children (tree)
399 (mapc 'profiler-report-insert-calltree
400 (profiler-calltree-children tree
)))
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
)
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)
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
)
424 (define-key map
"=" 'profiler-report-compare-profile
)
425 (define-key map
(kbd "C-x C-w") 'profiler-report-write-profile
)
426 (easy-menu-define profiler-report-menu map
"Menu for Profiler Report mode."
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"]
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"]
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"]
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"]))
462 "Keymap for `profiler-report-mode'.")
464 (defun profiler-report-make-buffer-name (profile)
465 (format "*%s-Profiler-Report %s*"
466 (cl-ecase (profiler-profile-type profile
) (cpu 'CPU
) (memory 'Memory
))
467 (format-time-string "%Y-%m-%d %T" (profiler-profile-timestamp profile
))))
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
))
472 (buffer (get-buffer-create buf-name
)))
473 (with-current-buffer buffer
474 (profiler-report-mode)
475 (setq profiler-report-profile profile
476 profiler-report-reversed nil
477 profiler-report-order
'descending
))
480 (defun profiler-report-setup-buffer (profile)
481 "Make a buffer for PROFILE with rendering the profile and
483 (let ((buffer (profiler-report-setup-buffer-1 profile
)))
484 (with-current-buffer buffer
485 (profiler-report-render-calltree))
488 (define-derived-mode profiler-report-mode special-mode
"Profiler-Report"
489 "Profiler Report Mode."
490 (setq buffer-read-only t
497 (defun profiler-report-calltree-at-point (&optional point
)
498 (get-text-property (or point
(point)) 'calltree
))
500 (defun profiler-report-move-to-entry ()
501 (let ((point (next-single-property-change
502 (line-beginning-position) 'profiler-entry
)))
505 (back-to-indentation))))
507 (defun profiler-report-next-entry ()
508 "Move cursor to next entry."
511 (profiler-report-move-to-entry))
513 (defun profiler-report-previous-entry ()
514 "Move cursor to previous entry."
517 (profiler-report-move-to-entry))
519 (defun profiler-report-expand-entry ()
520 "Expand entry at point."
524 (when (search-forward (concat profiler-report-closed-mark
" ")
525 (line-end-position) t
)
526 (let ((tree (profiler-report-calltree-at-point)))
528 (let ((inhibit-read-only t
))
529 (replace-match (concat profiler-report-open-mark
" "))
531 (profiler-report-insert-calltree-children tree
)
534 (defun profiler-report-collapse-entry ()
535 "Collapse entry at point."
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))
546 (let ((inhibit-read-only t
))
547 (replace-match (concat profiler-report-closed-mark
" "))
548 (while (and (eq (forward-line) 0)
549 (let ((child (get-text-property (point) 'calltree
)))
551 (numberp (setq d
(profiler-calltree-depth child
)))))
553 (delete-region start
(line-beginning-position)))))
556 (defun profiler-report-toggle-entry ()
557 "Expand entry at point if the tree is collapsed,
560 (or (profiler-report-expand-entry)
561 (profiler-report-collapse-entry)))
563 (defun profiler-report-find-entry (&optional event
)
564 "Find entry at point."
565 (interactive (list last-nonmenu-event
))
567 (if event
(window-buffer (posn-window (event-start event
)))
569 (and event
(setq event
(event-end event
))
570 (posn-set-point event
))
571 (let ((tree (profiler-report-calltree-at-point)))
573 (let ((entry (profiler-calltree-entry tree
)))
574 (find-function entry
))))))
576 (defun profiler-report-describe-entry ()
577 "Describe entry at point."
579 (let ((tree (profiler-report-calltree-at-point)))
581 (let ((entry (profiler-calltree-entry tree
)))
583 (describe-function entry
)))))
585 (cl-defun profiler-report-render-calltree-1
586 (profile &key reverse
(order 'descending
))
587 (let ((calltree (profiler-calltree-build
588 (profiler-profile-log profile
)
590 (setq header-line-format
591 (cl-ecase (profiler-profile-type profile
)
593 (profiler-report-header-line-format
594 profiler-report-cpu-line-format
595 "Function" (list "CPU samples" "%")))
597 (profiler-report-header-line-format
598 profiler-report-memory-line-format
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
))
606 (profiler-report-insert-calltree-children calltree
)
607 (goto-char (point-min))
608 (profiler-report-move-to-entry))))
610 (defun profiler-report-rerender-calltree ()
611 (profiler-report-render-calltree-1 profiler-report-profile
612 :reverse profiler-report-reversed
613 :order profiler-report-order
))
615 (defun profiler-report-render-calltree ()
616 "Render calltree view."
618 (setq profiler-report-reversed nil
)
619 (profiler-report-rerender-calltree))
621 (defun profiler-report-render-reversed-calltree ()
622 "Render reversed calltree view."
624 (setq profiler-report-reversed t
)
625 (profiler-report-rerender-calltree))
627 (defun profiler-report-ascending-sort ()
628 "Sort calltree view in ascending order."
630 (setq profiler-report-order
'ascending
)
631 (profiler-report-rerender-calltree))
633 (defun profiler-report-descending-sort ()
634 "Sort calltree view in descending order."
636 (setq profiler-report-order
'descending
)
637 (profiler-report-rerender-calltree))
639 (defun profiler-report-profile (profile)
640 (switch-to-buffer (profiler-report-setup-buffer profile
)))
642 (defun profiler-report-profile-other-window (profile)
643 (switch-to-buffer-other-window (profiler-report-setup-buffer profile
)))
645 (defun profiler-report-profile-other-frame (profile)
646 (switch-to-buffer-other-frame (profiler-report-setup-buffer profile
)))
648 (defun profiler-report-compare-profile (buffer)
649 "Compare the current profile with another."
650 (interactive (list (read-buffer "Compare to: ")))
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
)))
656 (defun profiler-report-write-profile (filename &optional confirm
)
657 "Write the current profile into file FILENAME."
659 (list (read-file-name "Write profile: " default-directory
)
660 (not current-prefix-arg
)))
661 (profiler-write-profile profiler-report-profile
666 ;;; Profiler commands
669 (defun profiler-start (mode)
670 "Start/restart profilers.
671 MODE can be one of `cpu', `mem', or `cpu+mem'.
672 If MODE is `cpu' or `cpu+mem', time-based profiler will be started.
673 Also, if MODE is `mem' or `cpu+mem', then memory profiler will be started."
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")))))
681 (profiler-cpu-start profiler-sampling-interval
)
682 (message "CPU profiler started"))
684 (profiler-memory-start)
685 (message "Memory profiler started"))
687 (profiler-cpu-start profiler-sampling-interval
)
688 (profiler-memory-start)
689 (message "CPU and memory profiler started"))))
691 (defun profiler-stop ()
692 "Stop started profilers. Profiler logs will be kept."
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")
702 (defun profiler-reset ()
703 "Reset profiler logs."
705 (when (fboundp 'profiler-cpu-log
)
706 (ignore (profiler-cpu-log)))
707 (ignore (profiler-memory-log))
710 (defun profiler-report-cpu ()
711 (let ((profile (profiler-cpu-profile)))
713 (profiler-report-profile-other-window profile
))))
715 (defun profiler-report-memory ()
716 (let ((profile (profiler-memory-profile)))
718 (profiler-report-profile-other-window profile
))))
720 (defun profiler-report ()
721 "Report profiling results."
723 (profiler-report-cpu)
724 (profiler-report-memory))
727 (defun profiler-find-profile (filename)
728 "Open profile FILENAME."
730 (list (read-file-name "Find profile: " default-directory
)))
731 (profiler-report-profile (profiler-read-profile filename
)))
734 (defun profiler-find-profile-other-window (filename)
735 "Open profile FILENAME."
737 (list (read-file-name "Find profile: " default-directory
)))
738 (profiler-report-profile-other-window (profiler-read-profile filename
)))
741 (defun profiler-find-profile-other-frame (filename)
742 "Open profile FILENAME."
744 (list (read-file-name "Find profile: " default-directory
)))
745 (profiler-report-profile-other-frame(profiler-read-profile filename
)))
748 ;;; Profiling helpers
750 ;; (cl-defmacro with-cpu-profiling ((&key sampling-interval) &rest body)
753 ;; (ignore (profiler-cpu-log))
754 ;; (profiler-cpu-start ,sampling-interval)
756 ;; (profiler-cpu-stop)
757 ;; (profiler--report-cpu)))
759 ;; (defmacro with-memory-profiling (&rest body)
762 ;; (ignore (profiler-memory-log))
763 ;; (profiler-memory-start)
765 ;; (profiler-memory-stop)
766 ;; (profiler--report-memory)))
769 ;;; profiler.el ends here