Rewrite sampler to use Elisp hash-tables.

* src/profiler.c: Remove filtering functionality.
(is_in_trace, Qgc): Remove vars.
(make_log, record_backtrace, Fsample_profiler_log):
Rewrite, using Elisp hash-tables.
(approximate_median, evict_lower_half): New functions.
(cpu_log): Rename from sample_log.
(cpu_gc_count): New var.
(Fsample_profiler_reset, Fmemory_profiler_reset): Remove.
(sigprof_handler): Add count to cpu_gc_count during GC, detected via
backtrace_list.
(block_sigprof, unblock_sigprof): Remove.
(gc_probe, mark_profiler): Remove functions.
(syms_of_profiler): Staticpro cpu_log and memory_log.

* lisp/profiler.el (profiler-sample-interval): Move before first use.
Change default to 1ms.
(profiler-entry=, profiler-backtrace-reverse, profiler-log-fixup-slot)
(profiler-calltree-elapsed<, profiler-calltree-elapsed>): Remove functions.
(profiler-entry-format): Don't use type-of.
(profiler-slot, profiler-log): Remove structs.
(profiler-log-timestamp, profiler-log-type, profiler-log-diff-p):
Redefine for new log representation.
(profiler-log-diff, profiler-log-fixup, profiler-calltree-build-1):
Rewrite for new log representation.
(profiler-calltree): Remove `elapsed' fields.
(profiler-calltree-count<, profiler-report-make-entry-part):
Remove gc special case.
(profiler-calltree-find): Use equal.
(profiler-calltree-walk): Remove `args'; rely on closures instead.
(profiler-calltree-compute-percentages-1): Remove; inlined.
(profiler-calltree-compute-percentages): Simplify.
(profiler-report-log, profiler-report-reversed)
(profiler-report-order): Use defvar-local.
(profiler-report-line-format): Remove `elapsed', do a bit of CSE.
(profiler-report-mode-map): Remove up/down bindings.
(profiler-report-make-buffer-name): Simplify by CSE.
(profiler-report-mode): Remove redundant code.
(profiler-report-expand-entry, profiler-report-collapse-entry):
Use inhibit-read-only.
(profiler-report-render-calltree-1): Simplify by CSE.
(profiler-reset): Rewrite for new subroutines.
(profiler--report-cpu): Rename from sample-profiler-report.
(profiler--report-memory): Rename from memory-profiler-report.

* src/alloc.c (Fgarbage_collect): Record itself in backtrace_list.
Don't set is_in_trace any more.  Don't call mark_profiler.
Only call gc_probe for the memory profiler.
(syms_of_alloc): Define Qautomatic_gc.

* src/lisp.h (SXHASH_COMBINE): Move back to...
* src/fns.c (SXHASH_COMBINE): ...here.

* src/xdisp.c (Qautomatic_redisplay): New constant.
(redisplay_internal): Record itself in backtrace_list.
(syms_of_xdisp): Define Qautomatic_redisplay.

* .dir-locals.el (indent-tabs-mode): Remove personal preference.

10 files changed, 422 insertions, 1117 deletions

diff --git a/.dir-locals.el b/.dir-locals.el
index b92f848d3eb..5bee88267c8 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -1,5 +1,4 @@
 ((nil . ((tab-width . 8)
-         (indent-tabs-mode . t)
          (sentence-end-double-space . t)
          (fill-column . 70)))
  (c-mode . ((c-file-style . "GNU")))
diff --git a/ChangeLog b/ChangeLog
index 4f339482a98..f4426fa36da 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2012-09-24  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * .dir-locals.el (indent-tabs-mode): Remove personal preference.
+
 2012-08-21  Paul Eggert  <eggert@cs.ucla.edu>
 
         Merge from gnulib, incorporating:
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index d8134f2c046..64fb7e2ffc7 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,35 @@
+2012-09-24  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * profiler.el (profiler-sample-interval): Move before first use.
+        Change default to 1ms.
+        (profiler-entry=, profiler-backtrace-reverse, profiler-log-fixup-slot)
+        (profiler-calltree-elapsed<, profiler-calltree-elapsed>): Remove functions.
+        (profiler-entry-format): Don't use type-of.
+        (profiler-slot, profiler-log): Remove structs.
+        (profiler-log-timestamp, profiler-log-type, profiler-log-diff-p):
+        Redefine for new log representation.
+        (profiler-log-diff, profiler-log-fixup, profiler-calltree-build-1):
+        Rewrite for new log representation.
+        (profiler-calltree): Remove `elapsed' fields.
+        (profiler-calltree-count<, profiler-report-make-entry-part):
+        Remove gc special case.
+        (profiler-calltree-find): Use equal.
+        (profiler-calltree-walk): Remove `args'; rely on closures instead.
+        (profiler-calltree-compute-percentages-1): Remove; inlined.
+        (profiler-calltree-compute-percentages): Simplify.
+        (profiler-report-log, profiler-report-reversed)
+        (profiler-report-order): Use defvar-local.
+        (profiler-report-line-format): Remove `elapsed', do a bit of CSE.
+        (profiler-report-mode-map): Remove up/down bindings.
+        (profiler-report-make-buffer-name): Simplify by CSE.
+        (profiler-report-mode): Remove redundant code.
+        (profiler-report-expand-entry, profiler-report-collapse-entry):
+        Use inhibit-read-only.
+        (profiler-report-render-calltree-1): Simplify by CSE.
+        (profiler-reset): Rewrite for new subroutines.
+        (profiler--report-cpu): Rename from sample-profiler-report.
+        (profiler--report-memory): Rename from memory-profiler-report.
+
 2012-08-22  Tomohiro Matsuyama  <tomo@cx4a.org>
 
         * profiler.el: Switch to cl-lib.
@@ -35,8 +67,8 @@
         * window.el (window-point-1, set-window-point-1): Remove.
         (window-in-direction, record-window-buffer)
         (set-window-buffer-start-and-point, split-window-below)
-        (window--state-get-1, display-buffer-record-window): Replace
-        calls to window-point-1 and set-window-point-1 by calls to
+        (window--state-get-1, display-buffer-record-window):
+        Replace calls to window-point-1 and set-window-point-1 by calls to
         window-point and set-window-point respectively.
 
 2012-08-21  Glenn Morris  <rgm@gnu.org>
@@ -154,8 +186,8 @@
         (yank-excluded-properties): Add font-lock-face and category.
         (yank): Doc fix.
 
-        * subr.el (remove-yank-excluded-properties): Obey
-        yank-handled-properties.  The special handling of font-lock-face
+        * subr.el (remove-yank-excluded-properties):
+        Obey yank-handled-properties.  The special handling of font-lock-face
         and category is now done this way, instead of being hard-coded.
         (insert-for-yank-1): Remove font-lock-face handling.
         (yank-handle-font-lock-face-property)
@@ -169,8 +201,8 @@
 
 2012-08-17  Michael Albinus  <michael.albinus@gmx.de>
 
