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