aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorTomohiro Matsuyama2012-10-01 07:21:25 +0900
committerTomohiro Matsuyama2012-10-01 07:21:25 +0900
commitc22bac2cc59c6c04924ecf62c5eeb97a92df7e28 (patch)
tree707758235e762854e17742bbbcc737687b85e457
parent5e4daaf3face7ed54de7cb3621edb31e16b011ed (diff)
downloademacs-c22bac2cc59c6c04924ecf62c5eeb97a92df7e28.tar.gz
emacs-c22bac2cc59c6c04924ecf62c5eeb97a92df7e28.zip
* profiler.el (profiler-sampling-interval): Rename from
profiler-sample-interval. (profiler-sampling-interval): Default to 10. (profiler-find-profile): New command (was profiler-find-log). (profiler-find-profile-other-window): New command. (profiler-find-profile-other-frame): New command. (profiler-profile): Introduce API-level data structure.
-rw-r--r--lisp/ChangeLog10
-rw-r--r--lisp/profiler.el349
-rw-r--r--src/profiler.c32
3 files changed, 232 insertions, 159 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 752549ba73d..b5b8c8bef9f 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
12012-09-30 Tomohiro Matsuyama <tomo@cx4a.org>
2
3 * profiler.el (profiler-sampling-interval): Rename from
4 profiler-sample-interval.
5 (profiler-sampling-interval): Default to 10.
6 (profiler-find-profile): New command (was profiler-find-log).
7 (profiler-find-profile-other-window): New command.
8 (profiler-find-profile-other-frame): New command.
9 (profiler-profile): Introduce API-level data structure.
10
12012-09-30 Paul Eggert <eggert@cs.ucla.edu> 112012-09-30 Paul Eggert <eggert@cs.ucla.edu>
2 12
3 file-attributes has a new optional arg FOLLOW-SYMLINKS. 13 file-attributes has a new optional arg FOLLOW-SYMLINKS.
diff --git a/lisp/profiler.el b/lisp/profiler.el
index 5fc74573262..b2963d837a5 100644
--- a/lisp/profiler.el
+++ b/lisp/profiler.el
@@ -24,19 +24,21 @@
24 24
25;;; Code: 25;;; Code:
26 26
27(eval-when-compile 27(require 'cl-lib)
28 (require 'cl-lib))
29 28
30(defgroup profiler nil 29(defgroup profiler nil
31 "Emacs profiler." 30 "Emacs profiler."
32 :group 'lisp 31 :group 'lisp
33 :prefix "profiler-") 32 :prefix "profiler-")
34 33
35(defcustom profiler-sample-interval 1 34(defconst profiler-version "24.3")
36 "Default sample interval in millisecond." 35
36(defcustom profiler-sampling-interval 10
37 "Default sampling interval in millisecond."
37 :type 'integer 38 :type 'integer
38 :group 'profiler) 39 :group 'profiler)
39 40
41
40;;; Utilities 42;;; Utilities
41 43
42(defun profiler-ensure-string (object) 44(defun profiler-ensure-string (object)
@@ -49,6 +51,23 @@
49 (t 51 (t
50 (format "%s" object)))) 52 (format "%s" object))))
51 53
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
52(defun profiler-format (fmt &rest args) 71(defun profiler-format (fmt &rest args)
53 (cl-loop for (width align subfmt) in fmt 72 (cl-loop for (width align subfmt) in fmt
54 for arg in args 73 for arg in args
@@ -74,27 +93,10 @@
74 into frags 93 into frags
75 finally return (apply #'concat frags))) 94 finally return (apply #'concat frags)))
76 95
77(defun profiler-format-percent (number divisor)
78 (concat (number-to-string (/ (* number 100) divisor)) "%"))
79
80(defun profiler-format-nbytes (nbytes)
81 "Format NBYTES in humarn readable string."
82 (if (and (integerp nbytes) (> nbytes 0))
83 (cl-loop with i = (% (1+ (floor (log10 nbytes))) 3)
84 for c in (append (number-to-string nbytes) nil)
85 if (= i 0)
86 collect ?, into s
87 and do (setq i 3)
88 collect c into s
89 do (cl-decf i)
90 finally return
91 (apply 'string (if (eq (car s) ?,) (cdr s) s)))
92 (profiler-ensure-string nbytes)))
93
94 96
95;;; Entries 97;;; Entries
96 98
97(defun profiler-entry-format (entry) 99(defun profiler-format-entry (entry)
98 "Format ENTRY in human readable string. ENTRY would be a 100 "Format ENTRY in human readable string. ENTRY would be a
99function name of a function itself." 101function name of a function itself."
100 (cond ((memq (car-safe entry) '(closure lambda)) 102 (cond ((memq (car-safe entry) '(closure lambda))
@@ -106,76 +108,117 @@ function name of a function itself."
106 (t 108 (t
107 (format "#<unknown 0x%x>" (sxhash entry))))) 109 (format "#<unknown 0x%x>" (sxhash entry)))))
108 110
109;;; Log data structure 111(defun profiler-fixup-entry (entry)
112 (if (symbolp entry)
113 entry
114 (profiler-format-entry entry)))
115
116
117;;; Backtraces
118
119(defun profiler-fixup-backtrace (backtrace)
120 (apply 'vector (mapcar 'profiler-fixup-entry backtrace)))
121
122
123;;; Logs
110 124
111;; The C code returns the log in the form of a hash-table where the keys are 125;; The C code returns the log in the form of a hash-table where the keys are
112;; vectors (of size profiler-max-stack-depth, holding truncated 126;; vectors (of size profiler-max-stack-depth, holding truncated
113;; backtraces, where the first element is the top of the stack) and 127;; backtraces, where the first element is the top of the stack) and
114;; the values are integers (which count how many times this backtrace 128;; the values are integers (which count how many times this backtrace
115;; has been seen, multiplied by a "weight factor" which is either the 129;; has been seen, multiplied by a "weight factor" which is either the
116;; sample-interval or the memory being allocated). 130;; sampling-interval or the memory being allocated).
117;; We extend it by adding a few other entries to the hash-table, most notably: 131
118;; - Key `type' has a value indicating the kind of log (`memory' or `cpu'). 132(defun profiler-compare-logs (log1 log2)
119;; - Key `timestamp' has a value giving the time when the log was obtained. 133 "Compare LOG1 with LOG2 and return diff."
120;; - Key `diff-p' indicates if this log represents a diff between two logs.
121
122(defun profiler-log-timestamp (log) (gethash 'timestamp log))
123(defun profiler-log-type (log) (gethash 'type log))
124(defun profiler-log-diff-p (log) (gethash 'diff-p log))
125
126(defun profiler-log-diff (log1 log2)
127 "Compare LOG1 with LOG2 and return a diff log. Both logs must
128be same type."
129 (unless (eq (profiler-log-type log1)
130 (profiler-log-type log2))
131 (error "Can't compare different type of logs"))
132 (let ((newlog (make-hash-table :test 'equal))) 134 (let ((newlog (make-hash-table :test 'equal)))
133 ;; Make a copy of `log1' into `newlog'. 135 ;; Make a copy of `log1' into `newlog'.
134 (maphash (lambda (backtrace count) (puthash backtrace count newlog)) 136 (maphash (lambda (backtrace count) (puthash backtrace count newlog))
135 log1) 137 log1)
136 (puthash 'diff-p t newlog)
137 (maphash (lambda (backtrace count) 138 (maphash (lambda (backtrace count)
138 (when (vectorp backtrace) 139 (puthash backtrace (- (gethash backtrace log1 0) count)
139 (puthash backtrace (- (gethash backtrace log1 0) count) 140 newlog))
140 newlog)))
141 log2) 141 log2)
142 newlog)) 142 newlog))
143 143
144(defun profiler-log-fixup-entry (entry) 144(defun profiler-fixup-log (log)
145 (if (symbolp entry)
146 entry
147 (profiler-entry-format entry)))
148
149(defun profiler-log-fixup-backtrace (backtrace)
150 (mapcar 'profiler-log-fixup-entry backtrace))
151
152(defun profiler-log-fixup (log)
153 "Fixup LOG so that the log could be serialized into file."
154 (let ((newlog (make-hash-table :test 'equal))) 145 (let ((newlog (make-hash-table :test 'equal)))
155 (maphash (lambda (backtrace count) 146 (maphash (lambda (backtrace count)
156 (puthash (if (not (vectorp backtrace)) 147 (puthash (profiler-fixup-backtrace backtrace)
157 backtrace
158 (profiler-log-fixup-backtrace backtrace))
159 count newlog)) 148 count newlog))
160 log) 149 log)
161 newlog)) 150 newlog))
162 151
163(defun profiler-log-write-file (log filename &optional confirm) 152
164 "Write LOG into FILENAME." 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."
165 (with-temp-buffer 188 (with-temp-buffer
166 (let (print-level print-length) 189 (let (print-level print-length)
167 (print (profiler-log-fixup log) (current-buffer))) 190 (print (profiler-fixup-profile profile)
191 (current-buffer)))
168 (write-file filename confirm))) 192 (write-file filename confirm)))
169 193
170(defun profiler-log-read-file (filename) 194(defun profiler-read-profile (filename)
171 "Read log from FILENAME." 195 "Read profile from file FILENAME."
196 ;; FIXME: tag and version check
172 (with-temp-buffer 197 (with-temp-buffer
173 (insert-file-contents filename) 198 (insert-file-contents filename)
174 (goto-char (point-min)) 199 (goto-char (point-min))
175 (read (current-buffer)))) 200 (read (current-buffer))))
176 201
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
177 220
178;;; Calltree data structure 221;;; Calltrees
179 222
180(cl-defstruct (profiler-calltree (:constructor profiler-make-calltree)) 223(cl-defstruct (profiler-calltree (:constructor profiler-make-calltree))
181 entry 224 entry
@@ -202,7 +245,6 @@ be same type."
202 245
203(defun profiler-calltree-find (tree entry) 246(defun profiler-calltree-find (tree entry)
204 "Return a child tree of ENTRY under TREE." 247 "Return a child tree of ENTRY under TREE."
205 ;; OPTIMIZED
206 (let (result (children (profiler-calltree-children tree))) 248 (let (result (children (profiler-calltree-children tree)))
207 ;; FIXME: Use `assoc'. 249 ;; FIXME: Use `assoc'.
208 (while (and children (null result)) 250 (while (and children (null result))
@@ -224,19 +266,18 @@ be same type."
224 ;; get a meaningful call-tree. 266 ;; get a meaningful call-tree.
225 (maphash 267 (maphash
226 (lambda (backtrace count) 268 (lambda (backtrace count)
227 (when (vectorp backtrace) 269 (let ((node tree)
228 (let ((node tree) 270 (max (length backtrace)))
229 (max (length backtrace))) 271 (dotimes (i max)
230 (dotimes (i max) 272 (let ((entry (aref backtrace (if reverse i (- max i 1)))))
231 (let ((entry (aref backtrace (if reverse i (- max i 1))))) 273 (when entry
232 (when entry 274 (let ((child (profiler-calltree-find node entry)))
233 (let ((child (profiler-calltree-find node entry))) 275 (unless child
234 (unless child 276 (setq child (profiler-make-calltree
235 (setq child (profiler-make-calltree 277 :entry entry :parent node))
236 :entry entry :parent node)) 278 (push child (profiler-calltree-children node)))
237 (push child (profiler-calltree-children node))) 279 (cl-incf (profiler-calltree-count child) count)
238 (cl-incf (profiler-calltree-count child) count) 280 (setq node child)))))))
239 (setq node child))))))))
240 log)) 281 log))
241 282
242(defun profiler-calltree-compute-percentages (tree) 283(defun profiler-calltree-compute-percentages (tree)
@@ -281,18 +322,18 @@ be same type."
281 :type 'string 322 :type 'string
282 :group 'profiler) 323 :group 'profiler)
283 324
284(defvar profiler-report-sample-line-format 325(defvar profiler-report-cpu-line-format
285 '((60 left) 326 '((60 left)
286 (14 right ((9 right) 327 (14 right ((9 right)
287 (5 right))))) 328 (5 right)))))
288 329
289(defvar profiler-report-memory-line-format 330(defvar profiler-report-memory-line-format
290 '((55 left) 331 '((55 left)
291 (19 right ((14 right profiler-format-nbytes) 332 (19 right ((14 right profiler-format-number)
292 (5 right))))) 333 (5 right)))))
293 334
294(defvar-local profiler-report-log nil 335(defvar-local profiler-report-profile nil
295 "The current profiler log.") 336 "The current profile.")
296 337
297(defvar-local profiler-report-reversed nil 338(defvar-local profiler-report-reversed nil
298 "True if calltree is rendered in bottom-up. Do not touch this 339 "True if calltree is rendered in bottom-up. Do not touch this
@@ -313,7 +354,7 @@ this variable directly.")
313 'mouse-face 'highlight 354 'mouse-face 'highlight
314 'help-echo "mouse-2 or RET jumps to definition")) 355 'help-echo "mouse-2 or RET jumps to definition"))
315 (t 356 (t
316 (profiler-entry-format entry))))) 357 (profiler-format-entry entry)))))
317 (propertize string 'profiler-entry entry))) 358 (propertize string 'profiler-entry entry)))
318 359
319(defun profiler-report-make-name-part (tree) 360(defun profiler-report-make-name-part (tree)
@@ -332,12 +373,12 @@ this variable directly.")
332 (concat " " escaped))) 373 (concat " " escaped)))
333 374
334(defun profiler-report-line-format (tree) 375(defun profiler-report-line-format (tree)
335 (let ((diff-p (profiler-log-diff-p profiler-report-log)) 376 (let ((diff-p (profiler-profile-diff-p profiler-report-profile))
336 (name-part (profiler-report-make-name-part tree)) 377 (name-part (profiler-report-make-name-part tree))
337 (count (profiler-calltree-count tree)) 378 (count (profiler-calltree-count tree))
338 (count-percent (profiler-calltree-count-percent tree))) 379 (count-percent (profiler-calltree-count-percent tree)))
339 (profiler-format (cl-ecase (profiler-log-type profiler-report-log) 380 (profiler-format (cl-ecase (profiler-profile-type profiler-report-profile)
340 (cpu profiler-report-sample-line-format) 381 (cpu profiler-report-cpu-line-format)
341 (memory profiler-report-memory-line-format)) 382 (memory profiler-report-memory-line-format))
342 name-part 383 name-part
343 (if diff-p 384 (if diff-p
@@ -378,27 +419,35 @@ this variable directly.")
378 (define-key map "B" 'profiler-report-render-reversed-calltree) 419 (define-key map "B" 'profiler-report-render-reversed-calltree)
379 (define-key map "A" 'profiler-report-ascending-sort) 420 (define-key map "A" 'profiler-report-ascending-sort)
380 (define-key map "D" 'profiler-report-descending-sort) 421 (define-key map "D" 'profiler-report-descending-sort)
381 (define-key map "=" 'profiler-report-compare-log) 422 (define-key map "=" 'profiler-report-compare-profile)
382 (define-key map (kbd "C-x C-w") 'profiler-report-write-log) 423 (define-key map (kbd "C-x C-w") 'profiler-report-write-profile)
383 (define-key map "q" 'quit-window) 424 (define-key map "q" 'quit-window)
384 map)) 425 map))
385 426
386(defun profiler-report-make-buffer-name (log) 427(defun profiler-report-make-buffer-name (profile)
387 (format "*%s-Profiler-Report %s*" 428 (format "*%s-Profiler-Report %s*"
388 (cl-ecase (profiler-log-type log) (cpu 'CPU) (memory 'Memory)) 429 (cl-ecase (profiler-profile-type profile) (cpu 'CPU) (memory 'Memory))
389 (format-time-string "%Y-%m-%d %T" (profiler-log-timestamp log)))) 430 (format-time-string "%Y-%m-%d %T" (profiler-profile-timestamp profile))))
390 431
391(defun profiler-report-setup-buffer (log) 432(defun profiler-report-setup-buffer-1 (profile)
392 "Make a buffer for LOG and return it." 433 "Make a buffer for PROFILE and return it."
393 (let* ((buf-name (profiler-report-make-buffer-name log)) 434 (let* ((buf-name (profiler-report-make-buffer-name profile))
394 (buffer (get-buffer-create buf-name))) 435 (buffer (get-buffer-create buf-name)))
395 (with-current-buffer buffer 436 (with-current-buffer buffer
396 (profiler-report-mode) 437 (profiler-report-mode)
397 (setq profiler-report-log log 438 (setq profiler-report-profile profile
398 profiler-report-reversed nil 439 profiler-report-reversed nil
399 profiler-report-order 'descending)) 440 profiler-report-order 'descending))
400 buffer)) 441 buffer))
401 442
443(defun profiler-report-setup-buffer (profile)
444 "Make a buffer for PROFILE with rendering the profile and
445return it."
446 (let ((buffer (profiler-report-setup-buffer-1 profile)))
447 (with-current-buffer buffer
448 (profiler-report-render-calltree))
449 buffer))
450
402(define-derived-mode profiler-report-mode special-mode "Profiler-Report" 451(define-derived-mode profiler-report-mode special-mode "Profiler-Report"
403 "Profiler Report Mode." 452 "Profiler Report Mode."
404 (setq buffer-read-only t 453 (setq buffer-read-only t
@@ -408,12 +457,12 @@ this variable directly.")
408 457
409;;; Report commands 458;;; Report commands
410 459
411(defun profiler-report-calltree-at-point () 460(defun profiler-report-calltree-at-point (&optional point)
412 (get-text-property (point) 'calltree)) 461 (get-text-property (or point (point)) 'calltree))
413 462
414(defun profiler-report-move-to-entry () 463(defun profiler-report-move-to-entry ()
415 (let ((point (next-single-property-change (line-beginning-position) 464 (let ((point (next-single-property-change
416 'profiler-entry))) 465 (line-beginning-position) 'profiler-entry)))
417 (if point 466 (if point
418 (goto-char point) 467 (goto-char point)
419 (back-to-indentation)))) 468 (back-to-indentation))))
@@ -493,14 +542,15 @@ otherwise collapse."
493 (describe-function entry))))) 542 (describe-function entry)))))
494 543
495(cl-defun profiler-report-render-calltree-1 544(cl-defun profiler-report-render-calltree-1
496 (log &key reverse (order 'descending)) 545 (profile &key reverse (order 'descending))
497 (let ((calltree (profiler-calltree-build profiler-report-log 546 (let ((calltree (profiler-calltree-build
498 :reverse reverse))) 547 (profiler-profile-log profile)
548 :reverse reverse)))
499 (setq header-line-format 549 (setq header-line-format
500 (cl-ecase (profiler-log-type log) 550 (cl-ecase (profiler-profile-type profile)
501 (cpu 551 (cpu
502 (profiler-report-header-line-format 552 (profiler-report-header-line-format
503 profiler-report-sample-line-format 553 profiler-report-cpu-line-format
504 "Function" (list "Time (ms)" "%"))) 554 "Function" (list "Time (ms)" "%")))
505 (memory 555 (memory
506 (profiler-report-header-line-format 556 (profiler-report-header-line-format
@@ -517,7 +567,7 @@ otherwise collapse."
517 (profiler-report-move-to-entry)))) 567 (profiler-report-move-to-entry))))
518 568
519(defun profiler-report-rerender-calltree () 569(defun profiler-report-rerender-calltree ()
520 (profiler-report-render-calltree-1 profiler-report-log 570 (profiler-report-render-calltree-1 profiler-report-profile
521 :reverse profiler-report-reversed 571 :reverse profiler-report-reversed
522 :order profiler-report-order)) 572 :order profiler-report-order))
523 573
@@ -545,28 +595,31 @@ otherwise collapse."
545 (setq profiler-report-order 'descending) 595 (setq profiler-report-order 'descending)
546 (profiler-report-rerender-calltree)) 596 (profiler-report-rerender-calltree))
547 597
548(defun profiler-report-log (log) 598(defun profiler-report-profile (profile)
549 (let ((buffer (profiler-report-setup-buffer log))) 599 (switch-to-buffer (profiler-report-setup-buffer profile)))
550 (with-current-buffer buffer 600
551 (profiler-report-render-calltree)) 601(defun profiler-report-profile-other-window (profile)
552 (pop-to-buffer buffer))) 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)))
553 606
554(defun profiler-report-compare-log (buffer) 607(defun profiler-report-compare-profile (buffer)
555 "Compare the current profiler log with another." 608 "Compare the current profile with another."
556 (interactive (list (read-buffer "Compare to: "))) 609 (interactive (list (read-buffer "Compare to: ")))
557 (let* ((log1 (with-current-buffer buffer profiler-report-log)) 610 (let* ((profile1 (with-current-buffer buffer profiler-report-profile))
558 (log2 profiler-report-log) 611 (profile2 profiler-report-profile)
559 (diff-log (profiler-log-diff log1 log2))) 612 (diff-profile (profiler-compare-profiles profile1 profile2)))
560 (profiler-report-log diff-log))) 613 (profiler-report-profile diff-profile)))
561 614
562(defun profiler-report-write-log (filename &optional confirm) 615(defun profiler-report-write-profile (filename &optional confirm)
563 "Write the current profiler log into FILENAME." 616 "Write the current profile into file FILENAME."
564 (interactive 617 (interactive
565 (list (read-file-name "Write log: " default-directory) 618 (list (read-file-name "Write profile: " default-directory)
566 (not current-prefix-arg))) 619 (not current-prefix-arg)))
567 (profiler-log-write-file profiler-report-log 620 (profiler-write-profile profiler-report-profile
568 filename 621 filename
569 confirm)) 622 confirm))
570 623
571 624
572;;; Profiler commands 625;;; Profiler commands
@@ -584,13 +637,13 @@ Also, if MODE is `mem' or `cpu+mem', then memory profiler will be started."
584 nil t nil nil "cpu"))))) 637 nil t nil nil "cpu")))))
585 (cl-ecase mode 638 (cl-ecase mode
586 (cpu 639 (cpu
587 (profiler-cpu-start profiler-sample-interval) 640 (profiler-cpu-start profiler-sampling-interval)
588 (message "CPU profiler started")) 641 (message "CPU profiler started"))
589 (mem 642 (mem
590 (profiler-memory-start) 643 (profiler-memory-start)
591 (message "Memory profiler started")) 644 (message "Memory profiler started"))
592 (cpu+mem 645 (cpu+mem
593 (profiler-cpu-start profiler-sample-interval) 646 (profiler-cpu-start profiler-sampling-interval)
594 (profiler-memory-start) 647 (profiler-memory-start)
595 (message "CPU and memory profiler started")))) 648 (message "CPU and memory profiler started"))))
596 649
@@ -606,48 +659,58 @@ Also, if MODE is `mem' or `cpu+mem', then memory profiler will be started."
606 (t "No"))))) 659 (t "No")))))
607 660
608(defun profiler-reset () 661(defun profiler-reset ()
609 "Reset profiler log." 662 "Reset profiler logs."
610 (interactive) 663 (interactive)
611 (when (fboundp 'profiler-cpu-log) 664 (when (fboundp 'profiler-cpu-log)
612 (ignore (profiler-cpu-log))) 665 (ignore (profiler-cpu-log)))
613 (ignore (profiler-memory-log)) 666 (ignore (profiler-memory-log))
614 t) 667 t)
615 668
616(defun profiler--report-cpu () 669(defun profiler-report-cpu ()
617 (let ((log (if (fboundp 'profiler-cpu-log) (profiler-cpu-log)))) 670 (let ((profile (profiler-cpu-profile)))
618 (when log 671 (when profile
619 (puthash 'type 'cpu log) 672 (profiler-report-profile-other-window profile))))
620 (puthash 'timestamp (current-time) log)
621 (profiler-report-log log))))
622 673
623(defun profiler--report-memory () 674(defun profiler-report-memory ()
624 (let ((log (profiler-memory-log))) 675 (let ((profile (profiler-memory-profile)))
625 (when log 676 (when profile
626 (puthash 'type 'memory log) 677 (profiler-report-profile-other-window profile))))
627 (puthash 'timestamp (current-time) log)
628 (profiler-report-log log))))
629 678
630(defun profiler-report () 679(defun profiler-report ()
631 "Report profiling results." 680 "Report profiling results."
632 (interactive) 681 (interactive)
633 (profiler--report-cpu) 682 (profiler-report-cpu)
634 (profiler--report-memory)) 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)))
635 698
636;;;###autoload 699;;;###autoload
637(defun profiler-find-log (filename) 700(defun profiler-find-profile-other-frame (filename)
638 "Read a profiler log from FILENAME and report it." 701 "Open profile FILENAME."
639 (interactive 702 (interactive
640 (list (read-file-name "Find log: " default-directory))) 703 (list (read-file-name "Find profile: " default-directory)))
641 (profiler-report-log (profiler-log-read-file filename))) 704 (profiler-report-profile-other-frame(profiler-read-profile filename)))
642 705
643 706
644;;; Profiling helpers 707;;; Profiling helpers
645 708
646;; (cl-defmacro with-sample-profiling ((&key interval) &rest body) 709;; (cl-defmacro with-cpu-profiling ((&key sampling-interval) &rest body)
647;; `(unwind-protect 710;; `(unwind-protect
648;; (progn 711;; (progn
649;; (ignore (profiler-cpu-log)) 712;; (ignore (profiler-cpu-log))
650;; (profiler-cpu-start ,interval) 713;; (profiler-cpu-start ,sampling-interval)
651;; ,@body) 714;; ,@body)
652;; (profiler-cpu-stop) 715;; (profiler-cpu-stop)
653;; (profiler--report-cpu))) 716;; (profiler--report-cpu)))
diff --git a/src/profiler.c b/src/profiler.c
index de118d13859..2f082edc390 100644
--- a/src/profiler.c
+++ b/src/profiler.c
@@ -198,7 +198,7 @@ record_backtrace (log_t *log, EMACS_INT count)
198 } 198 }
199} 199}
200 200
201/* Sample profiler. */ 201/* Sampling profiler. */
202 202
203#ifdef PROFILER_CPU_SUPPORT 203#ifdef PROFILER_CPU_SUPPORT
204 204
@@ -220,10 +220,10 @@ static Lisp_Object cpu_log;
220/* Separate counter for the time spent in the GC. */ 220/* Separate counter for the time spent in the GC. */
221static EMACS_INT cpu_gc_count; 221static EMACS_INT cpu_gc_count;
222 222
223/* The current sample interval in milliseconds. */ 223/* The current sampling interval in milliseconds. */
224static EMACS_INT current_sample_interval; 224static EMACS_INT current_sampling_interval;
225 225
226/* Signal handler for sample profiler. */ 226/* Signal handler for sampling profiler. */
227 227
228static void 228static void
229handle_profiler_signal (int signal) 229handle_profiler_signal (int signal)
@@ -235,11 +235,11 @@ handle_profiler_signal (int signal)
235 not expect the ARRAY_MARK_FLAG to be set. We could try and 235 not expect the ARRAY_MARK_FLAG to be set. We could try and
236 harden the hash-table code, but it doesn't seem worth the 236 harden the hash-table code, but it doesn't seem worth the
237 effort. */ 237 effort. */
238 cpu_gc_count = saturated_add (cpu_gc_count, current_sample_interval); 238 cpu_gc_count = saturated_add (cpu_gc_count, current_sampling_interval);
239 else 239 else
240 { 240 {
241 eassert (HASH_TABLE_P (cpu_log)); 241 eassert (HASH_TABLE_P (cpu_log));
242 record_backtrace (XHASH_TABLE (cpu_log), current_sample_interval); 242 record_backtrace (XHASH_TABLE (cpu_log), current_sampling_interval);
243 } 243 }
244} 244}
245 245
@@ -250,21 +250,21 @@ deliver_profiler_signal (int signal)
250} 250}
251 251
252static enum profiler_cpu_running 252static enum profiler_cpu_running
253setup_cpu_timer (Lisp_Object sample_interval) 253setup_cpu_timer (Lisp_Object sampling_interval)
254{ 254{
255 struct sigaction action; 255 struct sigaction action;
256 struct itimerval timer; 256 struct itimerval timer;
257 struct timespec interval; 257 struct timespec interval;
258 258
259 if (! RANGED_INTEGERP (1, sample_interval, 259 if (! RANGED_INTEGERP (1, sampling_interval,
260 (TYPE_MAXIMUM (time_t) < EMACS_INT_MAX / 1000 260 (TYPE_MAXIMUM (time_t) < EMACS_INT_MAX / 1000
261 ? (EMACS_INT) TYPE_MAXIMUM (time_t) * 1000 + 999 261 ? (EMACS_INT) TYPE_MAXIMUM (time_t) * 1000 + 999
262 : EMACS_INT_MAX))) 262 : EMACS_INT_MAX)))
263 return NOT_RUNNING; 263 return NOT_RUNNING;
264 264
265 current_sample_interval = XINT (sample_interval); 265 current_sampling_interval = XINT (sampling_interval);
266 interval = make_emacs_time (current_sample_interval / 1000, 266 interval = make_emacs_time (current_sampling_interval / 1000,
267 current_sample_interval % 1000 * 1000000); 267 current_sampling_interval % 1000 * 1000000);
268 emacs_sigaction_init (&action, deliver_profiler_signal); 268 emacs_sigaction_init (&action, deliver_profiler_signal);
269 sigaction (SIGPROF, &action, 0); 269 sigaction (SIGPROF, &action, 0);
270 270
@@ -315,12 +315,12 @@ setup_cpu_timer (Lisp_Object sample_interval)
315DEFUN ("profiler-cpu-start", Fprofiler_cpu_start, Sprofiler_cpu_start, 315DEFUN ("profiler-cpu-start", Fprofiler_cpu_start, Sprofiler_cpu_start,
316 1, 1, 0, 316 1, 1, 0,
317 doc: /* Start or restart the cpu profiler. 317 doc: /* Start or restart the cpu profiler.
318It takes call-stack samples each SAMPLE-INTERVAL milliseconds. 318It takes call-stack samples each SAMPLING-INTERVAL milliseconds.
319See also `profiler-log-size' and `profiler-max-stack-depth'. */) 319See also `profiler-log-size' and `profiler-max-stack-depth'. */)
320 (Lisp_Object sample_interval) 320 (Lisp_Object sampling_interval)
321{ 321{
322 if (profiler_cpu_running) 322 if (profiler_cpu_running)
323 error ("Sample profiler is already running"); 323 error ("CPU profiler is already running");
324 324
325 if (NILP (cpu_log)) 325 if (NILP (cpu_log))
326 { 326 {
@@ -329,9 +329,9 @@ See also `profiler-log-size' and `profiler-max-stack-depth'. */)
329 profiler_max_stack_depth); 329 profiler_max_stack_depth);
330 } 330 }
331 331
332 profiler_cpu_running = setup_cpu_timer (sample_interval); 332 profiler_cpu_running = setup_cpu_timer (sampling_interval);
333 if (! profiler_cpu_running) 333 if (! profiler_cpu_running)
334 error ("Invalid sample interval"); 334 error ("Invalid sampling interval");
335 335
336 return Qt; 336 return Qt;
337} 337}