/* Profiler implementation.
-Copyright (C) 2012 Free Software Foundation, Inc.
+Copyright (C) 2012-2013 Free Software Foundation, Inc.
This file is part of GNU Emacs.
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)
{
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
with the vectors we'll put in them. */
int i = ASIZE (h->key_and_value) / 2;
- while (0 < i)
+ while (i > 0)
set_hash_key_slot (h, --i,
Fmake_vector (make_number (max_stack_depth), Qnil));
return log;
}
/* Record the current backtrace in LOG. COUNT is the weight of this
- current backtrace: milliseconds for CPU counts, and the allocation
- size for memory logs. */
+ current backtrace: interrupt counts for CPU, and the allocation
+ size for memory. */
static void
record_backtrace (log_t *log, EMACS_INT count)
{
- struct backtrace *backlist = backtrace_list;
Lisp_Object backtrace;
- ptrdiff_t index, i = 0;
- ptrdiff_t asize;
+ ptrdiff_t index;
if (!INTEGERP (log->next_free))
/* FIXME: transfer the evicted counts to a special entry rather
/* Get a "working memory" vector. */
backtrace = HASH_KEY (log, index);
- asize = ASIZE (backtrace);
-
- /* Copy the backtrace contents into working memory. */
- for (; i < asize && backlist; i++, backlist = backlist->next)
- /* FIXME: For closures we should ignore the environment. */
- ASET (backtrace, i, backlist->function);
-
- /* Make sure that unused space of working memory is filled with nil. */
- for (; i < asize; i++)
- ASET (backtrace, i, Qnil);
+ get_backtrace (backtrace);
{ /* We basically do a `gethash+puthash' here, except that we have to be
careful to avoid memory allocation since we're in a signal
}
}
\f
-/* Sample profiler. */
+/* Sampling profiler. */
#ifdef PROFILER_CPU_SUPPORT
/* 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
/* Separate counter for the time spent in the GC. */
static EMACS_INT cpu_gc_count;
-/* The current sample interval in milliseconds. */
-static EMACS_INT current_sample_interval;
+/* The current sampling interval in nanoseconds. */
+static EMACS_INT current_sampling_interval;
-/* Signal handler for sample profiler. */
+/* Signal handler for sampling profiler. */
static void
handle_profiler_signal (int signal)
{
- if (backtrace_list && EQ (backtrace_list->function, Qautomatic_gc))
+ if (EQ (backtrace_top_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 = saturated_add (cpu_gc_count, current_sample_interval);
+ cpu_gc_count = saturated_add (cpu_gc_count, 1);
else
{
+ EMACS_INT count = 1;
+#ifdef HAVE_ITIMERSPEC
+ if (profiler_timer_ok)
+ {
+ int overruns = timer_getoverrun (profiler_timer);
+ eassert (overruns >= 0);
+ count += overruns;
+ }
+#endif
eassert (HASH_TABLE_P (cpu_log));
- record_backtrace (XHASH_TABLE (cpu_log), current_sample_interval);
+ record_backtrace (XHASH_TABLE (cpu_log), count);
}
}
}
static enum profiler_cpu_running
-setup_cpu_timer (Lisp_Object sample_interval)
+setup_cpu_timer (Lisp_Object sampling_interval)
{
struct sigaction action;
struct itimerval timer;
struct timespec interval;
+ int billion = 1000000000;
- if (! RANGED_INTEGERP (1, sample_interval,
- (TYPE_MAXIMUM (time_t) < EMACS_INT_MAX / 1000
- ? (EMACS_INT) TYPE_MAXIMUM (time_t) * 1000 + 999
+ if (! RANGED_INTEGERP (1, sampling_interval,
+ (TYPE_MAXIMUM (time_t) < EMACS_INT_MAX / billion
+ ? ((EMACS_INT) TYPE_MAXIMUM (time_t) * billion
+ + (billion - 1))
: EMACS_INT_MAX)))
return NOT_RUNNING;
- current_sample_interval = XINT (sample_interval);
- interval = make_emacs_time (current_sample_interval / 1000,
- current_sample_interval % 1000 * 1000000);
+ current_sampling_interval = XINT (sampling_interval);
+ interval = make_timespec (current_sampling_interval / billion,
+ current_sampling_interval % billion);
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. */
{
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,
1, 1, 0,
doc: /* Start or restart the cpu profiler.
-It takes call-stack samples each SAMPLE-INTERVAL milliseconds.
+It takes call-stack samples each SAMPLING-INTERVAL nanoseconds, approximately.
See also `profiler-log-size' and `profiler-max-stack-depth'. */)
- (Lisp_Object sample_interval)
+ (Lisp_Object sampling_interval)
{
if (profiler_cpu_running)
- error ("Sample profiler is already running");
+ error ("CPU profiler is already running");
if (NILP (cpu_log))
{
profiler_max_stack_depth);
}
- profiler_cpu_running = setup_cpu_timer (sample_interval);
+ profiler_cpu_running = setup_cpu_timer (sampling_interval);
if (! profiler_cpu_running)
- error ("Invalid sample interval");
+ error ("Invalid sampling interval");
return Qt;
}
case NOT_RUNNING:
return Qnil;
-#ifdef HAVE_TIMER_SETTIME
+#ifdef HAVE_ITIMERSPEC
case TIMER_SETTIME_RUNNING:
{
struct itimerspec disable;
break;
#endif
+#ifdef HAVE_SETITIMER
case SETITIMER_RUNNING:
{
struct itimerval disable;
setitimer (ITIMER_PROF, &disable, 0);
}
break;
+#endif
}
signal (SIGPROF, SIG_IGN);
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 SXHASH_REDUCE (hash);
+ }
+ else
+ return XHASH (bt);
+}
+
void
syms_of_profiler (void)
{
to make room for new entries. */);
profiler_log_size = 10000;
+ DEFSYM (Qprofiler_backtrace_equal, "profiler-backtrace-equal");
+
+ hashtest_profiler.name = Qprofiler_backtrace_equal;
+ hashtest_profiler.user_hash_function = Qnil;
+ hashtest_profiler.user_cmp_function = Qnil;
+ hashtest_profiler.cmpfn = cmpfn_profiler;
+ hashtest_profiler.hashfn = hashfn_profiler;
+
+ defsubr (&Sfunction_equal);
+
#ifdef PROFILER_CPU_SUPPORT
profiler_cpu_running = NOT_RUNNING;
cpu_log = Qnil;