Commit | Line | Data |
---|---|---|
c2d7786e TM |
1 | ;;; profiler.el --- UI and helper functions for Emacs's native profiler -*- lexical-binding: t -*- |
2 | ||
3 | ;; Copyright (C) 2012 Free Software Foundation, Inc. | |
4 | ||
5 | ;; Author: Tomohiro Matsuyama <tomo@cx4a.org> | |
6 | ;; Keywords: lisp | |
7 | ||
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. | |
12 | ||
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. | |
17 | ||
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/>. | |
20 | ||
21 | ;;; Commentary: | |
22 | ||
23 | ;; | |
24 | ||
25 | ;;; Code: | |
26 | ||
27 | (eval-when-compile | |
b02baf7f | 28 | (require 'cl-lib)) |
c2d7786e TM |
29 | |
30 | (defgroup profiler nil | |
31 | "Emacs profiler." | |
32 | :group 'lisp | |
33 | :prefix "profiler-") | |
34 | ||
35 | \f | |
36 | ||
37 | ;;; Utilities | |
38 | ||
39 | (defun profiler-ensure-string (object) | |
40 | (if (stringp object) | |
41 | object | |
42 | (format "%s" object))) | |
43 | ||
44 | (defun profiler-format (fmt &rest args) | |
b02baf7f TM |
45 | (cl-loop for (width align subfmt) in fmt |
46 | for arg in args | |
12b3895d TM |
47 | for str = (cond |
48 | ((consp subfmt) | |
49 | (apply 'profiler-format subfmt arg)) | |
50 | ((stringp subfmt) | |
51 | (format subfmt arg)) | |
52 | ((and (symbolp subfmt) | |
53 | (fboundp subfmt)) | |
54 | (funcall subfmt arg)) | |
55 | (t | |
56 | (profiler-ensure-string arg))) | |
b02baf7f TM |
57 | for len = (length str) |
58 | if (< width len) | |
59 | collect (substring str 0 width) into frags | |
60 | else | |
61 | collect | |
62 | (let ((padding (make-string (- width len) ?\s))) | |
63 | (cl-ecase align | |
64 | (left (concat str padding)) | |
65 | (right (concat padding str)))) | |
66 | into frags | |
67 | finally return (apply #'concat frags))) | |
c2d7786e | 68 | |
12b3895d TM |
69 | (defun profiler-format-nbytes (nbytes) |
70 | (if (and (integerp nbytes) (> nbytes 0)) | |
71 | (cl-loop with i = (% (1+ (floor (log10 nbytes))) 3) | |
72 | for c in (append (number-to-string nbytes) nil) | |
73 | if (= i 0) | |
74 | collect ?, into s | |
75 | and do (setq i 3) | |
76 | collect c into s | |
77 | do (cl-decf i) | |
78 | finally return | |
79 | (apply 'string (if (eq (car s) ?,) (cdr s) s))) | |
80 | (profiler-ensure-string nbytes))) | |
81 | ||
82 | \f | |
83 | ||
84 | ;;; Backtrace data structure | |
85 | ||
86 | (defun profiler-backtrace-reverse (backtrace) | |
87 | (cl-case (car backtrace) | |
88 | ((t gc) | |
89 | (cons (car backtrace) | |
90 | (reverse (cdr backtrace)))) | |
91 | (t (reverse backtrace)))) | |
92 | ||
c2d7786e TM |
93 | \f |
94 | ||
95 | ;;; Slot data structure | |
96 | ||
b02baf7f TM |
97 | (cl-defstruct (profiler-slot (:type list) |
98 | (:constructor profiler-make-slot)) | |
c2d7786e TM |
99 | backtrace count elapsed) |
100 | ||
101 | \f | |
102 | ||
103 | ;;; Log data structure | |
104 | ||
b02baf7f TM |
105 | (cl-defstruct (profiler-log (:type list) |
106 | (:constructor profiler-make-log)) | |
c2d7786e TM |
107 | type diff-p timestamp slots) |
108 | ||
109 | (defun profiler-log-diff (log1 log2) | |
110 | ;; FIXME zeros | |
111 | (unless (eq (profiler-log-type log1) | |
112 | (profiler-log-type log2)) | |
113 | (error "Can't compare different type of logs")) | |
114 | (let ((slots (profiler-log-slots log2))) | |
115 | (dolist (slot (profiler-log-slots log1)) | |
116 | (push (profiler-make-slot :backtrace (profiler-slot-backtrace slot) | |
117 | :count (- (profiler-slot-count slot)) | |
118 | :elapsed (- (profiler-slot-elapsed slot))) | |
119 | slots)) | |
120 | (profiler-make-log :type (profiler-log-type log1) | |
121 | :diff-p t | |
122 | :timestamp (current-time) | |
123 | :slots slots))) | |
124 | ||
125 | (defun profiler-log-fixup (log) | |
126 | "Fixup LOG so that the log could be serialized into file." | |
127 | (let ((fixup-entry | |
128 | (lambda (entry) | |
129 | (cond | |
130 | ((and (consp entry) | |
131 | (or (eq (car entry) 'lambda) | |
132 | (eq (car entry) 'closure))) | |
133 | (format "#<closure 0x%x>" (sxhash entry))) | |
134 | ((eq (type-of entry) 'compiled-function) | |
135 | (format "#<compiled 0x%x>" (sxhash entry))) | |
136 | ((subrp entry) | |
137 | (subr-name entry)) | |
12b3895d | 138 | ((or (symbolp entry) (stringp entry)) |
c2d7786e TM |
139 | entry) |
140 | (t | |
141 | (format "#<unknown 0x%x>" (sxhash entry))))))) | |
142 | (dolist (slot (profiler-log-slots log)) | |
143 | (setf (profiler-slot-backtrace slot) | |
144 | (mapcar fixup-entry (profiler-slot-backtrace slot)))))) | |
145 | ||
146 | \f | |
147 | ||
148 | ;;; Calltree data structure | |
149 | ||
b02baf7f | 150 | (cl-defstruct (profiler-calltree (:constructor profiler-make-calltree)) |
c2d7786e TM |
151 | entry |
152 | (count 0) count-percent | |
153 | (elapsed 0) elapsed-percent | |
154 | parent children) | |
155 | ||
156 | (defun profiler-calltree-leaf-p (tree) | |
157 | (null (profiler-calltree-children tree))) | |
158 | ||
159 | (defun profiler-calltree-count< (a b) | |
160 | (cond ((eq (profiler-calltree-entry a) t) t) | |
161 | ((eq (profiler-calltree-entry b) t) nil) | |
12b3895d TM |
162 | ((eq (profiler-calltree-entry a) 'gc) t) |
163 | ((eq (profiler-calltree-entry b) 'gc) nil) | |
c2d7786e TM |
164 | (t (< (profiler-calltree-count a) |
165 | (profiler-calltree-count b))))) | |
166 | ||
167 | (defun profiler-calltree-count> (a b) | |
168 | (not (profiler-calltree-count< a b))) | |
169 | ||
170 | (defun profiler-calltree-elapsed< (a b) | |
171 | (cond ((eq (profiler-calltree-entry a) t) t) | |
172 | ((eq (profiler-calltree-entry b) t) nil) | |
12b3895d TM |
173 | ((eq (profiler-calltree-entry a) 'gc) t) |
174 | ((eq (profiler-calltree-entry b) 'gc) nil) | |
c2d7786e TM |
175 | (t (< (profiler-calltree-elapsed a) |
176 | (profiler-calltree-elapsed b))))) | |
177 | ||
178 | (defun profiler-calltree-elapsed> (a b) | |
179 | (not (profiler-calltree-elapsed< a b))) | |
180 | ||
181 | (defun profiler-calltree-depth (tree) | |
182 | (let ((parent (profiler-calltree-parent tree))) | |
183 | (if (null parent) | |
184 | 0 | |
185 | (1+ (profiler-calltree-depth parent))))) | |
186 | ||
187 | (defun profiler-calltree-find (tree entry) | |
b02baf7f | 188 | (cl-dolist (child (profiler-calltree-children tree)) |
c2d7786e | 189 | (when (equal (profiler-calltree-entry child) entry) |
b02baf7f | 190 | (cl-return child)))) |
c2d7786e TM |
191 | |
192 | (defun profiler-calltree-walk (calltree function) | |
193 | (funcall function calltree) | |
194 | (dolist (child (profiler-calltree-children calltree)) | |
195 | (profiler-calltree-walk child function))) | |
196 | ||
197 | (defun profiler-calltree-build-1 (tree log &optional reverse) | |
198 | (dolist (slot (profiler-log-slots log)) | |
199 | (let ((backtrace (profiler-slot-backtrace slot)) | |
200 | (count (profiler-slot-count slot)) | |
201 | (elapsed (profiler-slot-elapsed slot)) | |
202 | (node tree)) | |
12b3895d TM |
203 | (dolist (entry (if reverse |
204 | backtrace | |
205 | (profiler-backtrace-reverse backtrace))) | |
c2d7786e TM |
206 | (let ((child (profiler-calltree-find node entry))) |
207 | (unless child | |
208 | (setq child (profiler-make-calltree :entry entry :parent node)) | |
209 | (push child (profiler-calltree-children node))) | |
b02baf7f TM |
210 | (cl-incf (profiler-calltree-count child) count) |
211 | (cl-incf (profiler-calltree-elapsed child) elapsed) | |
c2d7786e TM |
212 | (setq node child)))))) |
213 | ||
214 | (defun profiler-calltree-compute-percentages (tree) | |
215 | (let ((total-count 0) | |
216 | (total-elapsed 0)) | |
217 | (dolist (child (profiler-calltree-children tree)) | |
12b3895d TM |
218 | (if (eq (profiler-calltree-entry child) 'gc) |
219 | (profiler-calltree-compute-percentages child) | |
220 | (cl-incf total-count (profiler-calltree-count child)) | |
221 | (cl-incf total-elapsed (profiler-calltree-elapsed child)))) | |
222 | (dolist (child (profiler-calltree-children tree)) | |
223 | (if (eq (profiler-calltree-entry child) 'gc) | |
224 | (setf (profiler-calltree-count-percent child) "" | |
225 | (profiler-calltree-elapsed-percent child) "") | |
226 | (profiler-calltree-walk | |
227 | child | |
228 | (lambda (node) | |
229 | (unless (zerop total-count) | |
230 | (setf (profiler-calltree-count-percent node) | |
231 | (format "%s%%" | |
232 | (/ (* (profiler-calltree-count node) 100) | |
233 | total-count)))) | |
234 | (unless (zerop total-elapsed) | |
235 | (setf (profiler-calltree-elapsed-percent node) | |
236 | (format "%s%%" | |
237 | (/ (* (profiler-calltree-elapsed node) 100) | |
238 | total-elapsed)))))))))) | |
c2d7786e | 239 | |
b02baf7f | 240 | (cl-defun profiler-calltree-build (log &key reverse) |
c2d7786e TM |
241 | (let ((tree (profiler-make-calltree))) |
242 | (profiler-calltree-build-1 tree log reverse) | |
243 | (profiler-calltree-compute-percentages tree) | |
244 | tree)) | |
245 | ||
246 | (defun profiler-calltree-sort (tree predicate) | |
247 | (let ((children (profiler-calltree-children tree))) | |
248 | (setf (profiler-calltree-children tree) (sort children predicate)) | |
249 | (dolist (child (profiler-calltree-children tree)) | |
250 | (profiler-calltree-sort child predicate)))) | |
251 | ||
252 | \f | |
253 | ||
254 | ;;; Report rendering | |
255 | ||
256 | (defcustom profiler-report-closed-mark "+" | |
257 | "An indicator of closed calltrees." | |
258 | :type 'string | |
259 | :group 'profiler) | |
260 | ||
261 | (defcustom profiler-report-open-mark "-" | |
262 | "An indicator of open calltrees." | |
263 | :type 'string | |
264 | :group 'profiler) | |
265 | ||
266 | (defcustom profiler-report-leaf-mark " " | |
267 | "An indicator of calltree leaves." | |
268 | :type 'string | |
269 | :group 'profiler) | |
270 | ||
271 | (defvar profiler-report-sample-line-format | |
272 | '((60 left) | |
273 | (14 right ((9 right) | |
274 | (5 right))))) | |
275 | ||
276 | (defvar profiler-report-memory-line-format | |
12b3895d TM |
277 | '((55 left) |
278 | (19 right ((14 right profiler-format-nbytes) | |
c2d7786e TM |
279 | (5 right))))) |
280 | ||
281 | (defvar profiler-report-log nil) | |
282 | (defvar profiler-report-reversed nil) | |
283 | (defvar profiler-report-order nil) | |
284 | ||
285 | (defun profiler-report-make-entry-part (entry) | |
286 | (let ((string | |
287 | (cond | |
288 | ((eq entry t) | |
289 | "Others") | |
12b3895d TM |
290 | ((eq entry 'gc) |
291 | "Garbage Collection") | |
c2d7786e TM |
292 | ((and (symbolp entry) |
293 | (fboundp entry)) | |
294 | (propertize (symbol-name entry) | |
295 | 'face 'link | |
296 | 'mouse-face 'highlight | |
297 | 'help-echo "mouse-2 or RET jumps to definition")) | |
298 | (t | |
299 | (profiler-ensure-string entry))))) | |
300 | (propertize string 'entry entry))) | |
301 | ||
302 | (defun profiler-report-make-name-part (tree) | |
303 | (let* ((entry (profiler-calltree-entry tree)) | |
304 | (depth (profiler-calltree-depth tree)) | |
305 | (indent (make-string (* (1- depth) 2) ?\s)) | |
306 | (mark (if (profiler-calltree-leaf-p tree) | |
307 | profiler-report-leaf-mark | |
308 | profiler-report-closed-mark)) | |
309 | (entry (profiler-report-make-entry-part entry))) | |
310 | (format "%s%s %s" indent mark entry))) | |
311 | ||
312 | (defun profiler-report-header-line-format (fmt &rest args) | |
313 | (let* ((header (apply 'profiler-format fmt args)) | |
314 | (escaped (replace-regexp-in-string "%" "%%" header))) | |
315 | (concat " " escaped))) | |
316 | ||
317 | (defun profiler-report-line-format (tree) | |
318 | (let ((diff-p (profiler-log-diff-p profiler-report-log)) | |
319 | (name-part (profiler-report-make-name-part tree)) | |
320 | (elapsed (profiler-calltree-elapsed tree)) | |
321 | (elapsed-percent (profiler-calltree-elapsed-percent tree)) | |
322 | (count (profiler-calltree-count tree)) | |
323 | (count-percent (profiler-calltree-count-percent tree))) | |
b02baf7f | 324 | (cl-ecase (profiler-log-type profiler-report-log) |
c2d7786e TM |
325 | (sample |
326 | (if diff-p | |
327 | (profiler-format profiler-report-sample-line-format | |
328 | name-part | |
329 | (list (if (> elapsed 0) | |
330 | (format "+%s" elapsed) | |
331 | elapsed) | |
332 | "")) | |
333 | (profiler-format profiler-report-sample-line-format | |
334 | name-part (list elapsed elapsed-percent)))) | |
335 | (memory | |
336 | (if diff-p | |
337 | (profiler-format profiler-report-memory-line-format | |
338 | name-part | |
339 | (list (if (> count 0) | |
340 | (format "+%s" count) | |
341 | count) | |
342 | "")) | |
343 | (profiler-format profiler-report-memory-line-format | |
344 | name-part (list count count-percent))))))) | |
345 | ||
346 | (defun profiler-report-insert-calltree (tree) | |
347 | (let ((line (profiler-report-line-format tree))) | |
348 | (insert (propertize (concat line "\n") 'calltree tree)))) | |
349 | ||
350 | (defun profiler-report-insert-calltree-children (tree) | |
351 | (mapc 'profiler-report-insert-calltree | |
352 | (profiler-calltree-children tree))) | |
353 | ||
354 | \f | |
355 | ||
356 | ;;; Report mode | |
357 | ||
358 | (defvar profiler-report-mode-map | |
359 | (let ((map (make-sparse-keymap))) | |
360 | (define-key map "n" 'profiler-report-next-entry) | |
361 | (define-key map "p" 'profiler-report-previous-entry) | |
362 | (define-key map [down] 'profiler-report-next-entry) | |
363 | (define-key map [up] 'profiler-report-previous-entry) | |
364 | (define-key map "\r" 'profiler-report-toggle-entry) | |
365 | (define-key map "\t" 'profiler-report-toggle-entry) | |
366 | (define-key map "i" 'profiler-report-toggle-entry) | |
367 | (define-key map "f" 'profiler-report-find-entry) | |
368 | (define-key map "j" 'profiler-report-find-entry) | |
369 | (define-key map [mouse-2] 'profiler-report-find-entry) | |
370 | (define-key map "d" 'profiler-report-describe-entry) | |
371 | (define-key map "C" 'profiler-report-render-calltree) | |
372 | (define-key map "B" 'profiler-report-render-reversed-calltree) | |
373 | (define-key map "A" 'profiler-report-ascending-sort) | |
374 | (define-key map "D" 'profiler-report-descending-sort) | |
375 | (define-key map "=" 'profiler-report-compare-log) | |
376 | (define-key map (kbd "C-x C-w") 'profiler-report-write-log) | |
377 | (define-key map "q" 'quit-window) | |
378 | map)) | |
379 | ||
380 | (defun profiler-report-make-buffer-name (log) | |
381 | (let ((time (format-time-string "%Y-%m-%d %T" (profiler-log-timestamp log)))) | |
b02baf7f | 382 | (cl-ecase (profiler-log-type log) |
c2d7786e TM |
383 | (sample (format "*CPU-Profiler-Report %s*" time)) |
384 | (memory (format "*Memory-Profiler-Report %s*" time))))) | |
385 | ||
386 | (defun profiler-report-setup-buffer (log) | |
387 | (let* ((buf-name (profiler-report-make-buffer-name log)) | |
388 | (buffer (get-buffer-create buf-name))) | |
389 | (with-current-buffer buffer | |
390 | (profiler-report-mode) | |
391 | (setq profiler-report-log log | |
392 | profiler-report-reversed nil | |
393 | profiler-report-order 'descending)) | |
394 | buffer)) | |
395 | ||
396 | (define-derived-mode profiler-report-mode special-mode "Profiler-Report" | |
397 | "Profiler Report Mode." | |
398 | (make-local-variable 'profiler-report-log) | |
399 | (make-local-variable 'profiler-report-reversed) | |
400 | (make-local-variable 'profiler-report-order) | |
401 | (use-local-map profiler-report-mode-map) | |
402 | (setq buffer-read-only t | |
403 | buffer-undo-list t | |
404 | truncate-lines t)) | |
405 | ||
406 | \f | |
407 | ||
408 | ;;; Report commands | |
409 | ||
410 | (defun profiler-report-calltree-at-point () | |
411 | (get-text-property (point) 'calltree)) | |
412 | ||
413 | (defun profiler-report-move-to-entry () | |
414 | (let ((point (next-single-property-change (line-beginning-position) 'entry))) | |
415 | (if point | |
416 | (goto-char point) | |
417 | (back-to-indentation)))) | |
418 | ||
419 | (defun profiler-report-next-entry () | |
420 | "Move cursor to next profile entry." | |
421 | (interactive) | |
422 | (forward-line) | |
423 | (profiler-report-move-to-entry)) | |
424 | ||
425 | (defun profiler-report-previous-entry () | |
426 | "Move cursor to previous profile entry." | |
427 | (interactive) | |
428 | (forward-line -1) | |
429 | (profiler-report-move-to-entry)) | |
430 | ||
431 | (defun profiler-report-expand-entry () | |
432 | "Expand profile entry at point." | |
433 | (interactive) | |
434 | (save-excursion | |
435 | (beginning-of-line) | |
436 | (when (search-forward (concat profiler-report-closed-mark " ") | |
437 | (line-end-position) t) | |
438 | (let ((tree (profiler-report-calltree-at-point))) | |
439 | (when tree | |
440 | (let ((buffer-read-only nil)) | |
441 | (replace-match (concat profiler-report-open-mark " ")) | |
442 | (forward-line) | |
443 | (profiler-report-insert-calltree-children tree) | |
444 | t)))))) | |
445 | ||
446 | (defun profiler-report-collapse-entry () | |
447 | "Collpase profile entry at point." | |
448 | (interactive) | |
449 | (save-excursion | |
450 | (beginning-of-line) | |
451 | (when (search-forward (concat profiler-report-open-mark " ") | |
452 | (line-end-position) t) | |
453 | (let* ((tree (profiler-report-calltree-at-point)) | |
454 | (depth (profiler-calltree-depth tree)) | |
455 | (start (line-beginning-position 2)) | |
456 | d) | |
457 | (when tree | |
458 | (let ((buffer-read-only nil)) | |
459 | (replace-match (concat profiler-report-closed-mark " ")) | |
460 | (while (and (eq (forward-line) 0) | |
461 | (let ((child (get-text-property (point) 'calltree))) | |
462 | (and child | |
463 | (numberp (setq d (profiler-calltree-depth child))))) | |
464 | (> d depth))) | |
465 | (delete-region start (line-beginning-position))))) | |
466 | t))) | |
467 | ||
468 | (defun profiler-report-toggle-entry () | |
469 | "Expand profile entry at point if the tree is collapsed, | |
470 | otherwise collapse the entry." | |
471 | (interactive) | |
472 | (or (profiler-report-expand-entry) | |
473 | (profiler-report-collapse-entry))) | |
474 | ||
475 | (defun profiler-report-find-entry (&optional event) | |
476 | "Find profile entry at point." | |
477 | (interactive (list last-nonmenu-event)) | |
478 | (if event (posn-set-point (event-end event))) | |
479 | (let ((tree (profiler-report-calltree-at-point))) | |
480 | (when tree | |
481 | (let ((entry (profiler-calltree-entry tree))) | |
482 | (find-function entry))))) | |
483 | ||
484 | (defun profiler-report-describe-entry () | |
485 | "Describe profile entry at point." | |
486 | (interactive) | |
487 | (let ((tree (profiler-report-calltree-at-point))) | |
488 | (when tree | |
489 | (let ((entry (profiler-calltree-entry tree))) | |
490 | (require 'help-fns) | |
491 | (describe-function entry))))) | |
492 | ||
b02baf7f | 493 | (cl-defun profiler-report-render-calltree-1 (log &key reverse (order 'descending)) |
c2d7786e TM |
494 | (let ((calltree (profiler-calltree-build profiler-report-log |
495 | :reverse reverse))) | |
b02baf7f | 496 | (cl-ecase (profiler-log-type log) |
c2d7786e TM |
497 | (sample |
498 | (setq header-line-format | |
499 | (profiler-report-header-line-format | |
500 | profiler-report-sample-line-format | |
501 | "Function" (list "Time (ms)" "%"))) | |
b02baf7f | 502 | (let ((predicate (cl-ecase order |
c2d7786e TM |
503 | (ascending 'profiler-calltree-elapsed<) |
504 | (descending 'profiler-calltree-elapsed>)))) | |
505 | (profiler-calltree-sort calltree predicate))) | |
506 | (memory | |
507 | (setq header-line-format | |
508 | (profiler-report-header-line-format | |
509 | profiler-report-memory-line-format | |
12b3895d | 510 | "Function" (list "Bytes" "%"))) |
b02baf7f | 511 | (let ((predicate (cl-ecase order |
c2d7786e TM |
512 | (ascending 'profiler-calltree-count<) |
513 | (descending 'profiler-calltree-count>)))) | |
514 | (profiler-calltree-sort calltree predicate)))) | |
515 | (let ((buffer-read-only nil)) | |
516 | (erase-buffer) | |
517 | (profiler-report-insert-calltree-children calltree) | |
518 | (goto-char (point-min)) | |
519 | (profiler-report-move-to-entry)))) | |
520 | ||
521 | (defun profiler-report-rerender-calltree () | |
522 | (profiler-report-render-calltree-1 profiler-report-log | |
523 | :reverse profiler-report-reversed | |
524 | :order profiler-report-order)) | |
525 | ||
526 | (defun profiler-report-render-calltree () | |
527 | "Render calltree view of the current profile." | |
528 | (interactive) | |
529 | (setq profiler-report-reversed nil) | |
530 | (profiler-report-rerender-calltree)) | |
531 | ||
532 | (defun profiler-report-render-reversed-calltree () | |
533 | "Render reversed calltree view of the current profile." | |
534 | (interactive) | |
535 | (setq profiler-report-reversed t) | |
536 | (profiler-report-rerender-calltree)) | |
537 | ||
538 | (defun profiler-report-ascending-sort () | |
539 | "Sort calltree view in ascending order." | |
540 | (interactive) | |
541 | (setq profiler-report-order 'ascending) | |
542 | (profiler-report-rerender-calltree)) | |
543 | ||
544 | (defun profiler-report-descending-sort () | |
545 | "Sort calltree view in descending order." | |
546 | (interactive) | |
547 | (setq profiler-report-order 'descending) | |
548 | (profiler-report-rerender-calltree)) | |
549 | ||
550 | (defun profiler-report-log (log) | |
551 | (let ((buffer (profiler-report-setup-buffer log))) | |
552 | (with-current-buffer buffer | |
553 | (profiler-report-render-calltree)) | |
554 | (pop-to-buffer buffer))) | |
555 | ||
556 | (defun profiler-report-compare-log (buffer) | |
557 | "Compare current profiler log with another profiler log." | |
558 | (interactive (list (read-buffer "Compare to: "))) | |
559 | (let ((log1 (with-current-buffer buffer profiler-report-log)) | |
560 | (log2 profiler-report-log)) | |
561 | (profiler-report-log (profiler-log-diff log1 log2)))) | |
562 | ||
563 | (defun profiler-report-write-log (filename &optional confirm) | |
564 | "Write current profiler log into FILENAME." | |
565 | (interactive | |
566 | (list (read-file-name "Write log: " default-directory) | |
567 | (not current-prefix-arg))) | |
568 | (let ((log profiler-report-log)) | |
569 | (with-temp-buffer | |
570 | (let (print-level print-length) | |
571 | (print log (current-buffer))) | |
572 | (write-file filename confirm)))) | |
573 | ||
574 | \f | |
575 | ||
576 | ;;; Profiler commands | |
577 | ||
578 | (defcustom profiler-sample-interval 10 | |
579 | "Default sample interval in millisecond." | |
580 | :type 'integer | |
581 | :group 'profiler) | |
582 | ||
583 | ;;;###autoload | |
584 | (defun profiler-start (mode) | |
585 | (interactive | |
a4924b14 | 586 | (list (intern (completing-read "Mode: " '("cpu" "mem" "cpu+mem") |
c2d7786e | 587 | nil t nil nil "cpu")))) |
b02baf7f | 588 | (cl-ecase mode |
c2d7786e TM |
589 | (cpu |
590 | (sample-profiler-start profiler-sample-interval) | |
591 | (message "CPU profiler started")) | |
a4924b14 | 592 | (mem |
c2d7786e TM |
593 | (memory-profiler-start) |
594 | (message "Memory profiler started")) | |
a4924b14 | 595 | (cpu+mem |
c2d7786e TM |
596 | (sample-profiler-start profiler-sample-interval) |
597 | (memory-profiler-start) | |
598 | (message "CPU and memory profiler started")))) | |
599 | ||
600 | (defun profiler-stop () | |
601 | (interactive) | |
602 | (cond | |
603 | ((and (sample-profiler-running-p) | |
604 | (memory-profiler-running-p)) | |
605 | (sample-profiler-stop) | |
606 | (memory-profiler-stop) | |
607 | (message "CPU and memory profiler stopped")) | |
608 | ((sample-profiler-running-p) | |
609 | (sample-profiler-stop) | |
610 | (message "CPU profiler stopped")) | |
611 | ((memory-profiler-running-p) | |
612 | (memory-profiler-stop) | |
613 | (message "Memory profiler stopped")) | |
614 | (t | |
615 | (error "No profilers started")))) | |
616 | ||
617 | (defun profiler-reset () | |
618 | (interactive) | |
619 | (sample-profiler-reset) | |
620 | (memory-profiler-reset) | |
621 | t) | |
622 | ||
ce56157e | 623 | (defun sample-profiler-report () |
c2d7786e TM |
624 | (let ((sample-log (sample-profiler-log))) |
625 | (when sample-log | |
626 | (profiler-log-fixup sample-log) | |
ce56157e TM |
627 | (profiler-report-log sample-log)))) |
628 | ||
629 | (defun memory-profiler-report () | |
c2d7786e TM |
630 | (let ((memory-log (memory-profiler-log))) |
631 | (when memory-log | |
632 | (profiler-log-fixup memory-log) | |
633 | (profiler-report-log memory-log)))) | |
634 | ||
ce56157e TM |
635 | (defun profiler-report () |
636 | (interactive) | |
637 | (sample-profiler-report) | |
638 | (memory-profiler-report)) | |
639 | ||
c2d7786e TM |
640 | ;;;###autoload |
641 | (defun profiler-find-log (filename) | |
642 | (interactive | |
643 | (list (read-file-name "Find log: " default-directory))) | |
644 | (with-temp-buffer | |
645 | (insert-file-contents filename) | |
646 | (goto-char (point-min)) | |
647 | (let ((log (read (current-buffer)))) | |
648 | (profiler-report-log log)))) | |
649 | ||
ce56157e TM |
650 | \f |
651 | ||
652 | ;;; Profiling helpers | |
653 | ||
654 | (cl-defmacro with-sample-profiling ((&key (interval profiler-sample-interval)) &rest body) | |
655 | `(progn | |
656 | (sample-profiler-start ,interval) | |
657 | (sample-profiler-reset) | |
658 | (unwind-protect | |
659 | (progn ,@body) | |
660 | (sample-profiler-stop) | |
661 | (sample-profiler-report) | |
662 | (sample-profiler-reset)))) | |
663 | ||
664 | (cl-defmacro with-memory-profiling (() &rest body) | |
665 | `(progn | |
666 | (memory-profiler-start) | |
667 | (memory-profiler-reset) | |
668 | (unwind-protect | |
669 | (progn ,@body) | |
670 | (memory-profiler-stop) | |
671 | (memory-profiler-report) | |
672 | (memory-profiler-reset)))) | |
673 | ||
c2d7786e TM |
674 | (provide 'profiler) |
675 | ;;; profiler.el ends here |