diff options
| author | Mattias EngdegÄrd | 2023-11-01 16:42:59 +0100 |
|---|---|---|
| committer | Mattias EngdegÄrd | 2024-01-12 18:02:14 +0100 |
| commit | 22201dde773e5404f80baa1f59768e88d97a322a (patch) | |
| tree | aaaabf222aab18f92894e175721b335b9a158214 /src | |
| parent | 8acd89e955f9422c5201d0db102d3a5ac05f3094 (diff) | |
| download | emacs-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.c | 1 | ||||
| -rw-r--r-- | src/eval.c | 23 | ||||
| -rw-r--r-- | src/lisp.h | 3 | ||||
| -rw-r--r-- | src/profiler.c | 487 |
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. */ | ||
| 4253 | void | 4255 | void |
| 4254 | get_backtrace (Lisp_Object array) | 4256 | get_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 | ||
| 4272 | Lisp_Object backtrace_top_function (void) | 4267 | Lisp_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); | |||
| 4608 | extern void syms_of_eval (void); | 4608 | extern void syms_of_eval (void); |
| 4609 | extern void prog_ignore (Lisp_Object); | 4609 | extern void prog_ignore (Lisp_Object); |
| 4610 | extern void mark_specpdl (union specbinding *first, union specbinding *ptr); | 4610 | extern void mark_specpdl (union specbinding *first, union specbinding *ptr); |
| 4611 | extern void get_backtrace (Lisp_Object array); | 4611 | extern void get_backtrace (Lisp_Object *array, ptrdiff_t size); |
| 4612 | Lisp_Object backtrace_top_function (void); | 4612 | Lisp_Object backtrace_top_function (void); |
| 4613 | extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol); | 4613 | extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol); |
| 4614 | void do_debug_on_call (Lisp_Object code, specpdl_ref count); | 4614 | void do_debug_on_call (Lisp_Object code, specpdl_ref count); |
| @@ -5225,6 +5225,7 @@ void syms_of_dbusbind (void); | |||
| 5225 | extern bool profiler_memory_running; | 5225 | extern bool profiler_memory_running; |
| 5226 | extern void malloc_probe (size_t); | 5226 | extern void malloc_probe (size_t); |
| 5227 | extern void syms_of_profiler (void); | 5227 | extern void syms_of_profiler (void); |
| 5228 | extern 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 | ||
| 37 | typedef struct Lisp_Hash_Table log_t; | 37 | /* A fully associative cache of size SIZE, mapping vectors of DEPTH |
| 38 | Lisp objects to counts. */ | ||
| 39 | typedef 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 | ||
| 39 | static Lisp_Object cmpfn_profiler (Lisp_Object, Lisp_Object, | 54 | static void |
| 40 | struct Lisp_Hash_Table *); | 55 | mark_log (log_t *log) |
| 41 | static 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 | |||
| 66 | static log_t * | ||
| 67 | make_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 | |||
| 97 | static void | ||
| 98 | free_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 | |||
| 109 | static inline EMACS_INT | ||
| 110 | get_log_count (log_t *log, int idx) | ||
| 111 | { | ||
| 112 | eassume (idx >= 0 && idx < log->size); | ||
| 113 | return log->counts[idx]; | ||
| 114 | } | ||
| 115 | |||
| 116 | static inline void | ||
| 117 | set_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 | |||
| 123 | static inline Lisp_Object * | ||
| 124 | get_key_vector (log_t *log, int idx) | ||
| 125 | { | ||
| 126 | eassume (idx >= 0 && idx < log->size); | ||
| 127 | return log->keys + idx * log->depth; | ||
| 128 | } | ||
| 129 | |||
| 130 | static inline int | ||
| 131 | log_hash_index (log_t *log, EMACS_UINT hash) | ||
| 132 | { | ||
| 133 | /* FIXME: avoid division. */ | ||
| 134 | return hash % log->index_size; | ||
| 135 | } | ||
| 136 | |||
| 137 | static void | ||
| 138 | remove_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 | ||
| 43 | static const struct hash_table_test hashtest_profiler = | 156 | static bool |
| 44 | { | 157 | trace_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 | |||
| 165 | static EMACS_UINT | ||
| 166 | trace_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 | ||
| 52 | struct profiler_log { | 181 | struct 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 { | |||
| 58 | static Lisp_Object export_log (struct profiler_log *); | 187 | static Lisp_Object export_log (struct profiler_log *); |
| 59 | 188 | ||
| 60 | static struct profiler_log | 189 | static struct profiler_log |
| 61 | make_log (void) | 190 | make_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 | ||
| 198 | static void | ||
| 199 | free_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 | ||
| 103 | static EMACS_INT approximate_median (log_t *log, | 222 | static EMACS_INT |
| 104 | ptrdiff_t start, ptrdiff_t size) | 223 | approximate_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 | ||
| 129 | static void evict_lower_half (struct profiler_log *plog) | 248 | static void |
| 249 | evict_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) | |||
| 163 | static void | 272 | static void |
| 164 | record_backtrace (struct profiler_log *plog, EMACS_INT count) | 273 | record_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. */ | ||
| 345 | static 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. | |||
| 428 | Before returning, a new log is allocated for future samples. */) | 539 | Before 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. */ | ||
| 435 | static Lisp_Object | 558 | static Lisp_Object |
| 436 | export_log (struct profiler_log *log) | 559 | export_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. | |||
| 514 | Before returning, a new log is allocated for future samples. */) | 646 | Before 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 | ||
| 550 | static Lisp_Object | 691 | void |
| 551 | cmpfn_profiler (Lisp_Object bt1, Lisp_Object bt2, struct Lisp_Hash_Table *h) | 692 | mark_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 | |||
| 569 | static Lisp_Object | ||
| 570 | hashfn_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 | ||
| 592 | static void syms_of_profiler_for_pdumper (void); | ||
| 593 | |||
| 594 | void | 700 | void |
| 595 | syms_of_profiler (void) | 701 | syms_of_profiler (void) |
| 596 | { | 702 | { |
| @@ -603,47 +709,20 @@ If the log gets full, some of the least-seen call-stacks will be evicted | |||
| 603 | to make room for new entries. */); | 709 | to 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 | |||
| 631 | static void | ||
| 632 | syms_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 | } |