merge trunk

1 files changed, 62 insertions, 15 deletions

diff --git a/src/alloc.c b/src/alloc.c
index 02ba2f5f9e3..df166b4924a 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -205,6 +205,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.  */
@@ -633,13 +634,13 @@ static void
 malloc_block_input (void)
 {
   if (block_input_in_memory_allocators)
-    BLOCK_INPUT;
+    block_input ();
 }
 static void
 malloc_unblock_input (void)
 {
   if (block_input_in_memory_allocators)
-    UNBLOCK_INPUT;
+    unblock_input ();
 }
 # define MALLOC_BLOCK_INPUT malloc_block_input ()
 # define MALLOC_UNBLOCK_INPUT malloc_unblock_input ()
@@ -648,6 +649,13 @@ malloc_unblock_input (void)
 # define MALLOC_UNBLOCK_INPUT ((void) 0)
 #endif
 
+#define MALLOC_PROBE(size)                      \
+  do {                                          \
+    if (profiler_memory_running)                \
+      malloc_probe (size);                      \
+  } while (0)
+
+
 /* Like malloc but check for no memory and block interrupt input..  */
 
 void *
@@ -661,6 +669,7 @@ xmalloc (size_t size)
 
   if (!val && size)
     memory_full (size);
+  MALLOC_PROBE (size);
   return val;
 }
 
@@ -678,6 +687,7 @@ xzalloc (size_t size)
   if (!val && size)
     memory_full (size);
   memset (val, 0, size);
+  MALLOC_PROBE (size);
   return val;
 }
 
@@ -699,6 +709,7 @@ xrealloc (void *block, size_t size)
 
   if (!val && size)
     memory_full (size);
+  MALLOC_PROBE (size);
   return val;
 }
 
@@ -888,6 +899,7 @@ lisp_malloc (size_t nbytes, enum mem_type type)
   MALLOC_UNBLOCK_INPUT;
   if (!val && nbytes)
     memory_full (nbytes);
+  MALLOC_PROBE (nbytes);
   return val;
 }
 
@@ -1093,6 +1105,8 @@ lisp_align_malloc (size_t nbytes, enum mem_type type)
 
   MALLOC_UNBLOCK_INPUT;
 
+  MALLOC_PROBE (nbytes);
+
   eassert (0 == ((uintptr_t) val) % BLOCK_ALIGN);
   return val;
 }
@@ -5043,6 +5057,23 @@ bounded_number (EMACS_INT number)
   return make_number (min (MOST_POSITIVE_FIXNUM, number));
 }
 
+/* Calculate total bytes of live objects.  */
+
+static size_t
+total_bytes_of_live_objects (void)
+{
+  size_t tot = 0;
+  tot += total_conses  * sizeof (struct Lisp_Cons);
+  tot += total_symbols * sizeof (struct Lisp_Symbol);
+  tot += total_markers * sizeof (union Lisp_Misc);
+  tot += total_string_bytes;
+  tot += total_vector_slots * word_size;
+  tot += total_floats  * sizeof (struct Lisp_Float);
+  tot += total_intervals * sizeof (struct interval);
+  tot += total_strings * sizeof (struct Lisp_String);
+  return tot;
+}
+
 DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "",
        doc: /* Reclaim storage for Lisp objects no longer needed.
 Garbage collection happens automatically if you cons more than
@@ -5068,6 +5099,8 @@ See Info node `(elisp)Garbage Collection'.  */)
   ptrdiff_t count = SPECPDL_INDEX ();
   EMACS_TIME start;
   Lisp_Object retval = Qnil;
+  size_t tot_before = 0;
+  struct backtrace backtrace;
 
   if (abort_on_gc)
     emacs_abort ();
@@ -5077,6 +5110,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 = &Qnil;
+  backtrace.nargs = 0;
+  backtrace.debug_on_exit = 0;
+  backtrace_list = &backtrace;
+
   check_cons_list ();
 
   /* Don't keep undo information around forever.
@@ -5084,6 +5125,9 @@ See Info node `(elisp)Garbage Collection'.  */)
   FOR_EACH_BUFFER (nextb)
     compact_buffer (nextb);
 
+  if (profiler_memory_running)
+    tot_before = total_bytes_of_live_objects ();
+
   start = current_emacs_time ();
 
   /* In case user calls debug_print during GC,
@@ -5125,7 +5169,7 @@ See Info node `(elisp)Garbage Collection'.  */)
   if (garbage_collection_messages)
     message1_nolog ("Garbage collecting...");
 
-  BLOCK_INPUT;
+  block_input ();
 
   shrink_regexp_cache ();
 
@@ -5242,7 +5286,7 @@ See Info node `(elisp)Garbage Collection'.  */)
   dump_zombies ();
 #endif
 
-  UNBLOCK_INPUT;
+  unblock_input ();
 
   check_cons_list ();
 
@@ -5255,16 +5299,7 @@ See Info node `(elisp)Garbage Collection'.  */)
   gc_relative_threshold = 0;
   if (FLOATP (Vgc_cons_percentage))
     { /* Set gc_cons_combined_threshold.  */
-      double tot = 0;
-
-      tot += total_conses  * sizeof (struct Lisp_Cons);
-      tot += total_symbols * sizeof (struct Lisp_Symbol);
-      tot += total_markers * sizeof (union Lisp_Misc);
-      tot += total_string_bytes;
-      tot += total_vector_slots * word_size;
-      tot += total_floats  * sizeof (struct Lisp_Float);
-      tot += total_intervals * sizeof (struct interval);
-      tot += total_strings * sizeof (struct Lisp_String);
+      double tot = total_bytes_of_live_objects ();
 
       tot *= XFLOAT_DATA (Vgc_cons_percentage);
       if (0 < tot)
@@ -5367,6 +5402,17 @@ See Info node `(elisp)Garbage Collection'.  */)
 
   gcs_done++;
 
+  /* Collect profiling data.  */
+  if (profiler_memory_running)
+    {
+      size_t swept = 0;
+      size_t tot_after = total_bytes_of_live_objects ();
+      if (tot_before > tot_after)
+        swept = tot_before - tot_after;
+      malloc_probe (swept);
+    }
+
+  backtrace_list = backtrace.next;
   return retval;
 }
 
@@ -6395,7 +6441,7 @@ die (const char *msg, const char *file, int line)
 {
   fprintf (stderr, "\r\n%s:%d: Emacs fatal error: %s\r\n",
            file, line, msg);
-  fatal_error_backtrace (SIGABRT, INT_MAX);
+  terminate_due_to_signal (SIGABRT, INT_MAX);
 }
 #endif
 
@@ -6527,6 +6573,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");