From c2d7786e1272a10c62de7bd1c2d8810e510b3ab1 Mon Sep 17 00:00:00 2001 From: Tomohiro Matsuyama Date: Wed, 22 Aug 2012 15:38:59 +0900 Subject: Add emacs native profiler. --- src/profiler.c | 965 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 965 insertions(+) create mode 100644 src/profiler.c (limited to 'src/profiler.c') diff --git a/src/profiler.c b/src/profiler.c new file mode 100644 index 00000000000..56458c64b85 --- /dev/null +++ b/src/profiler.c @@ -0,0 +1,965 @@ +/* GNU Emacs profiler implementation. + +Copyright (C) 2012 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or +(at your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see . */ + +#include +#include +#include +#include +#include +#include +#include "lisp.h" + +static void sigprof_handler (int, siginfo_t *, void *); +static void block_sigprof (void); +static void unblock_sigprof (void); + +int sample_profiler_running; +int memory_profiler_running; + + + +/* Filters */ + +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); + } +} + +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; +} + +#if 0 +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 + +static struct pattern *filter_pattern; + +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) return; + filter_pattern = parse_pattern (pattern); + + if (sample_profiler_running) + unblock_sigprof (); +} + +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); +} + +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: /* FIXME */) + (Lisp_Object pattern) +{ + if (NILP (pattern)) + { + set_filter_pattern (0); + return Qt; + } + else if (!STRINGP (pattern)) + error ("Invalid type of profiler filter pattern"); + + set_filter_pattern (SDATA (pattern)); + + return Qt; +} + + + +/* Backtraces */ + +static Lisp_Object +make_backtrace (int size) +{ + return Fmake_vector (make_number (size), Qnil); +} + +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; +} + +static int +backtrace_equal (Lisp_Object a, Lisp_Object b) +{ + int i, j; + + 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; + } + + return 1; +} + +static Lisp_Object +backtrace_object_1 (Lisp_Object backtrace, int i) +{ + if (i >= ASIZE (backtrace) || NILP (AREF (backtrace, i))) + return Qnil; + else + return Fcons (AREF (backtrace, i), backtrace_object_1 (backtrace, i + 1)); +} + +static Lisp_Object +backtrace_object (Lisp_Object backtrace) +{ + backtrace_object_1 (backtrace, 0); +} + + + +/* Slots */ + +struct slot +{ + struct slot *next, *prev; + Lisp_Object backtrace; + unsigned int count; + unsigned int elapsed; + unsigned char used : 1; +}; + +static void +mark_slot (struct slot *slot) +{ + mark_object (slot->backtrace); +} + +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 +{ + unsigned int size; + struct slot *data; + 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; + + for (i = 0; i < heap->size; i++) + data[i].used = 0; + + free_list = heap->free_list = heap->data; + for (i = 1; i < heap->size; i++) + { + free_list->next = &data[i]; + free_list = free_list->next; + } + free_list->next = 0; +} + +static struct slot_heap * +make_slot_heap (unsigned int size, int max_stack_depth) +{ + int i; + struct slot_heap *heap; + struct slot *data; + + 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]); +} + +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; +} + +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 tables */ + +struct slot_table +{ + unsigned int size; + 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 +{ + Lisp_Object type; + Lisp_Object backtrace; + struct slot_heap *slot_heap; + struct slot_table *slot_table; + unsigned int others_count; + unsigned int 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); + 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; +} + +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); +} + +static void +evict_min_slot (struct log *log) +{ + struct slot *min = min_slot (log->slot_heap); + if (min) + evict_slot (log, min); +} + +static struct slot * +new_slot (struct log *log, Lisp_Object backtrace) +{ + int i; + struct slot *slot = allocate_slot (log->slot_heap); + + if (!slot) + { + evict_min_slot (log); + slot = allocate_slot (log->slot_heap); + eassert (slot); + } + + slot->prev = 0; + slot->next = 0; + for (i = 0; i < ASIZE (backtrace); i++) + ASET (slot->backtrace, i, AREF (backtrace, i)); + + return 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; + + while (slot) + { + if (backtrace_equal (backtrace, slot->backtrace)) + goto found; + prev = slot; + slot = slot->next; + } + + slot = new_slot (log, backtrace); + if (prev) + { + slot->prev = prev; + prev->next = slot; + } + else + log->slot_table->data[index] = slot; + + found: + return slot; +} + +static void +record_backtrace (struct log *log, unsigned int count, unsigned int elapsed) +{ + int i; + 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) + { + Lisp_Object function = *backlist->function; + if (FUNCTIONP (function)) + { + ASET (backtrace, i, function); + i++; + } + } + for (; i < ASIZE (backtrace); i++) + ASET (backtrace, i, Qnil); + + if (!NILP (AREF (backtrace, 0))) + { + struct slot *slot = ensure_slot (log, backtrace); + slot->count += count; + slot->elapsed += elapsed; + } +} + +static Lisp_Object +log_object (struct log *log) +{ + int i; + Lisp_Object slots = Qnil; + + if (log->others_count != 0 || log->others_elapsed != 0) + slots = list1 (list3 (list1 (Qt), + make_number (log->others_count), + make_number (log->others_elapsed))); + + 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); + } + } + + return list4 (log->type, Qnil, Fcurrent_time (), slots); +} + + + +/* Sample profiler */ + +static struct log *sample_log; +static int current_sample_interval; + +DEFUN ("sample-profiler-start", Fsample_profiler_start, Ssample_profiler_start, + 1, 1, 0, + doc: /* FIXME */) + (Lisp_Object sample_interval) +{ + struct sigaction sa; + struct itimerval timer; + + 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); + + current_sample_interval = XINT (sample_interval); + + sa.sa_sigaction = sigprof_handler; + sa.sa_flags = SA_RESTART | SA_SIGINFO; + sigemptyset (&sa.sa_mask); + sigaction (SIGPROF, &sa, 0); + + timer.it_interval.tv_sec = 0; + timer.it_interval.tv_usec = current_sample_interval * 1000; + timer.it_value = timer.it_interval; + setitimer (ITIMER_PROF, &timer, 0); + + sample_profiler_running = 1; + + return Qt; +} + +DEFUN ("sample-profiler-stop", Fsample_profiler_stop, Ssample_profiler_stop, + 0, 0, 0, + doc: /* FIXME */) + (void) +{ + if (!sample_profiler_running) + error ("Sample profiler is not running"); + sample_profiler_running = 0; + + setitimer (ITIMER_PROF, 0, 0); + + return Qt; +} + +DEFUN ("sample-profiler-reset", Fsample_profiler_reset, Ssample_profiler_reset, + 0, 0, 0, + doc: /* FIXME */) + (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, + doc: /* FIXME */) + (void) +{ + return sample_profiler_running ? Qt : Qnil; +} + +DEFUN ("sample-profiler-log", + Fsample_profiler_log, Ssample_profiler_log, + 0, 0, 0, + doc: /* FIXME */) + (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); + } + + return result; +} + + + +/* Memory profiler */ + +static struct log *memory_log; + +DEFUN ("memory-profiler-start", Fmemory_profiler_start, Smemory_profiler_start, + 0, 0, 0, + doc: /* FIXME */) + (void) +{ + if (memory_profiler_running) + error ("Memory profiler is already running"); + + if (!memory_log) + memory_log = make_log ("memory", + profiler_slot_heap_size, + profiler_max_stack_depth); + + memory_profiler_running = 1; + + return Qt; +} + +DEFUN ("memory-profiler-stop", + Fmemory_profiler_stop, Smemory_profiler_stop, + 0, 0, 0, + doc: /* FIXME */) + (void) +{ + if (!memory_profiler_running) + error ("Memory profiler is not running"); + memory_profiler_running = 0; + + return Qt; +} + +DEFUN ("memory-profiler-reset", + Fmemory_profiler_reset, Smemory_profiler_reset, + 0, 0, 0, + doc: /* FIXME */) + (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, + doc: /* FIXME */) + (void) +{ + return memory_profiler_running ? Qt : Qnil; +} + +DEFUN ("memory-profiler-log", + Fmemory_profiler_log, Smemory_profiler_log, + 0, 0, 0, + doc: /* FIXME */) + (void) +{ + Lisp_Object result = Qnil; + + if (memory_log) + result = log_object (memory_log); + + return result; +} + + + +/* Signals and probes */ + +static void +sigprof_handler (int signal, siginfo_t *info, void *ctx) +{ + 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); +} + +void +malloc_probe (size_t size) +{ + record_backtrace (memory_log, size, 0); +} + + + +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); +} + +void +syms_of_profiler (void) +{ + DEFVAR_INT ("profiler-max-stack-depth", profiler_max_stack_depth, + doc: /* FIXME */); + profiler_max_stack_depth = 16; + DEFVAR_INT ("profiler-slot-heap-size", profiler_slot_heap_size, + doc: /* FIXME */); + profiler_slot_heap_size = 10000; + + defsubr (&Sprofiler_set_filter_pattern); + + 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); +} -- cgit v1.2.1 From 12b3895d742e06ba3999773f0f02328ae7d9880f Mon Sep 17 00:00:00 2001 From: Tomohiro Matsuyama Date: Wed, 22 Aug 2012 21:38:39 +0900 Subject: Add GC profiler. --- src/profiler.c | 49 ++++++++++++++++++++++++++++++++++++------------- 1 file changed, 36 insertions(+), 13 deletions(-) (limited to 'src/profiler.c') 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 . */ #include #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; -- cgit v1.2.1 From 0efc778b8086065f657b8b12f91952ad6b2a8f8c Mon Sep 17 00:00:00 2001 From: Tomohiro Matsuyama Date: Thu, 23 Aug 2012 21:11:12 +0900 Subject: profiler: Refactoring and documentation. --- src/profiler.c | 191 +++++++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 153 insertions(+), 38 deletions(-) (limited to 'src/profiler.c') diff --git a/src/profiler.c b/src/profiler.c index c26761148df..0ef20a9a70c 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -1,4 +1,4 @@ -/* GNU Emacs profiler implementation. +/* Profiler implementation. Copyright (C) 2012 Free Software Foundation, Inc. @@ -25,19 +25,28 @@ along with GNU Emacs. If not, see . */ #include #include "lisp.h" -int is_in_trace; +/* True if sampling profiler is running. */ + +bool sample_profiler_running; + +/* True if memory profiler is 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); -int sample_profiler_running; -int memory_profiler_running; - - -/* Filters */ +/* Pattern matching. */ enum pattern_type { @@ -164,6 +173,7 @@ pattern_match (struct pattern *pattern, const char *string) } } +#if 0 static int match (const char *pattern, const char *string) { @@ -174,7 +184,6 @@ match (const char *pattern, const char *string) return res; } -#if 0 static void should_match (const char *pattern, const char *string) { @@ -222,8 +231,14 @@ pattern_match_tests (void) } #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) { @@ -235,13 +250,17 @@ set_filter_pattern (const char *pattern) free_pattern (filter_pattern); filter_pattern = 0; } - if (!pattern) return; - filter_pattern = parse_pattern (pattern); + 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) { @@ -260,6 +279,9 @@ apply_filter_1 (Lisp_Object function) 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) { @@ -275,12 +297,24 @@ apply_filter (struct backtrace *backlist) DEFUN ("profiler-set-filter-pattern", Fprofiler_set_filter_pattern, Sprofiler_set_filter_pattern, 1, 1, "sPattern: ", - doc: /* FIXME */) + 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)) + if (NILP (pattern) + || (STRINGP (pattern) && !SREF (pattern, 0))) { set_filter_pattern (0); + message ("Profiler filter pattern unset"); return Qt; } else if (!STRINGP (pattern)) @@ -292,8 +326,8 @@ DEFUN ("profiler-set-filter-pattern", } +/* Backtraces. */ -/* Backtraces */ static Lisp_Object make_backtrace (int size) @@ -339,6 +373,8 @@ backtrace_object_1 (Lisp_Object backtrace, int i) return Fcons (AREF (backtrace, i), backtrace_object_1 (backtrace, i + 1)); } +/* Convert BACKTRACE to a list. */ + static Lisp_Object backtrace_object (Lisp_Object backtrace) { @@ -346,15 +382,24 @@ backtrace_object (Lisp_Object backtrace) } +/* Slots. */ -/* Slots */ +/* Slot data structure. */ struct slot { - struct slot *next, *prev; + /* 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; }; @@ -364,6 +409,8 @@ mark_slot (struct slot *slot) mark_object (slot->backtrace); } +/* Convert SLOT to a list. */ + static Lisp_Object slot_object (struct slot *slot) { @@ -374,12 +421,15 @@ slot_object (struct slot *slot) -/* Slot heaps */ +/* 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; }; @@ -392,9 +442,11 @@ clear_slot_heap (struct slot_heap *heap) 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++) { @@ -404,6 +456,9 @@ clear_slot_heap (struct slot_heap *heap) 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) { @@ -442,6 +497,8 @@ mark_slot_heap (struct slot_heap *heap) 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) { @@ -465,6 +522,9 @@ free_slot (struct slot_heap *heap, struct slot *slot) 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) { @@ -480,12 +540,13 @@ min_slot (struct slot_heap *heap) } - -/* Slot tables */ +/* Slot hash tables. */ struct slot_table { + /* Number of slot buckets. */ unsigned int size; + /* Buckets data area. */ struct slot **data; }; @@ -530,12 +591,13 @@ remove_slot (struct slot_table *table, struct slot *slot) } - -/* Logs */ +/* 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; @@ -551,6 +613,7 @@ make_log (const char *type, int heap_size, int max_stack_depth) 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; @@ -582,6 +645,9 @@ clear_log (struct log *log) 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) { @@ -591,6 +657,8 @@ evict_slot (struct log *log, struct slot *slot) free_slot (log->slot_heap, slot); } +/* Evict a minimal slot from LOG. */ + static void evict_min_slot (struct log *log) { @@ -599,27 +667,38 @@ evict_min_slot (struct log *log) 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) { @@ -628,6 +707,7 @@ ensure_slot (struct log *log, Lisp_Object backtrace) 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)) @@ -636,6 +716,8 @@ ensure_slot (struct log *log, Lisp_Object backtrace) 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) { @@ -649,6 +731,12 @@ ensure_slot (struct log *log, Lisp_Object backtrace) return slot; } +/* Record the current backtrace in LOG. BASE is a special name for + describing which the backtrace come from. BASE can be nil. COUNT is + a number how many times the profiler sees the backtrace at the + time. ELAPSED is a elapsed time in millisecond that the backtrace + took. */ + static void record_backtrace_under (struct log *log, Lisp_Object base, size_t count, size_t elapsed) @@ -657,22 +745,29 @@ record_backtrace_under (struct log *log, Lisp_Object base, Lisp_Object backtrace = log->backtrace; struct backtrace *backlist = backtrace_list; + /* First of all, apply filter on the bactkrace. */ if (!apply_filter (backlist)) return; + /* Record BASE if necessary. */ if (!NILP (base) && ASIZE (backtrace) > 0) ASET (backtrace, i++, base); + /* 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; @@ -685,6 +780,8 @@ record_backtrace (struct log *log, size_t count, size_t elapsed) record_backtrace_under (log, Qnil, count, elapsed); } +/* Convert LOG to a list. */ + static Lisp_Object log_object (struct log *log) { @@ -692,9 +789,14 @@ log_object (struct log *log) Lisp_Object slots = Qnil; if (log->others_count != 0 || log->others_elapsed != 0) - slots = list1 (list3 (list1 (Qt), - make_number (log->others_count), - make_number (log->others_elapsed))); + { + /* 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++) { @@ -710,15 +812,19 @@ log_object (struct log *log) } - -/* Sample profiler */ +/* Sample profiler. */ static struct log *sample_log; + +/* The current sample interval in millisecond. */ + static int current_sample_interval; DEFUN ("sample-profiler-start", Fsample_profiler_start, Ssample_profiler_start, 1, 1, 0, - doc: /* FIXME */) + doc: /* Start or restart sample profiler. Sample profiler will +take samples each SAMPLE-INTERVAL in millisecond. See also +`profiler-slot-heap-size' and `profiler-max-stack-depth'. */) (Lisp_Object sample_interval) { struct sigaction sa; @@ -751,7 +857,7 @@ DEFUN ("sample-profiler-start", Fsample_profiler_start, Ssample_profiler_start, DEFUN ("sample-profiler-stop", Fsample_profiler_stop, Ssample_profiler_stop, 0, 0, 0, - doc: /* FIXME */) + doc: /* Stop sample profiler. Profiler log will be kept. */) (void) { if (!sample_profiler_running) @@ -765,7 +871,7 @@ DEFUN ("sample-profiler-stop", Fsample_profiler_stop, Ssample_profiler_stop, DEFUN ("sample-profiler-reset", Fsample_profiler_reset, Ssample_profiler_reset, 0, 0, 0, - doc: /* FIXME */) + doc: /* Clear sample profiler log. */) (void) { if (sample_log) @@ -787,7 +893,7 @@ DEFUN ("sample-profiler-reset", Fsample_profiler_reset, Ssample_profiler_reset, DEFUN ("sample-profiler-running-p", Fsample_profiler_running_p, Ssample_profiler_running_p, 0, 0, 0, - doc: /* FIXME */) + doc: /* Return t if sample profiler is running. */) (void) { return sample_profiler_running ? Qt : Qnil; @@ -796,7 +902,9 @@ DEFUN ("sample-profiler-running-p", DEFUN ("sample-profiler-log", Fsample_profiler_log, Ssample_profiler_log, 0, 0, 0, - doc: /* FIXME */) + doc: /* Return sample profiler log. The data is a list of +(sample nil TIMESTAMP SLOTS), where TIMESTAMP is a timestamp when the +log is collected and SLOTS is a list of slots. */) (void) { int i; @@ -818,14 +926,14 @@ DEFUN ("sample-profiler-log", } - -/* Memory profiler */ +/* Memory profiler. */ static struct log *memory_log; DEFUN ("memory-profiler-start", Fmemory_profiler_start, Smemory_profiler_start, 0, 0, 0, - doc: /* FIXME */) + doc: /* Start/restart memory profiler. See also +`profiler-slot-heap-size' and `profiler-max-stack-depth'. */) (void) { if (memory_profiler_running) @@ -844,7 +952,7 @@ DEFUN ("memory-profiler-start", Fmemory_profiler_start, Smemory_profiler_start, DEFUN ("memory-profiler-stop", Fmemory_profiler_stop, Smemory_profiler_stop, 0, 0, 0, - doc: /* FIXME */) + doc: /* Stop memory profiler. Profiler log will be kept. */) (void) { if (!memory_profiler_running) @@ -857,7 +965,7 @@ DEFUN ("memory-profiler-stop", DEFUN ("memory-profiler-reset", Fmemory_profiler_reset, Smemory_profiler_reset, 0, 0, 0, - doc: /* FIXME */) + doc: /* Clear memory profiler log. */) (void) { if (memory_log) @@ -875,7 +983,7 @@ DEFUN ("memory-profiler-reset", DEFUN ("memory-profiler-running-p", Fmemory_profiler_running_p, Smemory_profiler_running_p, 0, 0, 0, - doc: /* FIXME */) + doc: /* Return t if memory profiler is running. */) (void) { return memory_profiler_running ? Qt : Qnil; @@ -884,7 +992,9 @@ DEFUN ("memory-profiler-running-p", DEFUN ("memory-profiler-log", Fmemory_profiler_log, Smemory_profiler_log, 0, 0, 0, - doc: /* FIXME */) + doc: /* Return memory profiler log. The data is a list of +(memory nil TIMESTAMP SLOTS), where TIMESTAMP is a timestamp when the +log is collected and SLOTS is a list of slots. */) (void) { Lisp_Object result = Qnil; @@ -896,8 +1006,9 @@ DEFUN ("memory-profiler-log", } +/* Signals and probes. */ -/* Signals and probes */ +/* Signal handler for sample profiler. */ static void sigprof_handler (int signal, siginfo_t *info, void *ctx) @@ -924,6 +1035,8 @@ unblock_sigprof (void) sigprocmask (SIG_UNBLOCK, &sigset, 0); } +/* Record that the current backtrace allocated SIZE bytes. */ + void malloc_probe (size_t size) { @@ -931,6 +1044,8 @@ malloc_probe (size_t size) record_backtrace (memory_log, size, 0); } +/* Record that GC happened in the current backtrace. */ + void gc_probe (size_t size, size_t elapsed) { -- cgit v1.2.1 From 3d80c99f3817bf5eccd6acc6a79498a4fde979a4 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 24 Sep 2012 10:38:10 -0400 Subject: 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. --- src/profiler.c | 1030 +++++++++----------------------------------------------- 1 file changed, 164 insertions(+), 866 deletions(-) (limited to 'src/profiler.c') 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); } -- cgit v1.2.1 From ad942b63d7a9b984752f46bc2049fe10e488230d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 24 Sep 2012 17:15:53 -0400 Subject: Try to let it compile on other platforms * src/profiler.c (evict_lower_half): Fix typo. (PROFILER_CPU_SUPPORT): Check and define if cpu-profiler is supported. Don't compile the cpu-profiler code, if not supported. (malloc_probe): Presume memory_log is non-nil. (syms_of_profiler): Don't defsubr functions when they aren't defined. * src/lisp.h (sample_profiler_running, gc_probe): Don't declare. --- src/profiler.c | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) (limited to 'src/profiler.c') diff --git a/src/profiler.c b/src/profiler.c index 5eaaaf3330f..d22ab14e7ce 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -126,7 +126,7 @@ static void evict_lower_half (log_t *log) int j; eassert (VECTORP (key)); for (j = 0; j < ASIZE (key); j++) - ASET (key, i, Qnil); + ASET (key, j, Qnil); } set_hash_key_slot (log, i, key); } @@ -190,6 +190,9 @@ record_backtrace (log_t *log, size_t count) /* Sample profiler. */ +#if defined SIGPROF && defined HAVE_SETITIMER +#define PROFILER_CPU_SUPPORT + static Lisp_Object cpu_log; /* Separate counter for the time spent in the GC. */ static EMACS_INT cpu_gc_count; @@ -279,7 +282,7 @@ log is collected and SLOTS is a list of slots. */) cpu_gc_count = 0; return result; } - +#endif /* Memory profiler. */ @@ -365,12 +368,11 @@ sigprof_handler (int signal, siginfo_t *info, void *ctx) } /* Record that the current backtrace allocated SIZE bytes. */ -/* FIXME: Inline it everywhere! */ void malloc_probe (size_t size) { - if (HASH_TABLE_P (memory_log)) - record_backtrace (XHASH_TABLE (memory_log), size); + eassert (HASH_TABLE_P (memory_log)); + record_backtrace (XHASH_TABLE (memory_log), size); } void @@ -383,17 +385,18 @@ syms_of_profiler (void) doc: /* FIXME */); profiler_slot_heap_size = 10000; - 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. */ +#ifdef PROFILER_CPU_SUPPORT + cpu_log = Qnil; + staticpro (&cpu_log); defsubr (&Ssample_profiler_start); defsubr (&Ssample_profiler_stop); defsubr (&Ssample_profiler_running_p); defsubr (&Ssample_profiler_log); - +#endif + memory_log = Qnil; + staticpro (&memory_log); defsubr (&Smemory_profiler_start); defsubr (&Smemory_profiler_stop); defsubr (&Smemory_profiler_running_p); -- cgit v1.2.1 From 6521894d1aa5a1017dd6f3f55b5e7c11dde5d004 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 24 Sep 2012 22:30:46 -0400 Subject: * src/profiler.c: Rename sample_profiler_* to profiler_cpu_* and memory_profiler_* to profiler_memory_*. Move sigprof_handler before its first use, inside the PROFILER_CPU_SUPPORT conditional. --- src/profiler.c | 177 +++++++++++++++++++++++++++++---------------------------- 1 file changed, 89 insertions(+), 88 deletions(-) (limited to 'src/profiler.c') diff --git a/src/profiler.c b/src/profiler.c index d22ab14e7ce..1c4fa0fa218 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -25,17 +25,6 @@ along with GNU Emacs. If not, see . */ #include #include "lisp.h" -/* True if sampling profiler is running. */ - -bool sample_profiler_running; - -/* True if memory profiler is running. */ - -bool memory_profiler_running; - -static void sigprof_handler (int, siginfo_t *, void *); - - /* Logs. */ typedef struct Lisp_Hash_Table log_t; @@ -193,6 +182,9 @@ record_backtrace (log_t *log, size_t count) #if defined SIGPROF && defined HAVE_SETITIMER #define PROFILER_CPU_SUPPORT +/* True if sampling profiler is running. */ +static bool profiler_cpu_running; + static Lisp_Object cpu_log; /* Separate counter for the time spent in the GC. */ static EMACS_INT cpu_gc_count; @@ -201,23 +193,41 @@ static EMACS_INT cpu_gc_count; static int current_sample_interval; -DEFUN ("sample-profiler-start", Fsample_profiler_start, Ssample_profiler_start, +/* Signal handler for sample profiler. */ + +static void +sigprof_handler (int signal, siginfo_t *info, void *ctx) +{ + 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); +} + +DEFUN ("profiler-cpu-start", Fprofiler_cpu_start, Sprofiler_cpu_start, 1, 1, 0, - doc: /* Start or restart sample profiler. Sample profiler will -take samples each SAMPLE-INTERVAL in millisecond. See also -`profiler-slot-heap-size' and `profiler-max-stack-depth'. */) + doc: /* Start or restart the cpu profiler. +The cpu profiler will take call-stack samples each SAMPLE-INTERVAL (expressed in milliseconds). +See also `profiler-log-size' and `profiler-max-stack-depth'. */) (Lisp_Object sample_interval) { struct sigaction sa; struct itimerval timer; - if (sample_profiler_running) + if (profiler_cpu_running) error ("Sample profiler is already running"); if (NILP (cpu_log)) { cpu_gc_count = 0; - cpu_log = make_log (profiler_slot_heap_size, + cpu_log = make_log (profiler_log_size, profiler_max_stack_depth); } @@ -233,48 +243,49 @@ take samples each SAMPLE-INTERVAL in millisecond. See also timer.it_value = timer.it_interval; setitimer (ITIMER_PROF, &timer, 0); - sample_profiler_running = 1; + profiler_cpu_running = 1; return Qt; } -DEFUN ("sample-profiler-stop", Fsample_profiler_stop, Ssample_profiler_stop, +DEFUN ("profiler-cpu-stop", Fprofiler_cpu_stop, Sprofiler_cpu_stop, 0, 0, 0, - doc: /* Stop sample profiler. Profiler log will be kept. */) + doc: /* Stop the cpu profiler. The profiler log is not affected. */) (void) { - if (!sample_profiler_running) + if (!profiler_cpu_running) error ("Sample profiler is not running"); - sample_profiler_running = 0; + profiler_cpu_running = 0; setitimer (ITIMER_PROF, 0, 0); return Qt; } -DEFUN ("sample-profiler-running-p", - Fsample_profiler_running_p, Ssample_profiler_running_p, +DEFUN ("profiler-cpu-running-p", + Fprofiler_cpu_running_p, Sprofiler_cpu_running_p, 0, 0, 0, - doc: /* Return t if sample profiler is running. */) + doc: /* Return non-nil iff cpu profiler is running. */) (void) { - return sample_profiler_running ? Qt : Qnil; + return profiler_cpu_running ? Qt : Qnil; } -DEFUN ("sample-profiler-log", - Fsample_profiler_log, Ssample_profiler_log, +DEFUN ("profiler-cpu-log", Fprofiler_cpu_log, Sprofiler_cpu_log, 0, 0, 0, - doc: /* Return sample profiler log. The data is a list of -(sample nil TIMESTAMP SLOTS), where TIMESTAMP is a timestamp when the -log is collected and SLOTS is a list of slots. */) + doc: /* Return the current cpu profiler log. +The log is a hash-table mapping backtraces to counters which represent +the amount of time spent at those points. Every backtrace is a vector +of functions, where the last few elements may be nil. +Before returning, a new log is allocated for future samples. */) (void) { 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) + cpu_log = (profiler_cpu_running + ? make_log (profiler_log_size, profiler_max_stack_depth) : Qnil); Fputhash (Fmake_vector (make_number (1), Qautomatic_gc), make_number (cpu_gc_count), @@ -282,66 +293,74 @@ log is collected and SLOTS is a list of slots. */) cpu_gc_count = 0; return result; } -#endif +#endif /* not defined PROFILER_CPU_SUPPORT */ /* Memory profiler. */ +/* True if memory profiler is running. */ +bool profiler_memory_running; + static Lisp_Object memory_log; -DEFUN ("memory-profiler-start", Fmemory_profiler_start, Smemory_profiler_start, +DEFUN ("profiler-memory-start", Fprofiler_memory_start, Sprofiler_memory_start, 0, 0, 0, - doc: /* Start/restart memory profiler. See also -`profiler-slot-heap-size' and `profiler-max-stack-depth'. */) + doc: /* Start/restart the memory profiler. +The memory profiler will take samples of the call-stack whenever a new +allocation takes place. Note that most small allocations only trigger +the profiler occasionally. +See also `profiler-log-size' and `profiler-max-stack-depth'. */) (void) { - if (memory_profiler_running) + if (profiler_memory_running) error ("Memory profiler is already running"); if (NILP (memory_log)) - memory_log = make_log (profiler_slot_heap_size, + memory_log = make_log (profiler_log_size, profiler_max_stack_depth); - memory_profiler_running = 1; + profiler_memory_running = 1; return Qt; } -DEFUN ("memory-profiler-stop", - Fmemory_profiler_stop, Smemory_profiler_stop, +DEFUN ("profiler-memory-stop", + Fprofiler_memory_stop, Sprofiler_memory_stop, 0, 0, 0, - doc: /* Stop memory profiler. Profiler log will be kept. */) + doc: /* Stop the memory profiler. The profiler log is not affected. */) (void) { - if (!memory_profiler_running) + if (!profiler_memory_running) error ("Memory profiler is not running"); - memory_profiler_running = 0; + profiler_memory_running = 0; return Qt; } -DEFUN ("memory-profiler-running-p", - Fmemory_profiler_running_p, Smemory_profiler_running_p, +DEFUN ("profiler-memory-running-p", + Fprofiler_memory_running_p, Sprofiler_memory_running_p, 0, 0, 0, - doc: /* Return t if memory profiler is running. */) + doc: /* Return non-nil if memory profiler is running. */) (void) { - return memory_profiler_running ? Qt : Qnil; + return profiler_memory_running ? Qt : Qnil; } -DEFUN ("memory-profiler-log", - Fmemory_profiler_log, Smemory_profiler_log, +DEFUN ("profiler-memory-log", + Fprofiler_memory_log, Sprofiler_memory_log, 0, 0, 0, - doc: /* Return memory profiler log. The data is a list of -(memory nil TIMESTAMP SLOTS), where TIMESTAMP is a timestamp when the -log is collected and SLOTS is a list of slots. */) + doc: /* Return the current memory profiler log. +The log is a hash-table mapping backtraces to counters which represent +the amount of memory allocated at those points. Every backtrace is a vector +of functions, where the last few elements may be nil. +Before returning, a new log is allocated for future samples. */) (void) { 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) + memory_log = (profiler_memory_running + ? make_log (profiler_log_size, profiler_max_stack_depth) : Qnil); return result; } @@ -349,24 +368,6 @@ log is collected and SLOTS is a list of slots. */) /* Signals and probes. */ -/* Signal handler for sample profiler. */ - -static void -sigprof_handler (int signal, siginfo_t *info, void *ctx) -{ - 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. */ void malloc_probe (size_t size) @@ -379,26 +380,26 @@ void syms_of_profiler (void) { DEFVAR_INT ("profiler-max-stack-depth", profiler_max_stack_depth, - doc: /* FIXME */); + doc: /* Number of elements from the call-stack recorded in the log. */); profiler_max_stack_depth = 16; - DEFVAR_INT ("profiler-slot-heap-size", profiler_slot_heap_size, - doc: /* FIXME */); - profiler_slot_heap_size = 10000; + DEFVAR_INT ("profiler-log-size", profiler_log_size, + doc: /* Number of distinct call-stacks that can be recorded in a profiler log. +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; - /* FIXME: Rename things to start with "profiler-", to use "cpu" instead of - "sample", and to make them sound like they're internal or something. */ #ifdef PROFILER_CPU_SUPPORT cpu_log = Qnil; staticpro (&cpu_log); - defsubr (&Ssample_profiler_start); - defsubr (&Ssample_profiler_stop); - defsubr (&Ssample_profiler_running_p); - defsubr (&Ssample_profiler_log); + defsubr (&Sprofiler_cpu_start); + defsubr (&Sprofiler_cpu_stop); + defsubr (&Sprofiler_cpu_running_p); + defsubr (&Sprofiler_cpu_log); #endif memory_log = Qnil; staticpro (&memory_log); - defsubr (&Smemory_profiler_start); - defsubr (&Smemory_profiler_stop); - defsubr (&Smemory_profiler_running_p); - defsubr (&Smemory_profiler_log); + defsubr (&Sprofiler_memory_start); + defsubr (&Sprofiler_memory_stop); + defsubr (&Sprofiler_memory_running_p); + defsubr (&Sprofiler_memory_log); } -- cgit v1.2.1 From 611b7507a8eb63d0c3fd8b5c6182920453292688 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Tue, 25 Sep 2012 23:43:26 -0400 Subject: * src/makefile.w32-in (OBJ2, GLOBAL_SOURCES): Add profiler.c. ($(BLD)/profiler.$(O)): New target. --- src/profiler.c | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) (limited to 'src/profiler.c') diff --git a/src/profiler.c b/src/profiler.c index 1c4fa0fa218..8573d13b554 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -136,6 +136,8 @@ record_backtrace (log_t *log, size_t count) ptrdiff_t asize; if (!INTEGERP (log->next_free)) + /* FIXME: transfer the evicted counts to a special entry rather + than dropping them on the floor. */ evict_lower_half (log); index = XINT (log->next_free); @@ -145,6 +147,7 @@ record_backtrace (log_t *log, size_t count) /* 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. */ @@ -172,7 +175,18 @@ record_backtrace (log_t *log, size_t count) /* 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. */ + data elsewhere, so as to avoid the eviction code. + There are 2 ways to do that, AFAICT: + - Set a flag checked in QUIT, such that QUIT can then call + Fprofiler_cpu_log and stash the full log for later use. + - Set a flag check in post-gc-hook, so that Elisp code can call + profiler-cpu-log. That gives us more flexibility since that + Elisp code can then do all kinds of fun stuff like write + the log to disk. Or turn it right away into a call tree. + Of course, using Elisp is generally preferable, but it may + take longer until we get a chance to run the Elisp code, so + there's more risk that the table will get full before we + get there. */ } } } -- cgit v1.2.1 From 234148bf943ffce55121aefc8694889eb08b0daa Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 26 Sep 2012 00:02:21 -0400 Subject: * lisp/profiler.el (profiler-start): Don't prompt for choice when there isn't any. (profiler-stop): Use new semantics of profiler-*-stop. (profiler-reset, profiler--report-cpu): Don't signal an error if the cpu profiler is not available. * src/profiler.c (Fprofiler_cpu_stop, Fprofiler_memory_stop): Return whether the profiler was running, instead of signaling an error if it wasn't. --- src/profiler.c | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) (limited to 'src/profiler.c') diff --git a/src/profiler.c b/src/profiler.c index 8573d13b554..e7593a6a0e0 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -257,19 +257,20 @@ See also `profiler-log-size' and `profiler-max-stack-depth'. */) timer.it_value = timer.it_interval; setitimer (ITIMER_PROF, &timer, 0); - profiler_cpu_running = 1; + profiler_cpu_running = true; return Qt; } DEFUN ("profiler-cpu-stop", Fprofiler_cpu_stop, Sprofiler_cpu_stop, 0, 0, 0, - doc: /* Stop the cpu profiler. The profiler log is not affected. */) + doc: /* Stop the cpu profiler. The profiler log is not affected. +Return non-nil if the profiler was running. */) (void) { if (!profiler_cpu_running) - error ("Sample profiler is not running"); - profiler_cpu_running = 0; + return Qnil; + profiler_cpu_running = false; setitimer (ITIMER_PROF, 0, 0); @@ -332,7 +333,7 @@ See also `profiler-log-size' and `profiler-max-stack-depth'. */) memory_log = make_log (profiler_log_size, profiler_max_stack_depth); - profiler_memory_running = 1; + profiler_memory_running = true; return Qt; } @@ -340,13 +341,13 @@ See also `profiler-log-size' and `profiler-max-stack-depth'. */) DEFUN ("profiler-memory-stop", Fprofiler_memory_stop, Sprofiler_memory_stop, 0, 0, 0, - doc: /* Stop the memory profiler. The profiler log is not affected. */) + doc: /* Stop the memory profiler. The profiler log is not affected. +Return non-nil if the profiler was running. */) (void) { if (!profiler_memory_running) - error ("Memory profiler is not running"); - profiler_memory_running = 0; - + return Qnil; + profiler_memory_running = false; return Qt; } @@ -403,6 +404,7 @@ to make room for new entries. */); profiler_log_size = 10000; #ifdef PROFILER_CPU_SUPPORT + profiler_cpu_running = false; cpu_log = Qnil; staticpro (&cpu_log); defsubr (&Sprofiler_cpu_start); @@ -410,6 +412,7 @@ to make room for new entries. */); defsubr (&Sprofiler_cpu_running_p); defsubr (&Sprofiler_cpu_log); #endif + profiler_memory_running = false; memory_log = Qnil; staticpro (&memory_log); defsubr (&Sprofiler_memory_start); -- cgit v1.2.1