Merge 'master' into noverlay

1 files changed, 86 insertions, 57 deletions

diff --git a/lisp/profiler.el b/lisp/profiler.el
index 0eed79eff0c..8670e5786a4 100644
--- a/lisp/profiler.el
+++ b/lisp/profiler.el
@@ -1,6 +1,6 @@
 ;;; profiler.el --- UI and helper functions for Emacs's native profiler -*- lexical-binding: t -*-
 
-;; Copyright (C) 2012-2017 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2022 Free Software Foundation, Inc.
 
 ;; Author: Tomohiro Matsuyama <tomo@cx4a.org>
 ;; Keywords: lisp
@@ -34,11 +34,11 @@
   :version "24.3"
   :prefix "profiler-")
 
-(defconst profiler-version "24.3")
+(defconst profiler-version "28.1")
 
 (defcustom profiler-sampling-interval 1000000
   "Default sampling interval in nanoseconds."
-  :type 'integer
+  :type 'natnum
   :group 'profiler)
 
 
@@ -85,6 +85,9 @@
 		      (t
 		       (profiler-ensure-string arg)))
 	   for len = (length str)
+           if (zerop width)
+           collect str into frags
+           else
 	   if (< width len)
            collect (progn (put-text-property (max 0 (- width 2)) len
                                              'invisible 'profiler str)
@@ -102,16 +105,16 @@
 ;;; Entries
 
 (defun profiler-format-entry (entry)
-  "Format ENTRY in human readable string.  ENTRY would be a
-function name of a function itself."
+  "Format ENTRY in human readable string.
+ENTRY would be a function name of a function itself."
   (cond ((memq (car-safe entry) '(closure lambda))
-	 (format "#<lambda 0x%x>" (sxhash entry)))
+	 (format "#<lambda %#x>" (sxhash entry)))
 	((byte-code-function-p entry)
-	 (format "#<compiled 0x%x>" (sxhash entry)))
+	 (format "#<compiled %#x>" (sxhash entry)))
 	((or (subrp entry) (symbolp entry) (stringp entry))
 	 (format "%s" entry))
 	(t
-	 (format "#<unknown 0x%x>" (sxhash entry)))))
+	 (format "#<unknown %#x>" (sxhash entry)))))
 
 (defun profiler-fixup-entry (entry)
   (if (symbolp entry)
@@ -213,21 +216,22 @@ Optional argument MODE means only check for the specified mode (cpu or mem)."
         (t (or (profiler-running-p 'cpu)
                (profiler-running-p 'mem)))))
 
+(defvar profiler-cpu-log nil)
+(defvar profiler-memory-log nil)
+
 (defun profiler-cpu-profile ()
   "Return CPU profile."
-  (when (profiler-running-p 'cpu)
-    (profiler-make-profile
-     :type 'cpu
-     :timestamp (current-time)
-     :log (profiler-cpu-log))))
+  (profiler-make-profile
+   :type 'cpu
+   :timestamp (current-time)
+   :log profiler-cpu-log))
 
 (defun profiler-memory-profile ()
   "Return memory profile."
-  (when (profiler-memory-running-p)
-    (profiler-make-profile
-     :type 'memory
-     :timestamp (current-time)
-     :log (profiler-memory-log))))
+  (profiler-make-profile
+   :type 'memory
+   :timestamp (current-time)
+   :log profiler-memory-log))
 
 
 ;;; Calltrees
@@ -304,7 +308,7 @@ Optional argument MODE means only check for the specified mode (cpu or mem)."
   (let ((fun-map (make-hash-table :test 'profiler-function-equal))
         (parent-map (make-hash-table :test 'eq))
         (leftover-tree (profiler-make-calltree
-                        :entry (intern "...") :parent tree)))
+                        :entry '... :parent tree)))
     (push leftover-tree (profiler-calltree-children tree))
     (maphash
      (lambda (backtrace _count)
@@ -444,25 +448,27 @@ Optional argument MODE means only check for the specified mode (cpu or mem)."
   :group 'profiler)
 
 (defvar profiler-report-cpu-line-format
-  '((50 left)
-    (24 right ((19 right)
-	       (5 right)))))
+  '((17 right ((12 right)
+	       (5 right)))
+    (1 left "%s")
+    (0 left)))
 
 (defvar profiler-report-memory-line-format
-  '((55 left)
-    (19 right ((14 right profiler-format-number)
-	       (5 right)))))
+  '((20 right ((15 right profiler-format-number)
+	       (5 right)))
+    (1 left "%s")
+    (0 left)))
 
 (defvar-local profiler-report-profile nil
   "The current profile.")
 
 (defvar-local profiler-report-reversed nil
-  "True if calltree is rendered in bottom-up.  Do not touch this
-variable directly.")
+  "Non-nil if calltree is rendered in bottom-up.
+Do not touch this variable directly.")
 
 (defvar-local profiler-report-order nil
-  "The value can be `ascending' or `descending'.  Do not touch
-this variable directly.")
+  "The value can be `ascending' or `descending'.
+Do not touch this variable directly.")
 
 (defun profiler-report-make-entry-part (entry)
   (let ((string (cond
@@ -472,6 +478,7 @@ this variable directly.")
 		       (fboundp entry))
 		  (propertize (symbol-name entry)
 			      'face 'link
+                              'follow-link "\r"
 			      'mouse-face 'highlight
 			      'help-echo "\
 mouse-2: jump to definition\n\
@@ -492,8 +499,12 @@ RET: expand or collapse"))
 
 (defun profiler-report-header-line-format (fmt &rest args)
   (let* ((header (apply #'profiler-format fmt args))
-	 (escaped (replace-regexp-in-string "%" "%%" header)))
-    (concat " " escaped)))
+	 (escaped (string-replace "%" "%%" header)))
+    (concat
+     (propertize " "
+                 'display '(space :align-to 0)
+		 'face 'fixed-pitch)
+     escaped)))
 
 (defun profiler-report-line-format (tree)
   (let ((diff-p (profiler-profile-diff-p profiler-report-profile))
@@ -503,13 +514,14 @@ RET: expand or collapse"))
     (profiler-format (cl-ecase (profiler-profile-type profiler-report-profile)
 		       (cpu profiler-report-cpu-line-format)
 		       (memory profiler-report-memory-line-format))
-		     name-part
 		     (if diff-p
 			 (list (if (> count 0)
 				   (format "+%s" count)
 				 count)
 			       "")
-		       (list count count-percent)))))
+		       (list count count-percent))
+                     " "
+                     name-part)))
 
 (defun profiler-report-insert-calltree (tree)
   (let ((line (profiler-report-line-format tree)))
@@ -533,9 +545,9 @@ RET: expand or collapse"))
     (define-key map "\r"    'profiler-report-toggle-entry)
     (define-key map "\t"    'profiler-report-toggle-entry)
     (define-key map "i"     'profiler-report-toggle-entry)
-    (define-key map [mouse-1] 'profiler-report-toggle-entry)
     (define-key map "f"     'profiler-report-find-entry)
     (define-key map "j"     'profiler-report-find-entry)
+    (define-key map [follow-link] 'mouse-face)
     (define-key map [mouse-2] 'profiler-report-find-entry)
     (define-key map "d"	    'profiler-report-describe-entry)
     (define-key map "C"	    'profiler-report-render-calltree)
@@ -606,16 +618,18 @@ RET: expand or collapse"))
     buffer))
 
 (defun profiler-report-setup-buffer (profile)
-  "Make a buffer for PROFILE with rendering the profile and
-return it."
+  "Make a buffer for PROFILE with rendering the profile and return it."
   (let ((buffer (profiler-report-setup-buffer-1 profile)))
     (with-current-buffer buffer
       (profiler-report-render-calltree))
     buffer))
 
+(defun profiler--xref-backend () 'elisp)
+
 (define-derived-mode profiler-report-mode special-mode "Profiler-Report"
   "Profiler Report Mode."
   (add-to-invisibility-spec '(profiler . t))
+  (add-hook 'xref-backend-functions #'profiler--xref-backend nil t)
   (setq buffer-read-only t
 	buffer-undo-list t
 	truncate-lines t))
@@ -691,9 +705,9 @@ With a prefix argument, expand the whole subtree."
       t)))
 
 (defun profiler-report-toggle-entry (&optional arg)
-  "Expand entry at point if the tree is collapsed,
-otherwise collapse.  With prefix argument, expand all subentries
-below entry at point."
+  "Expand entry at point if the tree is collapsed, otherwise collapse.
+With prefix argument, expand all subentries below entry at
+point."
   (interactive "P")
   (or (profiler-report-expand-entry arg)
       (profiler-report-collapse-entry)))
@@ -730,11 +744,11 @@ below entry at point."
 	    (cpu
 	     (profiler-report-header-line-format
 	      profiler-report-cpu-line-format
-	      "Function" (list "CPU samples" "%")))
+	      (list "Samples" "%") " " "  Function"))
 	    (memory
 	     (profiler-report-header-line-format
 	      profiler-report-memory-line-format
-	      "Function" (list "Bytes" "%")))))
+	      (list "Bytes" "%") " " "  Function"))))
     (let ((predicate (cl-ecase order
 		       (ascending #'profiler-calltree-count<)
 		       (descending #'profiler-calltree-count>))))
@@ -807,11 +821,15 @@ below entry at point."
 (defun profiler-start (mode)
   "Start/restart profilers.
 MODE can be one of `cpu', `mem', or `cpu+mem'.
-If MODE is `cpu' or `cpu+mem', time-based profiler will be started.
-Also, if MODE is `mem' or `cpu+mem', then memory profiler will be started."
+If MODE is `cpu' or `cpu+mem', start the time-based profiler,
+   whereby CPU is sampled periodically using the SIGPROF signal.
+If MODE is `mem' or `cpu+mem', start profiler that samples CPU
+   whenever memory-allocation functions are called -- this is useful
+   if SIGPROF is not supported, or is unreliable, or is not sampling
+   at a high enough frequency."
   (interactive
    (list (if (not (fboundp 'profiler-cpu-start)) 'mem
-           (intern (completing-read "Mode (default cpu): "
+           (intern (completing-read (format-prompt "Mode" "cpu")
                                     '("cpu" "mem" "cpu+mem")
                                     nil t nil nil "cpu")))))
   (cl-ecase mode
@@ -829,7 +847,12 @@ Also, if MODE is `mem' or `cpu+mem', then memory profiler will be started."
 (defun profiler-stop ()
   "Stop started profilers.  Profiler logs will be kept."
   (interactive)
-  (let ((cpu (if (fboundp 'profiler-cpu-stop) (profiler-cpu-stop)))
+  (when (and (fboundp 'profiler-cpu-running-p)
+             (profiler-cpu-running-p))
+    (setq profiler-cpu-log (profiler-cpu-log)))
+  (when (profiler-memory-running-p)
+    (setq profiler-memory-log (profiler-memory-log)))
+  (let ((cpu (when (fboundp 'profiler-cpu-stop) (profiler-cpu-stop)))
         (mem (profiler-memory-stop)))
     (message "%s profiler stopped"
              (cond ((and mem cpu) "CPU and memory")
@@ -840,26 +863,32 @@ Also, if MODE is `mem' or `cpu+mem', then memory profiler will be started."
 (defun profiler-reset ()
   "Reset profiler logs."
   (interactive)
-  (when (fboundp 'profiler-cpu-log)
-    (ignore (profiler-cpu-log)))
-  (ignore (profiler-memory-log))
-  t)
+  (when (and (fboundp 'profiler-cpu-running-p) (profiler-cpu-running-p))
+    (profiler-cpu-stop))
+  (when (profiler-memory-running-p)
+    (profiler-memory-stop))
+  (setq profiler-cpu-log nil
+        profiler-memory-log nil))
 
 (defun profiler-report-cpu ()
-  (let ((profile (profiler-cpu-profile)))
-    (when profile
-      (profiler-report-profile-other-window profile))))
+  (when profiler-cpu-log
+    (profiler-report-profile-other-window (profiler-cpu-profile))))
 
 (defun profiler-report-memory ()
-  (let ((profile (profiler-memory-profile)))
-    (when profile
-      (profiler-report-profile-other-window profile))))
+  (when profiler-memory-log
+    (profiler-report-profile-other-window (profiler-memory-profile))))
 
 (defun profiler-report ()
   "Report profiling results."
   (interactive)
-  (profiler-report-cpu)
-  (profiler-report-memory))
+  (when (and (fboundp 'profiler-cpu-running-p) (profiler-cpu-running-p))
+    (setq profiler-cpu-log (profiler-cpu-log)))
+  (when (profiler-memory-running-p)
+    (setq profiler-memory-log (profiler-memory-log)))
+  (if (and (not profiler-cpu-log) (not profiler-memory-log))
+      (user-error "No profiler run recorded")
+    (profiler-report-cpu)
+    (profiler-report-memory)))
 
 ;;;###autoload
 (defun profiler-find-profile (filename)