code.delx.au - gnu-emacs/blob - lisp/profiler.el

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