1 /* 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/>. */
30 typedef struct Lisp_Hash_Table log_t
;
33 make_log (int heap_size
, int max_stack_depth
)
35 /* We use a standard Elisp hash-table object, but we use it in
36 a special way. This is OK as long as the object is not exposed
37 to Elisp, i.e. until it is returned by *-profiler-log, after which
38 it can't be used any more. */
39 Lisp_Object log
= make_hash_table (Qequal
, make_number (heap_size
),
40 make_float (DEFAULT_REHASH_SIZE
),
41 make_float (DEFAULT_REHASH_THRESHOLD
),
43 struct Lisp_Hash_Table
*h
= XHASH_TABLE (log
);
45 /* What is special about our hash-tables is that the keys are pre-filled
46 with the vectors we'll put in them. */
47 int i
= ASIZE (h
->key_and_value
) / 2;
49 set_hash_key_slot (h
, --i
,
50 Fmake_vector (make_number (max_stack_depth
), Qnil
));
54 /* Evict the least used half of the hash_table.
56 When the table is full, we have to evict someone.
57 The easiest and most efficient is to evict the value we're about to add
58 (i.e. once the table is full, stop sampling).
60 We could also pick the element with the lowest count and evict it,
61 but finding it is O(N) and for that amount of work we get very
62 little in return: for the next sample, this latest sample will have
63 count==1 and will hence be a prime candidate for eviction :-(
65 So instead, we take O(N) time to eliminate more or less half of the
66 entries (the half with the lowest counts). So we get an amortized
67 cost of O(1) and we get O(N) time for a new entry to grow larger
68 than the other least counts before a new round of eviction. */
70 static EMACS_INT
approximate_median (log_t
*log
,
71 ptrdiff_t start
, ptrdiff_t size
)
75 return XINT (HASH_VALUE (log
, start
));
77 /* Not an actual median, but better for our application than
78 choosing either of the two numbers. */
79 return ((XINT (HASH_VALUE (log
, start
))
80 + XINT (HASH_VALUE (log
, start
+ 1)))
84 ptrdiff_t newsize
= size
/ 3;
85 ptrdiff_t start2
= start
+ newsize
;
86 EMACS_INT i1
= approximate_median (log
, start
, newsize
);
87 EMACS_INT i2
= approximate_median (log
, start2
, newsize
);
88 EMACS_INT i3
= approximate_median (log
, start2
+ newsize
,
91 ? (i2
< i3
? i2
: (i1
< i3
? i3
: i1
))
92 : (i1
< i3
? i1
: (i2
< i3
? i3
: i2
)));
96 static void evict_lower_half (log_t
*log
)
98 ptrdiff_t size
= ASIZE (log
->key_and_value
) / 2;
99 EMACS_INT median
= approximate_median (log
, 0, size
);
102 for (i
= 0; i
< size
; i
++)
103 /* Evict not only values smaller but also values equal to the median,
104 so as to make sure we evict something no matter what. */
105 if (XINT (HASH_VALUE (log
, i
)) <= median
)
107 Lisp_Object key
= HASH_KEY (log
, i
);
108 { /* FIXME: we could make this more efficient. */
110 XSET_HASH_TABLE (tmp
, log
); /* FIXME: Use make_lisp_ptr. */
113 eassert (EQ (log
->next_free
, make_number (i
)));
116 eassert (VECTORP (key
));
117 for (j
= 0; j
< ASIZE (key
); j
++)
120 set_hash_key_slot (log
, i
, key
);
124 /* Record the current backtrace in LOG. BASE is a special name for
125 describing which the backtrace come from. BASE can be nil. COUNT is
126 a number how many times the profiler sees the backtrace at the
127 time. ELAPSED is a elapsed time in millisecond that the backtrace
131 record_backtrace (log_t
*log
, size_t count
)
133 struct backtrace
*backlist
= backtrace_list
;
134 Lisp_Object backtrace
;
135 ptrdiff_t index
, i
= 0;
138 if (!INTEGERP (log
->next_free
))
139 evict_lower_half (log
);
140 index
= XINT (log
->next_free
);
142 /* Get a "working memory" vector. */
143 backtrace
= HASH_KEY (log
, index
);
144 asize
= ASIZE (backtrace
);
146 /* Copy the backtrace contents into working memory. */
147 for (; i
< asize
&& backlist
; i
++, backlist
= backlist
->next
)
148 ASET (backtrace
, i
, *backlist
->function
);
150 /* Make sure that unused space of working memory is filled with nil. */
151 for (; i
< asize
; i
++)
152 ASET (backtrace
, i
, Qnil
);
154 { /* We basically do a `gethash+puthash' here, except that we have to be
155 careful to avoid memory allocation since we're in a signal
156 handler, and we optimize the code to try and avoid computing the
157 hash+lookup twice. See fns.c:Fputhash for reference. */
159 ptrdiff_t j
= hash_lookup (log
, backtrace
, &hash
);
161 set_hash_value_slot (log
, j
,
162 make_number (count
+ XINT (HASH_VALUE (log
, j
))));
164 { /* BEWARE! hash_put in general can allocate memory.
165 But currently it only does that if log->next_free is nil. */
167 eassert (!NILP (log
->next_free
));
168 j
= hash_put (log
, backtrace
, make_number (count
), hash
);
169 /* Let's make sure we've put `backtrace' right where it
170 already was to start with. */
171 eassert (index
== j
);
173 /* FIXME: If the hash-table is almost full, we should set
174 some global flag so that some Elisp code can offload its
175 data elsewhere, so as to avoid the eviction code. */
180 /* Sample profiler. */
182 #if defined SIGPROF && defined HAVE_SETITIMER
183 #define PROFILER_CPU_SUPPORT
185 /* True if sampling profiler is running. */
186 static bool profiler_cpu_running
;
188 static Lisp_Object cpu_log
;
189 /* Separate counter for the time spent in the GC. */
190 static EMACS_INT cpu_gc_count
;
192 /* The current sample interval in millisecond. */
194 static int current_sample_interval
;
196 /* Signal handler for sample profiler. */
199 sigprof_handler (int signal
, siginfo_t
*info
, void *ctx
)
201 eassert (HASH_TABLE_P (cpu_log
));
202 if (backtrace_list
&& EQ (*backtrace_list
->function
, Qautomatic_gc
))
203 /* Special case the time-count inside GC because the hash-table
204 code is not prepared to be used while the GC is running.
205 More specifically it uses ASIZE at many places where it does
206 not expect the ARRAY_MARK_FLAG to be set. We could try and
207 harden the hash-table code, but it doesn't seem worth the
209 cpu_gc_count
+= current_sample_interval
;
211 record_backtrace (XHASH_TABLE (cpu_log
), current_sample_interval
);
214 DEFUN ("profiler-cpu-start", Fprofiler_cpu_start
, Sprofiler_cpu_start
,
216 doc
: /* Start or restart the cpu profiler.
217 The cpu profiler will take call-stack samples each SAMPLE-INTERVAL (expressed in milliseconds).
218 See also `profiler-log-size' and `profiler-max-stack-depth'. */)
219 (Lisp_Object sample_interval
)
222 struct itimerval timer
;
224 if (profiler_cpu_running
)
225 error ("Sample profiler is already running");
230 cpu_log
= make_log (profiler_log_size
,
231 profiler_max_stack_depth
);
234 current_sample_interval
= XINT (sample_interval
);
236 sa
.sa_sigaction
= sigprof_handler
;
237 sa
.sa_flags
= SA_RESTART
| SA_SIGINFO
;
238 sigemptyset (&sa
.sa_mask
);
239 sigaction (SIGPROF
, &sa
, 0);
241 timer
.it_interval
.tv_sec
= 0;
242 timer
.it_interval
.tv_usec
= current_sample_interval
* 1000;
243 timer
.it_value
= timer
.it_interval
;
244 setitimer (ITIMER_PROF
, &timer
, 0);
246 profiler_cpu_running
= 1;
251 DEFUN ("profiler-cpu-stop", Fprofiler_cpu_stop
, Sprofiler_cpu_stop
,
253 doc
: /* Stop the cpu profiler. The profiler log is not affected. */)
256 if (!profiler_cpu_running
)
257 error ("Sample profiler is not running");
258 profiler_cpu_running
= 0;
260 setitimer (ITIMER_PROF
, 0, 0);
265 DEFUN ("profiler-cpu-running-p",
266 Fprofiler_cpu_running_p
, Sprofiler_cpu_running_p
,
268 doc
: /* Return non-nil iff cpu profiler is running. */)
271 return profiler_cpu_running
? Qt
: Qnil
;
274 DEFUN ("profiler-cpu-log", Fprofiler_cpu_log
, Sprofiler_cpu_log
,
276 doc
: /* Return the current cpu profiler log.
277 The log is a hash-table mapping backtraces to counters which represent
278 the amount of time spent at those points. Every backtrace is a vector
279 of functions, where the last few elements may be nil.
280 Before returning, a new log is allocated for future samples. */)
283 Lisp_Object result
= cpu_log
;
284 /* Here we're making the log visible to Elisp , so it's not safe any
285 more for our use afterwards since we can't rely on its special
286 pre-allocated keys anymore. So we have to allocate a new one. */
287 cpu_log
= (profiler_cpu_running
288 ? make_log (profiler_log_size
, profiler_max_stack_depth
)
290 Fputhash (Fmake_vector (make_number (1), Qautomatic_gc
),
291 make_number (cpu_gc_count
),
296 #endif /* not defined PROFILER_CPU_SUPPORT */
298 /* Memory profiler. */
300 /* True if memory profiler is running. */
301 bool profiler_memory_running
;
303 static Lisp_Object memory_log
;
305 DEFUN ("profiler-memory-start", Fprofiler_memory_start
, Sprofiler_memory_start
,
307 doc
: /* Start/restart the memory profiler.
308 The memory profiler will take samples of the call-stack whenever a new
309 allocation takes place. Note that most small allocations only trigger
310 the profiler occasionally.
311 See also `profiler-log-size' and `profiler-max-stack-depth'. */)
314 if (profiler_memory_running
)
315 error ("Memory profiler is already running");
317 if (NILP (memory_log
))
318 memory_log
= make_log (profiler_log_size
,
319 profiler_max_stack_depth
);
321 profiler_memory_running
= 1;
326 DEFUN ("profiler-memory-stop",
327 Fprofiler_memory_stop
, Sprofiler_memory_stop
,
329 doc
: /* Stop the memory profiler. The profiler log is not affected. */)
332 if (!profiler_memory_running
)
333 error ("Memory profiler is not running");
334 profiler_memory_running
= 0;
339 DEFUN ("profiler-memory-running-p",
340 Fprofiler_memory_running_p
, Sprofiler_memory_running_p
,
342 doc
: /* Return non-nil if memory profiler is running. */)
345 return profiler_memory_running
? Qt
: Qnil
;
348 DEFUN ("profiler-memory-log",
349 Fprofiler_memory_log
, Sprofiler_memory_log
,
351 doc
: /* Return the current memory profiler log.
352 The log is a hash-table mapping backtraces to counters which represent
353 the amount of memory allocated at those points. Every backtrace is a vector
354 of functions, where the last few elements may be nil.
355 Before returning, a new log is allocated for future samples. */)
358 Lisp_Object result
= memory_log
;
359 /* Here we're making the log visible to Elisp , so it's not safe any
360 more for our use afterwards since we can't rely on its special
361 pre-allocated keys anymore. So we have to allocate a new one. */
362 memory_log
= (profiler_memory_running
363 ? make_log (profiler_log_size
, profiler_max_stack_depth
)
369 /* Signals and probes. */
371 /* Record that the current backtrace allocated SIZE bytes. */
373 malloc_probe (size_t size
)
375 eassert (HASH_TABLE_P (memory_log
));
376 record_backtrace (XHASH_TABLE (memory_log
), size
);
380 syms_of_profiler (void)
382 DEFVAR_INT ("profiler-max-stack-depth", profiler_max_stack_depth
,
383 doc
: /* Number of elements from the call-stack recorded in the log. */);
384 profiler_max_stack_depth
= 16;
385 DEFVAR_INT ("profiler-log-size", profiler_log_size
,
386 doc
: /* Number of distinct call-stacks that can be recorded in a profiler log.
387 If the log gets full, some of the least-seen call-stacks will be evicted
388 to make room for new entries. */);
389 profiler_log_size
= 10000;
391 #ifdef PROFILER_CPU_SUPPORT
393 staticpro (&cpu_log
);
394 defsubr (&Sprofiler_cpu_start
);
395 defsubr (&Sprofiler_cpu_stop
);
396 defsubr (&Sprofiler_cpu_running_p
);
397 defsubr (&Sprofiler_cpu_log
);
400 staticpro (&memory_log
);
401 defsubr (&Sprofiler_memory_start
);
402 defsubr (&Sprofiler_memory_stop
);
403 defsubr (&Sprofiler_memory_running_p
);
404 defsubr (&Sprofiler_memory_log
);