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 (log number 10))) 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-running-p (&optional mode)
 206   "Return non-nil if the profiler is running.
 207 Optional argument MODE means only check for the specified mode (cpu or mem)."
 208   (cond ((eq mode 'cpu) (and (fboundp 'profiler-cpu-running-p)
 209                              (profiler-cpu-running-p)))
 210         ((eq mode 'mem) (profiler-memory-running-p))
 211         (t (or (profiler-running-p 'cpu)
 212                (profiler-running-p 'mem)))))
 213
 214 (defun profiler-cpu-profile ()
 215   "Return CPU profile."
 216   (when (profiler-running-p 'cpu)
 217     (profiler-make-profile
 218      :type 'cpu
 219      :timestamp (current-time)
 220      :log (profiler-cpu-log))))
 221
 222 (defun profiler-memory-profile ()
 223   "Return memory profile."
 224   (when (profiler-memory-running-p)
 225     (profiler-make-profile
 226      :type 'memory
 227      :timestamp (current-time)
 228      :log (profiler-memory-log))))
 229
 230 \f
 231 ;;; Calltrees
 232
 233 (cl-defstruct (profiler-calltree (:constructor profiler-make-calltree))
 234   entry
 235   (count 0) (count-percent "")
 236   parent children)
 237
 238 (defun profiler-calltree-leaf-p (tree)
 239   (null (profiler-calltree-children tree)))
 240
 241 (defun profiler-calltree-count< (a b)
 242   (cond ((eq (profiler-calltree-entry a) t) t)
 243         ((eq (profiler-calltree-entry b) t) nil)
 244         (t (< (profiler-calltree-count a)
 245               (profiler-calltree-count b)))))
 246
 247 (defun profiler-calltree-count> (a b)
 248   (not (profiler-calltree-count< a b)))
 249
 250 (defun profiler-calltree-depth (tree)
 251   (let ((parent (profiler-calltree-parent tree)))
 252     (if (null parent)
 253         0
 254       (1+ (profiler-calltree-depth parent)))))
 255
 256 (defun profiler-calltree-find (tree entry)
 257   "Return a child tree of ENTRY under TREE."
 258   (let (result (children (profiler-calltree-children tree)))
 259     (while (and children (null result))
 260       (let ((child (car children)))
 261         (when (function-equal (profiler-calltree-entry child) entry)
 262           (setq result child))
 263         (setq children (cdr children))))
 264     result))
 265
 266 (defun profiler-calltree-walk (calltree function)
 267   (funcall function calltree)
 268   (dolist (child (profiler-calltree-children calltree))
 269     (profiler-calltree-walk child function)))
 270
 271 (defun profiler-calltree-build-1 (tree log &optional reverse)
 272   ;; FIXME: Do a better job of reconstructing a complete call-tree
 273   ;; when the backtraces have been truncated.  Ideally, we should be
 274   ;; able to reduce profiler-max-stack-depth to 3 or 4 and still
 275   ;; get a meaningful call-tree.
 276   (maphash
 277    (lambda (backtrace count)
 278      (let ((node tree)
 279            (max (length backtrace)))
 280        (dotimes (i max)
 281          (let ((entry (aref backtrace (if reverse i (- max i 1)))))
 282            (when entry
 283              (let ((child (profiler-calltree-find node entry)))
 284                (unless child
 285                  (setq child (profiler-make-calltree
 286                               :entry entry :parent node))
 287                  (push child (profiler-calltree-children node)))
 288                (cl-incf (profiler-calltree-count child) count)
 289                (setq node child)))))))
 290    log))
 291
 292 (defun profiler-calltree-compute-percentages (tree)
 293   (let ((total-count 0))
 294     ;; FIXME: the memory profiler's total wraps around all too easily!
 295     (dolist (child (profiler-calltree-children tree))
 296       (cl-incf total-count (profiler-calltree-count child)))
 297     (unless (zerop total-count)
 298       (profiler-calltree-walk
 299        tree (lambda (node)
 300               (setf (profiler-calltree-count-percent node)
 301                     (profiler-format-percent (profiler-calltree-count node)
 302                                              total-count)))))))
 303
 304 (cl-defun profiler-calltree-build (log &key reverse)
 305   (let ((tree (profiler-make-calltree)))
 306     (profiler-calltree-build-1 tree log reverse)
 307     (profiler-calltree-compute-percentages tree)
 308     tree))
 309
 310 (defun profiler-calltree-sort (tree predicate)
 311   (let ((children (profiler-calltree-children tree)))
 312     (setf (profiler-calltree-children tree) (sort children predicate))
 313     (dolist (child (profiler-calltree-children tree))
 314       (profiler-calltree-sort child predicate))))
 315
 316 \f
 317 ;;; Report rendering
 318
 319 (defcustom profiler-report-closed-mark "+"
 320   "An indicator of closed calltrees."
 321   :type 'string
 322   :group 'profiler)
 323
 324 (defcustom profiler-report-open-mark "-"
 325   "An indicator of open calltrees."
 326   :type 'string
 327   :group 'profiler)
 328
 329 (defcustom profiler-report-leaf-mark " "
 330   "An indicator of calltree leaves."
 331   :type 'string
 332   :group 'profiler)
 333
 334 (defvar profiler-report-cpu-line-format
 335   '((50 left)
 336     (24 right ((19 right)
 337                (5 right)))))
 338
 339 (defvar profiler-report-memory-line-format
 340   '((55 left)
 341     (19 right ((14 right profiler-format-number)
 342                (5 right)))))
 343
 344 (defvar-local profiler-report-profile nil
 345   "The current profile.")
 346
 347 (defvar-local profiler-report-reversed nil
 348   "True if calltree is rendered in bottom-up.  Do not touch this
 349 variable directly.")
 350
 351 (defvar-local profiler-report-order nil
 352   "The value can be `ascending' or `descending'.  Do not touch
 353 this variable directly.")
 354
 355 (defun profiler-report-make-entry-part (entry)
 356   (let ((string (cond
 357                  ((eq entry t)
 358                   "Others")
 359                  ((and (symbolp entry)
 360                        (fboundp entry))
 361                   (propertize (symbol-name entry)
 362                               'face 'link
 363                               'mouse-face 'highlight
 364                               'help-echo "\
 365 mouse-2: jump to definition\n\
 366 RET: expand or collapse"))
 367                  (t
 368                   (profiler-format-entry entry)))))
 369     (propertize string 'profiler-entry entry)))
 370
 371 (defun profiler-report-make-name-part (tree)
 372   (let* ((entry (profiler-calltree-entry tree))
 373          (depth (profiler-calltree-depth tree))
 374          (indent (make-string (* (1- depth) 2) ?\s))
 375          (mark (if (profiler-calltree-leaf-p tree)
 376                    profiler-report-leaf-mark
 377                  profiler-report-closed-mark))
 378          (entry (profiler-report-make-entry-part entry)))
 379     (format "%s%s %s" indent mark entry)))
 380
 381 (defun profiler-report-header-line-format (fmt &rest args)
 382   (let* ((header (apply 'profiler-format fmt args))
 383          (escaped (replace-regexp-in-string "%" "%%" header)))
 384     (concat " " escaped)))
 385
 386 (defun profiler-report-line-format (tree)
 387   (let ((diff-p (profiler-profile-diff-p profiler-report-profile))
 388         (name-part (profiler-report-make-name-part tree))
 389         (count (profiler-calltree-count tree))
 390         (count-percent (profiler-calltree-count-percent tree)))
 391     (profiler-format (cl-ecase (profiler-profile-type profiler-report-profile)
 392                        (cpu profiler-report-cpu-line-format)
 393                        (memory profiler-report-memory-line-format))
 394                      name-part
 395                      (if diff-p
 396                          (list (if (> count 0)
 397                                    (format "+%s" count)
 398                                  count)
 399                                "")
 400                        (list count count-percent)))))
 401
 402 (defun profiler-report-insert-calltree (tree)
 403   (let ((line (profiler-report-line-format tree)))
 404     (insert (propertize (concat line "\n") 'calltree tree))))
 405
 406 (defun profiler-report-insert-calltree-children (tree)
 407   (mapc 'profiler-report-insert-calltree
 408         (profiler-calltree-children tree)))
 409
 410 \f
 411 ;;; Report mode
 412
 413 (defvar profiler-report-mode-map
 414   (let ((map (make-sparse-keymap)))
 415     (define-key map "n"     'profiler-report-next-entry)
 416     (define-key map "p"     'profiler-report-previous-entry)
 417     ;; I find it annoying more than helpful to not be able to navigate
 418     ;; normally with the cursor keys.  --Stef
 419     ;; (define-key map [down]  'profiler-report-next-entry)
 420     ;; (define-key map [up]    'profiler-report-previous-entry)
 421     (define-key map "\r"    'profiler-report-toggle-entry)
 422     (define-key map "\t"    'profiler-report-toggle-entry)
 423     (define-key map "i"     'profiler-report-toggle-entry)
 424     (define-key map "f"     'profiler-report-find-entry)
 425     (define-key map "j"     'profiler-report-find-entry)
 426     (define-key map [mouse-2] 'profiler-report-find-entry)
 427     (define-key map "d"     'profiler-report-describe-entry)
 428     (define-key map "C"     'profiler-report-render-calltree)
 429     (define-key map "B"     'profiler-report-render-reversed-calltree)
 430     (define-key map "A"     'profiler-report-ascending-sort)
 431     (define-key map "D"     'profiler-report-descending-sort)
 432     (define-key map "="     'profiler-report-compare-profile)
 433     (define-key map (kbd "C-x C-w") 'profiler-report-write-profile)
 434     (easy-menu-define  profiler-report-menu map "Menu for Profiler Report mode."
 435       '("Profiler"
 436         ["Next Entry" profiler-report-next-entry :active t
 437          :help "Move to next entry"]
 438         ["Previous Entry" profiler-report-previous-entry :active t
 439          :help "Move to previous entry"]
 440         "--"
 441         ["Toggle Entry" profiler-report-toggle-entry
 442          :active (profiler-report-calltree-at-point)
 443          :help "Expand or collapse the current entry"]
 444         ["Find Entry" profiler-report-find-entry
 445          ;; FIXME should deactivate if not on a known function.
 446          :active (profiler-report-calltree-at-point)
 447          :help "Find the definition of the current entry"]
 448         ["Describe Entry" profiler-report-describe-entry
 449          :active (profiler-report-calltree-at-point)
 450          :help "Show the documentation of the current entry"]
 451         "--"
 452         ["Show Calltree" profiler-report-render-calltree
 453          :active profiler-report-reversed
 454          :help "Show calltree view"]
 455         ["Show Reversed Calltree" profiler-report-render-reversed-calltree
 456          :active (not profiler-report-reversed)
 457          :help "Show reversed calltree view"]
 458         ["Sort Ascending" profiler-report-ascending-sort
 459          :active (not (eq profiler-report-order 'ascending))
 460          :help "Sort calltree view in ascending order"]
 461         ["Sort Descending" profiler-report-descending-sort
 462          :active (not (eq profiler-report-order 'descending))
 463          :help "Sort calltree view in descending order"]
 464         "--"
 465         ["Compare Profile..." profiler-report-compare-profile :active t
 466          :help "Compare current profile with another"]
 467         ["Write Profile..." profiler-report-write-profile :active t
 468          :help "Write current profile to a file"]
 469         "--"
 470         ["Start Profiler" profiler-start :active (not (profiler-running-p))
 471          :help "Start profiling"]
 472         ["Stop Profiler" profiler-stop :active (profiler-running-p)
 473          :help "Stop profiling"]
 474         ["New Report" profiler-report :active (profiler-running-p)
 475          :help "Make a new report"]))
 476       map)
 477   "Keymap for `profiler-report-mode'.")
 478
 479 (defun profiler-report-make-buffer-name (profile)
 480   (format "*%s-Profiler-Report %s*"
 481           (cl-ecase (profiler-profile-type profile) (cpu 'CPU) (memory 'Memory))
 482           (format-time-string "%Y-%m-%d %T" (profiler-profile-timestamp profile))))
 483
 484 (defun profiler-report-setup-buffer-1 (profile)
 485   "Make a buffer for PROFILE and return it."
 486   (let* ((buf-name (profiler-report-make-buffer-name profile))
 487          (buffer (get-buffer-create buf-name)))
 488     (with-current-buffer buffer
 489       (profiler-report-mode)
 490       (setq profiler-report-profile profile
 491             profiler-report-reversed nil
 492             profiler-report-order 'descending))
 493     buffer))
 494
 495 (defun profiler-report-setup-buffer (profile)
 496   "Make a buffer for PROFILE with rendering the profile and
 497 return it."
 498   (let ((buffer (profiler-report-setup-buffer-1 profile)))
 499     (with-current-buffer buffer
 500       (profiler-report-render-calltree))
 501     buffer))
 502
 503 (define-derived-mode profiler-report-mode special-mode "Profiler-Report"
 504   "Profiler Report Mode."
 505   (setq buffer-read-only t
 506         buffer-undo-list t
 507         truncate-lines t))
 508
 509 \f
 510 ;;; Report commands
 511
 512 (defun profiler-report-calltree-at-point (&optional point)
 513   (get-text-property (or point (point)) 'calltree))
 514
 515 (defun profiler-report-move-to-entry ()
 516   (let ((point (next-single-property-change
 517                 (line-beginning-position) 'profiler-entry)))
 518     (if point
 519         (goto-char point)
 520       (back-to-indentation))))
 521
 522 (defun profiler-report-next-entry ()
 523   "Move cursor to next entry."
 524   (interactive)
 525   (forward-line)
 526   (profiler-report-move-to-entry))
 527
 528 (defun profiler-report-previous-entry ()
 529   "Move cursor to previous entry."
 530   (interactive)
 531   (forward-line -1)
 532   (profiler-report-move-to-entry))
 533
 534 (defun profiler-report-expand-entry ()
 535   "Expand entry at point."
 536   (interactive)
 537   (save-excursion
 538     (beginning-of-line)
 539     (when (search-forward (concat profiler-report-closed-mark " ")
 540                           (line-end-position) t)
 541       (let ((tree (profiler-report-calltree-at-point)))
 542         (when tree
 543           (let ((inhibit-read-only t))
 544             (replace-match (concat profiler-report-open-mark " "))
 545             (forward-line)
 546             (profiler-report-insert-calltree-children tree)
 547             t))))))
 548
 549 (defun profiler-report-collapse-entry ()
 550   "Collapse entry at point."
 551   (interactive)
 552   (save-excursion
 553     (beginning-of-line)
 554     (when (search-forward (concat profiler-report-open-mark " ")
 555                           (line-end-position) t)
 556       (let* ((tree (profiler-report-calltree-at-point))
 557              (depth (profiler-calltree-depth tree))
 558              (start (line-beginning-position 2))
 559              d)
 560         (when tree
 561           (let ((inhibit-read-only t))
 562             (replace-match (concat profiler-report-closed-mark " "))
 563             (while (and (eq (forward-line) 0)
 564                         (let ((child (get-text-property (point) 'calltree)))
 565                           (and child
 566                                (numberp (setq d (profiler-calltree-depth child)))))
 567                         (> d depth)))
 568             (delete-region start (line-beginning-position)))))
 569       t)))
 570
 571 (defun profiler-report-toggle-entry ()
 572   "Expand entry at point if the tree is collapsed,
 573 otherwise collapse."
 574   (interactive)
 575   (or (profiler-report-expand-entry)
 576       (profiler-report-collapse-entry)))
 577
 578 (defun profiler-report-find-entry (&optional event)
 579   "Find entry at point."
 580   (interactive (list last-nonmenu-event))
 581   (with-current-buffer
 582       (if event (window-buffer (posn-window (event-start event)))
 583         (current-buffer))
 584     (and event (setq event (event-end event))
 585          (posn-set-point event))
 586     (let ((tree (profiler-report-calltree-at-point)))
 587       (when tree
 588         (let ((entry (profiler-calltree-entry tree)))
 589           (find-function entry))))))
 590
 591 (defun profiler-report-describe-entry ()
 592   "Describe entry at point."
 593   (interactive)
 594   (let ((tree (profiler-report-calltree-at-point)))
 595     (when tree
 596       (let ((entry (profiler-calltree-entry tree)))
 597         (require 'help-fns)
 598         (describe-function entry)))))
 599
 600 (cl-defun profiler-report-render-calltree-1
 601     (profile &key reverse (order 'descending))
 602   (let ((calltree (profiler-calltree-build
 603                    (profiler-profile-log profile)
 604                    :reverse reverse)))
 605     (setq header-line-format
 606           (cl-ecase (profiler-profile-type profile)
 607             (cpu
 608              (profiler-report-header-line-format
 609               profiler-report-cpu-line-format
 610               "Function" (list "CPU samples" "%")))
 611             (memory
 612              (profiler-report-header-line-format
 613               profiler-report-memory-line-format
 614               "Function" (list "Bytes" "%")))))
 615     (let ((predicate (cl-ecase order
 616                        (ascending #'profiler-calltree-count<)
 617                        (descending #'profiler-calltree-count>))))
 618       (profiler-calltree-sort calltree predicate))
 619     (let ((inhibit-read-only t))
 620       (erase-buffer)
 621       (profiler-report-insert-calltree-children calltree)
 622       (goto-char (point-min))
 623       (profiler-report-move-to-entry))))
 624
 625 (defun profiler-report-rerender-calltree ()
 626   (profiler-report-render-calltree-1 profiler-report-profile
 627                                      :reverse profiler-report-reversed
 628                                      :order profiler-report-order))
 629
 630 (defun profiler-report-render-calltree ()
 631   "Render calltree view."
 632   (interactive)
 633   (setq profiler-report-reversed nil)
 634   (profiler-report-rerender-calltree))
 635
 636 (defun profiler-report-render-reversed-calltree ()
 637   "Render reversed calltree view."
 638   (interactive)
 639   (setq profiler-report-reversed t)
 640   (profiler-report-rerender-calltree))
 641
 642 (defun profiler-report-ascending-sort ()
 643   "Sort calltree view in ascending order."
 644   (interactive)
 645   (setq profiler-report-order 'ascending)
 646   (profiler-report-rerender-calltree))
 647
 648 (defun profiler-report-descending-sort ()
 649   "Sort calltree view in descending order."
 650   (interactive)
 651   (setq profiler-report-order 'descending)
 652   (profiler-report-rerender-calltree))
 653
 654 (defun profiler-report-profile (profile)
 655   (switch-to-buffer (profiler-report-setup-buffer profile)))
 656
 657 (defun profiler-report-profile-other-window (profile)
 658   (switch-to-buffer-other-window (profiler-report-setup-buffer profile)))
 659
 660 (defun profiler-report-profile-other-frame (profile)
 661   (switch-to-buffer-other-frame (profiler-report-setup-buffer profile)))
 662
 663 (defun profiler-report-compare-profile (buffer)
 664   "Compare the current profile with another."
 665   (interactive (list (read-buffer "Compare to: ")))
 666   (let* ((profile1 (with-current-buffer buffer profiler-report-profile))
 667          (profile2 profiler-report-profile)
 668          (diff-profile (profiler-compare-profiles profile1 profile2)))
 669     (profiler-report-profile diff-profile)))
 670
 671 (defun profiler-report-write-profile (filename &optional confirm)
 672   "Write the current profile into file FILENAME."
 673   (interactive
 674    (list (read-file-name "Write profile: " default-directory)
 675          (not current-prefix-arg)))
 676   (profiler-write-profile profiler-report-profile
 677                           filename
 678                           confirm))
 679
 680 \f
 681 ;;; Profiler commands
 682
 683 ;;;###autoload
 684 (defun profiler-start (mode)
 685   "Start/restart profilers.
 686 MODE can be one of `cpu', `mem', or `cpu+mem'.
 687 If MODE is `cpu' or `cpu+mem', time-based profiler will be started.
 688 Also, if MODE is `mem' or `cpu+mem', then memory profiler will be started."
 689   (interactive
 690    (list (if (not (fboundp 'profiler-cpu-start)) 'mem
 691            (intern (completing-read "Mode (default cpu): "
 692                                     '("cpu" "mem" "cpu+mem")
 693                                     nil t nil nil "cpu")))))
 694   (cl-ecase mode
 695     (cpu
 696      (profiler-cpu-start profiler-sampling-interval)
 697      (message "CPU profiler started"))
 698     (mem
 699      (profiler-memory-start)
 700      (message "Memory profiler started"))
 701     (cpu+mem
 702      (profiler-cpu-start profiler-sampling-interval)
 703      (profiler-memory-start)
 704      (message "CPU and memory profiler started"))))
 705
 706 (defun profiler-stop ()
 707   "Stop started profilers.  Profiler logs will be kept."
 708   (interactive)
 709   (let ((cpu (if (fboundp 'profiler-cpu-stop) (profiler-cpu-stop)))
 710         (mem (profiler-memory-stop)))
 711     (message "%s profiler stopped"
 712              (cond ((and mem cpu) "CPU and memory")
 713                    (mem "Memory")
 714                    (cpu "CPU")
 715                    (t "No")))))
 716
 717 (defun profiler-reset ()
 718   "Reset profiler logs."
 719   (interactive)
 720   (when (fboundp 'profiler-cpu-log)
 721     (ignore (profiler-cpu-log)))
 722   (ignore (profiler-memory-log))
 723   t)
 724
 725 (defun profiler-report-cpu ()
 726   (let ((profile (profiler-cpu-profile)))
 727     (when profile
 728       (profiler-report-profile-other-window profile))))
 729
 730 (defun profiler-report-memory ()
 731   (let ((profile (profiler-memory-profile)))
 732     (when profile
 733       (profiler-report-profile-other-window profile))))
 734
 735 (defun profiler-report ()
 736   "Report profiling results."
 737   (interactive)
 738   (profiler-report-cpu)
 739   (profiler-report-memory))
 740
 741 ;;;###autoload
 742 (defun profiler-find-profile (filename)
 743   "Open profile FILENAME."
 744   (interactive
 745    (list (read-file-name "Find profile: " default-directory)))
 746   (profiler-report-profile (profiler-read-profile filename)))
 747
 748 ;;;###autoload
 749 (defun profiler-find-profile-other-window (filename)
 750   "Open profile FILENAME."
 751   (interactive
 752    (list (read-file-name "Find profile: " default-directory)))
 753   (profiler-report-profile-other-window (profiler-read-profile filename)))
 754
 755 ;;;###autoload
 756 (defun profiler-find-profile-other-frame (filename)
 757   "Open profile FILENAME."
 758   (interactive
 759    (list (read-file-name "Find profile: " default-directory)))
 760   (profiler-report-profile-other-frame(profiler-read-profile filename)))
 761
 762 \f
 763 ;;; Profiling helpers
 764
 765 ;; (cl-defmacro with-cpu-profiling ((&key sampling-interval) &rest body)
 766 ;;   `(unwind-protect
 767 ;;        (progn
 768 ;;          (ignore (profiler-cpu-log))
 769 ;;          (profiler-cpu-start ,sampling-interval)
 770 ;;          ,@body)
 771 ;;      (profiler-cpu-stop)
 772 ;;      (profiler--report-cpu)))
 773
 774 ;; (defmacro with-memory-profiling (&rest body)
 775 ;;   `(unwind-protect
 776 ;;        (progn
 777 ;;          (ignore (profiler-memory-log))
 778 ;;          (profiler-memory-start)
 779 ;;          ,@body)
 780 ;;      (profiler-memory-stop)
 781 ;;      (profiler--report-memory)))
 782
 783 (provide 'profiler)
 784 ;;; profiler.el ends here