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