lisp/profiler.el

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