lisp/profiler.el

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