1 ;;; profiler.el --- UI and helper functions for Emacs's native profiler -*- lexical-binding: t -*-
3 ;; Copyright (C) 2012 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
34 (defconst profiler-version
"24.3")
36 (defcustom profiler-sampling-interval
1
37 "Default sampling interval in millisecond."
44 (defun profiler-ensure-string (object)
45 (cond ((stringp object
)
50 (number-to-string object
))
52 (format "%s" object
))))
54 (defun profiler-format-percent (number divisor
)
55 (concat (number-to-string (/ (* number
100) divisor
)) "%"))
57 (defun profiler-format-number (number)
58 "Format NUMBER in human readable string."
59 (if (and (integerp number
) (> number
0))
60 (cl-loop with i
= (%
(1+ (floor (log10 number
))) 3)
61 for c in
(append (number-to-string number
) nil
)
68 (apply 'string
(if (eq (car s
) ?
,) (cdr s
) s
)))
69 (profiler-ensure-string number
)))
71 (defun profiler-format (fmt &rest args
)
72 (cl-loop for
(width align subfmt
) in fmt
76 (apply 'profiler-format subfmt arg
))
79 ((and (symbolp subfmt
)
83 (profiler-ensure-string arg
)))
84 for len
= (length str
)
86 collect
(substring str
0 width
) into frags
89 (let ((padding (make-string (- width len
) ?\s
)))
91 (left (concat str padding
))
92 (right (concat padding str
))))
94 finally return
(apply #'concat frags
)))
99 (defun profiler-format-entry (entry)
100 "Format ENTRY in human readable string. ENTRY would be a
101 function name of a function itself."
102 (cond ((memq (car-safe entry
) '(closure lambda
))
103 (format "#<lambda 0x%x>" (sxhash entry
)))
104 ((byte-code-function-p entry
)
105 (format "#<compiled 0x%x>" (sxhash entry
)))
106 ((or (subrp entry
) (symbolp entry
) (stringp entry
))
109 (format "#<unknown 0x%x>" (sxhash entry
)))))
111 (defun profiler-fixup-entry (entry)
114 (profiler-format-entry entry
)))
119 (defun profiler-fixup-backtrace (backtrace)
120 (apply 'vector
(mapcar 'profiler-fixup-entry backtrace
)))
125 ;; The C code returns the log in the form of a hash-table where the keys are
126 ;; vectors (of size profiler-max-stack-depth, holding truncated
127 ;; backtraces, where the first element is the top of the stack) and
128 ;; the values are integers (which count how many times this backtrace
129 ;; has been seen, multiplied by a "weight factor" which is either the
130 ;; sampling-interval or the memory being allocated).
132 (defun profiler-compare-logs (log1 log2
)
133 "Compare LOG1 with LOG2 and return diff."
134 (let ((newlog (make-hash-table :test
'equal
)))
135 ;; Make a copy of `log1' into `newlog'.
136 (maphash (lambda (backtrace count
) (puthash backtrace count newlog
))
138 (maphash (lambda (backtrace count
)
139 (puthash backtrace
(- (gethash backtrace log1
0) count
)
144 (defun profiler-fixup-log (log)
145 (let ((newlog (make-hash-table :test
'equal
)))
146 (maphash (lambda (backtrace count
)
147 (puthash (profiler-fixup-backtrace backtrace
)
155 (cl-defstruct (profiler-profile (:type vector
)
156 (:constructor profiler-make-profile
))
157 (tag 'profiler-profile
)
158 (version profiler-version
)
159 ;; - `type' has a value indicating the kind of profile (`memory' or `cpu').
160 ;; - `log' indicates the profile log.
161 ;; - `timestamp' has a value giving the time when the profile was obtained.
162 ;; - `diff-p' indicates if this profile represents a diff between two profiles.
163 type log timestamp diff-p
)
165 (defun profiler-compare-profiles (profile1 profile2
)
166 "Compare PROFILE1 with PROFILE2 and return diff."
167 (unless (eq (profiler-profile-type profile1
)
168 (profiler-profile-type profile2
))
169 (error "Can't compare different type of profiles"))
170 (profiler-make-profile
171 :type
(profiler-profile-type profile1
)
172 :timestamp
(current-time)
174 :log
(profiler-compare-logs
175 (profiler-profile-log profile1
)
176 (profiler-profile-log profile2
))))
178 (defun profiler-fixup-profile (profile)
179 "Fixup PROFILE so that the profile could be serialized into file."
180 (profiler-make-profile
181 :type
(profiler-profile-type profile
)
182 :timestamp
(profiler-profile-timestamp profile
)
183 :diff-p
(profiler-profile-diff-p profile
)
184 :log
(profiler-fixup-log (profiler-profile-log profile
))))
186 (defun profiler-write-profile (profile filename
&optional confirm
)
187 "Write PROFILE into file FILENAME."
189 (let (print-level print-length
)
190 (print (profiler-fixup-profile profile
)
192 (write-file filename confirm
)))
194 (defun profiler-read-profile (filename)
195 "Read profile from file FILENAME."
196 ;; FIXME: tag and version check
198 (insert-file-contents filename
)
199 (goto-char (point-min))
200 (read (current-buffer))))
202 (defun profiler-cpu-profile ()
203 "Return CPU profile."
204 (when (and (fboundp 'profiler-cpu-running-p
)
205 (fboundp 'profiler-cpu-log
)
206 (profiler-cpu-running-p))
207 (profiler-make-profile
209 :timestamp
(current-time)
210 :log
(profiler-cpu-log))))
212 (defun profiler-memory-profile ()
213 "Return memory profile."
214 (when (profiler-memory-running-p)
215 (profiler-make-profile
217 :timestamp
(current-time)
218 :log
(profiler-memory-log))))
223 (cl-defstruct (profiler-calltree (:constructor profiler-make-calltree
))
225 (count 0) (count-percent "")
228 (defun profiler-calltree-leaf-p (tree)
229 (null (profiler-calltree-children tree
)))
231 (defun profiler-calltree-count< (a b
)
232 (cond ((eq (profiler-calltree-entry a
) t
) t
)
233 ((eq (profiler-calltree-entry b
) t
) nil
)
234 (t (< (profiler-calltree-count a
)
235 (profiler-calltree-count b
)))))
237 (defun profiler-calltree-count> (a b
)
238 (not (profiler-calltree-count< a b
)))
240 (defun profiler-calltree-depth (tree)
241 (let ((parent (profiler-calltree-parent tree
)))
244 (1+ (profiler-calltree-depth parent
)))))
246 (defun profiler-calltree-find (tree entry
)
247 "Return a child tree of ENTRY under TREE."
248 (let (result (children (profiler-calltree-children tree
)))
249 ;; FIXME: Use `assoc'.
250 (while (and children
(null result
))
251 (let ((child (car children
)))
252 (when (equal (profiler-calltree-entry child
) entry
)
254 (setq children
(cdr children
))))
257 (defun profiler-calltree-walk (calltree function
)
258 (funcall function calltree
)
259 (dolist (child (profiler-calltree-children calltree
))
260 (profiler-calltree-walk child function
)))
262 (defun profiler-calltree-build-1 (tree log
&optional reverse
)
263 ;; FIXME: Do a better job of reconstructing a complete call-tree
264 ;; when the backtraces have been truncated. Ideally, we should be
265 ;; able to reduce profiler-max-stack-depth to 3 or 4 and still
266 ;; get a meaningful call-tree.
268 (lambda (backtrace count
)
270 (max (length backtrace
)))
272 (let ((entry (aref backtrace
(if reverse i
(- max i
1)))))
274 (let ((child (profiler-calltree-find node entry
)))
276 (setq child
(profiler-make-calltree
277 :entry entry
:parent node
))
278 (push child
(profiler-calltree-children node
)))
279 (cl-incf (profiler-calltree-count child
) count
)
280 (setq node child
)))))))
283 (defun profiler-calltree-compute-percentages (tree)
284 (let ((total-count 0))
285 ;; FIXME: the memory profiler's total wraps around all too easily!
286 (dolist (child (profiler-calltree-children tree
))
287 (cl-incf total-count
(profiler-calltree-count child
)))
288 (unless (zerop total-count
)
289 (profiler-calltree-walk
291 (setf (profiler-calltree-count-percent node
)
292 (profiler-format-percent (profiler-calltree-count node
)
295 (cl-defun profiler-calltree-build (log &key reverse
)
296 (let ((tree (profiler-make-calltree)))
297 (profiler-calltree-build-1 tree log reverse
)
298 (profiler-calltree-compute-percentages tree
)
301 (defun profiler-calltree-sort (tree predicate
)
302 (let ((children (profiler-calltree-children tree
)))
303 (setf (profiler-calltree-children tree
) (sort children predicate
))
304 (dolist (child (profiler-calltree-children tree
))
305 (profiler-calltree-sort child predicate
))))
310 (defcustom profiler-report-closed-mark
"+"
311 "An indicator of closed calltrees."
315 (defcustom profiler-report-open-mark
"-"
316 "An indicator of open calltrees."
320 (defcustom profiler-report-leaf-mark
" "
321 "An indicator of calltree leaves."
325 (defvar profiler-report-cpu-line-format
330 (defvar profiler-report-memory-line-format
332 (19 right
((14 right profiler-format-number
)
335 (defvar-local profiler-report-profile nil
336 "The current profile.")
338 (defvar-local profiler-report-reversed nil
339 "True if calltree is rendered in bottom-up. Do not touch this
342 (defvar-local profiler-report-order nil
343 "The value can be `ascending' or `descending'. Do not touch
344 this variable directly.")
346 (defun profiler-report-make-entry-part (entry)
350 ((and (symbolp entry
)
352 (propertize (symbol-name entry
)
354 'mouse-face
'highlight
355 'help-echo
"mouse-2 or RET jumps to definition"))
357 (profiler-format-entry entry
)))))
358 (propertize string
'profiler-entry entry
)))
360 (defun profiler-report-make-name-part (tree)
361 (let* ((entry (profiler-calltree-entry tree
))
362 (depth (profiler-calltree-depth tree
))
363 (indent (make-string (* (1- depth
) 2) ?\s
))
364 (mark (if (profiler-calltree-leaf-p tree
)
365 profiler-report-leaf-mark
366 profiler-report-closed-mark
))
367 (entry (profiler-report-make-entry-part entry
)))
368 (format "%s%s %s" indent mark entry
)))
370 (defun profiler-report-header-line-format (fmt &rest args
)
371 (let* ((header (apply 'profiler-format fmt args
))
372 (escaped (replace-regexp-in-string "%" "%%" header
)))
373 (concat " " escaped
)))
375 (defun profiler-report-line-format (tree)
376 (let ((diff-p (profiler-profile-diff-p profiler-report-profile
))
377 (name-part (profiler-report-make-name-part tree
))
378 (count (profiler-calltree-count tree
))
379 (count-percent (profiler-calltree-count-percent tree
)))
380 (profiler-format (cl-ecase (profiler-profile-type profiler-report-profile
)
381 (cpu profiler-report-cpu-line-format
)
382 (memory profiler-report-memory-line-format
))
385 (list (if (> count
0)
389 (list count count-percent
)))))
391 (defun profiler-report-insert-calltree (tree)
392 (let ((line (profiler-report-line-format tree
)))
393 (insert (propertize (concat line
"\n") 'calltree tree
))))
395 (defun profiler-report-insert-calltree-children (tree)
396 (mapc 'profiler-report-insert-calltree
397 (profiler-calltree-children tree
)))
402 (defvar profiler-report-mode-map
403 (let ((map (make-sparse-keymap)))
405 (define-key map
"n" 'profiler-report-next-entry
)
406 (define-key map
"p" 'profiler-report-previous-entry
)
407 ;; I find it annoying more than helpful to not be able to navigate
408 ;; normally with the cursor keys. --Stef
409 ;; (define-key map [down] 'profiler-report-next-entry)
410 ;; (define-key map [up] 'profiler-report-previous-entry)
411 (define-key map
"\r" 'profiler-report-toggle-entry
)
412 (define-key map
"\t" 'profiler-report-toggle-entry
)
413 (define-key map
"i" 'profiler-report-toggle-entry
)
414 (define-key map
"f" 'profiler-report-find-entry
)
415 (define-key map
"j" 'profiler-report-find-entry
)
416 (define-key map
[mouse-2
] 'profiler-report-find-entry
)
417 (define-key map
"d" 'profiler-report-describe-entry
)
418 (define-key map
"C" 'profiler-report-render-calltree
)
419 (define-key map
"B" 'profiler-report-render-reversed-calltree
)
420 (define-key map
"A" 'profiler-report-ascending-sort
)
421 (define-key map
"D" 'profiler-report-descending-sort
)
422 (define-key map
"=" 'profiler-report-compare-profile
)
423 (define-key map
(kbd "C-x C-w") 'profiler-report-write-profile
)
424 (define-key map
"q" 'quit-window
)
427 (defun profiler-report-make-buffer-name (profile)
428 (format "*%s-Profiler-Report %s*"
429 (cl-ecase (profiler-profile-type profile
) (cpu 'CPU
) (memory 'Memory
))
430 (format-time-string "%Y-%m-%d %T" (profiler-profile-timestamp profile
))))
432 (defun profiler-report-setup-buffer-1 (profile)
433 "Make a buffer for PROFILE and return it."
434 (let* ((buf-name (profiler-report-make-buffer-name profile
))
435 (buffer (get-buffer-create buf-name
)))
436 (with-current-buffer buffer
437 (profiler-report-mode)
438 (setq profiler-report-profile profile
439 profiler-report-reversed nil
440 profiler-report-order
'descending
))
443 (defun profiler-report-setup-buffer (profile)
444 "Make a buffer for PROFILE with rendering the profile and
446 (let ((buffer (profiler-report-setup-buffer-1 profile
)))
447 (with-current-buffer buffer
448 (profiler-report-render-calltree))
451 (define-derived-mode profiler-report-mode special-mode
"Profiler-Report"
452 "Profiler Report Mode."
453 (setq buffer-read-only t
460 (defun profiler-report-calltree-at-point (&optional point
)
461 (get-text-property (or point
(point)) 'calltree
))
463 (defun profiler-report-move-to-entry ()
464 (let ((point (next-single-property-change
465 (line-beginning-position) 'profiler-entry
)))
468 (back-to-indentation))))
470 (defun profiler-report-next-entry ()
471 "Move cursor to next entry."
474 (profiler-report-move-to-entry))
476 (defun profiler-report-previous-entry ()
477 "Move cursor to previous entry."
480 (profiler-report-move-to-entry))
482 (defun profiler-report-expand-entry ()
483 "Expand entry at point."
487 (when (search-forward (concat profiler-report-closed-mark
" ")
488 (line-end-position) t
)
489 (let ((tree (profiler-report-calltree-at-point)))
491 (let ((inhibit-read-only t
))
492 (replace-match (concat profiler-report-open-mark
" "))
494 (profiler-report-insert-calltree-children tree
)
497 (defun profiler-report-collapse-entry ()
498 "Collpase entry at point."
502 (when (search-forward (concat profiler-report-open-mark
" ")
503 (line-end-position) t
)
504 (let* ((tree (profiler-report-calltree-at-point))
505 (depth (profiler-calltree-depth tree
))
506 (start (line-beginning-position 2))
509 (let ((inhibit-read-only t
))
510 (replace-match (concat profiler-report-closed-mark
" "))
511 (while (and (eq (forward-line) 0)
512 (let ((child (get-text-property (point) 'calltree
)))
514 (numberp (setq d
(profiler-calltree-depth child
)))))
516 (delete-region start
(line-beginning-position)))))
519 (defun profiler-report-toggle-entry ()
520 "Expand entry at point if the tree is collapsed,
523 (or (profiler-report-expand-entry)
524 (profiler-report-collapse-entry)))
526 (defun profiler-report-find-entry (&optional event
)
527 "Find entry at point."
528 (interactive (list last-nonmenu-event
))
529 (if event
(posn-set-point (event-end event
)))
530 (let ((tree (profiler-report-calltree-at-point)))
532 (let ((entry (profiler-calltree-entry tree
)))
533 (find-function entry
)))))
535 (defun profiler-report-describe-entry ()
536 "Describe entry at point."
538 (let ((tree (profiler-report-calltree-at-point)))
540 (let ((entry (profiler-calltree-entry tree
)))
542 (describe-function entry
)))))
544 (cl-defun profiler-report-render-calltree-1
545 (profile &key reverse
(order 'descending
))
546 (let ((calltree (profiler-calltree-build
547 (profiler-profile-log profile
)
549 (setq header-line-format
550 (cl-ecase (profiler-profile-type profile
)
552 (profiler-report-header-line-format
553 profiler-report-cpu-line-format
554 "Function" (list "Time (ms)" "%")))
556 (profiler-report-header-line-format
557 profiler-report-memory-line-format
558 "Function" (list "Bytes" "%")))))
559 (let ((predicate (cl-ecase order
560 (ascending #'profiler-calltree-count
<)
561 (descending #'profiler-calltree-count
>))))
562 (profiler-calltree-sort calltree predicate
))
563 (let ((inhibit-read-only t
))
565 (profiler-report-insert-calltree-children calltree
)
566 (goto-char (point-min))
567 (profiler-report-move-to-entry))))
569 (defun profiler-report-rerender-calltree ()
570 (profiler-report-render-calltree-1 profiler-report-profile
571 :reverse profiler-report-reversed
572 :order profiler-report-order
))
574 (defun profiler-report-render-calltree ()
575 "Render calltree view."
577 (setq profiler-report-reversed nil
)
578 (profiler-report-rerender-calltree))
580 (defun profiler-report-render-reversed-calltree ()
581 "Render reversed calltree view."
583 (setq profiler-report-reversed t
)
584 (profiler-report-rerender-calltree))
586 (defun profiler-report-ascending-sort ()
587 "Sort calltree view in ascending order."
589 (setq profiler-report-order
'ascending
)
590 (profiler-report-rerender-calltree))
592 (defun profiler-report-descending-sort ()
593 "Sort calltree view in descending order."
595 (setq profiler-report-order
'descending
)
596 (profiler-report-rerender-calltree))
598 (defun profiler-report-profile (profile)
599 (switch-to-buffer (profiler-report-setup-buffer profile
)))
601 (defun profiler-report-profile-other-window (profile)
602 (switch-to-buffer-other-window (profiler-report-setup-buffer profile
)))
604 (defun profiler-report-profile-other-frame (profile)
605 (switch-to-buffer-other-frame (profiler-report-setup-buffer profile
)))
607 (defun profiler-report-compare-profile (buffer)
608 "Compare the current profile with another."
609 (interactive (list (read-buffer "Compare to: ")))
610 (let* ((profile1 (with-current-buffer buffer profiler-report-profile
))
611 (profile2 profiler-report-profile
)
612 (diff-profile (profiler-compare-profiles profile1 profile2
)))
613 (profiler-report-profile diff-profile
)))
615 (defun profiler-report-write-profile (filename &optional confirm
)
616 "Write the current profile into file FILENAME."
618 (list (read-file-name "Write profile: " default-directory
)
619 (not current-prefix-arg
)))
620 (profiler-write-profile profiler-report-profile
625 ;;; Profiler commands
628 (defun profiler-start (mode)
629 "Start/restart profilers.
630 MODE can be one of `cpu', `mem', or `cpu+mem'.
631 If MODE is `cpu' or `cpu+mem', time-based profiler will be started.
632 Also, if MODE is `mem' or `cpu+mem', then memory profiler will be started."
634 (list (if (not (fboundp 'profiler-cpu-start
)) 'mem
635 (intern (completing-read "Mode (default cpu): "
636 '("cpu" "mem" "cpu+mem")
637 nil t nil nil
"cpu")))))
640 (profiler-cpu-start profiler-sampling-interval
)
641 (message "CPU profiler started"))
643 (profiler-memory-start)
644 (message "Memory profiler started"))
646 (profiler-cpu-start profiler-sampling-interval
)
647 (profiler-memory-start)
648 (message "CPU and memory profiler started"))))
650 (defun profiler-stop ()
651 "Stop started profilers. Profiler logs will be kept."
653 (let ((cpu (if (fboundp 'profiler-cpu-stop
) (profiler-cpu-stop)))
654 (mem (profiler-memory-stop)))
655 (message "%s profiler stopped"
656 (cond ((and mem cpu
) "CPU and memory")
661 (defun profiler-reset ()
662 "Reset profiler logs."
664 (when (fboundp 'profiler-cpu-log
)
665 (ignore (profiler-cpu-log)))
666 (ignore (profiler-memory-log))
669 (defun profiler-report-cpu ()
670 (let ((profile (profiler-cpu-profile)))
672 (profiler-report-profile-other-window profile
))))
674 (defun profiler-report-memory ()
675 (let ((profile (profiler-memory-profile)))
677 (profiler-report-profile-other-window profile
))))
679 (defun profiler-report ()
680 "Report profiling results."
682 (profiler-report-cpu)
683 (profiler-report-memory))
686 (defun profiler-find-profile (filename)
687 "Open profile FILENAME."
689 (list (read-file-name "Find profile: " default-directory
)))
690 (profiler-report-profile (profiler-read-profile filename
)))
693 (defun profiler-find-profile-other-window (filename)
694 "Open profile FILENAME."
696 (list (read-file-name "Find profile: " default-directory
)))
697 (profiler-report-profile-other-window (profiler-read-profile filename
)))
700 (defun profiler-find-profile-other-frame (filename)
701 "Open profile FILENAME."
703 (list (read-file-name "Find profile: " default-directory
)))
704 (profiler-report-profile-other-frame(profiler-read-profile filename
)))
707 ;;; Profiling helpers
709 ;; (cl-defmacro with-cpu-profiling ((&key sampling-interval) &rest body)
712 ;; (ignore (profiler-cpu-log))
713 ;; (profiler-cpu-start ,sampling-interval)
715 ;; (profiler-cpu-stop)
716 ;; (profiler--report-cpu)))
718 ;; (defmacro with-memory-profiling (&rest body)
721 ;; (ignore (profiler-memory-log))
722 ;; (profiler-memory-start)
724 ;; (profiler-memory-stop)
725 ;; (profiler--report-memory)))
728 ;;; profiler.el ends here