From 12b3895d742e06ba3999773f0f02328ae7d9880f Mon Sep 17 00:00:00 2001 From: Tomohiro Matsuyama Date: Wed, 22 Aug 2012 21:38:39 +0900 Subject: [PATCH] Add GC profiler. --- lisp/profiler.el | 91 ++++++++++++++++++++++++++++++++++++------------ src/alloc.c | 53 ++++++++++++++++++++++------ src/lisp.h | 14 +++++--- src/profiler.c | 49 +++++++++++++++++++------- 4 files changed, 157 insertions(+), 50 deletions(-) diff --git a/lisp/profiler.el b/lisp/profiler.el index 9e94f0d078c..3f10735ccba 100644 --- a/lisp/profiler.el +++ b/lisp/profiler.el @@ -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 "#" (sxhash entry))) ((subrp entry) (subr-name entry)) - ((symbolp entry) + ((or (symbolp entry) (stringp entry)) entry) (t (format "#" (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>)))) diff --git a/src/alloc.c b/src/alloc.c index 3a4a8de90f5..389da29a533 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -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; } diff --git a/src/lisp.h b/src/lisp.h index b4cead003c2..a979d45b49f 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -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); 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; -- 2.39.2