Commit | Line | Data |
---|---|---|
c2d7786e TM |
1 | ;;; profiler.el --- UI and helper functions for Emacs's native profiler -*- lexical-binding: t -*- |
2 | ||
ab422c4d | 3 | ;; Copyright (C) 2012-2013 Free Software Foundation, Inc. |
c2d7786e TM |
4 | |
5 | ;; Author: Tomohiro Matsuyama <tomo@cx4a.org> | |
6 | ;; Keywords: lisp | |
7 | ||
b011a6e8 GM |
8 | ;; This file is part of GNU Emacs. |
9 | ||
10 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
c2d7786e TM |
11 | ;; it under the terms of the GNU General Public License as published by |
12 | ;; the Free Software Foundation, either version 3 of the License, or | |
13 | ;; (at your option) any later version. | |
14 | ||
b011a6e8 | 15 | ;; GNU Emacs is distributed in the hope that it will be useful, |
c2d7786e TM |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
b011a6e8 | 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
c2d7786e TM |
22 | |
23 | ;;; Commentary: | |
24 | ||
114d4d84 | 25 | ;; See Info node `(elisp)Profiling'. |
c2d7786e TM |
26 | |
27 | ;;; Code: | |
28 | ||
c22bac2c | 29 | (require 'cl-lib) |
c2d7786e TM |
30 | |
31 | (defgroup profiler nil | |
32 | "Emacs profiler." | |
33 | :group 'lisp | |
d1a1c7e6 | 34 | :version "24.3" |
c2d7786e TM |
35 | :prefix "profiler-") |
36 | ||
c22bac2c TM |
37 | (defconst profiler-version "24.3") |
38 | ||
b3ecad33 PE |
39 | (defcustom profiler-sampling-interval 1000000 |
40 | "Default sampling interval in nanoseconds." | |
3d80c99f SM |
41 | :type 'integer |
42 | :group 'profiler) | |
43 | ||
c22bac2c | 44 | \f |
c2d7786e TM |
45 | ;;; Utilities |
46 | ||
47 | (defun profiler-ensure-string (object) | |
0efc778b TM |
48 | (cond ((stringp object) |
49 | object) | |
50 | ((symbolp object) | |
51 | (symbol-name object)) | |
52 | ((numberp object) | |
53 | (number-to-string object)) | |
54 | (t | |
55 | (format "%s" object)))) | |
c2d7786e | 56 | |
c22bac2c TM |
57 | (defun profiler-format-percent (number divisor) |
58 | (concat (number-to-string (/ (* number 100) divisor)) "%")) | |
59 | ||
60 | (defun profiler-format-number (number) | |
61 | "Format NUMBER in human readable string." | |
62 | (if (and (integerp number) (> number 0)) | |
7a65a0b2 | 63 | (cl-loop with i = (% (1+ (floor (log number 10))) 3) |
c22bac2c TM |
64 | for c in (append (number-to-string number) nil) |
65 | if (= i 0) | |
66 | collect ?, into s | |
67 | and do (setq i 3) | |
68 | collect c into s | |
69 | do (cl-decf i) | |
70 | finally return | |
71 | (apply 'string (if (eq (car s) ?,) (cdr s) s))) | |
72 | (profiler-ensure-string number))) | |
73 | ||
c2d7786e | 74 | (defun profiler-format (fmt &rest args) |
b02baf7f TM |
75 | (cl-loop for (width align subfmt) in fmt |
76 | for arg in args | |
12b3895d TM |
77 | for str = (cond |
78 | ((consp subfmt) | |
79 | (apply 'profiler-format subfmt arg)) | |
80 | ((stringp subfmt) | |
81 | (format subfmt arg)) | |
82 | ((and (symbolp subfmt) | |
83 | (fboundp subfmt)) | |
84 | (funcall subfmt arg)) | |
85 | (t | |
86 | (profiler-ensure-string arg))) | |
b02baf7f TM |
87 | for len = (length str) |
88 | if (< width len) | |
89 | collect (substring str 0 width) into frags | |
90 | else | |
91 | collect | |
92 | (let ((padding (make-string (- width len) ?\s))) | |
93 | (cl-ecase align | |
94 | (left (concat str padding)) | |
95 | (right (concat padding str)))) | |
96 | into frags | |
97 | finally return (apply #'concat frags))) | |
c2d7786e | 98 | |
12b3895d | 99 | \f |
0efc778b TM |
100 | ;;; Entries |
101 | ||
c22bac2c | 102 | (defun profiler-format-entry (entry) |
0efc778b TM |
103 | "Format ENTRY in human readable string. ENTRY would be a |
104 | function name of a function itself." | |
3d80c99f SM |
105 | (cond ((memq (car-safe entry) '(closure lambda)) |
106 | (format "#<lambda 0x%x>" (sxhash entry))) | |
107 | ((byte-code-function-p entry) | |
0efc778b | 108 | (format "#<compiled 0x%x>" (sxhash entry))) |
3d80c99f SM |
109 | ((or (subrp entry) (symbolp entry) (stringp entry)) |
110 | (format "%s" entry)) | |
0efc778b TM |
111 | (t |
112 | (format "#<unknown 0x%x>" (sxhash entry))))) | |
12b3895d | 113 | |
c22bac2c TM |
114 | (defun profiler-fixup-entry (entry) |
115 | (if (symbolp entry) | |
116 | entry | |
117 | (profiler-format-entry entry))) | |
118 | ||
119 | \f | |
120 | ;;; Backtraces | |
121 | ||
122 | (defun profiler-fixup-backtrace (backtrace) | |
123 | (apply 'vector (mapcar 'profiler-fixup-entry backtrace))) | |
124 | ||
125 | \f | |
126 | ;;; Logs | |
c2d7786e | 127 | |
3d80c99f SM |
128 | ;; The C code returns the log in the form of a hash-table where the keys are |
129 | ;; vectors (of size profiler-max-stack-depth, holding truncated | |
130 | ;; backtraces, where the first element is the top of the stack) and | |
131 | ;; the values are integers (which count how many times this backtrace | |
132 | ;; has been seen, multiplied by a "weight factor" which is either the | |
c22bac2c TM |
133 | ;; sampling-interval or the memory being allocated). |
134 | ||
135 | (defun profiler-compare-logs (log1 log2) | |
136 | "Compare LOG1 with LOG2 and return diff." | |
3d80c99f SM |
137 | (let ((newlog (make-hash-table :test 'equal))) |
138 | ;; Make a copy of `log1' into `newlog'. | |
139 | (maphash (lambda (backtrace count) (puthash backtrace count newlog)) | |
140 | log1) | |
3d80c99f | 141 | (maphash (lambda (backtrace count) |
c22bac2c TM |
142 | (puthash backtrace (- (gethash backtrace log1 0) count) |
143 | newlog)) | |
3d80c99f SM |
144 | log2) |
145 | newlog)) | |
c2d7786e | 146 | |
c22bac2c | 147 | (defun profiler-fixup-log (log) |
3d80c99f SM |
148 | (let ((newlog (make-hash-table :test 'equal))) |
149 | (maphash (lambda (backtrace count) | |
c22bac2c | 150 | (puthash (profiler-fixup-backtrace backtrace) |
3d80c99f SM |
151 | count newlog)) |
152 | log) | |
153 | newlog)) | |
0efc778b | 154 | |
c22bac2c TM |
155 | \f |
156 | ;;; Profiles | |
157 | ||
158 | (cl-defstruct (profiler-profile (:type vector) | |
159 | (:constructor profiler-make-profile)) | |
160 | (tag 'profiler-profile) | |
161 | (version profiler-version) | |
162 | ;; - `type' has a value indicating the kind of profile (`memory' or `cpu'). | |
163 | ;; - `log' indicates the profile log. | |
164 | ;; - `timestamp' has a value giving the time when the profile was obtained. | |
165 | ;; - `diff-p' indicates if this profile represents a diff between two profiles. | |
166 | type log timestamp diff-p) | |
167 | ||
168 | (defun profiler-compare-profiles (profile1 profile2) | |
169 | "Compare PROFILE1 with PROFILE2 and return diff." | |
170 | (unless (eq (profiler-profile-type profile1) | |
171 | (profiler-profile-type profile2)) | |
172 | (error "Can't compare different type of profiles")) | |
173 | (profiler-make-profile | |
174 | :type (profiler-profile-type profile1) | |
175 | :timestamp (current-time) | |
176 | :diff-p t | |
177 | :log (profiler-compare-logs | |
178 | (profiler-profile-log profile1) | |
179 | (profiler-profile-log profile2)))) | |
180 | ||
181 | (defun profiler-fixup-profile (profile) | |
182 | "Fixup PROFILE so that the profile could be serialized into file." | |
183 | (profiler-make-profile | |
184 | :type (profiler-profile-type profile) | |
185 | :timestamp (profiler-profile-timestamp profile) | |
186 | :diff-p (profiler-profile-diff-p profile) | |
187 | :log (profiler-fixup-log (profiler-profile-log profile)))) | |
188 | ||
189 | (defun profiler-write-profile (profile filename &optional confirm) | |
190 | "Write PROFILE into file FILENAME." | |
0efc778b TM |
191 | (with-temp-buffer |
192 | (let (print-level print-length) | |
c22bac2c TM |
193 | (print (profiler-fixup-profile profile) |
194 | (current-buffer))) | |
0efc778b | 195 | (write-file filename confirm))) |
c2d7786e | 196 | |
c22bac2c TM |
197 | (defun profiler-read-profile (filename) |
198 | "Read profile from file FILENAME." | |
199 | ;; FIXME: tag and version check | |
0efc778b TM |
200 | (with-temp-buffer |
201 | (insert-file-contents filename) | |
202 | (goto-char (point-min)) | |
203 | (read (current-buffer)))) | |
c2d7786e | 204 | |
15df6fa4 GM |
205 | (defun profiler-running-p (&optional mode) |
206 | "Return non-nil if the profiler is running. | |
207 | Optional argument MODE means only check for the specified mode (cpu or mem)." | |
208 | (cond ((eq mode 'cpu) (and (fboundp 'profiler-cpu-running-p) | |
209 | (profiler-cpu-running-p))) | |
210 | ((eq mode 'mem) (profiler-memory-running-p)) | |
211 | (t (or (profiler-running-p 'cpu) | |
212 | (profiler-running-p 'mem))))) | |
213 | ||
c22bac2c TM |
214 | (defun profiler-cpu-profile () |
215 | "Return CPU profile." | |
15df6fa4 | 216 | (when (profiler-running-p 'cpu) |
c22bac2c TM |
217 | (profiler-make-profile |
218 | :type 'cpu | |
219 | :timestamp (current-time) | |
220 | :log (profiler-cpu-log)))) | |
221 | ||
222 | (defun profiler-memory-profile () | |
223 | "Return memory profile." | |
224 | (when (profiler-memory-running-p) | |
225 | (profiler-make-profile | |
226 | :type 'memory | |
227 | :timestamp (current-time) | |
228 | :log (profiler-memory-log)))) | |
229 | ||
0efc778b | 230 | \f |
c22bac2c | 231 | ;;; Calltrees |
c2d7786e | 232 | |
b02baf7f | 233 | (cl-defstruct (profiler-calltree (:constructor profiler-make-calltree)) |
c2d7786e | 234 | entry |
0efc778b | 235 | (count 0) (count-percent "") |
c2d7786e TM |
236 | parent children) |
237 | ||
238 | (defun profiler-calltree-leaf-p (tree) | |
239 | (null (profiler-calltree-children tree))) | |
240 | ||
241 | (defun profiler-calltree-count< (a b) | |
242 | (cond ((eq (profiler-calltree-entry a) t) t) | |
243 | ((eq (profiler-calltree-entry b) t) nil) | |
244 | (t (< (profiler-calltree-count a) | |
245 | (profiler-calltree-count b))))) | |
246 | ||
247 | (defun profiler-calltree-count> (a b) | |
248 | (not (profiler-calltree-count< a b))) | |
249 | ||
c2d7786e TM |
250 | (defun profiler-calltree-depth (tree) |
251 | (let ((parent (profiler-calltree-parent tree))) | |
252 | (if (null parent) | |
253 | 0 | |
254 | (1+ (profiler-calltree-depth parent))))) | |
255 | ||
256 | (defun profiler-calltree-find (tree entry) | |
0efc778b | 257 | "Return a child tree of ENTRY under TREE." |
0efc778b | 258 | (let (result (children (profiler-calltree-children tree))) |
3d80c99f | 259 | ;; FIXME: Use `assoc'. |
0efc778b TM |
260 | (while (and children (null result)) |
261 | (let ((child (car children))) | |
3d80c99f | 262 | (when (equal (profiler-calltree-entry child) entry) |
0efc778b TM |
263 | (setq result child)) |
264 | (setq children (cdr children)))) | |
265 | result)) | |
266 | ||
3d80c99f SM |
267 | (defun profiler-calltree-walk (calltree function) |
268 | (funcall function calltree) | |
c2d7786e | 269 | (dolist (child (profiler-calltree-children calltree)) |
3d80c99f | 270 | (profiler-calltree-walk child function))) |
c2d7786e TM |
271 | |
272 | (defun profiler-calltree-build-1 (tree log &optional reverse) | |
3a880af4 SM |
273 | ;; FIXME: Do a better job of reconstructing a complete call-tree |
274 | ;; when the backtraces have been truncated. Ideally, we should be | |
275 | ;; able to reduce profiler-max-stack-depth to 3 or 4 and still | |
276 | ;; get a meaningful call-tree. | |
3d80c99f SM |
277 | (maphash |
278 | (lambda (backtrace count) | |
c22bac2c TM |
279 | (let ((node tree) |
280 | (max (length backtrace))) | |
281 | (dotimes (i max) | |
282 | (let ((entry (aref backtrace (if reverse i (- max i 1))))) | |
283 | (when entry | |
284 | (let ((child (profiler-calltree-find node entry))) | |
285 | (unless child | |
286 | (setq child (profiler-make-calltree | |
287 | :entry entry :parent node)) | |
288 | (push child (profiler-calltree-children node))) | |
289 | (cl-incf (profiler-calltree-count child) count) | |
290 | (setq node child))))))) | |
3d80c99f | 291 | log)) |
0efc778b | 292 | |
c2d7786e | 293 | (defun profiler-calltree-compute-percentages (tree) |
3d80c99f | 294 | (let ((total-count 0)) |
ad942b63 | 295 | ;; FIXME: the memory profiler's total wraps around all too easily! |
c2d7786e | 296 | (dolist (child (profiler-calltree-children tree)) |
3d80c99f SM |
297 | (cl-incf total-count (profiler-calltree-count child))) |
298 | (unless (zerop total-count) | |
299 | (profiler-calltree-walk | |
300 | tree (lambda (node) | |
301 | (setf (profiler-calltree-count-percent node) | |
302 | (profiler-format-percent (profiler-calltree-count node) | |
303 | total-count))))))) | |
c2d7786e | 304 | |
b02baf7f | 305 | (cl-defun profiler-calltree-build (log &key reverse) |
c2d7786e TM |
306 | (let ((tree (profiler-make-calltree))) |
307 | (profiler-calltree-build-1 tree log reverse) | |
308 | (profiler-calltree-compute-percentages tree) | |
309 | tree)) | |
310 | ||
311 | (defun profiler-calltree-sort (tree predicate) | |
312 | (let ((children (profiler-calltree-children tree))) | |
313 | (setf (profiler-calltree-children tree) (sort children predicate)) | |
314 | (dolist (child (profiler-calltree-children tree)) | |
315 | (profiler-calltree-sort child predicate)))) | |
316 | ||
317 | \f | |
c2d7786e TM |
318 | ;;; Report rendering |
319 | ||
320 | (defcustom profiler-report-closed-mark "+" | |
321 | "An indicator of closed calltrees." | |
322 | :type 'string | |
323 | :group 'profiler) | |
324 | ||
325 | (defcustom profiler-report-open-mark "-" | |
326 | "An indicator of open calltrees." | |
327 | :type 'string | |
328 | :group 'profiler) | |
329 | ||
330 | (defcustom profiler-report-leaf-mark " " | |
331 | "An indicator of calltree leaves." | |
332 | :type 'string | |
333 | :group 'profiler) | |
334 | ||
c22bac2c | 335 | (defvar profiler-report-cpu-line-format |
b3ecad33 PE |
336 | '((50 left) |
337 | (24 right ((19 right) | |
c2d7786e TM |
338 | (5 right))))) |
339 | ||
340 | (defvar profiler-report-memory-line-format | |
12b3895d | 341 | '((55 left) |
c22bac2c | 342 | (19 right ((14 right profiler-format-number) |
c2d7786e TM |
343 | (5 right))))) |
344 | ||
c22bac2c TM |
345 | (defvar-local profiler-report-profile nil |
346 | "The current profile.") | |
0efc778b | 347 | |
3d80c99f | 348 | (defvar-local profiler-report-reversed nil |
0efc778b TM |
349 | "True if calltree is rendered in bottom-up. Do not touch this |
350 | variable directly.") | |
351 | ||
3d80c99f | 352 | (defvar-local profiler-report-order nil |
0efc778b TM |
353 | "The value can be `ascending' or `descending'. Do not touch |
354 | this variable directly.") | |
c2d7786e TM |
355 | |
356 | (defun profiler-report-make-entry-part (entry) | |
0efc778b TM |
357 | (let ((string (cond |
358 | ((eq entry t) | |
359 | "Others") | |
0efc778b TM |
360 | ((and (symbolp entry) |
361 | (fboundp entry)) | |
362 | (propertize (symbol-name entry) | |
363 | 'face 'link | |
364 | 'mouse-face 'highlight | |
d069271c EZ |
365 | 'help-echo "\ |
366 | mouse-2: jump to definition\n\ | |
367 | RET: expand or collapse")) | |
0efc778b | 368 | (t |
c22bac2c | 369 | (profiler-format-entry entry))))) |
3d80c99f | 370 | (propertize string 'profiler-entry entry))) |
c2d7786e TM |
371 | |
372 | (defun profiler-report-make-name-part (tree) | |
373 | (let* ((entry (profiler-calltree-entry tree)) | |
374 | (depth (profiler-calltree-depth tree)) | |
375 | (indent (make-string (* (1- depth) 2) ?\s)) | |
376 | (mark (if (profiler-calltree-leaf-p tree) | |
377 | profiler-report-leaf-mark | |
378 | profiler-report-closed-mark)) | |
379 | (entry (profiler-report-make-entry-part entry))) | |
380 | (format "%s%s %s" indent mark entry))) | |
381 | ||
382 | (defun profiler-report-header-line-format (fmt &rest args) | |
383 | (let* ((header (apply 'profiler-format fmt args)) | |
384 | (escaped (replace-regexp-in-string "%" "%%" header))) | |
385 | (concat " " escaped))) | |
386 | ||
387 | (defun profiler-report-line-format (tree) | |
c22bac2c | 388 | (let ((diff-p (profiler-profile-diff-p profiler-report-profile)) |
c2d7786e | 389 | (name-part (profiler-report-make-name-part tree)) |
c2d7786e TM |
390 | (count (profiler-calltree-count tree)) |
391 | (count-percent (profiler-calltree-count-percent tree))) | |
c22bac2c TM |
392 | (profiler-format (cl-ecase (profiler-profile-type profiler-report-profile) |
393 | (cpu profiler-report-cpu-line-format) | |
3d80c99f SM |
394 | (memory profiler-report-memory-line-format)) |
395 | name-part | |
396 | (if diff-p | |
397 | (list (if (> count 0) | |
398 | (format "+%s" count) | |
399 | count) | |
400 | "") | |
401 | (list count count-percent))))) | |
c2d7786e TM |
402 | |
403 | (defun profiler-report-insert-calltree (tree) | |
404 | (let ((line (profiler-report-line-format tree))) | |
405 | (insert (propertize (concat line "\n") 'calltree tree)))) | |
406 | ||
407 | (defun profiler-report-insert-calltree-children (tree) | |
408 | (mapc 'profiler-report-insert-calltree | |
409 | (profiler-calltree-children tree))) | |
410 | ||
411 | \f | |
c2d7786e TM |
412 | ;;; Report mode |
413 | ||
414 | (defvar profiler-report-mode-map | |
415 | (let ((map (make-sparse-keymap))) | |
416 | (define-key map "n" 'profiler-report-next-entry) | |
417 | (define-key map "p" 'profiler-report-previous-entry) | |
3d80c99f SM |
418 | ;; I find it annoying more than helpful to not be able to navigate |
419 | ;; normally with the cursor keys. --Stef | |
420 | ;; (define-key map [down] 'profiler-report-next-entry) | |
421 | ;; (define-key map [up] 'profiler-report-previous-entry) | |
c2d7786e TM |
422 | (define-key map "\r" 'profiler-report-toggle-entry) |
423 | (define-key map "\t" 'profiler-report-toggle-entry) | |
424 | (define-key map "i" 'profiler-report-toggle-entry) | |
425 | (define-key map "f" 'profiler-report-find-entry) | |
426 | (define-key map "j" 'profiler-report-find-entry) | |
427 | (define-key map [mouse-2] 'profiler-report-find-entry) | |
428 | (define-key map "d" 'profiler-report-describe-entry) | |
429 | (define-key map "C" 'profiler-report-render-calltree) | |
430 | (define-key map "B" 'profiler-report-render-reversed-calltree) | |
431 | (define-key map "A" 'profiler-report-ascending-sort) | |
432 | (define-key map "D" 'profiler-report-descending-sort) | |
c22bac2c TM |
433 | (define-key map "=" 'profiler-report-compare-profile) |
434 | (define-key map (kbd "C-x C-w") 'profiler-report-write-profile) | |
b0636be7 GM |
435 | (easy-menu-define profiler-report-menu map "Menu for Profiler Report mode." |
436 | '("Profiler" | |
437 | ["Next Entry" profiler-report-next-entry :active t | |
438 | :help "Move to next entry"] | |
439 | ["Previous Entry" profiler-report-previous-entry :active t | |
440 | :help "Move to previous entry"] | |
441 | "--" | |
442 | ["Toggle Entry" profiler-report-toggle-entry | |
443 | :active (profiler-report-calltree-at-point) | |
444 | :help "Expand or collapse the current entry"] | |
445 | ["Find Entry" profiler-report-find-entry | |
446 | ;; FIXME should deactivate if not on a known function. | |
447 | :active (profiler-report-calltree-at-point) | |
448 | :help "Find the definition of the current entry"] | |
449 | ["Describe Entry" profiler-report-describe-entry | |
450 | :active (profiler-report-calltree-at-point) | |
451 | :help "Show the documentation of the current entry"] | |
452 | "--" | |
453 | ["Show Calltree" profiler-report-render-calltree | |
454 | :active profiler-report-reversed | |
455 | :help "Show calltree view"] | |
456 | ["Show Reversed Calltree" profiler-report-render-reversed-calltree | |
457 | :active (not profiler-report-reversed) | |
458 | :help "Show reversed calltree view"] | |
459 | ["Sort Ascending" profiler-report-ascending-sort | |
460 | :active (not (eq profiler-report-order 'ascending)) | |
461 | :help "Sort calltree view in ascending order"] | |
462 | ["Sort Descending" profiler-report-descending-sort | |
463 | :active (not (eq profiler-report-order 'descending)) | |
464 | :help "Sort calltree view in descending order"] | |
465 | "--" | |
466 | ["Compare Profile..." profiler-report-compare-profile :active t | |
467 | :help "Compare current profile with another"] | |
468 | ["Write Profile..." profiler-report-write-profile :active t | |
15df6fa4 GM |
469 | :help "Write current profile to a file"] |
470 | "--" | |
ed746aa7 GM |
471 | ["Start Profiler" profiler-start :active (not (profiler-running-p)) |
472 | :help "Start profiling"] | |
15df6fa4 GM |
473 | ["Stop Profiler" profiler-stop :active (profiler-running-p) |
474 | :help "Stop profiling"] | |
475 | ["New Report" profiler-report :active (profiler-running-p) | |
476 | :help "Make a new report"])) | |
b0636be7 GM |
477 | map) |
478 | "Keymap for `profiler-report-mode'.") | |
c2d7786e | 479 | |
c22bac2c | 480 | (defun profiler-report-make-buffer-name (profile) |
3d80c99f | 481 | (format "*%s-Profiler-Report %s*" |
c22bac2c TM |
482 | (cl-ecase (profiler-profile-type profile) (cpu 'CPU) (memory 'Memory)) |
483 | (format-time-string "%Y-%m-%d %T" (profiler-profile-timestamp profile)))) | |
c2d7786e | 484 | |
c22bac2c TM |
485 | (defun profiler-report-setup-buffer-1 (profile) |
486 | "Make a buffer for PROFILE and return it." | |
487 | (let* ((buf-name (profiler-report-make-buffer-name profile)) | |
c2d7786e TM |
488 | (buffer (get-buffer-create buf-name))) |
489 | (with-current-buffer buffer | |
490 | (profiler-report-mode) | |
c22bac2c | 491 | (setq profiler-report-profile profile |
c2d7786e TM |
492 | profiler-report-reversed nil |
493 | profiler-report-order 'descending)) | |
494 | buffer)) | |
495 | ||
c22bac2c TM |
496 | (defun profiler-report-setup-buffer (profile) |
497 | "Make a buffer for PROFILE with rendering the profile and | |
498 | return it." | |
499 | (let ((buffer (profiler-report-setup-buffer-1 profile))) | |
500 | (with-current-buffer buffer | |
501 | (profiler-report-render-calltree)) | |
502 | buffer)) | |
503 | ||
c2d7786e TM |
504 | (define-derived-mode profiler-report-mode special-mode "Profiler-Report" |
505 | "Profiler Report Mode." | |
c2d7786e TM |
506 | (setq buffer-read-only t |
507 | buffer-undo-list t | |
508 | truncate-lines t)) | |
509 | ||
510 | \f | |
c2d7786e TM |
511 | ;;; Report commands |
512 | ||
c22bac2c TM |
513 | (defun profiler-report-calltree-at-point (&optional point) |
514 | (get-text-property (or point (point)) 'calltree)) | |
c2d7786e TM |
515 | |
516 | (defun profiler-report-move-to-entry () | |
c22bac2c TM |
517 | (let ((point (next-single-property-change |
518 | (line-beginning-position) 'profiler-entry))) | |
c2d7786e TM |
519 | (if point |
520 | (goto-char point) | |
521 | (back-to-indentation)))) | |
522 | ||
523 | (defun profiler-report-next-entry () | |
0efc778b | 524 | "Move cursor to next entry." |
c2d7786e TM |
525 | (interactive) |
526 | (forward-line) | |
527 | (profiler-report-move-to-entry)) | |
528 | ||
529 | (defun profiler-report-previous-entry () | |
0efc778b | 530 | "Move cursor to previous entry." |
c2d7786e TM |
531 | (interactive) |
532 | (forward-line -1) | |
533 | (profiler-report-move-to-entry)) | |
534 | ||
535 | (defun profiler-report-expand-entry () | |
0efc778b | 536 | "Expand entry at point." |
c2d7786e TM |
537 | (interactive) |
538 | (save-excursion | |
539 | (beginning-of-line) | |
540 | (when (search-forward (concat profiler-report-closed-mark " ") | |
541 | (line-end-position) t) | |
542 | (let ((tree (profiler-report-calltree-at-point))) | |
543 | (when tree | |
3d80c99f | 544 | (let ((inhibit-read-only t)) |
c2d7786e TM |
545 | (replace-match (concat profiler-report-open-mark " ")) |
546 | (forward-line) | |
547 | (profiler-report-insert-calltree-children tree) | |
548 | t)))))) | |
549 | ||
550 | (defun profiler-report-collapse-entry () | |
735135f9 | 551 | "Collapse entry at point." |
c2d7786e TM |
552 | (interactive) |
553 | (save-excursion | |
554 | (beginning-of-line) | |
555 | (when (search-forward (concat profiler-report-open-mark " ") | |
556 | (line-end-position) t) | |
557 | (let* ((tree (profiler-report-calltree-at-point)) | |
558 | (depth (profiler-calltree-depth tree)) | |
559 | (start (line-beginning-position 2)) | |
560 | d) | |
561 | (when tree | |
3d80c99f | 562 | (let ((inhibit-read-only t)) |
c2d7786e TM |
563 | (replace-match (concat profiler-report-closed-mark " ")) |
564 | (while (and (eq (forward-line) 0) | |
565 | (let ((child (get-text-property (point) 'calltree))) | |
566 | (and child | |
567 | (numberp (setq d (profiler-calltree-depth child))))) | |
568 | (> d depth))) | |
569 | (delete-region start (line-beginning-position))))) | |
570 | t))) | |
571 | ||
572 | (defun profiler-report-toggle-entry () | |
0efc778b TM |
573 | "Expand entry at point if the tree is collapsed, |
574 | otherwise collapse." | |
c2d7786e TM |
575 | (interactive) |
576 | (or (profiler-report-expand-entry) | |
577 | (profiler-report-collapse-entry))) | |
578 | ||
579 | (defun profiler-report-find-entry (&optional event) | |
0efc778b | 580 | "Find entry at point." |
c2d7786e | 581 | (interactive (list last-nonmenu-event)) |
b0636be7 GM |
582 | (with-current-buffer |
583 | (if event (window-buffer (posn-window (event-start event))) | |
584 | (current-buffer)) | |
585 | (and event (setq event (event-end event)) | |
586 | (posn-set-point event)) | |
587 | (let ((tree (profiler-report-calltree-at-point))) | |
588 | (when tree | |
589 | (let ((entry (profiler-calltree-entry tree))) | |
590 | (find-function entry)))))) | |
c2d7786e TM |
591 | |
592 | (defun profiler-report-describe-entry () | |
0efc778b | 593 | "Describe entry at point." |
c2d7786e TM |
594 | (interactive) |
595 | (let ((tree (profiler-report-calltree-at-point))) | |
596 | (when tree | |
597 | (let ((entry (profiler-calltree-entry tree))) | |
598 | (require 'help-fns) | |
599 | (describe-function entry))))) | |
600 | ||
3d80c99f | 601 | (cl-defun profiler-report-render-calltree-1 |
c22bac2c TM |
602 | (profile &key reverse (order 'descending)) |
603 | (let ((calltree (profiler-calltree-build | |
604 | (profiler-profile-log profile) | |
605 | :reverse reverse))) | |
3d80c99f | 606 | (setq header-line-format |
c22bac2c | 607 | (cl-ecase (profiler-profile-type profile) |
3d80c99f | 608 | (cpu |
c2d7786e | 609 | (profiler-report-header-line-format |
c22bac2c | 610 | profiler-report-cpu-line-format |
b3ecad33 | 611 | "Function" (list "CPU samples" "%"))) |
3d80c99f | 612 | (memory |
c2d7786e TM |
613 | (profiler-report-header-line-format |
614 | profiler-report-memory-line-format | |
3d80c99f SM |
615 | "Function" (list "Bytes" "%"))))) |
616 | (let ((predicate (cl-ecase order | |
617 | (ascending #'profiler-calltree-count<) | |
618 | (descending #'profiler-calltree-count>)))) | |
619 | (profiler-calltree-sort calltree predicate)) | |
620 | (let ((inhibit-read-only t)) | |
c2d7786e TM |
621 | (erase-buffer) |
622 | (profiler-report-insert-calltree-children calltree) | |
623 | (goto-char (point-min)) | |
624 | (profiler-report-move-to-entry)))) | |
625 | ||
626 | (defun profiler-report-rerender-calltree () | |
c22bac2c | 627 | (profiler-report-render-calltree-1 profiler-report-profile |
c2d7786e TM |
628 | :reverse profiler-report-reversed |
629 | :order profiler-report-order)) | |
630 | ||
631 | (defun profiler-report-render-calltree () | |
0efc778b | 632 | "Render calltree view." |
c2d7786e TM |
633 | (interactive) |
634 | (setq profiler-report-reversed nil) | |
635 | (profiler-report-rerender-calltree)) | |
636 | ||
637 | (defun profiler-report-render-reversed-calltree () | |
0efc778b | 638 | "Render reversed calltree view." |
c2d7786e TM |
639 | (interactive) |
640 | (setq profiler-report-reversed t) | |
641 | (profiler-report-rerender-calltree)) | |
642 | ||
643 | (defun profiler-report-ascending-sort () | |
644 | "Sort calltree view in ascending order." | |
645 | (interactive) | |
646 | (setq profiler-report-order 'ascending) | |
647 | (profiler-report-rerender-calltree)) | |
648 | ||
649 | (defun profiler-report-descending-sort () | |
650 | "Sort calltree view in descending order." | |
651 | (interactive) | |
652 | (setq profiler-report-order 'descending) | |
653 | (profiler-report-rerender-calltree)) | |
654 | ||
c22bac2c TM |
655 | (defun profiler-report-profile (profile) |
656 | (switch-to-buffer (profiler-report-setup-buffer profile))) | |
657 | ||
658 | (defun profiler-report-profile-other-window (profile) | |
659 | (switch-to-buffer-other-window (profiler-report-setup-buffer profile))) | |
660 | ||
661 | (defun profiler-report-profile-other-frame (profile) | |
662 | (switch-to-buffer-other-frame (profiler-report-setup-buffer profile))) | |
c2d7786e | 663 | |
c22bac2c TM |
664 | (defun profiler-report-compare-profile (buffer) |
665 | "Compare the current profile with another." | |
c2d7786e | 666 | (interactive (list (read-buffer "Compare to: "))) |
c22bac2c TM |
667 | (let* ((profile1 (with-current-buffer buffer profiler-report-profile)) |
668 | (profile2 profiler-report-profile) | |
669 | (diff-profile (profiler-compare-profiles profile1 profile2))) | |
670 | (profiler-report-profile diff-profile))) | |
c2d7786e | 671 | |
c22bac2c TM |
672 | (defun profiler-report-write-profile (filename &optional confirm) |
673 | "Write the current profile into file FILENAME." | |
c2d7786e | 674 | (interactive |
c22bac2c | 675 | (list (read-file-name "Write profile: " default-directory) |
c2d7786e | 676 | (not current-prefix-arg))) |
c22bac2c TM |
677 | (profiler-write-profile profiler-report-profile |
678 | filename | |
679 | confirm)) | |
c2d7786e TM |
680 | |
681 | \f | |
c2d7786e TM |
682 | ;;; Profiler commands |
683 | ||
c2d7786e TM |
684 | ;;;###autoload |
685 | (defun profiler-start (mode) | |
3d80c99f SM |
686 | "Start/restart profilers. |
687 | MODE can be one of `cpu', `mem', or `cpu+mem'. | |
688 | If MODE is `cpu' or `cpu+mem', time-based profiler will be started. | |
689 | Also, if MODE is `mem' or `cpu+mem', then memory profiler will be started." | |
c2d7786e | 690 | (interactive |
234148bf SM |
691 | (list (if (not (fboundp 'profiler-cpu-start)) 'mem |
692 | (intern (completing-read "Mode (default cpu): " | |
693 | '("cpu" "mem" "cpu+mem") | |
694 | nil t nil nil "cpu"))))) | |
b02baf7f | 695 | (cl-ecase mode |
c2d7786e | 696 | (cpu |
c22bac2c | 697 | (profiler-cpu-start profiler-sampling-interval) |
c2d7786e | 698 | (message "CPU profiler started")) |
a4924b14 | 699 | (mem |
6521894d | 700 | (profiler-memory-start) |
c2d7786e | 701 | (message "Memory profiler started")) |
a4924b14 | 702 | (cpu+mem |
c22bac2c | 703 | (profiler-cpu-start profiler-sampling-interval) |
6521894d | 704 | (profiler-memory-start) |
c2d7786e TM |
705 | (message "CPU and memory profiler started")))) |
706 | ||
707 | (defun profiler-stop () | |
0efc778b | 708 | "Stop started profilers. Profiler logs will be kept." |
c2d7786e | 709 | (interactive) |
234148bf SM |
710 | (let ((cpu (if (fboundp 'profiler-cpu-stop) (profiler-cpu-stop))) |
711 | (mem (profiler-memory-stop))) | |
712 | (message "%s profiler stopped" | |
713 | (cond ((and mem cpu) "CPU and memory") | |
714 | (mem "Memory") | |
715 | (cpu "CPU") | |
716 | (t "No"))))) | |
c2d7786e TM |
717 | |
718 | (defun profiler-reset () | |
c22bac2c | 719 | "Reset profiler logs." |
c2d7786e | 720 | (interactive) |
234148bf SM |
721 | (when (fboundp 'profiler-cpu-log) |
722 | (ignore (profiler-cpu-log))) | |
6521894d | 723 | (ignore (profiler-memory-log)) |
c2d7786e TM |
724 | t) |
725 | ||
c22bac2c TM |
726 | (defun profiler-report-cpu () |
727 | (let ((profile (profiler-cpu-profile))) | |
728 | (when profile | |
729 | (profiler-report-profile-other-window profile)))) | |
ce56157e | 730 | |
c22bac2c TM |
731 | (defun profiler-report-memory () |
732 | (let ((profile (profiler-memory-profile))) | |
733 | (when profile | |
734 | (profiler-report-profile-other-window profile)))) | |
c2d7786e | 735 | |
ce56157e | 736 | (defun profiler-report () |
0efc778b | 737 | "Report profiling results." |
ce56157e | 738 | (interactive) |
c22bac2c TM |
739 | (profiler-report-cpu) |
740 | (profiler-report-memory)) | |
741 | ||
742 | ;;;###autoload | |
743 | (defun profiler-find-profile (filename) | |
744 | "Open profile FILENAME." | |
745 | (interactive | |
746 | (list (read-file-name "Find profile: " default-directory))) | |
747 | (profiler-report-profile (profiler-read-profile filename))) | |
748 | ||
749 | ;;;###autoload | |
750 | (defun profiler-find-profile-other-window (filename) | |
751 | "Open profile FILENAME." | |
752 | (interactive | |
753 | (list (read-file-name "Find profile: " default-directory))) | |
754 | (profiler-report-profile-other-window (profiler-read-profile filename))) | |
ce56157e | 755 | |
c2d7786e | 756 | ;;;###autoload |
c22bac2c TM |
757 | (defun profiler-find-profile-other-frame (filename) |
758 | "Open profile FILENAME." | |
c2d7786e | 759 | (interactive |
c22bac2c TM |
760 | (list (read-file-name "Find profile: " default-directory))) |
761 | (profiler-report-profile-other-frame(profiler-read-profile filename))) | |
c2d7786e | 762 | |
ce56157e | 763 | \f |
ce56157e TM |
764 | ;;; Profiling helpers |
765 | ||
c22bac2c | 766 | ;; (cl-defmacro with-cpu-profiling ((&key sampling-interval) &rest body) |
3a880af4 SM |
767 | ;; `(unwind-protect |
768 | ;; (progn | |
769 | ;; (ignore (profiler-cpu-log)) | |
c22bac2c | 770 | ;; (profiler-cpu-start ,sampling-interval) |
3a880af4 SM |
771 | ;; ,@body) |
772 | ;; (profiler-cpu-stop) | |
773 | ;; (profiler--report-cpu))) | |
774 | ||
775 | ;; (defmacro with-memory-profiling (&rest body) | |
776 | ;; `(unwind-protect | |
777 | ;; (progn | |
778 | ;; (ignore (profiler-memory-log)) | |
779 | ;; (profiler-memory-start) | |
780 | ;; ,@body) | |
781 | ;; (profiler-memory-stop) | |
782 | ;; (profiler--report-memory))) | |
ce56157e | 783 | |
c2d7786e TM |
784 | (provide 'profiler) |
785 | ;;; profiler.el ends here |