Add GC profiler.

3 files changed, 89 insertions, 27 deletions

diff --git a/src/alloc.c b/src/alloc.c
index 3a4a8de90f5..389da29a533 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -5380,6 +5380,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
@@ -5405,6 +5422,7 @@ See Info node `(elisp)Garbage Collection'.  */)
   ptrdiff_t count = SPECPDL_INDEX ();
   EMACS_TIME start;
   Lisp_Object retval = Qnil;
+  size_t tot_before = 0;
 
   if (abort_on_gc)
     abort ();
@@ -5421,6 +5439,9 @@ See Info node `(elisp)Garbage Collection'.  */)
   FOR_EACH_BUFFER (nextb)
     compact_buffer (nextb);
 
+  if (memory_profiler_running)
+    tot_before = total_bytes_of_live_objects ();
+
   start = current_emacs_time ();
 
   /* In case user calls debug_print during GC,
@@ -5467,6 +5488,7 @@ 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.  */
 
@@ -5587,6 +5609,7 @@ 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)
@@ -5595,16 +5618,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)
@@ -5707,6 +5721,25 @@ See Info node `(elisp)Garbage Collection'.  */)
 
   gcs_done++;
 
+  /* Collect profiling data.  */
+  if (sample_profiler_running || 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);
+    }
+
   return retval;
 }
 
diff --git a/src/lisp.h b/src/lisp.h
index b4cead003c2..a979d45b49f 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3532,12 +3532,18 @@ void syms_of_dbusbind (void);
 /* Defined in profiler.c */
 extern int sample_profiler_running;
 extern int memory_profiler_running;
+extern int is_in_trace;
+extern Lisp_Object Qgc;
 extern void malloc_probe (size_t);
-#define MALLOC_PROBE(size)              \
-  do {                                  \
-    if (memory_profiler_running)        \
-      malloc_probe (size);              \
+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);
 
diff --git a/src/profiler.c b/src/profiler.c
index 56458c64b85..c26761148df 100644
--- a/src/profiler.c
+++ b/src/profiler.c
@@ -25,6 +25,9 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include <setjmp.h>
 #include "lisp.h"
 
+int is_in_trace;
+Lisp_Object Qgc;
+
 static void sigprof_handler (int, siginfo_t *, void *);
 static void block_sigprof (void);
 static void unblock_sigprof (void);
@@ -350,8 +353,8 @@ struct slot
 {
   struct slot *next, *prev;
   Lisp_Object backtrace;
-  unsigned int count;
-  unsigned int elapsed;
+  size_t count;
+  size_t elapsed;
   unsigned char used : 1;
 };
 
@@ -536,8 +539,8 @@ struct log
   Lisp_Object backtrace;
   struct slot_heap *slot_heap;
   struct slot_table *slot_table;
-  unsigned int others_count;
-  unsigned int others_elapsed;
+  size_t others_count;
+  size_t others_elapsed;
 };
 
 static struct log *
@@ -647,22 +650,23 @@ ensure_slot (struct log *log, Lisp_Object backtrace)
 }
 
 static void
-record_backtrace (struct log *log, unsigned int count, unsigned int elapsed)
+record_backtrace_under (struct log *log, Lisp_Object base,
+                        size_t count, size_t elapsed)
 {
-  int i;
+  int i = 0;
   Lisp_Object backtrace = log->backtrace;
   struct backtrace *backlist = backtrace_list;
 
   if (!apply_filter (backlist)) return;
 
-  for (i = 0; i < ASIZE (backtrace) && backlist; backlist = backlist->next)
+  if (!NILP (base) && ASIZE (backtrace) > 0)
+    ASET (backtrace, i++, base);
+
+  for (; i < ASIZE (backtrace) && backlist; backlist = backlist->next)
     {
       Lisp_Object function = *backlist->function;
       if (FUNCTIONP (function))
-        {
-          ASET (backtrace, i, function);
-          i++;
-        }
+        ASET (backtrace, i++, function);
     }
   for (; i < ASIZE (backtrace); i++)
     ASET (backtrace, i, Qnil);
@@ -675,6 +679,12 @@ record_backtrace (struct log *log, unsigned int count, unsigned int elapsed)
     }
 }
 
+static void
+record_backtrace (struct log *log, size_t count, size_t elapsed)
+{
+  record_backtrace_under (log, Qnil, count, elapsed);
+}
+
 static Lisp_Object
 log_object (struct log *log)
 {
@@ -892,7 +902,8 @@ DEFUN ("memory-profiler-log",
 static void
 sigprof_handler (int signal, siginfo_t *info, void *ctx)
 {
-  record_backtrace (sample_log, 1, current_sample_interval);
+  if (!is_in_trace && sample_log)
+    record_backtrace (sample_log, 1, current_sample_interval);
 }
 
 static void
@@ -916,7 +927,17 @@ unblock_sigprof (void)
 void
 malloc_probe (size_t size)
 {
-  record_backtrace (memory_log, size, 0);
+  if (memory_log)
+    record_backtrace (memory_log, size, 0);
+}
+
+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);
 }
 
 
@@ -942,6 +963,8 @@ mark_profiler (void)
 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;