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