Commit 12b3895d authored by Tomohiro Matsuyama's avatar Tomohiro Matsuyama
Browse files

Add GC profiler.

parent ce56157e
......@@ -44,10 +44,16 @@
(defun profiler-format (fmt &rest args)
(cl-loop for (width align subfmt) in fmt
for arg in args
for str = (cl-typecase subfmt
(cons (apply 'profiler-format subfmt arg))
(string (format subfmt arg))
(t (profiler-ensure-string arg)))
for str = (cond
((consp subfmt)
(apply 'profiler-format subfmt arg))
((stringp subfmt)
(format subfmt arg))
((and (symbolp subfmt)
(fboundp subfmt))
(funcall subfmt arg))
(t
(profiler-ensure-string arg)))
for len = (length str)
if (< width len)
collect (substring str 0 width) into frags
......@@ -60,6 +66,30 @@
into frags
finally return (apply #'concat frags)))
(defun profiler-format-nbytes (nbytes)
(if (and (integerp nbytes) (> nbytes 0))
(cl-loop with i = (% (1+ (floor (log10 nbytes))) 3)
for c in (append (number-to-string nbytes) nil)
if (= i 0)
collect ?, into s
and do (setq i 3)
collect c into s
do (cl-decf i)
finally return
(apply 'string (if (eq (car s) ?,) (cdr s) s)))
(profiler-ensure-string nbytes)))
;;; Backtrace data structure
(defun profiler-backtrace-reverse (backtrace)
(cl-case (car backtrace)
((t gc)
(cons (car backtrace)
(reverse (cdr backtrace))))
(t (reverse backtrace))))
;;; Slot data structure
......@@ -105,7 +135,7 @@
(format "#<compiled 0x%x>" (sxhash entry)))
((subrp entry)
(subr-name entry))
((symbolp entry)
((or (symbolp entry) (stringp entry))
entry)
(t
(format "#<unknown 0x%x>" (sxhash entry)))))))
......@@ -129,6 +159,8 @@
(defun profiler-calltree-count< (a b)
(cond ((eq (profiler-calltree-entry a) t) t)
((eq (profiler-calltree-entry b) t) nil)
((eq (profiler-calltree-entry a) 'gc) t)
((eq (profiler-calltree-entry b) 'gc) nil)
(t (< (profiler-calltree-count a)
(profiler-calltree-count b)))))
......@@ -138,6 +170,8 @@
(defun profiler-calltree-elapsed< (a b)
(cond ((eq (profiler-calltree-entry a) t) t)
((eq (profiler-calltree-entry b) t) nil)
((eq (profiler-calltree-entry a) 'gc) t)
((eq (profiler-calltree-entry b) 'gc) nil)
(t (< (profiler-calltree-elapsed a)
(profiler-calltree-elapsed b)))))
......@@ -166,7 +200,9 @@
(count (profiler-slot-count slot))
(elapsed (profiler-slot-elapsed slot))
(node tree))
(dolist (entry (if reverse backtrace (reverse backtrace)))
(dolist (entry (if reverse
backtrace
(profiler-backtrace-reverse backtrace)))
(let ((child (profiler-calltree-find node entry)))
(unless child
(setq child (profiler-make-calltree :entry entry :parent node))
......@@ -179,20 +215,27 @@
(let ((total-count 0)
(total-elapsed 0))
(dolist (child (profiler-calltree-children tree))
(cl-incf total-count (profiler-calltree-count child))
(cl-incf total-elapsed (profiler-calltree-elapsed child)))
(profiler-calltree-walk
tree (lambda (node)
(unless (zerop total-count)
(setf (profiler-calltree-count-percent node)
(format "%s%%"
(/ (* (profiler-calltree-count node) 100)
total-count))))
(unless (zerop total-elapsed)
(setf (profiler-calltree-elapsed-percent node)
(format "%s%%"
(/ (* (profiler-calltree-elapsed node) 100)
total-elapsed))))))))
(if (eq (profiler-calltree-entry child) 'gc)
(profiler-calltree-compute-percentages child)
(cl-incf total-count (profiler-calltree-count child))
(cl-incf total-elapsed (profiler-calltree-elapsed child))))
(dolist (child (profiler-calltree-children tree))
(if (eq (profiler-calltree-entry child) 'gc)
(setf (profiler-calltree-count-percent child) ""
(profiler-calltree-elapsed-percent child) "")
(profiler-calltree-walk
child
(lambda (node)
(unless (zerop total-count)
(setf (profiler-calltree-count-percent node)
(format "%s%%"
(/ (* (profiler-calltree-count node) 100)
total-count))))
(unless (zerop total-elapsed)
(setf (profiler-calltree-elapsed-percent node)
(format "%s%%"
(/ (* (profiler-calltree-elapsed node) 100)
total-elapsed))))))))))
(cl-defun profiler-calltree-build (log &key reverse)
(let ((tree (profiler-make-calltree)))
......@@ -231,8 +274,8 @@
(5 right)))))
(defvar profiler-report-memory-line-format
'((60 left)
(14 right ((9 right)
'((55 left)
(19 right ((14 right profiler-format-nbytes)
(5 right)))))
(defvar profiler-report-log nil)
......@@ -244,6 +287,8 @@
(cond
((eq entry t)
"Others")
((eq entry 'gc)
"Garbage Collection")
((and (symbolp entry)
(fboundp entry))
(propertize (symbol-name entry)
......@@ -462,7 +507,7 @@ otherwise collapse the entry."
(setq header-line-format
(profiler-report-header-line-format
profiler-report-memory-line-format
"Function" (list "Alloc" "%")))
"Function" (list "Bytes" "%")))
(let ((predicate (cl-ecase order
(ascending 'profiler-calltree-count<)
(descending 'profiler-calltree-count>))))
......
......@@ -5380,6 +5380,23 @@ bounded_number (EMACS_INT number)
return make_number (min (MOST_POSITIVE_FIXNUM, number));
}
/* Calculate total bytes of live objects. */
static size_t
total_bytes_of_live_objects (void)
{
size_t tot = 0;
tot += total_conses * sizeof (struct Lisp_Cons);
tot += total_symbols * sizeof (struct Lisp_Symbol);
tot += total_markers * sizeof (union Lisp_Misc);
tot += total_string_bytes;
tot += total_vector_slots * word_size;
tot += total_floats * sizeof (struct Lisp_Float);
tot += total_intervals * sizeof (struct interval);
tot += total_strings * sizeof (struct Lisp_String);
return tot;
}
DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "",
doc: /* Reclaim storage for Lisp objects no longer needed.
Garbage collection happens automatically if you cons more than
......@@ -5405,6 +5422,7 @@ See Info node `(elisp)Garbage Collection'. */)
ptrdiff_t count = SPECPDL_INDEX ();
EMACS_TIME start;
Lisp_Object retval = Qnil;
size_t tot_before = 0;
if (abort_on_gc)
abort ();
......@@ -5421,6 +5439,9 @@ See Info node `(elisp)Garbage Collection'. */)
FOR_EACH_BUFFER (nextb)
compact_buffer (nextb);
if (memory_profiler_running)
tot_before = total_bytes_of_live_objects ();
start = current_emacs_time ();
/* In case user calls debug_print during GC,
......@@ -5467,6 +5488,7 @@ See Info node `(elisp)Garbage Collection'. */)
shrink_regexp_cache ();
gc_in_progress = 1;
is_in_trace = 1;
/* Mark all the special slots that serve as the roots of accessibility. */
......@@ -5587,6 +5609,7 @@ See Info node `(elisp)Garbage Collection'. */)
check_cons_list ();
gc_in_progress = 0;
is_in_trace = 0;
consing_since_gc = 0;
if (gc_cons_threshold < GC_DEFAULT_THRESHOLD / 10)
......@@ -5595,16 +5618,7 @@ See Info node `(elisp)Garbage Collection'. */)
gc_relative_threshold = 0;
if (FLOATP (Vgc_cons_percentage))
{ /* Set gc_cons_combined_threshold. */
double tot = 0;
tot += total_conses * sizeof (struct Lisp_Cons);
tot += total_symbols * sizeof (struct Lisp_Symbol);
tot += total_markers * sizeof (union Lisp_Misc);
tot += total_string_bytes;
tot += total_vector_slots * word_size;
tot += total_floats * sizeof (struct Lisp_Float);
tot += total_intervals * sizeof (struct interval);
tot += total_strings * sizeof (struct Lisp_String);
double tot = total_bytes_of_live_objects ();
tot *= XFLOAT_DATA (Vgc_cons_percentage);
if (0 < tot)
......@@ -5707,6 +5721,25 @@ See Info node `(elisp)Garbage Collection'. */)
gcs_done++;
/* Collect profiling data. */
if (sample_profiler_running || memory_profiler_running)
{
size_t swept = 0;
size_t elapsed = 0;
if (memory_profiler_running)
{
size_t tot_after = total_bytes_of_live_objects ();
if (tot_before > tot_after)
swept = tot_before - tot_after;
}
if (sample_profiler_running)
{
EMACS_TIME since_start = sub_emacs_time (current_emacs_time (), start);
elapsed = EMACS_TIME_TO_DOUBLE (since_start) * 1000;
}
gc_probe (swept, elapsed);
}
return retval;
}
......
......@@ -3532,12 +3532,18 @@ void syms_of_dbusbind (void);
/* Defined in profiler.c */
extern int sample_profiler_running;
extern int memory_profiler_running;
extern int is_in_trace;
extern Lisp_Object Qgc;
extern void malloc_probe (size_t);
#define MALLOC_PROBE(size) \
do { \
if (memory_profiler_running) \
malloc_probe (size); \
extern void gc_probe (size_t, size_t);
#define ENTER_TRACE (is_in_trace = 1)
#define LEAVE_TRACE (is_in_trace = 0)
#define MALLOC_PROBE(size) \
do { \
if (memory_profiler_running) \
malloc_probe (size); \
} while (0)
extern void mark_profiler (void);
extern void syms_of_profiler (void);
......
......@@ -25,6 +25,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <setjmp.h>
#include "lisp.h"
int is_in_trace;
Lisp_Object Qgc;
static void sigprof_handler (int, siginfo_t *, void *);
static void block_sigprof (void);
static void unblock_sigprof (void);
......@@ -350,8 +353,8 @@ struct slot
{
struct slot *next, *prev;
Lisp_Object backtrace;
unsigned int count;
unsigned int elapsed;
size_t count;
size_t elapsed;
unsigned char used : 1;
};
......@@ -536,8 +539,8 @@ struct log
Lisp_Object backtrace;
struct slot_heap *slot_heap;
struct slot_table *slot_table;
unsigned int others_count;
unsigned int others_elapsed;
size_t others_count;
size_t others_elapsed;
};
static struct log *
......@@ -647,22 +650,23 @@ ensure_slot (struct log *log, Lisp_Object backtrace)
}
static void
record_backtrace (struct log *log, unsigned int count, unsigned int elapsed)
record_backtrace_under (struct log *log, Lisp_Object base,
size_t count, size_t elapsed)
{
int i;
int i = 0;
Lisp_Object backtrace = log->backtrace;
struct backtrace *backlist = backtrace_list;
if (!apply_filter (backlist)) return;
for (i = 0; i < ASIZE (backtrace) && backlist; backlist = backlist->next)
if (!NILP (base) && ASIZE (backtrace) > 0)
ASET (backtrace, i++, base);
for (; i < ASIZE (backtrace) && backlist; backlist = backlist->next)
{
Lisp_Object function = *backlist->function;
if (FUNCTIONP (function))
{
ASET (backtrace, i, function);
i++;
}
ASET (backtrace, i++, function);
}
for (; i < ASIZE (backtrace); i++)
ASET (backtrace, i, Qnil);
......@@ -675,6 +679,12 @@ record_backtrace (struct log *log, unsigned int count, unsigned int elapsed)
}
}
static void
record_backtrace (struct log *log, size_t count, size_t elapsed)
{
record_backtrace_under (log, Qnil, count, elapsed);
}
static Lisp_Object
log_object (struct log *log)
{
......@@ -892,7 +902,8 @@ DEFUN ("memory-profiler-log",
static void
sigprof_handler (int signal, siginfo_t *info, void *ctx)
{
record_backtrace (sample_log, 1, current_sample_interval);
if (!is_in_trace && sample_log)
record_backtrace (sample_log, 1, current_sample_interval);
}
static void
......@@ -916,7 +927,17 @@ unblock_sigprof (void)
void
malloc_probe (size_t size)
{
record_backtrace (memory_log, size, 0);
if (memory_log)
record_backtrace (memory_log, size, 0);
}
void
gc_probe (size_t size, size_t elapsed)
{
if (sample_log)
record_backtrace_under (sample_log, Qgc, 1, elapsed);
if (memory_log)
record_backtrace_under (memory_log, Qgc, size, elapsed);
}
......@@ -942,6 +963,8 @@ mark_profiler (void)
void
syms_of_profiler (void)
{
DEFSYM (Qgc, "gc");
DEFVAR_INT ("profiler-max-stack-depth", profiler_max_stack_depth,
doc: /* FIXME */);
profiler_max_stack_depth = 16;
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment