diff options
| author | Tomohiro Matsuyama | 2012-10-01 07:21:25 +0900 |
|---|---|---|
| committer | Tomohiro Matsuyama | 2012-10-01 07:21:25 +0900 |
| commit | c22bac2cc59c6c04924ecf62c5eeb97a92df7e28 (patch) | |
| tree | 707758235e762854e17742bbbcc737687b85e457 | |
| parent | 5e4daaf3face7ed54de7cb3621edb31e16b011ed (diff) | |
| download | emacs-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/ChangeLog | 10 | ||||
| -rw-r--r-- | lisp/profiler.el | 349 | ||||
| -rw-r--r-- | src/profiler.c | 32 |
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 @@ | |||
| 1 | 2012-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 | |||
| 1 | 2012-09-30 Paul Eggert <eggert@cs.ucla.edu> | 11 | 2012-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 |
| 99 | function name of a function itself." | 101 | function 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 | ||
| 128 | be 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 | ||
| 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 | |||
| 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. */ |
| 221 | static EMACS_INT cpu_gc_count; | 221 | static EMACS_INT cpu_gc_count; |
| 222 | 222 | ||
| 223 | /* The current sample interval in milliseconds. */ | 223 | /* The current sampling interval in milliseconds. */ |
| 224 | static EMACS_INT current_sample_interval; | 224 | static EMACS_INT current_sampling_interval; |
| 225 | 225 | ||
| 226 | /* Signal handler for sample profiler. */ | 226 | /* Signal handler for sampling profiler. */ |
| 227 | 227 | ||
| 228 | static void | 228 | static void |
| 229 | handle_profiler_signal (int signal) | 229 | handle_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 | ||
| 252 | static enum profiler_cpu_running | 252 | static enum profiler_cpu_running |
| 253 | setup_cpu_timer (Lisp_Object sample_interval) | 253 | setup_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) | |||
| 315 | DEFUN ("profiler-cpu-start", Fprofiler_cpu_start, Sprofiler_cpu_start, | 315 | DEFUN ("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. |
| 318 | It takes call-stack samples each SAMPLE-INTERVAL milliseconds. | 318 | It takes call-stack samples each SAMPLING-INTERVAL milliseconds. |
| 319 | See also `profiler-log-size' and `profiler-max-stack-depth'. */) | 319 | See 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 | } |