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

Add GC profiler.

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