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.

6 files changed, 229 insertions, 891 deletions

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);