:prefix "profiler-")
\f
-
;;; 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
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)
(profiler-ensure-string nbytes)))
\f
+;;; 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 "#<closure 0x%x>" (sxhash entry)))
+ ((eq (type-of entry) 'compiled-function)
+ (format "#<compiled 0x%x>" (sxhash entry)))
+ ((subrp entry)
+ (subr-name entry))
+ ((symbolp entry)
+ (symbol-name entry))
+ ((stringp entry)
+ entry)
+ (t
+ (format "#<unknown 0x%x>" (sxhash entry)))))
+\f
;;; 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))))
\f
-
;;; Slot data structure
(cl-defstruct (profiler-slot (:type list)
backtrace count elapsed)
\f
-
;;; Log data structure
(cl-defstruct (profiler-log (:type list)
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"))
: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 "#<closure 0x%x>" (sxhash entry)))
- ((eq (type-of entry) 'compiled-function)
- (format "#<compiled 0x%x>" (sxhash entry)))
- ((subrp entry)
- (subr-name entry))
- ((or (symbolp entry) (stringp entry))
- entry)
- (t
- (format "#<unknown 0x%x>" (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)))
-\f
+(defun profiler-log-read-file (filename)
+ "Read log from FILENAME."
+ (with-temp-buffer
+ (insert-file-contents filename)
+ (goto-char (point-min))
+ (read (current-buffer))))
+\f
;;; 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)
(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))
(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))
(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)))
(profiler-calltree-sort child predicate))))
\f
-
;;; Report rendering
(defcustom profiler-report-closed-mark "+"
(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)
(profiler-calltree-children tree)))
\f
-
;;; Report mode
(defvar profiler-report-mode-map
(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
truncate-lines t))
\f
-
;;; Report commands
(defun profiler-report-calltree-at-point ()
(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)
t))))))
(defun profiler-report-collapse-entry ()
- "Collpase profile entry at point."
+ "Collpase entry at point."
(interactive)
(save-excursion
(beginning-of-line)
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)))
(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
: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))
(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))
\f
-
;;; Profiler commands
(defcustom profiler-sample-interval 10
;;;###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"))))
(message "CPU and memory profiler started"))))
(defun profiler-stop ()
+ "Stop started profilers. Profiler logs will be kept."
(interactive)
(cond
((and (sample-profiler-running-p)
(error "No profilers started"))))
(defun profiler-reset ()
+ "Reset profiler log."
(interactive)
(sample-profiler-reset)
(memory-profiler-reset)
(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)))
\f
-
;;; Profiling helpers
(cl-defmacro with-sample-profiling ((&key (interval profiler-sample-interval)) &rest body)
-/* GNU Emacs profiler implementation.
+/* Profiler implementation.
Copyright (C) 2012 Free Software Foundation, Inc.
#include <setjmp.h>
#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;
-
\f
-
-/* Filters */
+/* Pattern matching. */
enum pattern_type
{
}
}
+#if 0
static int
match (const char *pattern, const char *string)
{
return res;
}
-#if 0
static void
should_match (const char *pattern, const char *string)
{
}
#endif
+\f
+/* 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)
{
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)
{
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)
{
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))
}
\f
+/* Backtraces. */
-/* Backtraces */
static Lisp_Object
make_backtrace (int size)
return Fcons (AREF (backtrace, i), backtrace_object_1 (backtrace, i + 1));
}
+/* Convert BACKTRACE to a list. */
+
static Lisp_Object
backtrace_object (Lisp_Object backtrace)
{
}
\f
+/* 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;
};
mark_object (slot->backtrace);
}
+/* Convert SLOT to a list. */
+
static Lisp_Object
slot_object (struct slot *slot)
{
\f
-/* 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;
};
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 = 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)
{
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)
{
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)
{
}
\f
-
-/* Slot tables */
+/* Slot hash tables. */
struct slot_table
{
+ /* Number of slot buckets. */
unsigned int size;
+ /* Buckets data area. */
struct slot **data;
};
}
\f
-
-/* 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;
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;
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)
{
free_slot (log->slot_heap, slot);
}
+/* Evict a minimal slot from LOG. */
+
static void
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)
{
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))
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)
{
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)
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;
record_backtrace_under (log, Qnil, count, elapsed);
}
+/* Convert LOG to a list. */
+
static Lisp_Object
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++)
{
}
\f
-
-/* 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;
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)
DEFUN ("sample-profiler-reset", Fsample_profiler_reset, Ssample_profiler_reset,
0, 0, 0,
- doc: /* FIXME */)
+ doc: /* Clear sample profiler log. */)
(void)
{
if (sample_log)
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;
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;
}
\f
-
-/* 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)
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)
DEFUN ("memory-profiler-reset",
Fmemory_profiler_reset, Smemory_profiler_reset,
0, 0, 0,
- doc: /* FIXME */)
+ doc: /* Clear memory profiler log. */)
(void)
{
if (memory_log)
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;
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;
}
\f
+/* Signals and probes. */
-/* Signals and probes */
+/* Signal handler for sample profiler. */
static void
sigprof_handler (int signal, siginfo_t *info, void *ctx)
sigprocmask (SIG_UNBLOCK, &sigset, 0);
}
+/* Record that the current backtrace allocated SIZE bytes. */
+
void
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)
{
projects / emacs.git / commitdiff