-        * net/tramp-sh.el (tramp-sh-handle-start-file-process): Eliminate
-        superfluous prompt.  (Bug#12203)
+        * net/tramp-sh.el (tramp-sh-handle-start-file-process):
+        Eliminate superfluous prompt.  (Bug#12203)
 
 2012-08-17  Chong Yidong  <cyd@gnu.org>
 
@@ -197,8 +229,8 @@
         (next-buffer, previous-buffer, split-window, balance-windows-2)
         (set-window-text-height, window-buffer-height)
         (fit-window-to-buffer, shrink-window-if-larger-than-buffer)
-        (truncated-partial-width-window-p): Minor code adjustments.  In
-        doc-strings state whether the argument window has to denote a
+        (truncated-partial-width-window-p): Minor code adjustments.
+        In doc-strings state whether the argument window has to denote a
         live, valid or any window.
 
 2012-08-16  Phil Sainty  <psainty@orcon.net.nz>  (tiny change)
diff --git a/lisp/profiler.el b/lisp/profiler.el
index 1777fc00bde..00ee99a6132 100644
--- a/lisp/profiler.el
+++ b/lisp/profiler.el
@@ -32,7 +32,11 @@
   :group 'lisp
   :prefix "profiler-")
 
-
+(defcustom profiler-sample-interval 1
+  "Default sample interval in millisecond."
+  :type 'integer
+  :group 'profiler)
+
 ;;; Utilities
 
 (defun profiler-ensure-string (object)
@@ -90,55 +94,34 @@
 
 ;;; Entries
 
-(defun profiler-entry= (entry1 entry2)
-  "Return t if ENTRY1 and ENTRY2 are same."
-  (or (eq entry1 entry2)
-      (and (stringp entry1)
-           (stringp entry2)
-           (string= entry1 entry2))))
-
 (defun profiler-entry-format (entry)
   "Format ENTRY in human readable string.  ENTRY would be a
 function name of a function itself."
-  (cond ((and (consp entry)
-              (or (eq (car entry) 'lambda)
-                  (eq (car entry) 'closure)))
-         (format "#<closure 0x%x>" (sxhash entry)))
-        ((eq (type-of entry) 'compiled-function)
+  (cond ((memq (car-safe entry) '(closure lambda))
+         (format "#<lambda 0x%x>" (sxhash entry)))
+        ((byte-code-function-p entry)
          (format "#<compiled 0x%x>" (sxhash entry)))
-        ((subrp entry)
-         (subr-name entry))
-        ((symbolp entry)
-         (symbol-name entry))
-        ((stringp entry)
-         entry)
+        ((or (subrp entry) (symbolp entry) (stringp entry))
+         (format "%s" entry))
         (t
          (format "#<unknown 0x%x>" (sxhash entry)))))
 
-
-;;; Backtrace data structure
-
-(defun profiler-backtrace-reverse (backtrace)
-  (cl-case (car backtrace)
-    ((t gc)
-     ;; Make sure Others node and GC node always be at top.
-     (cons (car backtrace)
-           (reverse (cdr backtrace))))
-    (t (reverse backtrace))))
-
-
-;;; Slot data structure
-
-(cl-defstruct (profiler-slot (:type list)
-                             (:constructor profiler-make-slot))
-  backtrace count elapsed)
-
-
 ;;; Log data structure
 
-(cl-defstruct (profiler-log (:type list)
-                            (:constructor profiler-make-log))
-  type diff-p timestamp slots)
+;; The C code returns the log in the form of a hash-table where the keys are
+;; vectors (of size profiler-max-stack-depth, holding truncated
+;; backtraces, where the first element is the top of the stack) and
+;; the values are integers (which count how many times this backtrace
+;; has been seen, multiplied by a "weight factor" which is either the
+;; sample-interval or the memory being allocated).
+;; We extend it by adding a few other entries to the hash-table, most notably:
+;; - Key `type' has a value indicating the kind of log (`memory' or `cpu').
+;; - Key `timestamp' has a value giving the time when the log was obtained.
+;; - Key `diff-p' indicates if this log represents a diff between two logs.
+
+(defun profiler-log-timestamp (log) (gethash 'timestamp log))
+(defun profiler-log-type (log) (gethash 'type log))
+(defun profiler-log-diff-p (log) (gethash 'diff-p log))
 
 (defun profiler-log-diff (log1 log2)
   "Compare LOG1 with LOG2 and return a diff log.  Both logs must
@@ -146,16 +129,17 @@ be same type."
   (unless (eq (profiler-log-type log1)
               (profiler-log-type log2))
     (error "Can't compare different type of logs"))
-  (let ((slots (profiler-log-slots log2)))
-    (dolist (slot (profiler-log-slots log1))
-      (push (profiler-make-slot :backtrace (profiler-slot-backtrace slot)
-                                :count (- (profiler-slot-count slot))
-                                :elapsed (- (profiler-slot-elapsed slot)))
-            slots))
-    (profiler-make-log :type (profiler-log-type log1)
-                       :diff-p t
-                       :timestamp (current-time)
-                       :slots slots)))
+  (let ((newlog (make-hash-table :test 'equal)))
+    ;; Make a copy of `log1' into `newlog'.
+    (maphash (lambda (backtrace count) (puthash backtrace count newlog))
+             log1)
+    (puthash 'diff-p t newlog)
+    (maphash (lambda (backtrace count)
+               (when (vectorp backtrace)
+                 (puthash backtrace (- (gethash backtrace log1 0) count)
+                          newlog)))
+             log2)
+    newlog))
 
 (defun profiler-log-fixup-entry (entry)
   (if (symbolp entry)
@@ -165,21 +149,16 @@ be same type."
 (defun profiler-log-fixup-backtrace (backtrace)
   (mapcar 'profiler-log-fixup-entry backtrace))
 
-(defun profiler-log-fixup-slot (slot)
-  (let ((backtrace (profiler-slot-backtrace slot)))
-    (profiler-make-slot :backtrace (profiler-log-fixup-backtrace backtrace)
-                        :count (profiler-slot-count slot)
-                        :elapsed (profiler-slot-elapsed slot))))
-
 (defun profiler-log-fixup (log)
   "Fixup LOG so that the log could be serialized into file."
-  (cl-loop for slot in (profiler-log-slots log)
-           collect (profiler-log-fixup-slot slot) into slots
-           finally return
-           (profiler-make-log :type (profiler-log-type log)
-                              :diff-p (profiler-log-diff-p log)
-                              :timestamp (profiler-log-timestamp log)
-                              :slots slots)))
+  (let ((newlog (make-hash-table :test 'equal)))
+    (maphash (lambda (backtrace count)
+               (puthash (if (not (vectorp backtrace))
+                            backtrace
+                          (profiler-log-fixup-backtrace backtrace))
+                        count newlog))
+             log)
+    newlog))
 
 (defun profiler-log-write-file (log filename &optional confirm)
   "Write LOG into FILENAME."
@@ -201,7 +180,6 @@ be same type."
 (cl-defstruct (profiler-calltree (:constructor profiler-make-calltree))
   entry
   (count 0) (count-percent "")
-  (elapsed 0) (elapsed-percent "")
   parent children)
 
 (defun profiler-calltree-leaf-p (tree)
@@ -210,25 +188,12 @@ be same type."
 (defun profiler-calltree-count< (a b)
   (cond ((eq (profiler-calltree-entry a) t) t)
         ((eq (profiler-calltree-entry b) t) nil)
-        ((eq (profiler-calltree-entry a) 'gc) t)
-        ((eq (profiler-calltree-entry b) 'gc) nil)
         (t (< (profiler-calltree-count a)
               (profiler-calltree-count b)))))
 
 (defun profiler-calltree-count> (a b)
   (not (profiler-calltree-count< a b)))
 
-(defun profiler-calltree-elapsed< (a b)
-  (cond ((eq (profiler-calltree-entry a) t) t)
-        ((eq (profiler-calltree-entry b) t) nil)
-        ((eq (profiler-calltree-entry a) 'gc) t)
-        ((eq (profiler-calltree-entry b) 'gc) nil)
-        (t (< (profiler-calltree-elapsed a)
-              (profiler-calltree-elapsed b)))))
-
-(defun profiler-calltree-elapsed> (a b)
-  (not (profiler-calltree-elapsed< a b)))
-
 (defun profiler-calltree-depth (tree)
   (let ((parent (profiler-calltree-parent tree)))
     (if (null parent)
@@ -239,58 +204,47 @@ be same type."
   "Return a child tree of ENTRY under TREE."
   ;; OPTIMIZED
   (let (result (children (profiler-calltree-children tree)))
+    ;; FIXME: Use `assoc'.
     (while (and children (null result))
       (let ((child (car children)))
-        (when (profiler-entry= (profiler-calltree-entry child) entry)
+        (when (equal (profiler-calltree-entry child) entry)
           (setq result child))
         (setq children (cdr children))))
     result))
 
-(defun profiler-calltree-walk (calltree function &rest args)
-  (apply function calltree args)
+(defun profiler-calltree-walk (calltree function)
+  (funcall function calltree)
   (dolist (child (profiler-calltree-children calltree))
-    (apply 'profiler-calltree-walk child function args)))
+    (profiler-calltree-walk child function)))
 
 (defun profiler-calltree-build-1 (tree log &optional reverse)
-  (dolist (slot (profiler-log-slots log))
-    (let ((backtrace (profiler-slot-backtrace slot))
-          (count (profiler-slot-count slot))
-          (elapsed (profiler-slot-elapsed slot))
-          (node tree))
-      (dolist (entry (if reverse
-                         backtrace
-                       (profiler-backtrace-reverse backtrace)))
-        (let ((child (profiler-calltree-find node entry)))
-          (unless child
-            (setq child (profiler-make-calltree :entry entry :parent node))
-            (push child (profiler-calltree-children node)))
-          (cl-incf (profiler-calltree-count child) count)
-          (cl-incf (profiler-calltree-elapsed child) elapsed)
-          (setq node child))))))
-
-(defun profiler-calltree-compute-percentages-1 (node total-count total-elapsed)
-  (unless (zerop total-count)
-    (setf (profiler-calltree-count-percent node)
-          (profiler-format-percent (profiler-calltree-count node)
-                                   total-count)))
-  (unless (zerop total-elapsed)
-    (setf (profiler-calltree-elapsed-percent node)
-          (profiler-format-percent (profiler-calltree-elapsed node)
-                                   total-elapsed))))
+  (maphash
+   (lambda (backtrace count)
+     (when (vectorp backtrace)
+       (let ((node tree)
+             (max (length backtrace)))
+         (dotimes (i max)
+           (let ((entry (aref backtrace (if reverse i (- max i 1)))))
+             (when entry
+               (let ((child (profiler-calltree-find node entry)))
+                 (unless child
+                   (setq child (profiler-make-calltree
+                                :entry entry :parent node))
+                   (push child (profiler-calltree-children node)))
+                 (cl-incf (profiler-calltree-count child) count)
+                 (setq node child))))))))
+   log))
 
 (defun profiler-calltree-compute-percentages (tree)
-  (let ((total-count 0)
-        (total-elapsed 0))
+  (let ((total-count 0))
     (dolist (child (profiler-calltree-children tree))
-      (if (eq (profiler-calltree-entry child) 'gc)
-          (profiler-calltree-compute-percentages child)
-        (cl-incf total-count (profiler-calltree-count child))
-        (cl-incf total-elapsed (profiler-calltree-elapsed child))))
-    (dolist (child (profiler-calltree-children tree))
-      (unless (eq (profiler-calltree-entry child) 'gc)
-        (profiler-calltree-walk
-         child 'profiler-calltree-compute-percentages-1
-         total-count total-elapsed)))))
+      (cl-incf total-count (profiler-calltree-count child)))
+    (unless (zerop total-count)
+      (profiler-calltree-walk
+       tree (lambda (node)
+              (setf (profiler-calltree-count-percent node)
+                    (profiler-format-percent (profiler-calltree-count node)
+                                             total-count)))))))
 
 (cl-defun profiler-calltree-build (log &key reverse)
   (let ((tree (profiler-make-calltree)))
@@ -332,14 +286,14 @@ be same type."
     (19 right ((14 right profiler-format-nbytes)
                (5 right)))))
 
-(defvar profiler-report-log nil
+(defvar-local profiler-report-log nil
   "The current profiler log.")
 
-(defvar profiler-report-reversed nil
+(defvar-local profiler-report-reversed nil
   "True if calltree is rendered in bottom-up.  Do not touch this
 variable directly.")
 
-(defvar profiler-report-order nil
+(defvar-local profiler-report-order nil
   "The value can be `ascending' or `descending'.  Do not touch
 this variable directly.")
 
@@ -347,8 +301,6 @@ this variable directly.")
   (let ((string (cond
                  ((eq entry t)
                   "Others")
-                 ((eq entry 'gc)
-                  "Garbage Collection")
                  ((and (symbolp entry)
                        (fboundp entry))
                   (propertize (symbol-name entry)
@@ -357,7 +309,7 @@ this variable directly.")
                               'help-echo "mouse-2 or RET jumps to definition"))
                  (t
                   (profiler-entry-format entry)))))
-    (propertize string 'entry entry)))
+    (propertize string 'profiler-entry entry)))
 
 (defun profiler-report-make-name-part (tree)
   (let* ((entry (profiler-calltree-entry tree))
@@ -377,31 +329,18 @@ this variable directly.")
 (defun profiler-report-line-format (tree)
   (let ((diff-p (profiler-log-diff-p profiler-report-log))
         (name-part (profiler-report-make-name-part tree))
-        (elapsed (profiler-calltree-elapsed tree))
-        (elapsed-percent (profiler-calltree-elapsed-percent tree))
         (count (profiler-calltree-count tree))
         (count-percent (profiler-calltree-count-percent tree)))
-    (cl-ecase (profiler-log-type profiler-report-log)
-      (sample
-       (if diff-p
-           (profiler-format profiler-report-sample-line-format
-                            name-part
-                            (list (if (> elapsed 0)
-                                      (format "+%s" elapsed)
-                                    elapsed)
-                                  ""))
-         (profiler-format profiler-report-sample-line-format
-                          name-part (list elapsed elapsed-percent))))
-      (memory
-       (if diff-p
-           (profiler-format profiler-report-memory-line-format
-                          name-part
-                          (list (if (> count 0)
-                                      (format "+%s" count)
-                                    count)
-                                ""))
-         (profiler-format profiler-report-memory-line-format
-                          name-part (list count count-percent)))))))
+    (profiler-format (cl-ecase (profiler-log-type profiler-report-log)
+                       (cpu profiler-report-sample-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)))))
 
 (defun profiler-report-insert-calltree (tree)
   (let ((line (profiler-report-line-format tree)))
@@ -416,10 +355,13 @@ this variable directly.")
 
 (defvar profiler-report-mode-map
   (let ((map (make-sparse-keymap)))
+    ;; FIXME: Add menu.
     (define-key map "n"     'profiler-report-next-entry)
     (define-key map "p"     'profiler-report-previous-entry)
-    (define-key map [down]  'profiler-report-next-entry)
-    (define-key map [up]    'profiler-report-previous-entry)
+    ;; I find it annoying more than helpful to not be able to navigate
+    ;; normally with the cursor keys.  --Stef
+    ;; (define-key map [down]  'profiler-report-next-entry)
+    ;; (define-key map [up]    'profiler-report-previous-entry)
     (define-key map "\r"    'profiler-report-toggle-entry)
     (define-key map "\t"    'profiler-report-toggle-entry)
     (define-key map "i"     'profiler-report-toggle-entry)
@@ -437,10 +379,9 @@ this variable directly.")
     map))
 
 (defun profiler-report-make-buffer-name (log)
-  (let ((time (format-time-string "%Y-%m-%d %T" (profiler-log-timestamp log))))
-    (cl-ecase (profiler-log-type log)
-      (sample (format "*CPU-Profiler-Report %s*" time))
-      (memory (format "*Memory-Profiler-Report %s*" time)))))
+  (format "*%s-Profiler-Report %s*"
+          (cl-ecase (profiler-log-type log) (cpu 'CPU) (memory 'Memory))
+          (format-time-string "%Y-%m-%d %T" (profiler-log-timestamp log))))
 
 (defun profiler-report-setup-buffer (log)
   "Make a buffer for LOG and return it."
@@ -455,10 +396,6 @@ this variable directly.")
 
 (define-derived-mode profiler-report-mode special-mode "Profiler-Report"
   "Profiler Report Mode."
-  (make-local-variable 'profiler-report-log)
-  (make-local-variable 'profiler-report-reversed)
-  (make-local-variable 'profiler-report-order)
-  (use-local-map profiler-report-mode-map)
   (setq buffer-read-only t
         buffer-undo-list t
         truncate-lines t))
@@ -470,7 +407,8 @@ this variable directly.")
   (get-text-property (point) 'calltree))
 
 (defun profiler-report-move-to-entry ()
-  (let ((point (next-single-property-change (line-beginning-position) 'entry)))
+  (let ((point (next-single-property-change (line-beginning-position)
+                                            'profiler-entry)))
     (if point
         (goto-char point)
       (back-to-indentation))))
@@ -496,7 +434,7 @@ this variable directly.")
                           (line-end-position) t)
       (let ((tree (profiler-report-calltree-at-point)))
         (when tree
-          (let ((buffer-read-only nil))
+          (let ((inhibit-read-only t))
             (replace-match (concat profiler-report-open-mark " "))
             (forward-line)
             (profiler-report-insert-calltree-children tree)
@@ -514,7 +452,7 @@ this variable directly.")
              (start (line-beginning-position 2))
              d)
         (when tree
-          (let ((buffer-read-only nil))
+          (let ((inhibit-read-only t))
             (replace-match (concat profiler-report-closed-mark " "))
             (while (and (eq (forward-line) 0)
                         (let ((child (get-text-property (point) 'calltree)))
@@ -549,29 +487,25 @@ otherwise collapse."
         (require 'help-fns)
         (describe-function entry)))))
 
-(cl-defun profiler-report-render-calltree-1 (log &key reverse (order 'descending))
+(cl-defun profiler-report-render-calltree-1
+    (log &key reverse (order 'descending))
   (let ((calltree (profiler-calltree-build profiler-report-log
                                            :reverse reverse)))
-    (cl-ecase (profiler-log-type log)
-      (sample
-       (setq header-line-format
+    (setq header-line-format
+          (cl-ecase (profiler-log-type log)
+            (cpu
              (profiler-report-header-line-format
               profiler-report-sample-line-format
               "Function" (list "Time (ms)" "%")))
-       (let ((predicate (cl-ecase order
-                          (ascending 'profiler-calltree-elapsed<)
-                          (descending 'profiler-calltree-elapsed>))))
-         (profiler-calltree-sort calltree predicate)))
-      (memory
-       (setq header-line-format
+            (memory
              (profiler-report-header-line-format
               profiler-report-memory-line-format
-              "Function" (list "Bytes" "%")))
-       (let ((predicate (cl-ecase order
-                          (ascending 'profiler-calltree-count<)
-                          (descending 'profiler-calltree-count>))))
-         (profiler-calltree-sort calltree predicate))))
-    (let ((buffer-read-only nil))
+              "Function" (list "Bytes" "%")))))
+    (let ((predicate (cl-ecase order
+                       (ascending #'profiler-calltree-count<)
+                       (descending #'profiler-calltree-count>))))
+      (profiler-calltree-sort calltree predicate))
+    (let ((inhibit-read-only t))
       (erase-buffer)
       (profiler-report-insert-calltree-children calltree)
       (goto-char (point-min))
@@ -632,19 +566,15 @@ otherwise collapse."
 
 ;;; Profiler commands
 
-(defcustom profiler-sample-interval 10
-  "Default sample interval in millisecond."
-  :type 'integer
-  :group 'profiler)
-
 ;;;###autoload
 (defun profiler-start (mode)
-  "Start/restart profilers.  MODE can be one of `cpu', `mem',
-and `cpu+mem'.  If MODE is `cpu' or `cpu+mem', sample profiler
-will be started.  Also, if MODE is `mem' or `cpu+mem', then
-memory profiler will be started."
+  "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."
   (interactive
-   (list (intern (completing-read "Mode: " '("cpu" "mem" "cpu+mem")
+   (list (intern (completing-read "Mode (default cpu): "
+                                  '("cpu" "mem" "cpu+mem")
                                   nil t nil nil "cpu"))))
   (cl-ecase mode
     (cpu
@@ -679,25 +609,29 @@ memory profiler will be started."
 (defun profiler-reset ()
   "Reset profiler log."
   (interactive)
-  (sample-profiler-reset)
-  (memory-profiler-reset)
+  (ignore (sample-profiler-log))
+  (ignore (memory-profiler-log))
   t)
 
-(defun sample-profiler-report ()
-  (let ((sample-log (sample-profiler-log)))
-    (when sample-log
-      (profiler-report-log sample-log))))
+(defun profiler--report-cpu ()
+  (let ((log (sample-profiler-log)))
+    (when log
+      (puthash 'type 'cpu log)
+      (puthash 'timestamp (current-time) log)
+      (profiler-report-log log))))
 
-(defun memory-profiler-report ()
-  (let ((memory-log (memory-profiler-log)))
-    (when memory-log
-      (profiler-report-log memory-log))))
+(defun profiler--report-memory ()
+  (let ((log (memory-profiler-log)))
+    (when log
+      (puthash 'type 'memory log)
+      (puthash 'timestamp (current-time) log)
+      (profiler-report-log log))))
 
 (defun profiler-report ()
   "Report profiling results."
   (interactive)
-  (sample-profiler-report)
-  (memory-profiler-report))
+  (profiler--report-cpu)
+  (profiler--report-memory))
 
 ;;;###autoload
 (defun profiler-find-log (filename)
@@ -709,25 +643,23 @@ memory profiler will be started."
 
 ;;; Profiling helpers
 
-(cl-defmacro with-sample-profiling ((&key (interval profiler-sample-interval)) &rest body)
-  `(progn
-     (sample-profiler-start ,interval)
-     (sample-profiler-reset)
-     (unwind-protect
-         (progn ,@body)
-       (sample-profiler-stop)
-       (sample-profiler-report)
-       (sample-profiler-reset))))
-
-(cl-defmacro with-memory-profiling (() &rest body)
-  `(progn
-     (memory-profiler-start)
-     (memory-profiler-reset)
-     (unwind-protect
-         (progn ,@body)
-       (memory-profiler-stop)
-       (memory-profiler-report)
-       (memory-profiler-reset))))
+(cl-defmacro with-sample-profiling ((&key interval) &rest body)
+  `(unwind-protect
+       (progn
+         (ignore (sample-profiler-log))
+         (sample-profiler-start ,interval)
+         ,@body)
+     (sample-profiler-stop)
+     (profiler--report-cpu)))
+
+(defmacro with-memory-profiling (&rest body)
+  `(unwind-protect
+       (progn
+         (ignore (memory-profiler-log))
+         (memory-profiler-start)
+         ,@body)
+     (memory-profiler-stop)
+     (profiler--report-memory)))
 
 (provide 'profiler)
 ;;; profiler.el ends here
diff --git a/src/ChangeLog b/src/ChangeLog
index feb9c6219fb..1b90ae8b976 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,31 @@
+2012-09-24  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * xdisp.c (Qautomatic_redisplay): New constant.
+        (redisplay_internal): Record itself in backtrace_list.
+        (syms_of_xdisp): Define Qautomatic_redisplay.
+
+        * profiler.c: Remove filtering functionality.
+        (is_in_trace, Qgc): Remove vars.
+        (make_log, record_backtrace, Fsample_profiler_log):
+        Rewrite, using Elisp hash-tables.
+        (approximate_median, evict_lower_half): New functions.
+        (cpu_log): Rename from sample_log.
+        (cpu_gc_count): New var.
+        (Fsample_profiler_reset, Fmemory_profiler_reset): Remove.
+        (sigprof_handler): Add count to cpu_gc_count during GC, detected via
+        backtrace_list.
+        (block_sigprof, unblock_sigprof): Remove.
+        (gc_probe, mark_profiler): Remove functions.
+        (syms_of_profiler): Staticpro cpu_log and memory_log.
+
+        * lisp.h (SXHASH_COMBINE): Move back to...
+        * fns.c (SXHASH_COMBINE): ...here.
+
+        * alloc.c (Fgarbage_collect): Record itself in backtrace_list.
+        Don't set is_in_trace any more.  Don't call mark_profiler.
+        Only call gc_probe for the memory profiler.
+        (syms_of_alloc): Define Qautomatic_gc.
+
 2012-09-15  Tomohiro Matsuyama  <tomo@cx4a.org>
 
         * alloc.c (emacs_blocked_malloc): Remove redundant MALLOC_PROBE.
diff --git a/src/alloc.c b/src/alloc.c
index 36adb49f835..2fc93f825d1 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -264,6 +264,7 @@ static Lisp_Object Qintervals;
 static Lisp_Object Qbuffers;
 static Lisp_Object Qstring_bytes, Qvector_slots, Qheap;
 static Lisp_Object Qgc_cons_threshold;
+Lisp_Object Qautomatic_gc;
 Lisp_Object Qchar_table_extra_slots;
 
 /* Hook run after GC has finished.  */
@@ -5421,6 +5422,7 @@ See Info node `(elisp)Garbage Collection'.  */)
   EMACS_TIME start;
   Lisp_Object retval = Qnil;
   size_t tot_before = 0;
+  struct backtrace backtrace;
 
   if (abort_on_gc)
     abort ();
@@ -5430,6 +5432,14 @@ See Info node `(elisp)Garbage Collection'.  */)
   if (pure_bytes_used_before_overflow)
     return Qnil;
 
+  /* Record this function, so it appears on the profiler's backtraces.  */
+  backtrace.next = backtrace_list;
+  backtrace.function = &Qautomatic_gc;
+  backtrace.args = &Qautomatic_gc;
+  backtrace.nargs = 0;
+  backtrace.debug_on_exit = 0;
+  backtrace_list = &backtrace;
+
   check_cons_list ();
 
   /* Don't keep undo information around forever.
@@ -5486,7 +5496,6 @@ See Info node `(elisp)Garbage Collection'.  */)
   shrink_regexp_cache ();
 
   gc_in_progress = 1;
-  is_in_trace = 1;
 
   /* Mark all the special slots that serve as the roots of accessibility.  */
 
@@ -5538,8 +5547,6 @@ See Info node `(elisp)Garbage Collection'.  */)
   mark_backtrace ();
 #endif
 
-  mark_profiler ();
-
 #ifdef HAVE_WINDOW_SYSTEM
   mark_fringe_data ();
 #endif
@@ -5607,7 +5614,6 @@ See Info node `(elisp)Garbage Collection'.  */)
   check_cons_list ();
 
   gc_in_progress = 0;
-  is_in_trace = 0;
 
   consing_since_gc = 0;
   if (gc_cons_threshold < GC_DEFAULT_THRESHOLD / 10)
@@ -5720,24 +5726,19 @@ See Info node `(elisp)Garbage Collection'.  */)
   gcs_done++;
 
   /* Collect profiling data.  */
-  if (sample_profiler_running || memory_profiler_running)
+  if (memory_profiler_running)
     {
       size_t swept = 0;
-      size_t elapsed = 0;
       if (memory_profiler_running)
         {
           size_t tot_after = total_bytes_of_live_objects ();
           if (tot_before > tot_after)
             swept = tot_before - tot_after;
         }
-      if (sample_profiler_running)
-        {
-          EMACS_TIME since_start = sub_emacs_time (current_emacs_time (), start);
-          elapsed = EMACS_TIME_TO_DOUBLE (since_start) * 1000;
-        }
-      gc_probe (swept, elapsed);
+      malloc_probe (swept);
     }
 
+  backtrace_list = backtrace.next;
   return retval;
 }
 
@@ -6867,6 +6868,7 @@ do hash-consing of the objects allocated to pure space.  */);
   DEFSYM (Qstring_bytes, "string-bytes");
   DEFSYM (Qvector_slots, "vector-slots");
   DEFSYM (Qheap, "heap");
+  DEFSYM (Qautomatic_gc, "Automatic GC");
 
   DEFSYM (Qgc_cons_threshold, "gc-cons-threshold");
   DEFSYM (Qchar_table_extra_slots, "char-table-extra-slots");
diff --git a/src/fns.c b/src/fns.c
index 3cb66534e0c..3225fefc5e3 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -4096,6 +4096,13 @@ sweep_weak_hash_tables (void)
 
 #define SXHASH_MAX_LEN   7
 
+/* Combine two integers X and Y for hashing.  The result might not fit
+   into a Lisp integer.  */
+
+#define SXHASH_COMBINE(X, Y)                                            \
+  ((((EMACS_UINT) (X) << 4) + ((EMACS_UINT) (X) >> (BITS_PER_EMACS_INT - 4))) \
+   + (EMACS_UINT) (Y))
+
 /* Hash X, returning a value that fits into a Lisp integer.  */
 #define SXHASH_REDUCE(X) \
   ((((X) ^ (X) >> (BITS_PER_EMACS_INT - FIXNUM_BITS))) & INTMASK)
diff --git a/src/lisp.h b/src/lisp.h
index 894b18c838c..09a812829a3 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2679,11 +2679,6 @@ extern void init_syntax_once (void);
 extern void syms_of_syntax (void);
 
 /* Defined in fns.c */
-/* Combine two integers X and Y for hashing.  The result might not fit
-   into a Lisp integer.  */
-#define SXHASH_COMBINE(X, Y)                                            \
-  ((((EMACS_UINT) (X) << 4) + ((EMACS_UINT) (X) >> (BITS_PER_EMACS_INT - 4))) \
-   + (EMACS_UINT) (Y))
 extern Lisp_Object QCrehash_size, QCrehash_threshold;
 enum { NEXT_ALMOST_PRIME_LIMIT = 11 };
 EXFUN (Fidentity, 1) ATTRIBUTE_CONST;
@@ -2921,6 +2916,7 @@ build_string (const char *str)
 
 extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object);
 extern void make_byte_code (struct Lisp_Vector *);
+extern Lisp_Object Qautomatic_gc;
 extern Lisp_Object Qchar_table_extra_slots;
 extern struct Lisp_Vector *allocate_vector (EMACS_INT);
 extern struct Lisp_Vector *allocate_pseudovector (int memlen, int lisplen, int tag);
@@ -3532,19 +3528,14 @@ void syms_of_dbusbind (void);
 /* Defined in profiler.c */
 extern bool sample_profiler_running;
 extern bool memory_profiler_running;
-extern bool is_in_trace;
-extern Lisp_Object Qgc;
 extern void malloc_probe (size_t);
 extern void gc_probe (size_t, size_t);
-#define ENTER_TRACE (is_in_trace = 1)
-#define LEAVE_TRACE (is_in_trace = 0)
 #define MALLOC_PROBE(size)                      \
   do {                                          \
     if (memory_profiler_running)                \
       malloc_probe (size);                      \
   } while (0)
 
-extern void mark_profiler (void);
 extern void syms_of_profiler (void);
 
 #ifdef DOS_NT
diff --git a/src/profiler.c b/src/profiler.c
index 0ef20a9a70c..5eaaaf3330f 100644
--- a/src/profiler.c
+++ b/src/profiler.c
@@ -33,702 +33,103 @@ bool sample_profiler_running;
 
 bool memory_profiler_running;
 
-/* True during tracing.  */
-
-bool is_in_trace;
-
-/* Tag for GC entry.  */
-
-Lisp_Object Qgc;
-
 static void sigprof_handler (int, siginfo_t *, void *);
-static void block_sigprof (void);
-static void unblock_sigprof (void);
-
-
-/* Pattern matching.  */
-
-enum pattern_type
-{
-  pattern_exact,                /* foo */
-  pattern_body_exact,           /* *foo* */
-  pattern_pre_any,              /* *foo */
-  pattern_post_any,             /* foo* */
-  pattern_body_any              /* foo*bar */
-};
-
-struct pattern
-{
-  enum pattern_type type;
-  char *exact;
-  char *extra;
-  int exact_length;
-  int extra_length;
-};
-
-static struct pattern *
-parse_pattern (const char *pattern)
-{
-  int length = strlen (pattern);
-  enum pattern_type type;
-  char *exact;
-  char *extra = 0;
-  struct pattern *pat =
-    (struct pattern *) xmalloc (sizeof (struct pattern));
-
-  if (length > 1
-      && *pattern == '*'
-      && pattern[length - 1] == '*')
-    {
-      type = pattern_body_exact;
-      exact = xstrdup (pattern + 1);
-      exact[length - 2] = 0;
-    }
-  else if (*pattern == '*')
-    {
-      type = pattern_pre_any;
-      exact = xstrdup (pattern + 1);
-    }
-  else if (pattern[length - 1] == '*')
-    {
-      type = pattern_post_any;
-      exact = xstrdup (pattern);
-      exact[length - 1] = 0;
-    }
-  else if (strchr (pattern, '*'))
-    {
-      type = pattern_body_any;
-      exact = xstrdup (pattern);
-      extra = strchr (exact, '*');
-      *extra++ = 0;
-    }
-  else
-    {
-      type = pattern_exact;
-      exact = xstrdup (pattern);
-    }
-
-  pat->type = type;
-  pat->exact = exact;
-  pat->extra = extra;
-  pat->exact_length = strlen (exact);
-  pat->extra_length = extra ? strlen (extra) : 0;
-
-  return pat;
-}
-
-static void
-free_pattern (struct pattern *pattern)
-{
-  xfree (pattern->exact);
-  xfree (pattern);
-}
-
-static int
-pattern_match_1 (enum pattern_type type,
-                 const char *exact,
-                 int exact_length,
-                 const char *string,
-                 int length)
-{
-  if (exact_length > length)
-    return 0;
-  switch (type)
-    {
-    case pattern_exact:
-      return exact_length == length && !strncmp (exact, string, length);
-    case pattern_body_exact:
-      return strstr (string, exact) != 0;
-    case pattern_pre_any:
-      return !strncmp (exact, string + (length - exact_length), exact_length);
-    case pattern_post_any:
-      return !strncmp (exact, string, exact_length);
-    case pattern_body_any:
-      return 0;
-    }
-}
-
-static int
-pattern_match (struct pattern *pattern, const char *string)
-{
-  int length = strlen (string);
-  switch (pattern->type)
-    {
-    case pattern_body_any:
-      if (pattern->exact_length + pattern->extra_length > length)
-        return 0;
-      return pattern_match_1 (pattern_post_any,
-                              pattern->exact,
-                              pattern->exact_length,
-                              string, length)
-        &&   pattern_match_1 (pattern_pre_any,
-                              pattern->extra,
-                              pattern->extra_length,
-                              string, length);
-    default:
-      return pattern_match_1 (pattern->type,
-                              pattern->exact,
-                              pattern->exact_length,
-                              string, length);
-    }
-}
-
-#if 0
-static int
-match (const char *pattern, const char *string)
-{
-  int res;
-  struct pattern *pat = parse_pattern (pattern);
-  res = pattern_match (pat, string);
-  free_pattern (pat);
-  return res;
-}
-
-static void
-should_match (const char *pattern, const char *string)
-{
-  putchar (match (pattern, string) ? '.' : 'F');
-}
-
-static void
-should_not_match (const char *pattern, const char *string)
-{
-  putchar (match (pattern, string) ? 'F' : '.');
-}
-
-static void
-pattern_match_tests (void)
-{
-  should_match ("", "");
-  should_not_match ("", "a");
-  should_match ("a", "a");
-  should_not_match ("a", "ab");
-  should_not_match ("ab", "a");
-  should_match ("*a*", "a");
-  should_match ("*a*", "ab");
-  should_match ("*a*", "ba");
-  should_match ("*a*", "bac");
-  should_not_match ("*a*", "");
-  should_not_match ("*a*", "b");
-  should_match ("*", "");
-  should_match ("*", "a");
-  should_match ("a*", "a");
-  should_match ("a*", "ab");
-  should_not_match ("a*", "");
-  should_not_match ("a*",  "ba");
-  should_match ("*a", "a");
-  should_match ("*a", "ba");
-  should_not_match ("*a", "");
-  should_not_match ("*a", "ab");
-  should_match ("a*b", "ab");
-  should_match ("a*b", "acb");
-  should_match ("a*b", "aab");
-  should_match ("a*b", "abb");
-  should_not_match ("a*b", "");
-  should_not_match ("a*b", "");
-  should_not_match ("a*b", "abc");
-  puts ("");
-}
-#endif
-
-
-/* Filters.  */
-
-static struct pattern *filter_pattern;
-
-/* Set the current filter pattern.  If PATTERN is null, unset the
-   current filter pattern instead.  */
-
-static void
-set_filter_pattern (const char *pattern)
-{
-  if (sample_profiler_running)
-    block_sigprof ();
-
-  if (filter_pattern)
-    {
-      free_pattern (filter_pattern);
-      filter_pattern = 0;
-    }
-  if (pattern)
-    filter_pattern = parse_pattern (pattern);
-
-  if (sample_profiler_running)
-    unblock_sigprof ();
-}
-
-/* Return true if the current filter pattern is matched with FUNCTION.
-   FUNCTION should be a symbol or a subroutine, otherwise return
-   false.  */
-
-static int
-apply_filter_1 (Lisp_Object function)
-{
-  const char *name;
-
-  if (!filter_pattern)
-    return 1;
-
-  if (SYMBOLP (function))
-    name = SDATA (SYMBOL_NAME (function));
-  else if (SUBRP (function))
-    name = XSUBR (function)->symbol_name;
-  else
-    return 0;
-
-  return pattern_match (filter_pattern, name);
-}
-
-/* Return true if the current filter pattern is matched with at least
-   one entry in BACKLIST.  */
-
-static int
-apply_filter (struct backtrace *backlist)
-{
-  while (backlist)
-    {
-      if (apply_filter_1 (*backlist->function))
-        return 1;
-      backlist = backlist->next;
-    }
-  return 0;
-}
-
-DEFUN ("profiler-set-filter-pattern",
-       Fprofiler_set_filter_pattern, Sprofiler_set_filter_pattern,
-       1, 1, "sPattern: ",
-       doc: /* Set the current filter pattern.  PATTERN can contain
-one or two wildcards (*) as follows:
-
-- foo
-- *foo
-- foo*
-- *foo*
-- foo*bar
-
-If PATTERN is nil or an empty string, then unset the current filter
-pattern.  */)
-  (Lisp_Object pattern)
-{
-  if (NILP (pattern)
-      || (STRINGP (pattern) && !SREF (pattern, 0)))
-    {
-      set_filter_pattern (0);
-      message ("Profiler filter pattern unset");
-      return Qt;
-    }
-  else if (!STRINGP (pattern))
-    error ("Invalid type of profiler filter pattern");
-
-  set_filter_pattern (SDATA (pattern));
-
-  return Qt;
-}
 
 
-/* Backtraces.  */
+/* Logs.  */
 
+typedef struct Lisp_Hash_Table log_t;
 
 static Lisp_Object
-make_backtrace (int size)
-{
-  return Fmake_vector (make_number (size), Qnil);
+make_log (int heap_size, int max_stack_depth)
+{
+  /* We use a standard Elisp hash-table object, but we use it in
+     a special way.  This is OK as long as the object is not exposed
+     to Elisp, i.e. until it is returned by *-profiler-log, after which
+     it can't be used any more.  */
+  Lisp_Object log = make_hash_table (Qequal, make_number (heap_size),
+                                     make_float (DEFAULT_REHASH_SIZE),
+                                     make_float (DEFAULT_REHASH_THRESHOLD),
+                                     Qnil, Qnil, Qnil);
+  struct Lisp_Hash_Table *h = XHASH_TABLE (log);
+
+  /* What is special about our hash-tables is that the keys are pre-filled
+     with the vectors we'll put in them.  */
+  int i = ASIZE (h->key_and_value) / 2;
+  while (0 < i)
+    set_hash_key_slot (h, --i,
+                       Fmake_vector (make_number (max_stack_depth), Qnil));
+  return log;
 }
 
-static EMACS_UINT
-backtrace_hash (Lisp_Object backtrace)
-{
-  int i;
-  EMACS_UINT hash = 0;
-  for (i = 0; i < ASIZE (backtrace); i++)
-    /* FIXME */
-    hash = SXHASH_COMBINE (XUINT (AREF (backtrace, i)), hash);
-  return hash;
-}
+/* Evict the least used half of the hash_table.
 
-static int
-backtrace_equal (Lisp_Object a, Lisp_Object b)
-{
-  int i, j;
+   When the table is full, we have to evict someone.
+   The easiest and most efficient is to evict the value we're about to add
+   (i.e. once the table is full, stop sampling).
 
-  for (i = 0, j = 0;; i++, j++)
-    {
-      Lisp_Object x = i < ASIZE (a) ? AREF (a, i) : Qnil;
-      Lisp_Object y = j < ASIZE (b) ? AREF (b, j) : Qnil;
-      if (NILP (x) && NILP (y))
-        break;
-      else if (!EQ (x, y))
-        return 0;
-    }
+   We could also pick the element with the lowest count and evict it,
+   but finding it is O(N) and for that amount of work we get very
+   little in return: for the next sample, this latest sample will have
+   count==1 and will hence be a prime candidate for eviction :-(
 
-  return 1;
-}
+   So instead, we take O(N) time to eliminate more or less half of the
+   entries (the half with the lowest counts).  So we get an amortized
+   cost of O(1) and we get O(N) time for a new entry to grow larger
+   than the other least counts before a new round of eviction.  */
 
-static Lisp_Object
-backtrace_object_1 (Lisp_Object backtrace, int i)
+static EMACS_INT approximate_median (log_t *log,
+                                     ptrdiff_t start, ptrdiff_t size)
 {
-  if (i >= ASIZE (backtrace) || NILP (AREF (backtrace, i)))
-    return Qnil;
+  eassert (size > 0);
+  if (size < 2)
+    return XINT (HASH_VALUE (log, start));
+  if (size < 3)
+    /* Not an actual median, but better for our application than
+       choosing either of the two numbers.  */
+    return ((XINT (HASH_VALUE (log, start))
+             + XINT (HASH_VALUE (log, start + 1)))
+            / 2);
   else
-    return Fcons (AREF (backtrace, i), backtrace_object_1 (backtrace, i + 1));
-}
-
-/* Convert BACKTRACE to a list.  */
-
-static Lisp_Object
-backtrace_object (Lisp_Object backtrace)
-{
-  backtrace_object_1 (backtrace, 0);
-}
-
-
-/* Slots.  */
-
-/* Slot data structure.  */
-
-struct slot
-{
-  /* Point to next free slot or next hash table link.  */
-  struct slot *next;
-  /* Point to previous hash table link.  */
-  struct slot *prev;
-  /* Backtrace object with fixed size.  */
-  Lisp_Object backtrace;
-  /* How many times a profiler sees the slot, or how much resouce
-     allocated during profiling.  */
-  size_t count;
-  /* How long the slot takes to execute.  */
-  size_t elapsed;
-  /* True in used.  */
-  unsigned char used : 1;
-};
-
-static void
-mark_slot (struct slot *slot)
-{
-  mark_object (slot->backtrace);
-}
-
-/* Convert SLOT to a list.  */
-
-static Lisp_Object
-slot_object (struct slot *slot)
-{
-  return list3 (backtrace_object (slot->backtrace),
-                make_number (slot->count),
-                make_number (slot->elapsed));
-}
-
-
-
-/* Slot heaps.  */
-
-struct slot_heap
-{
-  /* Number of slots allocated to the heap.  */
-  unsigned int size;
-  /* Actual data area.  */
-  struct slot *data;
-  /* Free list.  */
-  struct slot *free_list;
-};
-
-static void
-clear_slot_heap (struct slot_heap *heap)
-{
-  int i;
-  struct slot *data;
-  struct slot *free_list;
-
-  data = heap->data;
-
-  /* Mark all slots unsused.  */
-  for (i = 0; i < heap->size; i++)
-    data[i].used = 0;
-
-  /* Rebuild a free list.  */
-  free_list = heap->free_list = heap->data;
-  for (i = 1; i < heap->size; i++)
     {
-      free_list->next = &data[i];
-      free_list = free_list->next;
+      ptrdiff_t newsize = size / 3;
+      ptrdiff_t start2 = start + newsize;
+      EMACS_INT i1 = approximate_median (log, start, newsize);
+      EMACS_INT i2 = approximate_median (log, start2, newsize);
+      EMACS_INT i3 = approximate_median (log, start2 + newsize,
+                                         size - 2 * newsize);
+      return (i1 < i2
+              ? (i2 < i3 ? i2 : (i1 < i3 ? i3 : i1))
+              : (i1 < i3 ? i1 : (i2 < i3 ? i3 : i2)));
     }
-  free_list->next = 0;
 }
 
-/* Make a slot heap with SIZE.  MAX_STACK_DEPTH is a fixed size of
-   allocated slots.  */
-
-static struct slot_heap *
-make_slot_heap (unsigned int size, int max_stack_depth)
+static void evict_lower_half (log_t *log)
 {
-  int i;
-  struct slot_heap *heap;
-  struct slot *data;
+  ptrdiff_t size = ASIZE (log->key_and_value) / 2;
+  EMACS_INT median = approximate_median (log, 0, size);
+  ptrdiff_t i;
 
-  data = (struct slot *) xmalloc (sizeof (struct slot) * size);
   for (i = 0; i < size; i++)
-    data[i].backtrace = make_backtrace (max_stack_depth);
-
-  heap = (struct slot_heap *) xmalloc (sizeof (struct slot_heap));
-  heap->size = size;
-  heap->data = data;
-  clear_slot_heap (heap);
-
-  return heap;
-}
-
-static void
-free_slot_heap (struct slot_heap *heap)
-{
-  int i;
-  struct slot *data = heap->data;
-  for (i = 0; i < heap->size; i++)
-    data[i].backtrace = Qnil;
-  xfree (data);
-  xfree (heap);
-}
-
-static void
-mark_slot_heap (struct slot_heap *heap)
-{
-  int i;
-  for (i = 0; i < heap->size; i++)
-    mark_slot (&heap->data[i]);
-}
-
-/* Allocate one slot from HEAP.  Return 0 if no free slot in HEAP.  */
-
-static struct slot *
-allocate_slot (struct slot_heap *heap)
-{
-  struct slot *slot;
-  if (!heap->free_list)
-    return 0;
-  slot = heap->free_list;
-  slot->count = 0;
-  slot->elapsed = 0;
-  slot->used = 1;
-  heap->free_list = heap->free_list->next;
-  return slot;
-}
-
-static void
-free_slot (struct slot_heap *heap, struct slot *slot)
-{
-  eassert (slot->used);
-  slot->used = 0;
-  slot->next = heap->free_list;
-  heap->free_list = slot;
-}
-
-/* Return a minimal slot from HEAP.  "Minimal" means that such a slot
-   is meaningless for profiling.  */
-
-static struct slot *
-min_slot (struct slot_heap *heap)
-{
-  int i;
-  struct slot *min = 0;
-  for (i = 0; i < heap->size; i++)
-    {
-      struct slot *slot = &heap->data[i];
-      if (!min || (slot->used && slot->count < min->count))
-        min = slot;
-    }
-  return min;
-}
-
-
-/* Slot hash tables.  */
-
-struct slot_table
-{
-  /* Number of slot buckets.  */
-  unsigned int size;
-  /* Buckets data area.  */
-  struct slot **data;
-};
-
-static void
-clear_slot_table (struct slot_table *table)
-{
-  int i;
-  for (i = 0; i < table->size; i++)
-    table->data[i] = 0;
-}
-
-static struct slot_table *
-make_slot_table (int size)
-{
-  struct slot_table *table
-    = (struct slot_table *) xmalloc (sizeof (struct slot_table));
-  table->size = size;
-  table->data = (struct slot **) xmalloc (sizeof (struct slot *) * size);
-  clear_slot_table (table);
-  return table;
-}
-
-static void
-free_slot_table (struct slot_table *table)
-{
-  xfree (table->data);
-  xfree (table);
-}
-
-static void
-remove_slot (struct slot_table *table, struct slot *slot)
-{
-  if (slot->prev)
-    slot->prev->next = slot->next;
-  else
-    {
-      EMACS_UINT hash = backtrace_hash (slot->backtrace);
-      table->data[hash % table->size] = slot->next;
-    }
-  if (slot->next)
-    slot->next->prev = slot->prev;
-}
-
-
-/* Logs.  */
-
-struct log
-{
-  /* Type of log in symbol.  `sample' or `memory'.  */
-  Lisp_Object type;
-  /* Backtrace for working.  */
-  Lisp_Object backtrace;
-  struct slot_heap *slot_heap;
-  struct slot_table *slot_table;
-  size_t others_count;
-  size_t others_elapsed;
-};
-
-static struct log *
-make_log (const char *type, int heap_size, int max_stack_depth)
-{
-  struct log *log =
-    (struct log *) xmalloc (sizeof (struct log));
-  log->type = intern (type);
-  log->backtrace = make_backtrace (max_stack_depth);
-  log->slot_heap = make_slot_heap (heap_size, max_stack_depth);
-  /* Number of buckets of hash table will be 10% of HEAP_SIZE.  */
-  log->slot_table = make_slot_table (max (256, heap_size) / 10);
-  log->others_count = 0;
-  log->others_elapsed = 0;
-  return log;
-}
-
-static void
-free_log (struct log *log)
-{
-  log->backtrace = Qnil;
-  free_slot_heap (log->slot_heap);
-  free_slot_table (log->slot_table);
-}
-
-static void
-mark_log (struct log *log)
-{
-  mark_object (log->type);
-  mark_object (log->backtrace);
-  mark_slot_heap (log->slot_heap);
-}
-
-static void
-clear_log (struct log *log)
-{
-  clear_slot_heap (log->slot_heap);
-  clear_slot_table (log->slot_table);
-  log->others_count = 0;
-  log->others_elapsed = 0;
-}
-
-/* Evint SLOT from LOG and accumulate the slot counts into others
-   counts.  */
-
-static void
-evict_slot (struct log *log, struct slot *slot)
-{
-  log->others_count += slot->count;
-  log->others_elapsed += slot->elapsed;
-  remove_slot (log->slot_table, slot);
-  free_slot (log->slot_heap, slot);
-}
-
-/* Evict a minimal slot from LOG.  */
-
-static void
-evict_min_slot (struct log *log)
-{
-  struct slot *min = min_slot (log->slot_heap);
-  if (min)
-    evict_slot (log, min);
-}
-
-/* Allocate a new slot for BACKTRACE from LOG.  The returen value must
-   be a valid pointer to the slot.  */
-
-static struct slot *
-new_slot (struct log *log, Lisp_Object backtrace)
-{
-  int i;
-  struct slot *slot = allocate_slot (log->slot_heap);
-
-  /* If failed to allocate a slot, free some slots to make a room in
-     heap.  */
-  if (!slot)
-    {
-      evict_min_slot (log);
-      slot = allocate_slot (log->slot_heap);
-      /* Must be allocated.  */
-      eassert (slot);
-    }
-
-  slot->prev = 0;
-  slot->next = 0;
-
-  /* Assign BACKTRACE to the slot.  */
-  for (i = 0; i < ASIZE (backtrace); i++)
-    ASET (slot->backtrace, i, AREF (backtrace, i));
-
-  return slot;
-}
-
-/* Make sure that a slot for BACKTRACE is in LOG and return the
-   slot. The return value must be a valid pointer to the slot.  */
-
-static struct slot *
-ensure_slot (struct log *log, Lisp_Object backtrace)
-{
-  EMACS_UINT hash = backtrace_hash (backtrace);
-  int index = hash % log->slot_table->size;
-  struct slot *slot = log->slot_table->data[index];
-  struct slot *prev = slot;
-
-  /* Looking up in hash table bucket.  */
-  while (slot)
-    {
-      if (backtrace_equal (backtrace, slot->backtrace))
-        goto found;
-      prev = slot;
-      slot = slot->next;
-    }
-
-  /* If not found, allocate a new slot for BACKTRACE from LOG and link
-     it with bucket chain.  */
-  slot = new_slot (log, backtrace);
-  if (prev)
-    {
-      slot->prev = prev;
-      prev->next = slot;
-    }
-  else
-    log->slot_table->data[index] = slot;
-
- found:
-  return slot;
+    /* Evict not only values smaller but also values equal to the median,
+       so as to make sure we evict something no matter what.  */
+    if (XINT (HASH_VALUE (log, i)) <= median)
+      {
+        Lisp_Object key = HASH_KEY (log, i);
+        { /* FIXME: we could make this more efficient.  */
+          Lisp_Object tmp;
+          XSET_HASH_TABLE (tmp, log); /* FIXME: Use make_lisp_ptr.  */
+          Fremhash (key, tmp);
+        }
+        eassert (EQ (log->next_free, make_number (i)));
+        {
+          int j;
+          eassert (VECTORP (key));
+          for (j = 0; j < ASIZE (key); j++)
+            ASET (key, i, Qnil);
+        }
+        set_hash_key_slot (log, i, key);
+      }
 }
 
 /* Record the current backtrace in LOG. BASE is a special name for
@@ -738,83 +139,60 @@ ensure_slot (struct log *log, Lisp_Object backtrace)
    took.  */
 
 static void
-record_backtrace_under (struct log *log, Lisp_Object base,
-                        size_t count, size_t elapsed)
+record_backtrace (log_t *log, size_t count)
 {
-  int i = 0;
-  Lisp_Object backtrace = log->backtrace;
   struct backtrace *backlist = backtrace_list;
+  Lisp_Object backtrace;
+  ptrdiff_t index, i = 0;
+  ptrdiff_t asize;
 
-  /* First of all, apply filter on the bactkrace.  */
-  if (!apply_filter (backlist)) return;
+  if (!INTEGERP (log->next_free))
+    evict_lower_half (log);
+  index = XINT (log->next_free);
 
-  /* Record BASE if necessary.  */
-  if (!NILP (base) && ASIZE (backtrace) > 0)
-    ASET (backtrace, i++, base);
+  /* Get a "working memory" vector.  */
+  backtrace = HASH_KEY (log, index);
+  asize = ASIZE (backtrace);
 
   /* Copy the backtrace contents into working memory.  */
-  for (; i < ASIZE (backtrace) && backlist; backlist = backlist->next)
-    {
-      Lisp_Object function = *backlist->function;
-      if (FUNCTIONP (function))
-        ASET (backtrace, i++, function);
-    }
-  /* Make sure that unused space of working memory is filled with
-     nil.  */
-  for (; i < ASIZE (backtrace); i++)
-    ASET (backtrace, i, Qnil);
-
-  /* If the backtrace is not empty, */
-  if (!NILP (AREF (backtrace, 0)))
-    {
-      /* then record counts.  */
-      struct slot *slot = ensure_slot (log, backtrace);
-      slot->count += count;
-      slot->elapsed += elapsed;
-    }
-}
-
-static void
-record_backtrace (struct log *log, size_t count, size_t elapsed)
-{
-  record_backtrace_under (log, Qnil, count, elapsed);
-}
-
-/* Convert LOG to a list.  */
+  for (; i < asize && backlist; i++, backlist = backlist->next)
+    ASET (backtrace, i, *backlist->function);
 
-static Lisp_Object
-log_object (struct log *log)
-{
-  int i;
-  Lisp_Object slots = Qnil;
-
-  if (log->others_count != 0 || log->others_elapsed != 0)
-    {
-      /* Add others slot.  */
-      Lisp_Object others_slot
-        = list3 (list1 (Qt),
-                 make_number (log->others_count),
-                 make_number (log->others_elapsed));
-      slots = list1 (others_slot);
-    }
-
-  for (i = 0; i < log->slot_heap->size; i++)
-    {
-      struct slot *s = &log->slot_heap->data[i];
-      if (s->used)
-        {
-          Lisp_Object slot = slot_object (s);
-          slots = Fcons (slot, slots);
-        }
-    }
+  /* Make sure that unused space of working memory is filled with nil.  */
+  for (; i < asize; i++)
+    ASET (backtrace, i, Qnil);
 
-  return list4 (log->type, Qnil, Fcurrent_time (), slots);
+  { /* We basically do a `gethash+puthash' here, except that we have to be
+       careful to avoid memory allocation since we're in a signal
+       handler, and we optimize the code to try and avoid computing the
+       hash+lookup twice.  See fns.c:Fputhash for reference.  */
+    EMACS_UINT hash;
+    ptrdiff_t j = hash_lookup (log, backtrace, &hash);
+    if (j >= 0)
+      set_hash_value_slot (log, j,
+                           make_number (count + XINT (HASH_VALUE (log, j))));
+    else
+      { /* BEWARE!  hash_put in general can allocate memory.
+           But currently it only does that if log->next_free is nil.  */
+        int j;
+        eassert (!NILP (log->next_free));
+        j = hash_put (log, backtrace, make_number (count), hash);
+        /* Let's make sure we've put `backtrace' right where it
+           already was to start with.  */
+        eassert (index == j);
+
+        /* FIXME: If the hash-table is almost full, we should set
+           some global flag so that some Elisp code can offload its
+           data elsewhere, so as to avoid the eviction code.  */
+      }
+  }
 }
-
 
 /* Sample profiler.  */
 
-static struct log *sample_log;
+static Lisp_Object cpu_log;
+/* Separate counter for the time spent in the GC.  */
+static EMACS_INT cpu_gc_count;
 
 /* The current sample interval in millisecond.  */
 
@@ -833,10 +211,12 @@ take samples each SAMPLE-INTERVAL in millisecond.  See also
   if (sample_profiler_running)
     error ("Sample profiler is already running");
 
-  if (!sample_log)
-    sample_log = make_log ("sample",
-                           profiler_slot_heap_size,
-                           profiler_max_stack_depth);
+  if (NILP (cpu_log))
+    {
+      cpu_gc_count = 0;
+      cpu_log = make_log (profiler_slot_heap_size,
+                          profiler_max_stack_depth);
+    }
 
   current_sample_interval = XINT (sample_interval);
 
@@ -869,27 +249,6 @@ DEFUN ("sample-profiler-stop", Fsample_profiler_stop, Ssample_profiler_stop,
   return Qt;
 }
 
-DEFUN ("sample-profiler-reset", Fsample_profiler_reset, Ssample_profiler_reset,
-       0, 0, 0,
-       doc: /* Clear sample profiler log.  */)
-  (void)
-{
-  if (sample_log)
-    {
-      if (sample_profiler_running)
-        {
-          block_sigprof ();
-          clear_log (sample_log);
-          unblock_sigprof ();
-        }
-      else
-        {
-          free_log (sample_log);
-          sample_log = 0;
-        }
-    }
-}
-
 DEFUN ("sample-profiler-running-p",
        Fsample_profiler_running_p, Ssample_profiler_running_p,
        0, 0, 0,
@@ -907,28 +266,24 @@ DEFUN ("sample-profiler-log",
 log is collected and SLOTS is a list of slots.  */)
   (void)
 {
-  int i;
-  Lisp_Object result = Qnil;
-
-  if (sample_log)
-    {
-      if (sample_profiler_running)
-        {
-          block_sigprof ();
-          result = log_object (sample_log);
-          unblock_sigprof ();
-        }
-      else
-        result = log_object (sample_log);
-    }
-
+  Lisp_Object result = cpu_log;
+  /* Here we're making the log visible to Elisp , so it's not safe any
+     more for our use afterwards since we can't rely on its special
+     pre-allocated keys anymore.  So we have to allocate a new one.  */
+  cpu_log = (sample_profiler_running
+             ? make_log (profiler_slot_heap_size, profiler_max_stack_depth)
+             : Qnil);
+  Fputhash (Fmake_vector (make_number (1), Qautomatic_gc),
+            make_number (cpu_gc_count),
+            result);
+  cpu_gc_count = 0;
   return result;
 }
 
 
 /* Memory profiler.  */
 
-static struct log *memory_log;
+static Lisp_Object memory_log;
 
 DEFUN ("memory-profiler-start", Fmemory_profiler_start, Smemory_profiler_start,
        0, 0, 0,
@@ -939,9 +294,8 @@ DEFUN ("memory-profiler-start", Fmemory_profiler_start, Smemory_profiler_start,
   if (memory_profiler_running)
     error ("Memory profiler is already running");
 
-  if (!memory_log)
-    memory_log = make_log ("memory",
-                           profiler_slot_heap_size,
+  if (NILP (memory_log))
+    memory_log = make_log (profiler_slot_heap_size,
                            profiler_max_stack_depth);
 
   memory_profiler_running = 1;
@@ -962,24 +316,6 @@ DEFUN ("memory-profiler-stop",
   return Qt;
 }
 
-DEFUN ("memory-profiler-reset",
-       Fmemory_profiler_reset, Smemory_profiler_reset,
-       0, 0, 0,
-       doc: /* Clear memory profiler log.  */)
-  (void)
-{
-  if (memory_log)
-    {
-      if (memory_profiler_running)
-        clear_log (memory_log);
-      else
-        {
-          free_log (memory_log);
-          memory_log = 0;
-        }
-    }
-}
-
 DEFUN ("memory-profiler-running-p",
        Fmemory_profiler_running_p, Smemory_profiler_running_p,
        0, 0, 0,
@@ -997,11 +333,13 @@ DEFUN ("memory-profiler-log",
 log is collected and SLOTS is a list of slots.  */)
   (void)
 {
-  Lisp_Object result = Qnil;
-
-  if (memory_log)
-    result = log_object (memory_log);
-
+  Lisp_Object result = memory_log;
+  /* Here we're making the log visible to Elisp , so it's not safe any
+     more for our use afterwards since we can't rely on its special
+     pre-allocated keys anymore.  So we have to allocate a new one.  */
+  memory_log = (memory_profiler_running
+                ? make_log (profiler_slot_heap_size, profiler_max_stack_depth)
+                : Qnil);
   return result;
 }
 
@@ -1013,73 +351,31 @@ log is collected and SLOTS is a list of slots.  */)
 static void
 sigprof_handler (int signal, siginfo_t *info, void *ctx)
 {
-  if (!is_in_trace && sample_log)
-    record_backtrace (sample_log, 1, current_sample_interval);
-}
-
-static void
-block_sigprof (void)
-{
-  sigset_t sigset;
-  sigemptyset (&sigset);
-  sigaddset (&sigset, SIGPROF);
-  sigprocmask (SIG_BLOCK, &sigset, 0);
-}
-
-static void
-unblock_sigprof (void)
-{
-  sigset_t sigset;
-  sigemptyset (&sigset);
-  sigaddset (&sigset, SIGPROF);
-  sigprocmask (SIG_UNBLOCK, &sigset, 0);
+  eassert (HASH_TABLE_P (cpu_log));
+  if (backtrace_list && EQ (*backtrace_list->function, Qautomatic_gc))
+    /* Special case the time-count inside GC because the hash-table
+       code is not prepared to be used while the GC is running.
+       More specifically it uses ASIZE at many places where it does
+       not expect the ARRAY_MARK_FLAG to be set.  We could try and
+       harden the hash-table code, but it doesn't seem worth the
+       effort.  */
+    cpu_gc_count += current_sample_interval;
+  else
+    record_backtrace (XHASH_TABLE (cpu_log), current_sample_interval);
 }
 
 /* Record that the current backtrace allocated SIZE bytes.  */
-
+/* FIXME: Inline it everywhere!  */
 void
 malloc_probe (size_t size)
 {
-  if (memory_log)
-    record_backtrace (memory_log, size, 0);
-}
-
-/* Record that GC happened in the current backtrace.  */
-
-void
-gc_probe (size_t size, size_t elapsed)
-{
-  if (sample_log)
-    record_backtrace_under (sample_log, Qgc, 1, elapsed);
-  if (memory_log)
-    record_backtrace_under (memory_log, Qgc, size, elapsed);
-}
-
-
-
-void
-mark_profiler (void)
-{
-  if (sample_log)
-    {
-      if (sample_profiler_running)
-        {
-          block_sigprof ();
-          mark_log (sample_log);
-          unblock_sigprof ();
-        }
-      else
-        mark_log (sample_log);  
-    }
-  if (memory_log)
-    mark_log (memory_log);
+  if (HASH_TABLE_P (memory_log))
+    record_backtrace (XHASH_TABLE (memory_log), size);
 }
 
 void
 syms_of_profiler (void)
 {
-  DEFSYM (Qgc, "gc");
-
   DEFVAR_INT ("profiler-max-stack-depth", profiler_max_stack_depth,
               doc: /* FIXME */);
   profiler_max_stack_depth = 16;
@@ -1087,17 +383,19 @@ syms_of_profiler (void)
               doc: /* FIXME */);
   profiler_slot_heap_size = 10000;
 
-  defsubr (&Sprofiler_set_filter_pattern);
+  cpu_log = memory_log = Qnil;
+  staticpro (&cpu_log);
+  staticpro (&memory_log);
 
+  /* FIXME: Rename things to start with "profiler-", to use "cpu" instead of
+     "sample", and to make them sound like they're internal or something.  */
   defsubr (&Ssample_profiler_start);
   defsubr (&Ssample_profiler_stop);
-  defsubr (&Ssample_profiler_reset);
   defsubr (&Ssample_profiler_running_p);
   defsubr (&Ssample_profiler_log);
 
   defsubr (&Smemory_profiler_start);
   defsubr (&Smemory_profiler_stop);
-  defsubr (&Smemory_profiler_reset);
   defsubr (&Smemory_profiler_running_p);
   defsubr (&Smemory_profiler_log);
 }
diff --git a/src/xdisp.c b/src/xdisp.c
index f5edb4b16f8..ccfa251fd1c 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -333,10 +333,10 @@ static Lisp_Object Qinhibit_eval_during_redisplay;
 static Lisp_Object Qbuffer_position, Qposition, Qobject;
 static Lisp_Object Qright_to_left, Qleft_to_right;
 
-/* Cursor shapes */
+/* Cursor shapes.  */
 Lisp_Object Qbar, Qhbar, Qbox, Qhollow;
 
-/* Pointer shapes */
+/* Pointer shapes.  */
 static Lisp_Object Qarrow, Qhand;
 Lisp_Object Qtext;
 
@@ -347,6 +347,7 @@ static Lisp_Object Qfontification_functions;
 
 static Lisp_Object Qwrap_prefix;
 static Lisp_Object Qline_prefix;
+static Lisp_Object Qautomatic_redisplay;
 
 /* Non-nil means don't actually do any redisplay.  */
 
@@ -12931,12 +12932,13 @@ redisplay_internal (void)
   struct frame *sf;
   int polling_stopped_here = 0;
   Lisp_Object old_frame = selected_frame;
+  struct backtrace backtrace;
 
   /* Non-zero means redisplay has to consider all windows on all
      frames.  Zero means, only selected_window is considered.  */
   int consider_all_windows_p;
 
-  /* Non-zero means redisplay has to redisplay the miniwindow */
+  /* Non-zero means redisplay has to redisplay the miniwindow.  */
   int update_miniwindow_p = 0;
 
   TRACE ((stderr, "redisplay_internal %d\n", redisplaying_p));
@@ -12974,6 +12976,14 @@ redisplay_internal (void)
   ++redisplaying_p;
   specbind (Qinhibit_free_realized_faces, Qnil);
 
+  /* Record this function, so it appears on the profiler's backtraces.  */
+  backtrace.next = backtrace_list;
+  backtrace.function = &Qautomatic_redisplay;
+  backtrace.args = &Qautomatic_redisplay;
+  backtrace.nargs = 0;
+  backtrace.debug_on_exit = 0;
+  backtrace_list = &backtrace;
+
   {
     Lisp_Object tail, frame;
 
@@ -13671,6 +13681,7 @@ redisplay_internal (void)
 #endif /* HAVE_WINDOW_SYSTEM */
 
  end_of_redisplay:
+  backtrace_list = backtrace.next;
   unbind_to (count, Qnil);
   RESUME_POLLING;
 }
@@ -28696,6 +28707,7 @@ syms_of_xdisp (void)
   staticpro (&Vmessage_stack);
 
   DEFSYM (Qinhibit_redisplay, "inhibit-redisplay");
+  DEFSYM (Qautomatic_redisplay, "Automatic Redisplay");
 
   message_dolog_marker1 = Fmake_marker ();
   staticpro (&message_dolog_marker1);