lisp/profiler.el

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