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