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