From 0efc778b8086065f657b8b12f91952ad6b2a8f8c Mon Sep 17 00:00:00 2001 From: Tomohiro Matsuyama Date: Thu, 23 Aug 2012 21:11:12 +0900 Subject: [PATCH] profiler: Refactoring and documentation. --- lisp/profiler.el | 256 +++++++++++++++++++++++++++++------------------ src/lisp.h | 6 +- src/profiler.c | 191 ++++++++++++++++++++++++++++------- 3 files changed, 313 insertions(+), 140 deletions(-) diff --git a/lisp/profiler.el b/lisp/profiler.el index 3f10735ccba..1777fc00bde 100644 --- a/lisp/profiler.el +++ b/lisp/profiler.el @@ -33,13 +33,17 @@ :prefix "profiler-") - ;;; Utilities (defun profiler-ensure-string (object) - (if (stringp object) - object - (format "%s" object))) + (cond ((stringp object) + object) + ((symbolp object) + (symbol-name object)) + ((numberp object) + (number-to-string object)) + (t + (format "%s" object)))) (defun profiler-format (fmt &rest args) (cl-loop for (width align subfmt) in fmt @@ -66,7 +70,11 @@ into frags finally return (apply #'concat frags))) +(defun profiler-format-percent (number divisor) + (concat (number-to-string (/ (* number 100) divisor)) "%")) + (defun profiler-format-nbytes (nbytes) + "Format NBYTES in humarn readable string." (if (and (integerp nbytes) (> nbytes 0)) (cl-loop with i = (% (1+ (floor (log10 nbytes))) 3) for c in (append (number-to-string nbytes) nil) @@ -80,18 +88,45 @@ (profiler-ensure-string nbytes))) +;;; Entries + +(defun profiler-entry= (entry1 entry2) + "Return t if ENTRY1 and ENTRY2 are same." + (or (eq entry1 entry2) + (and (stringp entry1) + (stringp entry2) + (string= entry1 entry2)))) + +(defun profiler-entry-format (entry) + "Format ENTRY in human readable string. ENTRY would be a +function name of a function itself." + (cond ((and (consp entry) + (or (eq (car entry) 'lambda) + (eq (car entry) 'closure))) + (format "#" (sxhash entry))) + ((eq (type-of entry) 'compiled-function) + (format "#" (sxhash entry))) + ((subrp entry) + (subr-name entry)) + ((symbolp entry) + (symbol-name entry)) + ((stringp entry) + entry) + (t + (format "#" (sxhash entry))))) + ;;; Backtrace data structure (defun profiler-backtrace-reverse (backtrace) (cl-case (car backtrace) ((t gc) + ;; Make sure Others node and GC node always be at top. (cons (car backtrace) (reverse (cdr backtrace)))) (t (reverse backtrace)))) - ;;; Slot data structure (cl-defstruct (profiler-slot (:type list) @@ -99,7 +134,6 @@ backtrace count elapsed) - ;;; Log data structure (cl-defstruct (profiler-log (:type list) @@ -107,7 +141,8 @@ type diff-p timestamp slots) (defun profiler-log-diff (log1 log2) - ;; FIXME zeros + "Compare LOG1 with LOG2 and return a diff log. Both logs must +be same type." (unless (eq (profiler-log-type log1) (profiler-log-type log2)) (error "Can't compare different type of logs")) @@ -122,35 +157,51 @@ :timestamp (current-time) :slots slots))) +(defun profiler-log-fixup-entry (entry) + (if (symbolp entry) + entry + (profiler-entry-format entry))) + +(defun profiler-log-fixup-backtrace (backtrace) + (mapcar 'profiler-log-fixup-entry backtrace)) + +(defun profiler-log-fixup-slot (slot) + (let ((backtrace (profiler-slot-backtrace slot))) + (profiler-make-slot :backtrace (profiler-log-fixup-backtrace backtrace) + :count (profiler-slot-count slot) + :elapsed (profiler-slot-elapsed slot)))) + (defun profiler-log-fixup (log) "Fixup LOG so that the log could be serialized into file." - (let ((fixup-entry - (lambda (entry) - (cond - ((and (consp entry) - (or (eq (car entry) 'lambda) - (eq (car entry) 'closure))) - (format "#" (sxhash entry))) - ((eq (type-of entry) 'compiled-function) - (format "#" (sxhash entry))) - ((subrp entry) - (subr-name entry)) - ((or (symbolp entry) (stringp entry)) - entry) - (t - (format "#" (sxhash entry))))))) - (dolist (slot (profiler-log-slots log)) - (setf (profiler-slot-backtrace slot) - (mapcar fixup-entry (profiler-slot-backtrace slot)))))) + (cl-loop for slot in (profiler-log-slots log) + collect (profiler-log-fixup-slot slot) into slots + finally return + (profiler-make-log :type (profiler-log-type log) + :diff-p (profiler-log-diff-p log) + :timestamp (profiler-log-timestamp log) + :slots slots))) + +(defun profiler-log-write-file (log filename &optional confirm) + "Write LOG into FILENAME." + (with-temp-buffer + (let (print-level print-length) + (print (profiler-log-fixup log) (current-buffer))) + (write-file filename confirm))) - +(defun profiler-log-read-file (filename) + "Read log from FILENAME." + (with-temp-buffer + (insert-file-contents filename) + (goto-char (point-min)) + (read (current-buffer)))) + ;;; Calltree data structure (cl-defstruct (profiler-calltree (:constructor profiler-make-calltree)) entry - (count 0) count-percent - (elapsed 0) elapsed-percent + (count 0) (count-percent "") + (elapsed 0) (elapsed-percent "") parent children) (defun profiler-calltree-leaf-p (tree) @@ -185,14 +236,20 @@ (1+ (profiler-calltree-depth parent))))) (defun profiler-calltree-find (tree entry) - (cl-dolist (child (profiler-calltree-children tree)) - (when (equal (profiler-calltree-entry child) entry) - (cl-return child)))) - -(defun profiler-calltree-walk (calltree function) - (funcall function calltree) + "Return a child tree of ENTRY under TREE." + ;; OPTIMIZED + (let (result (children (profiler-calltree-children tree))) + (while (and children (null result)) + (let ((child (car children))) + (when (profiler-entry= (profiler-calltree-entry child) entry) + (setq result child)) + (setq children (cdr children)))) + result)) + +(defun profiler-calltree-walk (calltree function &rest args) + (apply function calltree args) (dolist (child (profiler-calltree-children calltree)) - (profiler-calltree-walk child function))) + (apply 'profiler-calltree-walk child function args))) (defun profiler-calltree-build-1 (tree log &optional reverse) (dolist (slot (profiler-log-slots log)) @@ -211,6 +268,16 @@ (cl-incf (profiler-calltree-elapsed child) elapsed) (setq node child)))))) +(defun profiler-calltree-compute-percentages-1 (node total-count total-elapsed) + (unless (zerop total-count) + (setf (profiler-calltree-count-percent node) + (profiler-format-percent (profiler-calltree-count node) + total-count))) + (unless (zerop total-elapsed) + (setf (profiler-calltree-elapsed-percent node) + (profiler-format-percent (profiler-calltree-elapsed node) + total-elapsed)))) + (defun profiler-calltree-compute-percentages (tree) (let ((total-count 0) (total-elapsed 0)) @@ -220,22 +287,10 @@ (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) "") + (unless (eq (profiler-calltree-entry child) 'gc) (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)))))))))) + child 'profiler-calltree-compute-percentages-1 + total-count total-elapsed))))) (cl-defun profiler-calltree-build (log &key reverse) (let ((tree (profiler-make-calltree))) @@ -250,7 +305,6 @@ (profiler-calltree-sort child predicate)))) - ;;; Report rendering (defcustom profiler-report-closed-mark "+" @@ -278,25 +332,31 @@ (19 right ((14 right profiler-format-nbytes) (5 right))))) -(defvar profiler-report-log nil) -(defvar profiler-report-reversed nil) -(defvar profiler-report-order nil) +(defvar profiler-report-log nil + "The current profiler log.") + +(defvar profiler-report-reversed nil + "True if calltree is rendered in bottom-up. Do not touch this +variable directly.") + +(defvar profiler-report-order nil + "The value can be `ascending' or `descending'. Do not touch +this variable directly.") (defun profiler-report-make-entry-part (entry) - (let ((string - (cond - ((eq entry t) - "Others") - ((eq entry 'gc) - "Garbage Collection") - ((and (symbolp entry) - (fboundp entry)) - (propertize (symbol-name entry) - 'face 'link - 'mouse-face 'highlight - 'help-echo "mouse-2 or RET jumps to definition")) - (t - (profiler-ensure-string entry))))) + (let ((string (cond + ((eq entry t) + "Others") + ((eq entry 'gc) + "Garbage Collection") + ((and (symbolp entry) + (fboundp entry)) + (propertize (symbol-name entry) + 'face 'link + 'mouse-face 'highlight + 'help-echo "mouse-2 or RET jumps to definition")) + (t + (profiler-entry-format entry))))) (propertize string 'entry entry))) (defun profiler-report-make-name-part (tree) @@ -352,7 +412,6 @@ (profiler-calltree-children tree))) - ;;; Report mode (defvar profiler-report-mode-map @@ -384,6 +443,7 @@ (memory (format "*Memory-Profiler-Report %s*" time))))) (defun profiler-report-setup-buffer (log) + "Make a buffer for LOG and return it." (let* ((buf-name (profiler-report-make-buffer-name log)) (buffer (get-buffer-create buf-name))) (with-current-buffer buffer @@ -404,7 +464,6 @@ truncate-lines t)) - ;;; Report commands (defun profiler-report-calltree-at-point () @@ -417,19 +476,19 @@ (back-to-indentation)))) (defun profiler-report-next-entry () - "Move cursor to next profile entry." + "Move cursor to next entry." (interactive) (forward-line) (profiler-report-move-to-entry)) (defun profiler-report-previous-entry () - "Move cursor to previous profile entry." + "Move cursor to previous entry." (interactive) (forward-line -1) (profiler-report-move-to-entry)) (defun profiler-report-expand-entry () - "Expand profile entry at point." + "Expand entry at point." (interactive) (save-excursion (beginning-of-line) @@ -444,7 +503,7 @@ t)))))) (defun profiler-report-collapse-entry () - "Collpase profile entry at point." + "Collpase entry at point." (interactive) (save-excursion (beginning-of-line) @@ -466,14 +525,14 @@ t))) (defun profiler-report-toggle-entry () - "Expand profile entry at point if the tree is collapsed, -otherwise collapse the entry." + "Expand entry at point if the tree is collapsed, +otherwise collapse." (interactive) (or (profiler-report-expand-entry) (profiler-report-collapse-entry))) (defun profiler-report-find-entry (&optional event) - "Find profile entry at point." + "Find entry at point." (interactive (list last-nonmenu-event)) (if event (posn-set-point (event-end event))) (let ((tree (profiler-report-calltree-at-point))) @@ -482,7 +541,7 @@ otherwise collapse the entry." (find-function entry))))) (defun profiler-report-describe-entry () - "Describe profile entry at point." + "Describe entry at point." (interactive) (let ((tree (profiler-report-calltree-at-point))) (when tree @@ -524,13 +583,13 @@ otherwise collapse the entry." :order profiler-report-order)) (defun profiler-report-render-calltree () - "Render calltree view of the current profile." + "Render calltree view." (interactive) (setq profiler-report-reversed nil) (profiler-report-rerender-calltree)) (defun profiler-report-render-reversed-calltree () - "Render reversed calltree view of the current profile." + "Render reversed calltree view." (interactive) (setq profiler-report-reversed t) (profiler-report-rerender-calltree)) @@ -554,25 +613,23 @@ otherwise collapse the entry." (pop-to-buffer buffer))) (defun profiler-report-compare-log (buffer) - "Compare current profiler log with another profiler log." + "Compare the current profiler log with another." (interactive (list (read-buffer "Compare to: "))) - (let ((log1 (with-current-buffer buffer profiler-report-log)) - (log2 profiler-report-log)) - (profiler-report-log (profiler-log-diff log1 log2)))) + (let* ((log1 (with-current-buffer buffer profiler-report-log)) + (log2 profiler-report-log) + (diff-log (profiler-log-diff log1 log2))) + (profiler-report-log diff-log))) (defun profiler-report-write-log (filename &optional confirm) - "Write current profiler log into FILENAME." + "Write the current profiler log into FILENAME." (interactive (list (read-file-name "Write log: " default-directory) (not current-prefix-arg))) - (let ((log profiler-report-log)) - (with-temp-buffer - (let (print-level print-length) - (print log (current-buffer))) - (write-file filename confirm)))) + (profiler-log-write-file profiler-report-log + filename + confirm)) - ;;; Profiler commands (defcustom profiler-sample-interval 10 @@ -582,6 +639,10 @@ otherwise collapse the entry." ;;;###autoload (defun profiler-start (mode) + "Start/restart profilers. MODE can be one of `cpu', `mem', +and `cpu+mem'. If MODE is `cpu' or `cpu+mem', sample profiler +will be started. Also, if MODE is `mem' or `cpu+mem', then +memory profiler will be started." (interactive (list (intern (completing-read "Mode: " '("cpu" "mem" "cpu+mem") nil t nil nil "cpu")))) @@ -598,6 +659,7 @@ otherwise collapse the entry." (message "CPU and memory profiler started")))) (defun profiler-stop () + "Stop started profilers. Profiler logs will be kept." (interactive) (cond ((and (sample-profiler-running-p) @@ -615,6 +677,7 @@ otherwise collapse the entry." (error "No profilers started")))) (defun profiler-reset () + "Reset profiler log." (interactive) (sample-profiler-reset) (memory-profiler-reset) @@ -623,32 +686,27 @@ otherwise collapse the entry." (defun sample-profiler-report () (let ((sample-log (sample-profiler-log))) (when sample-log - (profiler-log-fixup sample-log) (profiler-report-log sample-log)))) (defun memory-profiler-report () (let ((memory-log (memory-profiler-log))) (when memory-log - (profiler-log-fixup memory-log) (profiler-report-log memory-log)))) (defun profiler-report () + "Report profiling results." (interactive) (sample-profiler-report) (memory-profiler-report)) ;;;###autoload (defun profiler-find-log (filename) + "Read a profiler log from FILENAME and report it." (interactive (list (read-file-name "Find log: " default-directory))) - (with-temp-buffer - (insert-file-contents filename) - (goto-char (point-min)) - (let ((log (read (current-buffer)))) - (profiler-report-log log)))) + (profiler-report-log (profiler-log-read-file filename))) - ;;; Profiling helpers (cl-defmacro with-sample-profiling ((&key (interval profiler-sample-interval)) &rest body) diff --git a/src/lisp.h b/src/lisp.h index a979d45b49f..894b18c838c 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3530,9 +3530,9 @@ void syms_of_dbusbind (void); #endif /* Defined in profiler.c */ -extern int sample_profiler_running; -extern int memory_profiler_running; -extern int is_in_trace; +extern bool sample_profiler_running; +extern bool memory_profiler_running; +extern bool is_in_trace; extern Lisp_Object Qgc; extern void malloc_probe (size_t); extern void gc_probe (size_t, size_t); 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) { -- 2.39.5