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