aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorMattias EngdegÄrd2023-11-01 16:42:59 +0100
committerMattias EngdegÄrd2024-01-12 18:02:14 +0100
commit22201dde773e5404f80baa1f59768e88d97a322a (patch)
treeaaaabf222aab18f92894e175721b335b9a158214 /src
parent8acd89e955f9422c5201d0db102d3a5ac05f3094 (diff)
downloademacs-22201dde773e5404f80baa1f59768e88d97a322a.tar.gz
emacs-22201dde773e5404f80baa1f59768e88d97a322a.zip
Decouple profiler from Lisp hash table internals
The profiler stored data being collected in Lisp hash tables but relied heavily on their exact internal representation, which made it difficult and error-prone to change the hash table implementation. In particular, the profiler has special run-time requirements that are not easily met using standard Lisp data structures: accesses and updates are made from async signal handlers in almost any messy context you can think of and are therefore very constrained in what they can do. The new profiler tables are designed specifically for their purpose and are more efficient and, by not being coupled to Lisp hash tables, easier to keep safe. The old profiler morphed internal hash tables to ones usable from Lisp and thereby made them impossible to use internally; now export_log just makes new hash table objects for Lisp. The Lisp part of the profiler remains entirely unchanged. * src/alloc.c (garbage_collect): Mark profiler tables. * src/eval.c (get_backtrace): Fill an array of Lisp values instead of a Lisp vector. * src/profiler.c (log_t): No longer a Lisp hash table but a custom data structure: a fully associative fixed-sized cache that maps fixed-size arrays of Lisp objects to counts. (make_log): Build new struct. (mark_log, free_log, get_log_count, set_log_count, get_key_vector) (log_hash_index, remove_log_entry, trace_equal, trace_hash) (make_profiler_log, free_profiler_log, mark_profiler): New. (cmpfn_profiler, hashtest_profiler, hashfn_profiler) (syms_of_profiler_for_pdumper): Remove. (approximate_median, evict_lower_half, record_backtrace, export_log) (Fprofiler_cpu_log, Fprofiler_memory_log, syms_of_profiler): Adapt to the new data structure.
Diffstat (limited to 'src')
-rw-r--r--src/alloc.c1
-rw-r--r--src/eval.c23
-rw-r--r--src/lisp.h3
-rw-r--r--src/profiler.c487
4 files changed, 295 insertions, 219 deletions
diff --git a/src/alloc.c b/src/alloc.c
index 53ba85d88b7..fae76d24189 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -6541,6 +6541,7 @@ garbage_collect (void)
6541 mark_terminals (); 6541 mark_terminals ();
6542 mark_kboards (); 6542 mark_kboards ();
6543 mark_threads (); 6543 mark_threads ();
6544 mark_profiler ();
6544#ifdef HAVE_PGTK 6545#ifdef HAVE_PGTK
6545 mark_pgtkterm (); 6546 mark_pgtkterm ();
6546#endif 6547#endif
diff --git a/src/eval.c b/src/eval.c
index 94f6d8e31f8..c995183ceb8 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -4250,23 +4250,18 @@ mark_specpdl (union specbinding *first, union specbinding *ptr)
4250 } 4250 }
4251} 4251}
4252 4252
4253/* Fill ARRAY of size SIZE with backtrace entries, most recent call first.
4254 Truncate the backtrace if longer than SIZE; pad with nil if shorter. */
4253void 4255void
4254get_backtrace (Lisp_Object array) 4256get_backtrace (Lisp_Object *array, ptrdiff_t size)
4255{ 4257{
4256 union specbinding *pdl = backtrace_top ();
4257 ptrdiff_t i = 0, asize = ASIZE (array);
4258
4259 /* Copy the backtrace contents into working memory. */ 4258 /* Copy the backtrace contents into working memory. */
4260 for (; i < asize; i++) 4259 union specbinding *pdl = backtrace_top ();
4261 { 4260 ptrdiff_t i = 0;
4262 if (backtrace_p (pdl)) 4261 for (; i < size && backtrace_p (pdl); i++, pdl = backtrace_next (pdl))
4263 { 4262 array[i] = backtrace_function (pdl);
4264 ASET (array, i, backtrace_function (pdl)); 4263 for (; i < size; i++)
4265 pdl = backtrace_next (pdl); 4264 array[i] = Qnil;
4266 }
4267 else
4268 ASET (array, i, Qnil);
4269 }
4270} 4265}
4271 4266
4272Lisp_Object backtrace_top_function (void) 4267Lisp_Object backtrace_top_function (void)
diff --git a/src/lisp.h b/src/lisp.h
index 44f69892c6f..5ec895ecc81 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4608,7 +4608,7 @@ extern void init_eval (void);
4608extern void syms_of_eval (void); 4608extern void syms_of_eval (void);
4609extern void prog_ignore (Lisp_Object); 4609extern void prog_ignore (Lisp_Object);
4610extern void mark_specpdl (union specbinding *first, union specbinding *ptr); 4610extern void mark_specpdl (union specbinding *first, union specbinding *ptr);
4611extern void get_backtrace (Lisp_Object array); 4611extern void get_backtrace (Lisp_Object *array, ptrdiff_t size);
4612Lisp_Object backtrace_top_function (void); 4612Lisp_Object backtrace_top_function (void);
4613extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol); 4613extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol);
4614void do_debug_on_call (Lisp_Object code, specpdl_ref count); 4614void do_debug_on_call (Lisp_Object code, specpdl_ref count);
@@ -5225,6 +5225,7 @@ void syms_of_dbusbind (void);
5225extern bool profiler_memory_running; 5225extern bool profiler_memory_running;
5226extern void malloc_probe (size_t); 5226extern void malloc_probe (size_t);
5227extern void syms_of_profiler (void); 5227extern void syms_of_profiler (void);
5228extern void mark_profiler (void);
5228 5229
5229 5230
5230#ifdef DOS_NT 5231#ifdef DOS_NT
diff --git a/src/profiler.c b/src/profiler.c
index 243a34872c2..48a042cc8aa 100644
--- a/src/profiler.c
+++ b/src/profiler.c
@@ -34,23 +34,152 @@ saturated_add (EMACS_INT a, EMACS_INT b)
34 34
35/* Logs. */ 35/* Logs. */
36 36
37typedef struct Lisp_Hash_Table log_t; 37/* A fully associative cache of size SIZE, mapping vectors of DEPTH
38 Lisp objects to counts. */
39typedef struct {
40 /* We use `int' throughout for table indices because anything bigger
41 is overkill. (Maybe we should make a typedef, but int is short.) */
42 int size; /* number of entries */
43 int depth; /* elements in each key vector */
44 int index_size; /* size of index */
45 Lisp_Object *trace; /* working trace, `depth' elements */
46 int *index; /* `index_size' indices or -1 if nothing */
47 int *next; /* `size' indices to next bucket or -1 */
48 EMACS_UINT *hash; /* `size' hash values */
49 Lisp_Object *keys; /* `size' keys of `depth' objects each */
50 EMACS_INT *counts; /* `size' entries, 0 indicates unused entry */
51 int next_free; /* next free entry, -1 if all taken */
52} log_t;
38 53
39static Lisp_Object cmpfn_profiler (Lisp_Object, Lisp_Object, 54static void
40 struct Lisp_Hash_Table *); 55mark_log (log_t *log)
41static Lisp_Object hashfn_profiler (Lisp_Object, struct Lisp_Hash_Table *); 56{
57 if (log == NULL)
58 return;
59 int size = log->size;
60 int depth = log->depth;
61 for (int i = 0; i < size; i++)
62 if (log->counts[i] > 0) /* Only mark valid keys. */
63 mark_objects (log->keys + i * depth, depth);
64}
65
66static log_t *
67make_log (int size, int depth)
68{
69 log_t *log = xmalloc (sizeof *log);
70 log->size = size;
71 log->depth = depth;
72
73 /* The index size is arbitrary but for there to be any point it should be
74 bigger than SIZE. FIXME: make it a power of 2 or a (pseudo)prime. */
75 int index_size = size * 2 + 1;
76 log->index_size = index_size;
77
78 log->trace = xmalloc (depth * sizeof *log->trace);
79
80 log->index = xmalloc (index_size * sizeof *log->index);
81 for (int i = 0; i < index_size; i++)
82 log->index[i] = -1;
83
84 log->next = xmalloc (size * sizeof *log->next);
85 for (int i = 0; i < size - 1; i++)
86 log->next[i] = i + 1;
87 log->next[size - 1] = -1;
88 log->next_free = 0;
89
90 log->hash = xmalloc (size * sizeof *log->hash);
91 log->keys = xzalloc (size * depth * sizeof *log->keys);
92 log->counts = xzalloc (size * sizeof *log->counts);
93
94 return log;
95}
96
97static void
98free_log (log_t *log)
99{
100 xfree (log->trace);
101 xfree (log->index);
102 xfree (log->next);
103 xfree (log->hash);
104 xfree (log->keys);
105 xfree (log->counts);
106 xfree (log);
107}
108
109static inline EMACS_INT
110get_log_count (log_t *log, int idx)
111{
112 eassume (idx >= 0 && idx < log->size);
113 return log->counts[idx];
114}
115
116static inline void
117set_log_count (log_t *log, int idx, EMACS_INT val)
118{
119 eassume (idx >= 0 && idx < log->size && val >= 0);
120 log->counts[idx] = val;
121}
122
123static inline Lisp_Object *
124get_key_vector (log_t *log, int idx)
125{
126 eassume (idx >= 0 && idx < log->size);
127 return log->keys + idx * log->depth;
128}
129
130static inline int
131log_hash_index (log_t *log, EMACS_UINT hash)
132{
133 /* FIXME: avoid division. */
134 return hash % log->index_size;
135}
136
137static void
138remove_log_entry (log_t *log, int idx)
139{
140 eassume (idx >= 0 && idx < log->size);
141 /* Remove from index. */
142 int hidx = log_hash_index (log, log->hash[idx]);
143 int *p = &log->index[hidx];
144 while (*p != idx)
145 {
146 eassert (*p >= 0 && *p < log->size);
147 p = &log->next[*p];
148 }
149 *p = log->next[*p];
150 /* Invalidate entry and put it on the free list. */
151 log->counts[idx] = 0;
152 log->next[idx] = log->next_free;
153 log->next_free = idx;
154}
42 155
43static const struct hash_table_test hashtest_profiler = 156static bool
44 { 157trace_equal (Lisp_Object *bt1, Lisp_Object *bt2, int depth)
45 LISPSYM_INITIALLY (Qprofiler_backtrace_equal), 158{
46 LISPSYM_INITIALLY (Qnil) /* user_hash_function */, 159 for (int i = 0; i < depth; i++)
47 LISPSYM_INITIALLY (Qnil) /* user_cmp_function */, 160 if (!BASE_EQ (bt1[i], bt2[i]) && NILP (Ffunction_equal (bt1[i], bt2[i])))
48 cmpfn_profiler, 161 return false;
49 hashfn_profiler, 162 return true;
50 }; 163}
164
165static EMACS_UINT
166trace_hash (Lisp_Object *trace, int depth)
167{
168 EMACS_UINT hash = 0;
169 for (int i = 0; i < depth; i++)
170 {
171 Lisp_Object f = trace[i];
172 EMACS_UINT hash1
173 = (COMPILEDP (f) ? XHASH (AREF (f, COMPILED_BYTECODE))
174 : (CONSP (f) && CONSP (XCDR (f)) && BASE_EQ (Qclosure, XCAR (f)))
175 ? XHASH (XCDR (XCDR (f))) : XHASH (f));
176 hash = sxhash_combine (hash, hash1);
177 }
178 return hash;
179}
51 180
52struct profiler_log { 181struct profiler_log {
53 Lisp_Object log; 182 log_t *log;
54 EMACS_INT gc_count; /* Samples taken during GC. */ 183 EMACS_INT gc_count; /* Samples taken during GC. */
55 EMACS_INT discarded; /* Samples evicted during table overflow. */ 184 EMACS_INT discarded; /* Samples evicted during table overflow. */
56}; 185};
@@ -58,32 +187,22 @@ struct profiler_log {
58static Lisp_Object export_log (struct profiler_log *); 187static Lisp_Object export_log (struct profiler_log *);
59 188
60static struct profiler_log 189static struct profiler_log
61make_log (void) 190make_profiler_log (void)
62{ 191{
63 /* We use a standard Elisp hash-table object, but we use it in 192 int size = clip_to_bounds (0, profiler_log_size,
64 a special way. This is OK as long as the object is not exposed 193 min (MOST_POSITIVE_FIXNUM, INT_MAX));
65 to Elisp, i.e. until it is returned by *-profiler-log, after which 194 int max_stack_depth = clip_to_bounds (0, profiler_max_stack_depth, INT_MAX);
66 it can't be used any more. */ 195 return (struct profiler_log){make_log (size, max_stack_depth), 0, 0};
67 EMACS_INT heap_size
68 = clip_to_bounds (0, profiler_log_size, MOST_POSITIVE_FIXNUM);
69 ptrdiff_t max_stack_depth
70 = clip_to_bounds (0, profiler_max_stack_depth, PTRDIFF_MAX);;
71 struct profiler_log log
72 = { make_hash_table (hashtest_profiler, heap_size,
73 DEFAULT_REHASH_SIZE,
74 DEFAULT_REHASH_THRESHOLD,
75 Qnil, false),
76 0, 0 };
77 struct Lisp_Hash_Table *h = XHASH_TABLE (log.log);
78
79 /* What is special about our hash-tables is that the values are pre-filled
80 with the vectors we'll use as keys. */
81 ptrdiff_t i = ASIZE (h->key_and_value) >> 1;
82 while (i > 0)
83 set_hash_value_slot (h, --i, make_nil_vector (max_stack_depth));
84 return log;
85} 196}
86 197
198static void
199free_profiler_log (struct profiler_log *plog)
200{
201 free_log (plog->log);
202 plog->log = NULL;
203}
204
205
87/* Evict the least used half of the hash_table. 206/* Evict the least used half of the hash_table.
88 207
89 When the table is full, we have to evict someone. 208 When the table is full, we have to evict someone.
@@ -100,22 +219,22 @@ make_log (void)
100 cost of O(1) and we get O(N) time for a new entry to grow larger 219 cost of O(1) and we get O(N) time for a new entry to grow larger
101 than the other least counts before a new round of eviction. */ 220 than the other least counts before a new round of eviction. */
102 221
103static EMACS_INT approximate_median (log_t *log, 222static EMACS_INT
104 ptrdiff_t start, ptrdiff_t size) 223approximate_median (log_t *log, int start, int size)
105{ 224{
106 eassert (size > 0); 225 eassert (size > 0);
107 if (size < 2) 226 if (size < 2)
108 return XFIXNUM (HASH_VALUE (log, start)); 227 return get_log_count (log, start);
109 if (size < 3) 228 if (size < 3)
110 /* Not an actual median, but better for our application than 229 /* Not an actual median, but better for our application than
111 choosing either of the two numbers. */ 230 choosing either of the two numbers. */
112 return ((XFIXNUM (HASH_VALUE (log, start)) 231 return ((get_log_count (log, start)
113 + XFIXNUM (HASH_VALUE (log, start + 1))) 232 + get_log_count (log, start + 1))
114 / 2); 233 / 2);
115 else 234 else
116 { 235 {
117 ptrdiff_t newsize = size / 3; 236 int newsize = size / 3;
118 ptrdiff_t start2 = start + newsize; 237 int start2 = start + newsize;
119 EMACS_INT i1 = approximate_median (log, start, newsize); 238 EMACS_INT i1 = approximate_median (log, start, newsize);
120 EMACS_INT i2 = approximate_median (log, start2, newsize); 239 EMACS_INT i2 = approximate_median (log, start2, newsize);
121 EMACS_INT i3 = approximate_median (log, start2 + newsize, 240 EMACS_INT i3 = approximate_median (log, start2 + newsize,
@@ -126,34 +245,24 @@ static EMACS_INT approximate_median (log_t *log,
126 } 245 }
127} 246}
128 247
129static void evict_lower_half (struct profiler_log *plog) 248static void
249evict_lower_half (struct profiler_log *plog)
130{ 250{
131 log_t *log = XHASH_TABLE (plog->log); 251 log_t *log = plog->log;
132 ptrdiff_t size = ASIZE (log->key_and_value) / 2; 252 int size = log->size;
133 EMACS_INT median = approximate_median (log, 0, size); 253 EMACS_INT median = approximate_median (log, 0, size);
134 254
135 for (ptrdiff_t i = 0; i < size; i++) 255 for (int i = 0; i < size; i++)
136 /* Evict not only values smaller but also values equal to the median, 256 {
137 so as to make sure we evict something no matter what. */ 257 EMACS_INT count = get_log_count (log, i);
138 if (XFIXNUM (HASH_VALUE (log, i)) <= median) 258 /* Evict not only values smaller but also values equal to the median,
139 { 259 so as to make sure we evict something no matter what. */
140 Lisp_Object key = HASH_KEY (log, i); 260 if (count <= median)
141 EMACS_INT count = XFIXNUM (HASH_VALUE (log, i)); 261 {
142 plog->discarded = saturated_add (plog->discarded, count); 262 plog->discarded = saturated_add (plog->discarded, count);
143 { /* FIXME: we could make this more efficient. */ 263 remove_log_entry (log, i);
144 Lisp_Object tmp;
145 XSET_HASH_TABLE (tmp, log); /* FIXME: Use make_lisp_ptr. */
146 Fremhash (key, tmp);
147 } 264 }
148 eassert (BASE_EQ (Qunbound, HASH_KEY (log, i))); 265 }
149 eassert (log->next_free == i);
150
151 eassert (VECTORP (key));
152 for (ptrdiff_t j = 0; j < ASIZE (key); j++)
153 ASET (key, j, Qnil);
154
155 set_hash_value_slot (log, i, key);
156 }
157} 266}
158 267
159/* Record the current backtrace in LOG. COUNT is the weight of this 268/* Record the current backtrace in LOG. COUNT is the weight of this
@@ -163,54 +272,52 @@ static void evict_lower_half (struct profiler_log *plog)
163static void 272static void
164record_backtrace (struct profiler_log *plog, EMACS_INT count) 273record_backtrace (struct profiler_log *plog, EMACS_INT count)
165{ 274{
166 eassert (HASH_TABLE_P (plog->log)); 275 log_t *log = plog->log;
167 log_t *log = XHASH_TABLE (plog->log); 276 get_backtrace (log->trace, log->depth);
277 EMACS_UINT hash = trace_hash (log->trace, log->depth);
278 int hidx = log_hash_index (log, hash);
279 int idx = log->index[hidx];
280 while (idx >= 0)
281 {
282 if (log->hash[idx] == hash
283 && trace_equal (log->trace, get_key_vector (log, idx), log->depth))
284 {
285 /* Found existing entry. */
286 set_log_count (log, idx,
287 saturated_add (get_log_count (log, idx), count));
288 return;
289 }
290 idx = log->next[idx];
291 }
292
293 /* Add new entry. */
168 if (log->next_free < 0) 294 if (log->next_free < 0)
169 evict_lower_half (plog); 295 evict_lower_half (plog);
170 ptrdiff_t index = log->next_free; 296 idx = log->next_free;
171 297 eassert (idx >= 0);
172 /* Get a "working memory" vector. */ 298 log->next_free = log->next[idx];
173 Lisp_Object backtrace = HASH_VALUE (log, index); 299 log->next[idx] = log->index[hidx];
174 eassert (BASE_EQ (Qunbound, HASH_KEY (log, index))); 300 log->index[hidx] = idx;
175 get_backtrace (backtrace); 301 eassert (log->counts[idx] == 0);
176 302 log->hash[idx] = hash;
177 { /* We basically do a `gethash+puthash' here, except that we have to be 303 memcpy (get_key_vector (log, idx), log->trace,
178 careful to avoid memory allocation since we're in a signal 304 log->depth * sizeof *log->trace);
179 handler, and we optimize the code to try and avoid computing the 305 log->counts[idx] = count;
180 hash+lookup twice. See fns.c:Fputhash for reference. */ 306
181 Lisp_Object hash; 307 /* FIXME: If the hash-table is almost full, we should set
182 ptrdiff_t j = hash_lookup (log, backtrace, &hash); 308 some global flag so that some Elisp code can offload its
183 if (j >= 0) 309 data elsewhere, so as to avoid the eviction code.
184 { 310 There are 2 ways to do that:
185 EMACS_INT old_val = XFIXNUM (HASH_VALUE (log, j)); 311 - Set a flag checked in maybe_quit, such that maybe_quit can then
186 EMACS_INT new_val = saturated_add (old_val, count); 312 call Fprofiler_cpu_log and stash the full log for later use.
187 set_hash_value_slot (log, j, make_fixnum (new_val)); 313 - Set a flag check in post-gc-hook, so that Elisp code can call
188 } 314 profiler-cpu-log. That gives us more flexibility since that
189 else 315 Elisp code can then do all kinds of fun stuff like write
190 { /* BEWARE! hash_put in general can allocate memory. 316 the log to disk. Or turn it right away into a call tree.
191 But currently it only does that if log->next_free is -1. */ 317 Of course, using Elisp is generally preferable, but it may
192 eassert (0 <= log->next_free); 318 take longer until we get a chance to run the Elisp code, so
193 ptrdiff_t j = hash_put (log, backtrace, make_fixnum (count), hash); 319 there's more risk that the table will get full before we
194 /* Let's make sure we've put `backtrace' right where it 320 get there. */
195 already was to start with. */
196 eassert (index == j);
197
198 /* FIXME: If the hash-table is almost full, we should set
199 some global flag so that some Elisp code can offload its
200 data elsewhere, so as to avoid the eviction code.
201 There are 2 ways to do that, AFAICT:
202 - Set a flag checked in maybe_quit, such that maybe_quit can then
203 call Fprofiler_cpu_log and stash the full log for later use.
204 - Set a flag check in post-gc-hook, so that Elisp code can call
205 profiler-cpu-log. That gives us more flexibility since that
206 Elisp code can then do all kinds of fun stuff like write
207 the log to disk. Or turn it right away into a call tree.
208 Of course, using Elisp is generally preferable, but it may
209 take longer until we get a chance to run the Elisp code, so
210 there's more risk that the table will get full before we
211 get there. */
212 }
213 }
214} 321}
215 322
216/* Sampling profiler. */ 323/* Sampling profiler. */
@@ -234,6 +341,9 @@ add_sample (struct profiler_log *plog, EMACS_INT count)
234 341
235#ifdef PROFILER_CPU_SUPPORT 342#ifdef PROFILER_CPU_SUPPORT
236 343
344/* The sampling interval specified. */
345static Lisp_Object profiler_cpu_interval = LISPSYM_INITIALLY (Qnil);
346
237/* The profiler timer and whether it was properly initialized, if 347/* The profiler timer and whether it was properly initialized, if
238 POSIX timers are available. */ 348 POSIX timers are available. */
239#ifdef HAVE_ITIMERSPEC 349#ifdef HAVE_ITIMERSPEC
@@ -356,8 +466,8 @@ See also `profiler-log-size' and `profiler-max-stack-depth'. */)
356 if (profiler_cpu_running) 466 if (profiler_cpu_running)
357 error ("CPU profiler is already running"); 467 error ("CPU profiler is already running");
358 468
359 if (NILP (cpu.log)) 469 if (cpu.log == NULL)
360 cpu = make_log (); 470 cpu = make_profiler_log ();
361 471
362 int status = setup_cpu_timer (sampling_interval); 472 int status = setup_cpu_timer (sampling_interval);
363 if (status < 0) 473 if (status < 0)
@@ -367,6 +477,7 @@ See also `profiler-log-size' and `profiler-max-stack-depth'. */)
367 } 477 }
368 else 478 else
369 { 479 {
480 profiler_cpu_interval = sampling_interval;
370 profiler_cpu_running = status; 481 profiler_cpu_running = status;
371 if (! profiler_cpu_running) 482 if (! profiler_cpu_running)
372 error ("Unable to start profiler timer"); 483 error ("Unable to start profiler timer");
@@ -428,30 +539,51 @@ of functions, where the last few elements may be nil.
428Before returning, a new log is allocated for future samples. */) 539Before returning, a new log is allocated for future samples. */)
429 (void) 540 (void)
430{ 541{
431 return (export_log (&cpu)); 542 /* Temporarily stop profiling to avoid it interfering with our data
543 access. */
544 bool prof_cpu = profiler_cpu_running;
545 if (prof_cpu)
546 Fprofiler_cpu_stop ();
547
548 Lisp_Object ret = export_log (&cpu);
549
550 if (prof_cpu)
551 Fprofiler_cpu_start (profiler_cpu_interval);
552
553 return ret;
432} 554}
433#endif /* PROFILER_CPU_SUPPORT */ 555#endif /* PROFILER_CPU_SUPPORT */
434 556
557/* Extract log data to a Lisp hash table. The log data is then erased. */
435static Lisp_Object 558static Lisp_Object
436export_log (struct profiler_log *log) 559export_log (struct profiler_log *plog)
437{ 560{
438 Lisp_Object result = log->log; 561 log_t *log = plog->log;
439 if (log->gc_count) 562 /* The returned hash table uses `equal' as key equivalence predicate
563 which is more discriminating than the `function-equal' used by
564 the log but close enough, and will never confuse two distinct
565 keys in the log. */
566 Lisp_Object h = make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE,
567 DEFAULT_REHASH_SIZE,
568 DEFAULT_REHASH_THRESHOLD,
569 Qnil, false);
570 for (int i = 0; i < log->size; i++)
571 {
572 int count = get_log_count (log, i);
573 if (count > 0)
574 Fputhash (Fvector (log->depth, get_key_vector (log, i)),
575 make_fixnum (count), h);
576 }
577 if (plog->gc_count)
440 Fputhash (CALLN (Fvector, QAutomatic_GC, Qnil), 578 Fputhash (CALLN (Fvector, QAutomatic_GC, Qnil),
441 make_fixnum (log->gc_count), 579 make_fixnum (plog->gc_count),
442 result); 580 h);
443 if (log->discarded) 581 if (plog->discarded)
444 Fputhash (CALLN (Fvector, QDiscarded_Samples, Qnil), 582 Fputhash (CALLN (Fvector, QDiscarded_Samples, Qnil),
445 make_fixnum (log->discarded), 583 make_fixnum (plog->discarded),
446 result); 584 h);
447#ifdef PROFILER_CPU_SUPPORT 585 free_profiler_log (plog);
448 /* Here we're making the log visible to Elisp, so it's not safe any 586 return h;
449 more for our use afterwards since we can't rely on its special
450 pre-allocated keys anymore. So we have to allocate a new one. */
451 if (profiler_cpu_running)
452 *log = make_log ();
453#endif /* PROFILER_CPU_SUPPORT */
454 return result;
455} 587}
456 588
457/* Memory profiler. */ 589/* Memory profiler. */
@@ -474,8 +606,8 @@ See also `profiler-log-size' and `profiler-max-stack-depth'. */)
474 if (profiler_memory_running) 606 if (profiler_memory_running)
475 error ("Memory profiler is already running"); 607 error ("Memory profiler is already running");
476 608
477 if (NILP (memory.log)) 609 if (memory.log == NULL)
478 memory = make_log (); 610 memory = make_profiler_log ();
479 611
480 profiler_memory_running = true; 612 profiler_memory_running = true;
481 613
@@ -514,7 +646,16 @@ of functions, where the last few elements may be nil.
514Before returning, a new log is allocated for future samples. */) 646Before returning, a new log is allocated for future samples. */)
515 (void) 647 (void)
516{ 648{
517 return (export_log (&memory)); 649 bool prof_mem = profiler_memory_running;
650 if (prof_mem)
651 Fprofiler_memory_stop ();
652
653 Lisp_Object ret = export_log (&memory);
654
655 if (prof_mem)
656 Fprofiler_memory_start ();
657
658 return ret;
518} 659}
519 660
520 661
@@ -547,50 +688,15 @@ the same lambda expression, or are really unrelated function. */)
547 return res ? Qt : Qnil; 688 return res ? Qt : Qnil;
548} 689}
549 690
550static Lisp_Object 691void
551cmpfn_profiler (Lisp_Object bt1, Lisp_Object bt2, struct Lisp_Hash_Table *h) 692mark_profiler (void)
552{
553 if (EQ (bt1, bt2))
554 return Qt;
555 else if (VECTORP (bt1) && VECTORP (bt2))
556 {
557 ptrdiff_t l = ASIZE (bt1);
558 if (l != ASIZE (bt2))
559 return Qnil;
560 for (ptrdiff_t i = 0; i < l; i++)
561 if (NILP (Ffunction_equal (AREF (bt1, i), AREF (bt2, i))))
562 return Qnil;
563 return Qt;
564 }
565 else
566 return Qnil;
567}
568
569static Lisp_Object
570hashfn_profiler (Lisp_Object bt, struct Lisp_Hash_Table *h)
571{ 693{
572 EMACS_UINT hash; 694#ifdef PROFILER_CPU_SUPPORT
573 if (VECTORP (bt)) 695 mark_log (cpu.log);
574 { 696#endif
575 hash = 0; 697 mark_log (memory.log);
576 ptrdiff_t l = ASIZE (bt);
577 for (ptrdiff_t i = 0; i < l; i++)
578 {
579 Lisp_Object f = AREF (bt, i);
580 EMACS_UINT hash1
581 = (COMPILEDP (f) ? XHASH (AREF (f, COMPILED_BYTECODE))
582 : (CONSP (f) && CONSP (XCDR (f)) && EQ (Qclosure, XCAR (f)))
583 ? XHASH (XCDR (XCDR (f))) : XHASH (f));
584 hash = sxhash_combine (hash, hash1);
585 }
586 }
587 else
588 hash = XHASH (bt);
589 return make_ufixnum (SXHASH_REDUCE (hash));
590} 698}
591 699
592static void syms_of_profiler_for_pdumper (void);
593
594void 700void
595syms_of_profiler (void) 701syms_of_profiler (void)
596{ 702{
@@ -603,47 +709,20 @@ If the log gets full, some of the least-seen call-stacks will be evicted
603to make room for new entries. */); 709to make room for new entries. */);
604 profiler_log_size = 10000; 710 profiler_log_size = 10000;
605 711
606 DEFSYM (Qprofiler_backtrace_equal, "profiler-backtrace-equal");
607 DEFSYM (QDiscarded_Samples, "Discarded Samples"); 712 DEFSYM (QDiscarded_Samples, "Discarded Samples");
608 713
609 defsubr (&Sfunction_equal); 714 defsubr (&Sfunction_equal);
610 715
611#ifdef PROFILER_CPU_SUPPORT 716#ifdef PROFILER_CPU_SUPPORT
612 profiler_cpu_running = NOT_RUNNING; 717 profiler_cpu_running = NOT_RUNNING;
613 cpu.log = Qnil;
614 staticpro (&cpu.log);
615 defsubr (&Sprofiler_cpu_start); 718 defsubr (&Sprofiler_cpu_start);
616 defsubr (&Sprofiler_cpu_stop); 719 defsubr (&Sprofiler_cpu_stop);
617 defsubr (&Sprofiler_cpu_running_p); 720 defsubr (&Sprofiler_cpu_running_p);
618 defsubr (&Sprofiler_cpu_log); 721 defsubr (&Sprofiler_cpu_log);
619#endif 722#endif
620 profiler_memory_running = false; 723 profiler_memory_running = false;
621 memory.log = Qnil;
622 staticpro (&memory.log);
623 defsubr (&Sprofiler_memory_start); 724 defsubr (&Sprofiler_memory_start);
624 defsubr (&Sprofiler_memory_stop); 725 defsubr (&Sprofiler_memory_stop);
625 defsubr (&Sprofiler_memory_running_p); 726 defsubr (&Sprofiler_memory_running_p);
626 defsubr (&Sprofiler_memory_log); 727 defsubr (&Sprofiler_memory_log);
627
628 pdumper_do_now_and_after_load (syms_of_profiler_for_pdumper);
629}
630
631static void
632syms_of_profiler_for_pdumper (void)
633{
634 if (dumped_with_pdumper_p ())
635 {
636#ifdef PROFILER_CPU_SUPPORT
637 cpu.log = Qnil;
638#endif
639 memory.log = Qnil;
640 }
641 else
642 {
643#ifdef PROFILER_CPU_SUPPORT
644 eassert (NILP (cpu.log));
645#endif
646 eassert (NILP (memory.log));
647 }
648
649} 728}