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