Merge from emacs-24; up to 2012-12-06T01:39:03Z!monnier@iro.umontreal.ca

[bpt/emacs.git] / src / profiler.c

diff --git a/src/profiler.c b/src/profiler.c
index 3282b8b..f6503cf 100644 (file)
--- a/src/profiler.c
+++ b/src/profiler.c
@@ -1,6 +1,6 @@
 /* Profiler implementation.
 
-Copyright (C) 2012 Free Software Foundation, Inc.
+Copyright (C) 2012-2013 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -35,6 +35,9 @@ saturated_add (EMACS_INT a, EMACS_INT b)
 
 typedef struct Lisp_Hash_Table log_t;
 
+static Lisp_Object Qprofiler_backtrace_equal;
+static struct hash_table_test hashtest_profiler;
+
 static Lisp_Object
 make_log (int heap_size, int max_stack_depth)
 {
@@ -42,10 +45,11 @@ make_log (int heap_size, int max_stack_depth)
      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),
+  Lisp_Object log = make_hash_table (hashtest_profiler,
+                                    make_number (heap_size),
                                     make_float (DEFAULT_REHASH_SIZE),
                                     make_float (DEFAULT_REHASH_THRESHOLD),
-                                    Qnil, 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
@@ -204,7 +208,7 @@ record_backtrace (log_t *log, EMACS_INT count)
 
 /* The profiler timer and whether it was properly initialized, if
    POSIX timers are available.  */
-#ifdef HAVE_TIMER_SETTIME
+#ifdef HAVE_ITIMERSPEC
 static timer_t profiler_timer;
 static bool profiler_timer_ok;
 #endif
@@ -239,7 +243,7 @@ handle_profiler_signal (int signal)
   else
     {
       EMACS_INT count = 1;
-#ifdef HAVE_TIMER_SETTIME
+#ifdef HAVE_ITIMERSPEC
       if (profiler_timer_ok)
        {
          int overruns = timer_getoverrun (profiler_timer);
@@ -279,7 +283,7 @@ setup_cpu_timer (Lisp_Object sampling_interval)
   emacs_sigaction_init (&action, deliver_profiler_signal);
   sigaction (SIGPROF, &action, 0);
 
-#ifdef HAVE_TIMER_SETTIME
+#ifdef HAVE_ITIMERSPEC
   if (! profiler_timer_ok)
     {
       /* System clocks to try, in decreasing order of desirability.  */
@@ -313,14 +317,18 @@ setup_cpu_timer (Lisp_Object sampling_interval)
     {
       struct itimerspec ispec;
       ispec.it_value = ispec.it_interval = interval;
-      timer_settime (profiler_timer, 0, &ispec, 0);
-      return TIMER_SETTIME_RUNNING;
+      if (timer_settime (profiler_timer, 0, &ispec, 0) == 0)
+       return TIMER_SETTIME_RUNNING;
     }
 #endif
 
+#ifdef HAVE_SETITIMER
   timer.it_value = timer.it_interval = make_timeval (interval);
-  setitimer (ITIMER_PROF, &timer, 0);
-  return SETITIMER_RUNNING;
+  if (setitimer (ITIMER_PROF, &timer, 0) == 0)
+    return SETITIMER_RUNNING;
+#endif
+
+  return NOT_RUNNING;
 }
 
 DEFUN ("profiler-cpu-start", Fprofiler_cpu_start, Sprofiler_cpu_start,
@@ -358,7 +366,7 @@ Return non-nil if the profiler was running.  */)
     case NOT_RUNNING:
       return Qnil;
 
-#ifdef HAVE_TIMER_SETTIME
+#ifdef HAVE_ITIMERSPEC
     case TIMER_SETTIME_RUNNING:
       {
        struct itimerspec disable;
@@ -368,6 +376,7 @@ Return non-nil if the profiler was running.  */)
       break;
 #endif
 
+#ifdef HAVE_SETITIMER
     case SETITIMER_RUNNING:
       {
        struct itimerval disable;
@@ -375,6 +384,7 @@ Return non-nil if the profiler was running.  */)
        setitimer (ITIMER_PROF, &disable, 0);
       }
       break;
+#endif
     }
 
   signal (SIGPROF, SIG_IGN);
@@ -496,6 +506,66 @@ malloc_probe (size_t size)
   record_backtrace (XHASH_TABLE (memory_log), min (size, MOST_POSITIVE_FIXNUM));
 }
 
+DEFUN ("function-equal", Ffunction_equal, Sfunction_equal, 2, 2, 0,
+       doc: /* Return non-nil if F1 and F2 come from the same source.
+Used to determine if different closures are just different instances of
+the same lambda expression, or are really unrelated function.  */)
+     (Lisp_Object f1, Lisp_Object f2)
+{
+  bool res;
+  if (EQ (f1, f2))
+    res = true;
+  else if (COMPILEDP (f1) && COMPILEDP (f2))
+    res = EQ (AREF (f1, COMPILED_BYTECODE), AREF (f2, COMPILED_BYTECODE));
+  else if (CONSP (f1) && CONSP (f2) && CONSP (XCDR (f1)) && CONSP (XCDR (f2))
+          && EQ (Qclosure, XCAR (f1))
+          && EQ (Qclosure, XCAR (f2)))
+    res = EQ (XCDR (XCDR (f1)), XCDR (XCDR (f2)));
+  else
+    res = false;
+  return res ? Qt : Qnil;
+}
+
+static bool
+cmpfn_profiler (struct hash_table_test *t,
+               Lisp_Object bt1, Lisp_Object bt2)
+{
+  if (VECTORP (bt1) && VECTORP (bt2))
+    {
+      ptrdiff_t i, l = ASIZE (bt1);
+      if (l != ASIZE (bt2))
+       return false;
+      for (i = 0; i < l; i++)
+       if (NILP (Ffunction_equal (AREF (bt1, i), AREF (bt2, i))))
+         return false;
+      return true;
+    }
+  else
+    return EQ (bt1, bt2);
+}
+
+static EMACS_UINT
+hashfn_profiler (struct hash_table_test *ht, Lisp_Object bt)
+{
+  if (VECTORP (bt))
+    {
+      EMACS_UINT hash = 0;
+      ptrdiff_t i, l = ASIZE (bt);
+      for (i = 0; i < l; i++)
+       {
+         Lisp_Object f = AREF (bt, i);
+         EMACS_UINT hash1
+           = (COMPILEDP (f) ? XHASH (AREF (f, COMPILED_BYTECODE))
+              : (CONSP (f) && CONSP (XCDR (f)) && EQ (Qclosure, XCAR (f)))
+              ? XHASH (XCDR (XCDR (f))) : XHASH (f));
+         hash = sxhash_combine (hash, hash1);
+       }
+      return (hash & INTMASK);
+    }
+  else
+    return XHASH (bt);
+}
+
 void
 syms_of_profiler (void)
 {
@@ -508,6 +578,16 @@ If the log gets full, some of the least-seen call-stacks will be evicted
 to make room for new entries.  */);
   profiler_log_size = 10000;
 
+  DEFSYM (Qprofiler_backtrace_equal, "profiler-backtrace-equal");
+  {
+    struct hash_table_test test
+      = { Qprofiler_backtrace_equal, Qnil, Qnil,
+         cmpfn_profiler, hashfn_profiler };
+    hashtest_profiler = test;
+  }
+
+  defsubr (&Sfunction_equal);
+
 #ifdef PROFILER_CPU_SUPPORT
   profiler_cpu_running = NOT_RUNNING;
   cpu_log = Qnil;