1 /* GNU Emacs profiler implementation.
3 Copyright (C) 2012 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
28 static void sigprof_handler (int, siginfo_t
*, void *);
29 static void block_sigprof (void);
30 static void unblock_sigprof (void);
32 int sample_profiler_running
;
33 int memory_profiler_running
;
41 pattern_exact
, /* foo */
42 pattern_body_exact
, /* *foo* */
43 pattern_pre_any
, /* *foo */
44 pattern_post_any
, /* foo* */
45 pattern_body_any
/* foo*bar */
50 enum pattern_type type
;
57 static struct pattern
*
58 parse_pattern (const char *pattern
)
60 int length
= strlen (pattern
);
61 enum pattern_type type
;
65 (struct pattern
*) xmalloc (sizeof (struct pattern
));
69 && pattern
[length
- 1] == '*')
71 type
= pattern_body_exact
;
72 exact
= xstrdup (pattern
+ 1);
73 exact
[length
- 2] = 0;
75 else if (*pattern
== '*')
77 type
= pattern_pre_any
;
78 exact
= xstrdup (pattern
+ 1);
80 else if (pattern
[length
- 1] == '*')
82 type
= pattern_post_any
;
83 exact
= xstrdup (pattern
);
84 exact
[length
- 1] = 0;
86 else if (strchr (pattern
, '*'))
88 type
= pattern_body_any
;
89 exact
= xstrdup (pattern
);
90 extra
= strchr (exact
, '*');
96 exact
= xstrdup (pattern
);
102 pat
->exact_length
= strlen (exact
);
103 pat
->extra_length
= extra
? strlen (extra
) : 0;
109 free_pattern (struct pattern
*pattern
)
111 xfree (pattern
->exact
);
116 pattern_match_1 (enum pattern_type type
,
122 if (exact_length
> length
)
127 return exact_length
== length
&& !strncmp (exact
, string
, length
);
128 case pattern_body_exact
:
129 return strstr (string
, exact
) != 0;
130 case pattern_pre_any
:
131 return !strncmp (exact
, string
+ (length
- exact_length
), exact_length
);
132 case pattern_post_any
:
133 return !strncmp (exact
, string
, exact_length
);
134 case pattern_body_any
:
140 pattern_match (struct pattern
*pattern
, const char *string
)
142 int length
= strlen (string
);
143 switch (pattern
->type
)
145 case pattern_body_any
:
146 if (pattern
->exact_length
+ pattern
->extra_length
> length
)
148 return pattern_match_1 (pattern_post_any
,
150 pattern
->exact_length
,
152 && pattern_match_1 (pattern_pre_any
,
154 pattern
->extra_length
,
157 return pattern_match_1 (pattern
->type
,
159 pattern
->exact_length
,
165 match (const char *pattern
, const char *string
)
168 struct pattern
*pat
= parse_pattern (pattern
);
169 res
= pattern_match (pat
, string
);
176 should_match (const char *pattern
, const char *string
)
178 putchar (match (pattern
, string
) ? '.' : 'F');
182 should_not_match (const char *pattern
, const char *string
)
184 putchar (match (pattern
, string
) ? 'F' : '.');
188 pattern_match_tests (void)
190 should_match ("", "");
191 should_not_match ("", "a");
192 should_match ("a", "a");
193 should_not_match ("a", "ab");
194 should_not_match ("ab", "a");
195 should_match ("*a*", "a");
196 should_match ("*a*", "ab");
197 should_match ("*a*", "ba");
198 should_match ("*a*", "bac");
199 should_not_match ("*a*", "");
200 should_not_match ("*a*", "b");
201 should_match ("*", "");
202 should_match ("*", "a");
203 should_match ("a*", "a");
204 should_match ("a*", "ab");
205 should_not_match ("a*", "");
206 should_not_match ("a*", "ba");
207 should_match ("*a", "a");
208 should_match ("*a", "ba");
209 should_not_match ("*a", "");
210 should_not_match ("*a", "ab");
211 should_match ("a*b", "ab");
212 should_match ("a*b", "acb");
213 should_match ("a*b", "aab");
214 should_match ("a*b", "abb");
215 should_not_match ("a*b", "");
216 should_not_match ("a*b", "");
217 should_not_match ("a*b", "abc");
222 static struct pattern
*filter_pattern
;
225 set_filter_pattern (const char *pattern
)
227 if (sample_profiler_running
)
232 free_pattern (filter_pattern
);
235 if (!pattern
) return;
236 filter_pattern
= parse_pattern (pattern
);
238 if (sample_profiler_running
)
243 apply_filter_1 (Lisp_Object function
)
250 if (SYMBOLP (function
))
251 name
= SDATA (SYMBOL_NAME (function
));
252 else if (SUBRP (function
))
253 name
= XSUBR (function
)->symbol_name
;
257 return pattern_match (filter_pattern
, name
);
261 apply_filter (struct backtrace
*backlist
)
265 if (apply_filter_1 (*backlist
->function
))
267 backlist
= backlist
->next
;
272 DEFUN ("profiler-set-filter-pattern",
273 Fprofiler_set_filter_pattern
, Sprofiler_set_filter_pattern
,
276 (Lisp_Object pattern
)
280 set_filter_pattern (0);
283 else if (!STRINGP (pattern
))
284 error ("Invalid type of profiler filter pattern");
286 set_filter_pattern (SDATA (pattern
));
296 make_backtrace (int size
)
298 return Fmake_vector (make_number (size
), Qnil
);
302 backtrace_hash (Lisp_Object backtrace
)
306 for (i
= 0; i
< ASIZE (backtrace
); i
++)
308 hash
= SXHASH_COMBINE (XUINT (AREF (backtrace
, i
)), hash
);
313 backtrace_equal (Lisp_Object a
, Lisp_Object b
)
317 for (i
= 0, j
= 0;; i
++, j
++)
319 Lisp_Object x
= i
< ASIZE (a
) ? AREF (a
, i
) : Qnil
;
320 Lisp_Object y
= j
< ASIZE (b
) ? AREF (b
, j
) : Qnil
;
321 if (NILP (x
) && NILP (y
))
331 backtrace_object_1 (Lisp_Object backtrace
, int i
)
333 if (i
>= ASIZE (backtrace
) || NILP (AREF (backtrace
, i
)))
336 return Fcons (AREF (backtrace
, i
), backtrace_object_1 (backtrace
, i
+ 1));
340 backtrace_object (Lisp_Object backtrace
)
342 backtrace_object_1 (backtrace
, 0);
351 struct slot
*next
, *prev
;
352 Lisp_Object backtrace
;
354 unsigned int elapsed
;
355 unsigned char used
: 1;
359 mark_slot (struct slot
*slot
)
361 mark_object (slot
->backtrace
);
365 slot_object (struct slot
*slot
)
367 return list3 (backtrace_object (slot
->backtrace
),
368 make_number (slot
->count
),
369 make_number (slot
->elapsed
));
380 struct slot
*free_list
;
384 clear_slot_heap (struct slot_heap
*heap
)
388 struct slot
*free_list
;
392 for (i
= 0; i
< heap
->size
; i
++)
395 free_list
= heap
->free_list
= heap
->data
;
396 for (i
= 1; i
< heap
->size
; i
++)
398 free_list
->next
= &data
[i
];
399 free_list
= free_list
->next
;
404 static struct slot_heap
*
405 make_slot_heap (unsigned int size
, int max_stack_depth
)
408 struct slot_heap
*heap
;
411 data
= (struct slot
*) xmalloc (sizeof (struct slot
) * size
);
412 for (i
= 0; i
< size
; i
++)
413 data
[i
].backtrace
= make_backtrace (max_stack_depth
);
415 heap
= (struct slot_heap
*) xmalloc (sizeof (struct slot_heap
));
418 clear_slot_heap (heap
);
424 free_slot_heap (struct slot_heap
*heap
)
427 struct slot
*data
= heap
->data
;
428 for (i
= 0; i
< heap
->size
; i
++)
429 data
[i
].backtrace
= Qnil
;
435 mark_slot_heap (struct slot_heap
*heap
)
438 for (i
= 0; i
< heap
->size
; i
++)
439 mark_slot (&heap
->data
[i
]);
443 allocate_slot (struct slot_heap
*heap
)
446 if (!heap
->free_list
)
448 slot
= heap
->free_list
;
452 heap
->free_list
= heap
->free_list
->next
;
457 free_slot (struct slot_heap
*heap
, struct slot
*slot
)
459 eassert (slot
->used
);
461 slot
->next
= heap
->free_list
;
462 heap
->free_list
= slot
;
466 min_slot (struct slot_heap
*heap
)
469 struct slot
*min
= 0;
470 for (i
= 0; i
< heap
->size
; i
++)
472 struct slot
*slot
= &heap
->data
[i
];
473 if (!min
|| (slot
->used
&& slot
->count
< min
->count
))
490 clear_slot_table (struct slot_table
*table
)
493 for (i
= 0; i
< table
->size
; i
++)
497 static struct slot_table
*
498 make_slot_table (int size
)
500 struct slot_table
*table
501 = (struct slot_table
*) xmalloc (sizeof (struct slot_table
));
503 table
->data
= (struct slot
**) xmalloc (sizeof (struct slot
*) * size
);
504 clear_slot_table (table
);
509 free_slot_table (struct slot_table
*table
)
516 remove_slot (struct slot_table
*table
, struct slot
*slot
)
519 slot
->prev
->next
= slot
->next
;
522 EMACS_UINT hash
= backtrace_hash (slot
->backtrace
);
523 table
->data
[hash
% table
->size
] = slot
->next
;
526 slot
->next
->prev
= slot
->prev
;
536 Lisp_Object backtrace
;
537 struct slot_heap
*slot_heap
;
538 struct slot_table
*slot_table
;
539 unsigned int others_count
;
540 unsigned int others_elapsed
;
544 make_log (const char *type
, int heap_size
, int max_stack_depth
)
547 (struct log
*) xmalloc (sizeof (struct log
));
548 log
->type
= intern (type
);
549 log
->backtrace
= make_backtrace (max_stack_depth
);
550 log
->slot_heap
= make_slot_heap (heap_size
, max_stack_depth
);
551 log
->slot_table
= make_slot_table (max (256, heap_size
) / 10);
552 log
->others_count
= 0;
553 log
->others_elapsed
= 0;
558 free_log (struct log
*log
)
560 log
->backtrace
= Qnil
;
561 free_slot_heap (log
->slot_heap
);
562 free_slot_table (log
->slot_table
);
566 mark_log (struct log
*log
)
568 mark_object (log
->type
);
569 mark_object (log
->backtrace
);
570 mark_slot_heap (log
->slot_heap
);
574 clear_log (struct log
*log
)
576 clear_slot_heap (log
->slot_heap
);
577 clear_slot_table (log
->slot_table
);
578 log
->others_count
= 0;
579 log
->others_elapsed
= 0;
583 evict_slot (struct log
*log
, struct slot
*slot
)
585 log
->others_count
+= slot
->count
;
586 log
->others_elapsed
+= slot
->elapsed
;
587 remove_slot (log
->slot_table
, slot
);
588 free_slot (log
->slot_heap
, slot
);
592 evict_min_slot (struct log
*log
)
594 struct slot
*min
= min_slot (log
->slot_heap
);
596 evict_slot (log
, min
);
600 new_slot (struct log
*log
, Lisp_Object backtrace
)
603 struct slot
*slot
= allocate_slot (log
->slot_heap
);
607 evict_min_slot (log
);
608 slot
= allocate_slot (log
->slot_heap
);
614 for (i
= 0; i
< ASIZE (backtrace
); i
++)
615 ASET (slot
->backtrace
, i
, AREF (backtrace
, i
));
621 ensure_slot (struct log
*log
, Lisp_Object backtrace
)
623 EMACS_UINT hash
= backtrace_hash (backtrace
);
624 int index
= hash
% log
->slot_table
->size
;
625 struct slot
*slot
= log
->slot_table
->data
[index
];
626 struct slot
*prev
= slot
;
630 if (backtrace_equal (backtrace
, slot
->backtrace
))
636 slot
= new_slot (log
, backtrace
);
643 log
->slot_table
->data
[index
] = slot
;
650 record_backtrace (struct log
*log
, unsigned int count
, unsigned int elapsed
)
653 Lisp_Object backtrace
= log
->backtrace
;
654 struct backtrace
*backlist
= backtrace_list
;
656 if (!apply_filter (backlist
)) return;
658 for (i
= 0; i
< ASIZE (backtrace
) && backlist
; backlist
= backlist
->next
)
660 Lisp_Object function
= *backlist
->function
;
661 if (FUNCTIONP (function
))
663 ASET (backtrace
, i
, function
);
667 for (; i
< ASIZE (backtrace
); i
++)
668 ASET (backtrace
, i
, Qnil
);
670 if (!NILP (AREF (backtrace
, 0)))
672 struct slot
*slot
= ensure_slot (log
, backtrace
);
673 slot
->count
+= count
;
674 slot
->elapsed
+= elapsed
;
679 log_object (struct log
*log
)
682 Lisp_Object slots
= Qnil
;
684 if (log
->others_count
!= 0 || log
->others_elapsed
!= 0)
685 slots
= list1 (list3 (list1 (Qt
),
686 make_number (log
->others_count
),
687 make_number (log
->others_elapsed
)));
689 for (i
= 0; i
< log
->slot_heap
->size
; i
++)
691 struct slot
*s
= &log
->slot_heap
->data
[i
];
694 Lisp_Object slot
= slot_object (s
);
695 slots
= Fcons (slot
, slots
);
699 return list4 (log
->type
, Qnil
, Fcurrent_time (), slots
);
704 /* Sample profiler */
706 static struct log
*sample_log
;
707 static int current_sample_interval
;
709 DEFUN ("sample-profiler-start", Fsample_profiler_start
, Ssample_profiler_start
,
712 (Lisp_Object sample_interval
)
715 struct itimerval timer
;
717 if (sample_profiler_running
)
718 error ("Sample profiler is already running");
721 sample_log
= make_log ("sample",
722 profiler_slot_heap_size
,
723 profiler_max_stack_depth
);
725 current_sample_interval
= XINT (sample_interval
);
727 sa
.sa_sigaction
= sigprof_handler
;
728 sa
.sa_flags
= SA_RESTART
| SA_SIGINFO
;
729 sigemptyset (&sa
.sa_mask
);
730 sigaction (SIGPROF
, &sa
, 0);
732 timer
.it_interval
.tv_sec
= 0;
733 timer
.it_interval
.tv_usec
= current_sample_interval
* 1000;
734 timer
.it_value
= timer
.it_interval
;
735 setitimer (ITIMER_PROF
, &timer
, 0);
737 sample_profiler_running
= 1;
742 DEFUN ("sample-profiler-stop", Fsample_profiler_stop
, Ssample_profiler_stop
,
747 if (!sample_profiler_running
)
748 error ("Sample profiler is not running");
749 sample_profiler_running
= 0;
751 setitimer (ITIMER_PROF
, 0, 0);
756 DEFUN ("sample-profiler-reset", Fsample_profiler_reset
, Ssample_profiler_reset
,
763 if (sample_profiler_running
)
766 clear_log (sample_log
);
771 free_log (sample_log
);
777 DEFUN ("sample-profiler-running-p",
778 Fsample_profiler_running_p
, Ssample_profiler_running_p
,
783 return sample_profiler_running
? Qt
: Qnil
;
786 DEFUN ("sample-profiler-log",
787 Fsample_profiler_log
, Ssample_profiler_log
,
793 Lisp_Object result
= Qnil
;
797 if (sample_profiler_running
)
800 result
= log_object (sample_log
);
804 result
= log_object (sample_log
);
812 /* Memory profiler */
814 static struct log
*memory_log
;
816 DEFUN ("memory-profiler-start", Fmemory_profiler_start
, Smemory_profiler_start
,
821 if (memory_profiler_running
)
822 error ("Memory profiler is already running");
825 memory_log
= make_log ("memory",
826 profiler_slot_heap_size
,
827 profiler_max_stack_depth
);
829 memory_profiler_running
= 1;
834 DEFUN ("memory-profiler-stop",
835 Fmemory_profiler_stop
, Smemory_profiler_stop
,
840 if (!memory_profiler_running
)
841 error ("Memory profiler is not running");
842 memory_profiler_running
= 0;
847 DEFUN ("memory-profiler-reset",
848 Fmemory_profiler_reset
, Smemory_profiler_reset
,
855 if (memory_profiler_running
)
856 clear_log (memory_log
);
859 free_log (memory_log
);
865 DEFUN ("memory-profiler-running-p",
866 Fmemory_profiler_running_p
, Smemory_profiler_running_p
,
871 return memory_profiler_running
? Qt
: Qnil
;
874 DEFUN ("memory-profiler-log",
875 Fmemory_profiler_log
, Smemory_profiler_log
,
880 Lisp_Object result
= Qnil
;
883 result
= log_object (memory_log
);
890 /* Signals and probes */
893 sigprof_handler (int signal
, siginfo_t
*info
, void *ctx
)
895 record_backtrace (sample_log
, 1, current_sample_interval
);
902 sigemptyset (&sigset
);
903 sigaddset (&sigset
, SIGPROF
);
904 sigprocmask (SIG_BLOCK
, &sigset
, 0);
908 unblock_sigprof (void)
911 sigemptyset (&sigset
);
912 sigaddset (&sigset
, SIGPROF
);
913 sigprocmask (SIG_UNBLOCK
, &sigset
, 0);
917 malloc_probe (size_t size
)
919 record_backtrace (memory_log
, size
, 0);
929 if (sample_profiler_running
)
932 mark_log (sample_log
);
936 mark_log (sample_log
);
939 mark_log (memory_log
);
943 syms_of_profiler (void)
945 DEFVAR_INT ("profiler-max-stack-depth", profiler_max_stack_depth
,
947 profiler_max_stack_depth
= 16;
948 DEFVAR_INT ("profiler-slot-heap-size", profiler_slot_heap_size
,
950 profiler_slot_heap_size
= 10000;
952 defsubr (&Sprofiler_set_filter_pattern
);
954 defsubr (&Ssample_profiler_start
);
955 defsubr (&Ssample_profiler_stop
);
956 defsubr (&Ssample_profiler_reset
);
957 defsubr (&Ssample_profiler_running_p
);
958 defsubr (&Ssample_profiler_log
);
960 defsubr (&Smemory_profiler_start
);
961 defsubr (&Smemory_profiler_stop
);
962 defsubr (&Smemory_profiler_reset
);
963 defsubr (&Smemory_profiler_running_p
);
964 defsubr (&Smemory_profiler_log
);