commit ec16b69e7f0b9437e998688cb2877cc425edb70b (HEAD, refs/remotes/origin/master) Author: Eli Zaretskii Date: Sat Jan 13 08:30:50 2024 +0200 * src/fns.c (maybe_resize_hash_table): Fix EMACS_INT format specifier. diff --git a/src/fns.c b/src/fns.c index b1d152a15a9..89434e02ca3 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4702,7 +4702,7 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) #ifdef ENABLE_CHECKING if (HASH_TABLE_P (Vpurify_flag) && XHASH_TABLE (Vpurify_flag) == h) - message ("Growing hash table to: %"pD"d", new_size); + message ("Growing hash table to: %"pI"d", new_size); #endif } } commit 4edb77132de731f9d4cb2cffee2f8847eafdcc72 Author: Po Lu Date: Sat Jan 13 09:51:59 2024 +0800 Properly sort results for partial font specs * src/sfntfont.c (sfntfont_compare_font_entities): New function. (sfntfont_list): Sort matching font entities by the number of fields set, and mention why. diff --git a/src/sfntfont.c b/src/sfntfont.c index 1ad41deac70..860fc446184 100644 --- a/src/sfntfont.c +++ b/src/sfntfont.c @@ -1939,13 +1939,51 @@ sfntfont_desc_to_entity (struct sfnt_font_desc *desc, int instance) return entity; } +/* Return whether fewer fields inside the font entity A are set than + there are set inside the font entity B. */ + +static Lisp_Object +sfntfont_compare_font_entities (Lisp_Object a, Lisp_Object b) +{ + ptrdiff_t count_a, count_b, i; + + count_a = 0; + count_b = 0; + + for (i = 0; i < FONT_ENTITY_MAX; ++i) + { + if (!NILP (AREF (a, i))) + count_a++; + } + + for (i = 0; i < FONT_ENTITY_MAX; ++i) + { + if (!NILP (AREF (b, i))) + count_b++; + } + + return count_a < count_b ? Qt : Qnil; +} + +/* Function that compares two font entities to return whether fewer + fields are set within the first than in the second. */ + +static union Aligned_Lisp_Subr Scompare_font_entities = + { + { + { PSEUDOVECTOR_FLAG | (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS), }, + { .a2 = sfntfont_compare_font_entities, }, + 2, 2, "sfntfont_compare_font_entities", {0}, lisp_h_Qnil, + }, + }; + /* Return a list of font-entities matching the specified FONT_SPEC. */ Lisp_Object sfntfont_list (struct frame *f, Lisp_Object font_spec) { - Lisp_Object matching, tem; + Lisp_Object matching, tem, compare_font_entities; struct sfnt_font_desc *desc; int i, rc, instances[100]; @@ -1982,9 +2020,16 @@ sfntfont_list (struct frame *f, Lisp_Object font_spec) matching); } } - unblock_input (); + /* Sort matching by the number of fields set inside each element, so + that values of FONT_SPECs that leave a number of fields + unspecified will yield a list with the closest matches (that is + to say, those whose fields are precisely as specified by the + caller) ordered first. */ + + XSETSUBR (compare_font_entities, &Scompare_font_entities.s); + matching = Fsort (matching, compare_font_entities); return matching; } commit 8b7a6d7b6deca9346092501dbfa679e3e5ea5892 Author: Mattias Engdegård Date: Sun Jan 7 18:52:48 2024 +0100 ; * src/lisp.h (struct Lisp_Hash_Table): Add ASCII art. diff --git a/src/lisp.h b/src/lisp.h index 0421cb68c10..e80a6388657 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2405,11 +2405,33 @@ struct hash_table_test struct Lisp_Hash_Table { - /* Change pdumper.c if you change the fields here. */ - - /* This is for Lisp; the hash table code does not refer to it. */ union vectorlike_header header; + /* Hash table internal structure: + + Lisp key index table + | vector + | hash fn hash key value next + v +--+ +------+-------+------+----+ + hash value |-1| | C351 | cow | moo | -1 |<- + | +--+ +------+-------+------+----+ | + ------------>| -------->| 07A8 | cat | meow | -1 | | + range +--+ +------+-------+------+----+ | + reduction |-1| ->| 91D2 | dog | woof | ---- + +--+ | +------+-------+------+----+ + | ------ | ? |unbound| ? | -1 |<- + +--+ +------+-------+------+----+ | + | -------->| F6B0 | duck |quack | -1 | | + +--+ +------+-------+------+----+ | + |-1| ->| ? |unbound| ? | ---- + +--+ | +------+-------+------+----+ + : : | : : : : : + | + next_free + + The table is physically split into three vectors (hash, next, + key_and_value) which may or may not be beneficial. */ + /* Nil if table is non-weak. Otherwise a symbol describing the weakness of the table. */ Lisp_Object weak; commit 4b7985db11c0fd3a3346a05f271eff9ad687851b Author: Mattias Engdegård Date: Thu Nov 30 14:57:51 2023 +0100 ; * src/fns.c (Fmake_hash_table): ensure `test` is a bare symbol diff --git a/src/fns.c b/src/fns.c index d8da8992ce9..b1d152a15a9 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5299,10 +5299,6 @@ in an error. usage: (make-hash-table &rest KEYWORD-ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { - Lisp_Object test, weak; - bool purecopy; - struct hash_table_test testdesc; - ptrdiff_t i; USE_SAFE_ALLOCA; /* The vector `used' is used to keep track of arguments that @@ -5311,20 +5307,21 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) memset (used, 0, nargs * sizeof *used); /* See if there's a `:test TEST' among the arguments. */ - i = get_key_arg (QCtest, nargs, args, used); - test = i ? args[i] : Qeql; - if (EQ (test, Qeq)) + ptrdiff_t i = get_key_arg (QCtest, nargs, args, used); + Lisp_Object test = i ? args[i] : Qeql; + if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (test)) + test = SYMBOL_WITH_POS_SYM (test); + struct hash_table_test testdesc; + if (BASE_EQ (test, Qeq)) testdesc = hashtest_eq; - else if (EQ (test, Qeql)) + else if (BASE_EQ (test, Qeql)) testdesc = hashtest_eql; - else if (EQ (test, Qequal)) + else if (BASE_EQ (test, Qequal)) testdesc = hashtest_equal; else { /* See if it is a user-defined test. */ - Lisp_Object prop; - - prop = Fget (test, Qhash_table_test); + Lisp_Object prop = Fget (test, Qhash_table_test); if (!CONSP (prop) || !CONSP (XCDR (prop))) signal_error ("Invalid hash table test", test); testdesc.name = test; @@ -5336,7 +5333,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) /* See if there's a `:purecopy PURECOPY' argument. */ i = get_key_arg (QCpurecopy, nargs, args, used); - purecopy = i && !NILP (args[i]); + bool purecopy = i && !NILP (args[i]); /* See if there's a `:size SIZE' argument. */ i = get_key_arg (QCsize, nargs, args, used); Lisp_Object size_arg = i ? args[i] : Qnil; @@ -5370,7 +5367,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) /* Look for `:weakness WEAK'. */ i = get_key_arg (QCweakness, nargs, args, used); - weak = i ? args[i] : Qnil; + Lisp_Object weak = i ? args[i] : Qnil; if (EQ (weak, Qt)) weak = Qkey_and_value; if (!NILP (weak) diff --git a/src/lisp.h b/src/lisp.h index 549b51d3f7f..0421cb68c10 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2387,7 +2387,7 @@ struct Lisp_Hash_Table; struct hash_table_test { - /* Name of the function used to compare keys. */ + /* Function used to compare keys; always a bare symbol. */ Lisp_Object name; /* User-supplied hash function, or nil. */ commit 29e3d1c56f07a53d1955c9a71e68f70f3b901728 Author: Mattias Engdegård Date: Thu Dec 28 19:04:43 2023 +0100 Abstract predicate and constant for unused hash keys Qunbound is used for many things; using a predicate and constant for the specific purpose of unused hash entry keys allows us to locate them and make changes much more easily. * src/lisp.h (HASH_UNUSED_ENTRY_KEY, hash_unused_entry_key_p): New constant and function. * src/comp.c (compile_function, Fcomp__compile_ctxt_to_file): * src/composite.c (composition_gstring_cache_clear_font): * src/emacs-module.c (module_global_reference_p): * src/fns.c (make_hash_table, maybe_resize_hash_table, hash_put) (hash_remove_from_table, hash_clear, sweep_weak_table, Fmaphash): * src/json.c (lisp_to_json_nonscalar_1): * src/minibuf.c (Ftry_completion, Fall_completions, Ftest_completion): * src/print.c (print, print_object): Use them. diff --git a/src/comp.c b/src/comp.c index 347f8924793..2872c28a2b1 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4334,7 +4334,7 @@ compile_function (Lisp_Object func) { Lisp_Object block_name = HASH_KEY (ht, i); if (!EQ (block_name, Qentry) - && !BASE_EQ (block_name, Qunbound)) + && !hash_unused_entry_key_p (block_name)) declare_block (block_name); } @@ -4347,7 +4347,7 @@ compile_function (Lisp_Object func) for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (ht); i++) { Lisp_Object block_name = HASH_KEY (ht, i); - if (!BASE_EQ (block_name, Qunbound)) + if (!hash_unused_entry_key_p (block_name)) { Lisp_Object block = HASH_VALUE (ht, i); Lisp_Object insns = CALL1I (comp-block-insns, block); @@ -4966,12 +4966,12 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, struct Lisp_Hash_Table *func_h = XHASH_TABLE (CALL1I (comp-ctxt-funcs-h, Vcomp_ctxt)); for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (func_h); i++) - if (!BASE_EQ (HASH_KEY (func_h, i), Qunbound)) + if (!hash_unused_entry_key_p (HASH_KEY (func_h, i))) declare_function (HASH_VALUE (func_h, i)); /* Compile all functions. Can't be done before because the relocation structs has to be already defined. */ for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (func_h); i++) - if (!BASE_EQ (HASH_KEY (func_h, i), Qunbound)) + if (!hash_unused_entry_key_p (HASH_KEY (func_h, i))) compile_function (HASH_VALUE (func_h, i)); /* Work around bug#46495 (GCC PR99126). */ diff --git a/src/composite.c b/src/composite.c index 7c7f4720514..ed1aeb380a0 100644 --- a/src/composite.c +++ b/src/composite.c @@ -690,7 +690,7 @@ composition_gstring_cache_clear_font (Lisp_Object font_object) { Lisp_Object k = HASH_KEY (h, i); - if (!BASE_EQ (k, Qunbound)) + if (!hash_unused_entry_key_p (k)) { Lisp_Object gstring = HASH_VALUE (h, i); diff --git a/src/emacs-module.c b/src/emacs-module.c index 46bd732e8eb..283703b3651 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -412,7 +412,7 @@ module_global_reference_p (emacs_value v, ptrdiff_t *n) reference that's identical to some global reference. */ for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i) { - if (!BASE_EQ (HASH_KEY (h, i), Qunbound) + if (!hash_unused_entry_key_p (HASH_KEY (h, i)) && &XMODULE_GLOBAL_REFERENCE (HASH_VALUE (h, i))->value == v) return true; } diff --git a/src/fns.c b/src/fns.c index 56b4e9a18c0..d8da8992ce9 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4575,7 +4575,7 @@ make_hash_table (struct hash_table_test test, EMACS_INT size, h->rehash_threshold = rehash_threshold; h->rehash_size = rehash_size; h->count = 0; - h->key_and_value = make_vector (2 * size, Qunbound); + h->key_and_value = make_vector (2 * size, HASH_UNUSED_ENTRY_KEY); h->hash = make_nil_vector (size); h->next = make_vector (size, make_fixnum (-1)); h->index = make_vector (hash_index_size (h, size), make_fixnum (-1)); @@ -4678,7 +4678,7 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) Lisp_Object key_and_value = alloc_larger_vector (h->key_and_value, 2 * new_size); for (ptrdiff_t i = 2 * old_size; i < 2 * new_size; i++) - ASET (key_and_value, i, Qunbound); + ASET (key_and_value, i, HASH_UNUSED_ENTRY_KEY); Lisp_Object hash = alloc_larger_vector (h->hash, new_size); memclear (XVECTOR (hash)->contents + old_size, @@ -4782,7 +4782,7 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, /* Store key/value in the key_and_value vector. */ ptrdiff_t i = h->next_free; eassert (NILP (HASH_HASH (h, i))); - eassert (BASE_EQ (Qunbound, (HASH_KEY (h, i)))); + eassert (hash_unused_entry_key_p (HASH_KEY (h, i))); h->next_free = HASH_NEXT (h, i); set_hash_key_slot (h, i, key); set_hash_value_slot (h, i, value); @@ -4824,7 +4824,7 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key) /* Clear slots in key_and_value and add the slots to the free list. */ - set_hash_key_slot (h, i, Qunbound); + set_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY); set_hash_value_slot (h, i, Qnil); set_hash_hash_slot (h, i, Qnil); set_hash_next_slot (h, i, h->next_free); @@ -4851,7 +4851,7 @@ hash_clear (struct Lisp_Hash_Table *h) for (ptrdiff_t i = 0; i < size; i++) { set_hash_next_slot (h, i, i < size - 1 ? i + 1 : -1); - set_hash_key_slot (h, i, Qunbound); + set_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY); set_hash_value_slot (h, i, Qnil); } @@ -4922,7 +4922,7 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p) h->next_free = i; /* Clear key, value, and hash. */ - set_hash_key_slot (h, i, Qunbound); + set_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY); set_hash_value_slot (h, i, Qnil); if (!NILP (h->hash)) set_hash_hash_slot (h, i, Qnil); @@ -5535,7 +5535,7 @@ FUNCTION is called with two arguments, KEY and VALUE. for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i) { Lisp_Object k = HASH_KEY (h, i); - if (!BASE_EQ (k, Qunbound)) + if (!hash_unused_entry_key_p (k)) call2 (function, k, HASH_VALUE (h, i)); } diff --git a/src/json.c b/src/json.c index af5f30c7275..d98b312ecc9 100644 --- a/src/json.c +++ b/src/json.c @@ -364,7 +364,7 @@ lisp_to_json_nonscalar_1 (Lisp_Object lisp, for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i) { Lisp_Object key = HASH_KEY (h, i); - if (!BASE_EQ (key, Qunbound)) + if (!hash_unused_entry_key_p (key)) { CHECK_STRING (key); Lisp_Object ekey = json_encode (key); diff --git a/src/lisp.h b/src/lisp.h index a34726adbcb..549b51d3f7f 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2462,7 +2462,7 @@ struct Lisp_Hash_Table /* Vector of keys and values. The key of item I is found at index 2 * I, the value is found at index 2 * I + 1. - If the key is equal to Qunbound, then this slot is unused. + If the key is HASH_UNUSED_ENTRY_KEY, then this slot is unused. This is gc_marked specially if the table is weak. */ Lisp_Object key_and_value; @@ -2478,6 +2478,16 @@ struct Lisp_Hash_Table /* Sanity-check pseudovector layout. */ verify (offsetof (struct Lisp_Hash_Table, weak) == header_size); +/* Key value that marks an unused hash table entry. */ +#define HASH_UNUSED_ENTRY_KEY Qunbound + +/* KEY is a key of an unused hash table entry. */ +INLINE bool +hash_unused_entry_key_p (Lisp_Object key) +{ + return BASE_EQ (key, HASH_UNUSED_ENTRY_KEY); +} + INLINE bool HASH_TABLE_P (Lisp_Object a) { diff --git a/src/minibuf.c b/src/minibuf.c index f4f9da9c3f9..22bb8fa1d75 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1680,8 +1680,8 @@ or from one of the possible completions. */) else /* if (type == hash_table) */ { while (idx < HASH_TABLE_SIZE (XHASH_TABLE (collection)) - && BASE_EQ (HASH_KEY (XHASH_TABLE (collection), idx), - Qunbound)) + && hash_unused_entry_key_p (HASH_KEY (XHASH_TABLE (collection), + idx))) idx++; if (idx >= HASH_TABLE_SIZE (XHASH_TABLE (collection))) break; @@ -1918,8 +1918,8 @@ with a space are ignored unless STRING itself starts with a space. */) else /* if (type == 3) */ { while (idx < HASH_TABLE_SIZE (XHASH_TABLE (collection)) - && BASE_EQ (HASH_KEY (XHASH_TABLE (collection), idx), - Qunbound)) + && hash_unused_entry_key_p (HASH_KEY (XHASH_TABLE (collection), + idx))) idx++; if (idx >= HASH_TABLE_SIZE (XHASH_TABLE (collection))) break; @@ -2117,7 +2117,7 @@ the values STRING, PREDICATE and `lambda'. */) for (i = 0; i < HASH_TABLE_SIZE (h); ++i) { tem = HASH_KEY (h, i); - if (BASE_EQ (tem, Qunbound)) continue; + if (hash_unused_entry_key_p (tem)) continue; Lisp_Object strkey = (SYMBOLP (tem) ? Fsymbol_name (tem) : tem); if (!STRINGP (strkey)) continue; if (BASE_EQ (Fcompare_strings (string, Qnil, Qnil, diff --git a/src/print.c b/src/print.c index 26ed52b4653..e22f3b6778c 100644 --- a/src/print.c +++ b/src/print.c @@ -1290,7 +1290,7 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) for (i = 0; i < HASH_TABLE_SIZE (h); ++i) { Lisp_Object key = HASH_KEY (h, i); - if (!BASE_EQ (key, Qunbound) + if (!hash_unused_entry_key_p (key) && EQ (HASH_VALUE (h, i), Qt)) Fremhash (key, Vprint_number_table); } @@ -2770,7 +2770,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) { Lisp_Object key; ptrdiff_t idx = e->u.hash.idx; - while (BASE_EQ ((key = HASH_KEY (h, idx)), Qunbound)) + while (hash_unused_entry_key_p ((key = HASH_KEY (h, idx)))) idx++; e->u.hash.idx = idx; obj = key; commit 484e04efa4fcb81968cba8e05835812c62856287 Author: Mattias Engdegård Date: Tue Nov 28 13:54:26 2023 +0100 ; * src/alloc.c (purecopy_hash_table): Simplify Copy the entire struct, then take care of fields needing special treatment. diff --git a/src/alloc.c b/src/alloc.c index fae76d24189..af9c169a3a0 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5891,26 +5891,16 @@ purecopy_hash_table (struct Lisp_Hash_Table *table) eassert (table->purecopy); struct Lisp_Hash_Table *pure = pure_alloc (sizeof *pure, Lisp_Vectorlike); - struct hash_table_test pure_test = table->test; + *pure = *table; + pure->mutable = false; - /* Purecopy the hash table test. */ - pure_test.name = purecopy (table->test.name); - pure_test.user_hash_function = purecopy (table->test.user_hash_function); - pure_test.user_cmp_function = purecopy (table->test.user_cmp_function); - - pure->header = table->header; - pure->weak = purecopy (Qnil); + pure->test.name = purecopy (table->test.name); + pure->test.user_hash_function = purecopy (table->test.user_hash_function); + pure->test.user_cmp_function = purecopy (table->test.user_cmp_function); pure->hash = purecopy (table->hash); pure->next = purecopy (table->next); pure->index = purecopy (table->index); - pure->count = table->count; - pure->next_free = table->next_free; - pure->purecopy = table->purecopy; - eassert (!pure->mutable); - pure->rehash_threshold = table->rehash_threshold; - pure->rehash_size = table->rehash_size; pure->key_and_value = purecopy (table->key_and_value); - pure->test = pure_test; return pure; } commit 43127e5ec110debadef5e823ee8adbfc561bb708 Author: Mattias Engdegård Date: Sat Oct 28 12:07:42 2023 +0200 Refactor hash table vector reallocation * src/fns.c (larger_vecalloc): Remove. (larger_vector): Simplify. (alloc_larger_vector): New. (maybe_resize_hash_table): Use alloc_larger_vector as a simpler and faster replacement for larger_vecalloc. diff --git a/src/fns.c b/src/fns.c index 207094909f4..56b4e9a18c0 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4339,11 +4339,10 @@ get_key_arg (Lisp_Object key, ptrdiff_t nargs, Lisp_Object *args, char *used) /* Return a Lisp vector which has the same contents as VEC but has at least INCR_MIN more entries, where INCR_MIN is positive. If NITEMS_MAX is not -1, do not grow the vector to be any larger - than NITEMS_MAX. New entries in the resulting vector are - uninitialized. */ + than NITEMS_MAX. New entries in the resulting vector are nil. */ -static Lisp_Object -larger_vecalloc (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max) +Lisp_Object +larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max) { struct Lisp_Vector *v; ptrdiff_t incr, incr_max, old_size, new_size; @@ -4360,23 +4359,11 @@ larger_vecalloc (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max) new_size = old_size + incr; v = allocate_vector (new_size); memcpy (v->contents, XVECTOR (vec)->contents, old_size * sizeof *v->contents); + memclear (v->contents + old_size, (new_size - old_size) * word_size); XSETVECTOR (vec, v); return vec; } -/* Likewise, except set new entries in the resulting vector to nil. */ - -Lisp_Object -larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max) -{ - ptrdiff_t old_size = ASIZE (vec); - Lisp_Object v = larger_vecalloc (vec, incr_min, nitems_max); - ptrdiff_t new_size = ASIZE (v); - memclear (XVECTOR (v)->contents + old_size, - (new_size - old_size) * word_size); - return v; -} - /*********************************************************************** Low-level Functions @@ -4631,6 +4618,20 @@ copy_hash_table (struct Lisp_Hash_Table *h1) } +/* Allocate a Lisp vector of NEW_SIZE elements. + Copy elements from VEC and leave the rest undefined. */ +static Lisp_Object +alloc_larger_vector (Lisp_Object vec, ptrdiff_t new_size) +{ + eassert (VECTORP (vec)); + ptrdiff_t old_size = ASIZE (vec); + eassert (new_size >= old_size); + struct Lisp_Vector *v = allocate_vector (new_size); + memcpy (v->contents, XVECTOR (vec)->contents, old_size * sizeof *v->contents); + XSETVECTOR (vec, v); + return vec; +} + /* Compute index into the index vector from a hash value. */ static inline ptrdiff_t hash_index_index (struct Lisp_Hash_Table *h, Lisp_Object hash_code) @@ -4666,26 +4667,23 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) new_size = old_size + 1; /* Allocate all the new vectors before updating *H, to - avoid problems if memory is exhausted. larger_vecalloc - finishes computing the size of the replacement vectors. */ - Lisp_Object next = larger_vecalloc (h->next, new_size - old_size, - new_size); - ptrdiff_t next_size = ASIZE (next); - for (ptrdiff_t i = old_size; i < next_size - 1; i++) + avoid problems if memory is exhausted. */ + Lisp_Object next = alloc_larger_vector (h->next, new_size); + for (ptrdiff_t i = old_size; i < new_size - 1; i++) ASET (next, i, make_fixnum (i + 1)); - ASET (next, next_size - 1, make_fixnum (-1)); + ASET (next, new_size - 1, make_fixnum (-1)); /* Build the new&larger key_and_value vector, making sure the new fields are initialized to `unbound`. */ Lisp_Object key_and_value - = larger_vecalloc (h->key_and_value, 2 * (next_size - old_size), - 2 * next_size); - for (ptrdiff_t i = 2 * old_size; i < 2 * next_size; i++) + = alloc_larger_vector (h->key_and_value, 2 * new_size); + for (ptrdiff_t i = 2 * old_size; i < 2 * new_size; i++) ASET (key_and_value, i, Qunbound); - Lisp_Object hash = larger_vector (h->hash, next_size - old_size, - next_size); - ptrdiff_t index_size = hash_index_size (h, next_size); + Lisp_Object hash = alloc_larger_vector (h->hash, new_size); + memclear (XVECTOR (hash)->contents + old_size, + (new_size - old_size) * word_size); + ptrdiff_t index_size = hash_index_size (h, new_size); h->index = make_vector (index_size, make_fixnum (-1)); h->key_and_value = key_and_value; h->hash = hash; @@ -4704,7 +4702,7 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) #ifdef ENABLE_CHECKING if (HASH_TABLE_P (Vpurify_flag) && XHASH_TABLE (Vpurify_flag) == h) - message ("Growing hash table to: %"pD"d", next_size); + message ("Growing hash table to: %"pD"d", new_size); #endif } } commit 462b3e6ae4eefeb65a2dc7b144db3e1af9a7720d Author: Mattias Engdegård Date: Sun Oct 29 12:27:04 2023 +0100 Refactor: extract hash and index computations to functions * src/lisp.h (hash_from_key): * src/fns.c (hash_index_index): New. (hash_table_rehash, hash_lookup, hash_remove_from_table): (maybe_resize_hash_table, hash_put): * src/composite.c (composition_gstring_put_cache): Use them. diff --git a/src/composite.c b/src/composite.c index 91836fa2a8f..7c7f4720514 100644 --- a/src/composite.c +++ b/src/composite.c @@ -653,7 +653,7 @@ composition_gstring_put_cache (Lisp_Object gstring, ptrdiff_t len) { struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table); Lisp_Object header = LGSTRING_HEADER (gstring); - Lisp_Object hash = h->test.hashfn (header, h); + Lisp_Object hash = hash_from_key (h, header); if (len < 0) { ptrdiff_t glyph_len = LGSTRING_GLYPH_LEN (gstring); diff --git a/src/fns.c b/src/fns.c index 33ee7c3d36e..207094909f4 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4631,6 +4631,13 @@ copy_hash_table (struct Lisp_Hash_Table *h1) } +/* Compute index into the index vector from a hash value. */ +static inline ptrdiff_t +hash_index_index (struct Lisp_Hash_Table *h, Lisp_Object hash_code) +{ + return XUFIXNUM (hash_code) % ASIZE (h->index); +} + /* Resize hash table H if it's too full. If H cannot be resized because it's already too large, throw an error. */ @@ -4689,8 +4696,8 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) for (ptrdiff_t i = 0; i < old_size; i++) if (!NILP (HASH_HASH (h, i))) { - EMACS_UINT hash_code = XUFIXNUM (HASH_HASH (h, i)); - ptrdiff_t start_of_bucket = hash_code % ASIZE (h->index); + Lisp_Object hash_code = HASH_HASH (h, i); + ptrdiff_t start_of_bucket = hash_index_index (h, hash_code); set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket)); set_hash_index_slot (h, start_of_bucket, i); } @@ -4718,8 +4725,8 @@ hash_table_rehash (Lisp_Object hash) for (i = 0; i < count; i++) { Lisp_Object key = HASH_KEY (h, i); - Lisp_Object hash_code = h->test.hashfn (key, h); - ptrdiff_t start_of_bucket = XUFIXNUM (hash_code) % ASIZE (h->index); + Lisp_Object hash_code = hash_from_key (h, key); + ptrdiff_t start_of_bucket = hash_index_index (h, hash_code); set_hash_hash_slot (h, i, hash_code); set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket)); set_hash_index_slot (h, start_of_bucket, i); @@ -4738,15 +4745,12 @@ hash_table_rehash (Lisp_Object hash) ptrdiff_t hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object *hash) { - ptrdiff_t start_of_bucket, i; - - Lisp_Object hash_code; - hash_code = h->test.hashfn (key, h); + Lisp_Object hash_code = hash_from_key (h, key); if (hash) *hash = hash_code; - start_of_bucket = XUFIXNUM (hash_code) % ASIZE (h->index); - + ptrdiff_t start_of_bucket = hash_index_index (h, hash_code); + ptrdiff_t i; for (i = HASH_INDEX (h, start_of_bucket); 0 <= i; i = HASH_NEXT (h, i)) if (EQ (key, HASH_KEY (h, i)) || (h->test.cmpfn @@ -4773,14 +4777,12 @@ ptrdiff_t hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, Lisp_Object hash) { - ptrdiff_t start_of_bucket, i; - /* Increment count after resizing because resizing may fail. */ maybe_resize_hash_table (h); h->count++; /* Store key/value in the key_and_value vector. */ - i = h->next_free; + ptrdiff_t i = h->next_free; eassert (NILP (HASH_HASH (h, i))); eassert (BASE_EQ (Qunbound, (HASH_KEY (h, i)))); h->next_free = HASH_NEXT (h, i); @@ -4791,7 +4793,7 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, set_hash_hash_slot (h, i, hash); /* Add new entry to its collision chain. */ - start_of_bucket = XUFIXNUM (hash) % ASIZE (h->index); + ptrdiff_t start_of_bucket = hash_index_index (h, hash); set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket)); set_hash_index_slot (h, start_of_bucket, i); return i; @@ -4803,8 +4805,8 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, void hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key) { - Lisp_Object hash_code = h->test.hashfn (key, h); - ptrdiff_t start_of_bucket = XUFIXNUM (hash_code) % ASIZE (h->index); + Lisp_Object hash_code = hash_from_key (h, key); + ptrdiff_t start_of_bucket = hash_index_index (h, hash_code); ptrdiff_t prev = -1; for (ptrdiff_t i = HASH_INDEX (h, start_of_bucket); diff --git a/src/lisp.h b/src/lisp.h index 5ec895ecc81..a34726adbcb 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2524,6 +2524,13 @@ HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h) return size; } +/* Compute hash value for KEY in hash table H. */ +INLINE Lisp_Object +hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key) +{ + return h->test.hashfn (key, h); +} + void hash_table_rehash (Lisp_Object); /* Default size for hash tables if not specified. */ commit 0bc13945acb8d18bc18b5abc5c5cf9adebc46ca6 Author: Mattias Engdegård Date: Sat Nov 11 17:42:51 2023 +0100 ; * src/fns.c (collect_interval): Move misplaced function. diff --git a/src/fns.c b/src/fns.c index 4ce855827c9..33ee7c3d36e 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4765,15 +4765,6 @@ check_mutable_hash_table (Lisp_Object obj, struct Lisp_Hash_Table *h) eassert (!PURE_P (h)); } -static void -collect_interval (INTERVAL interval, Lisp_Object collector) -{ - nconc2 (collector, - list1(list3 (make_fixnum (interval->position), - make_fixnum (interval->position + LENGTH (interval)), - interval->plist))); -} - /* Put an entry into hash table H that associates KEY with VALUE. HASH is a previously computed hash code of KEY. Value is the index of the entry in H matching KEY. */ @@ -5198,6 +5189,15 @@ sxhash_obj (Lisp_Object obj, int depth) } } +static void +collect_interval (INTERVAL interval, Lisp_Object collector) +{ + nconc2 (collector, + list1(list3 (make_fixnum (interval->position), + make_fixnum (interval->position + LENGTH (interval)), + interval->plist))); +} + /*********************************************************************** commit 3da324fbd3c7e8e282585ed617efe6ae740acf1a Author: Mattias Engdegård Date: Mon Oct 30 12:34:26 2023 +0100 Refactor: less layering violation in composite.h Avoid using hash table internals directly. * src/composite.h (COMPOSITION_KEY): New. (COMPOSITION_GLYPH, COMPOSITION_RULE): Use COMPOSITION_KEY. diff --git a/src/composite.h b/src/composite.h index c99888ccec2..4fe49b764e4 100644 --- a/src/composite.h +++ b/src/composite.h @@ -84,23 +84,21 @@ composition_registered_p (Lisp_Object prop) ? XCDR (XCDR (XCDR (prop))) \ : CONSP (prop) ? XCDR (prop) : Qnil) +#define COMPOSITION_KEY(cmp) \ + HASH_KEY (XHASH_TABLE (composition_hash_table), (cmp)->hash_index) + /* Return the Nth glyph of composition specified by CMP. CMP is a pointer to `struct composition'. */ #define COMPOSITION_GLYPH(cmp, n) \ - XFIXNUM (XVECTOR (XVECTOR (XHASH_TABLE (composition_hash_table) \ - ->key_and_value) \ - ->contents[cmp->hash_index * 2]) \ - ->contents[cmp->method == COMPOSITION_WITH_RULE_ALTCHARS \ - ? (n) * 2 : (n)]) + XFIXNUM (AREF (COMPOSITION_KEY (cmp), \ + (cmp)->method == COMPOSITION_WITH_RULE_ALTCHARS \ + ? (n) * 2 : (n))) /* Return the encoded composition rule to compose the Nth glyph of rule-base composition specified by CMP. CMP is a pointer to `struct composition'. */ -#define COMPOSITION_RULE(cmp, n) \ - XFIXNUM (XVECTOR (XVECTOR (XHASH_TABLE (composition_hash_table) \ - ->key_and_value) \ - ->contents[cmp->hash_index * 2]) \ - ->contents[(n) * 2 - 1]) +#define COMPOSITION_RULE(cmp, n) \ + XFIXNUM (AREF (COMPOSITION_KEY (cmp), (n) * 2 - 1)) /* Decode encoded composition rule RULE_CODE into GREF (global reference point code), NREF (new ref. point code). Don't check RULE_CODE; commit 22201dde773e5404f80baa1f59768e88d97a322a Author: Mattias Engdegård Date: Wed Nov 1 16:42:59 2023 +0100 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. 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) mark_terminals (); mark_kboards (); mark_threads (); + mark_profiler (); #ifdef HAVE_PGTK mark_pgtkterm (); #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) } } +/* Fill ARRAY of size SIZE with backtrace entries, most recent call first. + Truncate the backtrace if longer than SIZE; pad with nil if shorter. */ void -get_backtrace (Lisp_Object array) +get_backtrace (Lisp_Object *array, ptrdiff_t size) { - union specbinding *pdl = backtrace_top (); - ptrdiff_t i = 0, asize = ASIZE (array); - /* Copy the backtrace contents into working memory. */ - for (; i < asize; i++) - { - if (backtrace_p (pdl)) - { - ASET (array, i, backtrace_function (pdl)); - pdl = backtrace_next (pdl); - } - else - ASET (array, i, Qnil); - } + union specbinding *pdl = backtrace_top (); + ptrdiff_t i = 0; + for (; i < size && backtrace_p (pdl); i++, pdl = backtrace_next (pdl)) + array[i] = backtrace_function (pdl); + for (; i < size; i++) + array[i] = Qnil; } 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); extern void syms_of_eval (void); extern void prog_ignore (Lisp_Object); extern void mark_specpdl (union specbinding *first, union specbinding *ptr); -extern void get_backtrace (Lisp_Object array); +extern void get_backtrace (Lisp_Object *array, ptrdiff_t size); Lisp_Object backtrace_top_function (void); extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol); void do_debug_on_call (Lisp_Object code, specpdl_ref count); @@ -5225,6 +5225,7 @@ void syms_of_dbusbind (void); extern bool profiler_memory_running; extern void malloc_probe (size_t); extern void syms_of_profiler (void); +extern void mark_profiler (void); #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) /* Logs. */ -typedef struct Lisp_Hash_Table log_t; +/* A fully associative cache of size SIZE, mapping vectors of DEPTH + Lisp objects to counts. */ +typedef struct { + /* We use `int' throughout for table indices because anything bigger + is overkill. (Maybe we should make a typedef, but int is short.) */ + int size; /* number of entries */ + int depth; /* elements in each key vector */ + int index_size; /* size of index */ + Lisp_Object *trace; /* working trace, `depth' elements */ + int *index; /* `index_size' indices or -1 if nothing */ + int *next; /* `size' indices to next bucket or -1 */ + EMACS_UINT *hash; /* `size' hash values */ + Lisp_Object *keys; /* `size' keys of `depth' objects each */ + EMACS_INT *counts; /* `size' entries, 0 indicates unused entry */ + int next_free; /* next free entry, -1 if all taken */ +} log_t; -static Lisp_Object cmpfn_profiler (Lisp_Object, Lisp_Object, - struct Lisp_Hash_Table *); -static Lisp_Object hashfn_profiler (Lisp_Object, struct Lisp_Hash_Table *); +static void +mark_log (log_t *log) +{ + if (log == NULL) + return; + int size = log->size; + int depth = log->depth; + for (int i = 0; i < size; i++) + if (log->counts[i] > 0) /* Only mark valid keys. */ + mark_objects (log->keys + i * depth, depth); +} + +static log_t * +make_log (int size, int depth) +{ + log_t *log = xmalloc (sizeof *log); + log->size = size; + log->depth = depth; + + /* The index size is arbitrary but for there to be any point it should be + bigger than SIZE. FIXME: make it a power of 2 or a (pseudo)prime. */ + int index_size = size * 2 + 1; + log->index_size = index_size; + + log->trace = xmalloc (depth * sizeof *log->trace); + + log->index = xmalloc (index_size * sizeof *log->index); + for (int i = 0; i < index_size; i++) + log->index[i] = -1; + + log->next = xmalloc (size * sizeof *log->next); + for (int i = 0; i < size - 1; i++) + log->next[i] = i + 1; + log->next[size - 1] = -1; + log->next_free = 0; + + log->hash = xmalloc (size * sizeof *log->hash); + log->keys = xzalloc (size * depth * sizeof *log->keys); + log->counts = xzalloc (size * sizeof *log->counts); + + return log; +} + +static void +free_log (log_t *log) +{ + xfree (log->trace); + xfree (log->index); + xfree (log->next); + xfree (log->hash); + xfree (log->keys); + xfree (log->counts); + xfree (log); +} + +static inline EMACS_INT +get_log_count (log_t *log, int idx) +{ + eassume (idx >= 0 && idx < log->size); + return log->counts[idx]; +} + +static inline void +set_log_count (log_t *log, int idx, EMACS_INT val) +{ + eassume (idx >= 0 && idx < log->size && val >= 0); + log->counts[idx] = val; +} + +static inline Lisp_Object * +get_key_vector (log_t *log, int idx) +{ + eassume (idx >= 0 && idx < log->size); + return log->keys + idx * log->depth; +} + +static inline int +log_hash_index (log_t *log, EMACS_UINT hash) +{ + /* FIXME: avoid division. */ + return hash % log->index_size; +} + +static void +remove_log_entry (log_t *log, int idx) +{ + eassume (idx >= 0 && idx < log->size); + /* Remove from index. */ + int hidx = log_hash_index (log, log->hash[idx]); + int *p = &log->index[hidx]; + while (*p != idx) + { + eassert (*p >= 0 && *p < log->size); + p = &log->next[*p]; + } + *p = log->next[*p]; + /* Invalidate entry and put it on the free list. */ + log->counts[idx] = 0; + log->next[idx] = log->next_free; + log->next_free = idx; +} -static const struct hash_table_test hashtest_profiler = - { - LISPSYM_INITIALLY (Qprofiler_backtrace_equal), - LISPSYM_INITIALLY (Qnil) /* user_hash_function */, - LISPSYM_INITIALLY (Qnil) /* user_cmp_function */, - cmpfn_profiler, - hashfn_profiler, - }; +static bool +trace_equal (Lisp_Object *bt1, Lisp_Object *bt2, int depth) +{ + for (int i = 0; i < depth; i++) + if (!BASE_EQ (bt1[i], bt2[i]) && NILP (Ffunction_equal (bt1[i], bt2[i]))) + return false; + return true; +} + +static EMACS_UINT +trace_hash (Lisp_Object *trace, int depth) +{ + EMACS_UINT hash = 0; + for (int i = 0; i < depth; i++) + { + Lisp_Object f = trace[i]; + EMACS_UINT hash1 + = (COMPILEDP (f) ? XHASH (AREF (f, COMPILED_BYTECODE)) + : (CONSP (f) && CONSP (XCDR (f)) && BASE_EQ (Qclosure, XCAR (f))) + ? XHASH (XCDR (XCDR (f))) : XHASH (f)); + hash = sxhash_combine (hash, hash1); + } + return hash; +} struct profiler_log { - Lisp_Object log; + log_t *log; EMACS_INT gc_count; /* Samples taken during GC. */ EMACS_INT discarded; /* Samples evicted during table overflow. */ }; @@ -58,32 +187,22 @@ struct profiler_log { static Lisp_Object export_log (struct profiler_log *); static struct profiler_log -make_log (void) -{ - /* We use a standard Elisp hash-table object, but we use it in - a special way. This is OK as long as the object is not exposed - to Elisp, i.e. until it is returned by *-profiler-log, after which - it can't be used any more. */ - EMACS_INT heap_size - = clip_to_bounds (0, profiler_log_size, MOST_POSITIVE_FIXNUM); - ptrdiff_t max_stack_depth - = clip_to_bounds (0, profiler_max_stack_depth, PTRDIFF_MAX);; - struct profiler_log log - = { make_hash_table (hashtest_profiler, heap_size, - DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, - Qnil, false), - 0, 0 }; - struct Lisp_Hash_Table *h = XHASH_TABLE (log.log); - - /* What is special about our hash-tables is that the values are pre-filled - with the vectors we'll use as keys. */ - ptrdiff_t i = ASIZE (h->key_and_value) >> 1; - while (i > 0) - set_hash_value_slot (h, --i, make_nil_vector (max_stack_depth)); - return log; +make_profiler_log (void) +{ + int size = clip_to_bounds (0, profiler_log_size, + min (MOST_POSITIVE_FIXNUM, INT_MAX)); + int max_stack_depth = clip_to_bounds (0, profiler_max_stack_depth, INT_MAX); + return (struct profiler_log){make_log (size, max_stack_depth), 0, 0}; } +static void +free_profiler_log (struct profiler_log *plog) +{ + free_log (plog->log); + plog->log = NULL; +} + + /* Evict the least used half of the hash_table. When the table is full, we have to evict someone. @@ -100,22 +219,22 @@ make_log (void) cost of O(1) and we get O(N) time for a new entry to grow larger than the other least counts before a new round of eviction. */ -static EMACS_INT approximate_median (log_t *log, - ptrdiff_t start, ptrdiff_t size) +static EMACS_INT +approximate_median (log_t *log, int start, int size) { eassert (size > 0); if (size < 2) - return XFIXNUM (HASH_VALUE (log, start)); + return get_log_count (log, start); if (size < 3) /* Not an actual median, but better for our application than choosing either of the two numbers. */ - return ((XFIXNUM (HASH_VALUE (log, start)) - + XFIXNUM (HASH_VALUE (log, start + 1))) + return ((get_log_count (log, start) + + get_log_count (log, start + 1)) / 2); else { - ptrdiff_t newsize = size / 3; - ptrdiff_t start2 = start + newsize; + int newsize = size / 3; + int start2 = start + newsize; EMACS_INT i1 = approximate_median (log, start, newsize); EMACS_INT i2 = approximate_median (log, start2, newsize); EMACS_INT i3 = approximate_median (log, start2 + newsize, @@ -126,34 +245,24 @@ static EMACS_INT approximate_median (log_t *log, } } -static void evict_lower_half (struct profiler_log *plog) +static void +evict_lower_half (struct profiler_log *plog) { - log_t *log = XHASH_TABLE (plog->log); - ptrdiff_t size = ASIZE (log->key_and_value) / 2; + log_t *log = plog->log; + int size = log->size; EMACS_INT median = approximate_median (log, 0, size); - for (ptrdiff_t i = 0; i < size; i++) - /* Evict not only values smaller but also values equal to the median, - so as to make sure we evict something no matter what. */ - if (XFIXNUM (HASH_VALUE (log, i)) <= median) - { - Lisp_Object key = HASH_KEY (log, i); - EMACS_INT count = XFIXNUM (HASH_VALUE (log, i)); - plog->discarded = saturated_add (plog->discarded, count); - { /* FIXME: we could make this more efficient. */ - Lisp_Object tmp; - XSET_HASH_TABLE (tmp, log); /* FIXME: Use make_lisp_ptr. */ - Fremhash (key, tmp); + for (int i = 0; i < size; i++) + { + EMACS_INT count = get_log_count (log, i); + /* Evict not only values smaller but also values equal to the median, + so as to make sure we evict something no matter what. */ + if (count <= median) + { + plog->discarded = saturated_add (plog->discarded, count); + remove_log_entry (log, i); } - eassert (BASE_EQ (Qunbound, HASH_KEY (log, i))); - eassert (log->next_free == i); - - eassert (VECTORP (key)); - for (ptrdiff_t j = 0; j < ASIZE (key); j++) - ASET (key, j, Qnil); - - set_hash_value_slot (log, i, key); - } + } } /* 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) static void record_backtrace (struct profiler_log *plog, EMACS_INT count) { - eassert (HASH_TABLE_P (plog->log)); - log_t *log = XHASH_TABLE (plog->log); + log_t *log = plog->log; + get_backtrace (log->trace, log->depth); + EMACS_UINT hash = trace_hash (log->trace, log->depth); + int hidx = log_hash_index (log, hash); + int idx = log->index[hidx]; + while (idx >= 0) + { + if (log->hash[idx] == hash + && trace_equal (log->trace, get_key_vector (log, idx), log->depth)) + { + /* Found existing entry. */ + set_log_count (log, idx, + saturated_add (get_log_count (log, idx), count)); + return; + } + idx = log->next[idx]; + } + + /* Add new entry. */ if (log->next_free < 0) evict_lower_half (plog); - ptrdiff_t index = log->next_free; - - /* Get a "working memory" vector. */ - Lisp_Object backtrace = HASH_VALUE (log, index); - eassert (BASE_EQ (Qunbound, HASH_KEY (log, index))); - get_backtrace (backtrace); - - { /* We basically do a `gethash+puthash' here, except that we have to be - careful to avoid memory allocation since we're in a signal - handler, and we optimize the code to try and avoid computing the - hash+lookup twice. See fns.c:Fputhash for reference. */ - Lisp_Object hash; - ptrdiff_t j = hash_lookup (log, backtrace, &hash); - if (j >= 0) - { - EMACS_INT old_val = XFIXNUM (HASH_VALUE (log, j)); - EMACS_INT new_val = saturated_add (old_val, count); - set_hash_value_slot (log, j, make_fixnum (new_val)); - } - else - { /* BEWARE! hash_put in general can allocate memory. - But currently it only does that if log->next_free is -1. */ - eassert (0 <= log->next_free); - ptrdiff_t j = hash_put (log, backtrace, make_fixnum (count), hash); - /* Let's make sure we've put `backtrace' right where it - already was to start with. */ - eassert (index == j); - - /* FIXME: If the hash-table is almost full, we should set - some global flag so that some Elisp code can offload its - data elsewhere, so as to avoid the eviction code. - There are 2 ways to do that, AFAICT: - - Set a flag checked in maybe_quit, such that maybe_quit can then - call Fprofiler_cpu_log and stash the full log for later use. - - Set a flag check in post-gc-hook, so that Elisp code can call - profiler-cpu-log. That gives us more flexibility since that - Elisp code can then do all kinds of fun stuff like write - the log to disk. Or turn it right away into a call tree. - Of course, using Elisp is generally preferable, but it may - take longer until we get a chance to run the Elisp code, so - there's more risk that the table will get full before we - get there. */ - } - } + idx = log->next_free; + eassert (idx >= 0); + log->next_free = log->next[idx]; + log->next[idx] = log->index[hidx]; + log->index[hidx] = idx; + eassert (log->counts[idx] == 0); + log->hash[idx] = hash; + memcpy (get_key_vector (log, idx), log->trace, + log->depth * sizeof *log->trace); + log->counts[idx] = count; + + /* FIXME: If the hash-table is almost full, we should set + some global flag so that some Elisp code can offload its + data elsewhere, so as to avoid the eviction code. + There are 2 ways to do that: + - Set a flag checked in maybe_quit, such that maybe_quit can then + call Fprofiler_cpu_log and stash the full log for later use. + - Set a flag check in post-gc-hook, so that Elisp code can call + profiler-cpu-log. That gives us more flexibility since that + Elisp code can then do all kinds of fun stuff like write + the log to disk. Or turn it right away into a call tree. + Of course, using Elisp is generally preferable, but it may + take longer until we get a chance to run the Elisp code, so + there's more risk that the table will get full before we + get there. */ } /* Sampling profiler. */ @@ -234,6 +341,9 @@ add_sample (struct profiler_log *plog, EMACS_INT count) #ifdef PROFILER_CPU_SUPPORT +/* The sampling interval specified. */ +static Lisp_Object profiler_cpu_interval = LISPSYM_INITIALLY (Qnil); + /* The profiler timer and whether it was properly initialized, if POSIX timers are available. */ #ifdef HAVE_ITIMERSPEC @@ -356,8 +466,8 @@ See also `profiler-log-size' and `profiler-max-stack-depth'. */) if (profiler_cpu_running) error ("CPU profiler is already running"); - if (NILP (cpu.log)) - cpu = make_log (); + if (cpu.log == NULL) + cpu = make_profiler_log (); int status = setup_cpu_timer (sampling_interval); if (status < 0) @@ -367,6 +477,7 @@ See also `profiler-log-size' and `profiler-max-stack-depth'. */) } else { + profiler_cpu_interval = sampling_interval; profiler_cpu_running = status; if (! profiler_cpu_running) error ("Unable to start profiler timer"); @@ -428,30 +539,51 @@ of functions, where the last few elements may be nil. Before returning, a new log is allocated for future samples. */) (void) { - return (export_log (&cpu)); + /* Temporarily stop profiling to avoid it interfering with our data + access. */ + bool prof_cpu = profiler_cpu_running; + if (prof_cpu) + Fprofiler_cpu_stop (); + + Lisp_Object ret = export_log (&cpu); + + if (prof_cpu) + Fprofiler_cpu_start (profiler_cpu_interval); + + return ret; } #endif /* PROFILER_CPU_SUPPORT */ +/* Extract log data to a Lisp hash table. The log data is then erased. */ static Lisp_Object -export_log (struct profiler_log *log) +export_log (struct profiler_log *plog) { - Lisp_Object result = log->log; - if (log->gc_count) + log_t *log = plog->log; + /* The returned hash table uses `equal' as key equivalence predicate + which is more discriminating than the `function-equal' used by + the log but close enough, and will never confuse two distinct + keys in the log. */ + Lisp_Object h = make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, + DEFAULT_REHASH_SIZE, + DEFAULT_REHASH_THRESHOLD, + Qnil, false); + for (int i = 0; i < log->size; i++) + { + int count = get_log_count (log, i); + if (count > 0) + Fputhash (Fvector (log->depth, get_key_vector (log, i)), + make_fixnum (count), h); + } + if (plog->gc_count) Fputhash (CALLN (Fvector, QAutomatic_GC, Qnil), - make_fixnum (log->gc_count), - result); - if (log->discarded) + make_fixnum (plog->gc_count), + h); + if (plog->discarded) Fputhash (CALLN (Fvector, QDiscarded_Samples, Qnil), - make_fixnum (log->discarded), - result); -#ifdef PROFILER_CPU_SUPPORT - /* Here we're making the log visible to Elisp, so it's not safe any - more for our use afterwards since we can't rely on its special - pre-allocated keys anymore. So we have to allocate a new one. */ - if (profiler_cpu_running) - *log = make_log (); -#endif /* PROFILER_CPU_SUPPORT */ - return result; + make_fixnum (plog->discarded), + h); + free_profiler_log (plog); + return h; } /* Memory profiler. */ @@ -474,8 +606,8 @@ See also `profiler-log-size' and `profiler-max-stack-depth'. */) if (profiler_memory_running) error ("Memory profiler is already running"); - if (NILP (memory.log)) - memory = make_log (); + if (memory.log == NULL) + memory = make_profiler_log (); profiler_memory_running = true; @@ -514,7 +646,16 @@ of functions, where the last few elements may be nil. Before returning, a new log is allocated for future samples. */) (void) { - return (export_log (&memory)); + bool prof_mem = profiler_memory_running; + if (prof_mem) + Fprofiler_memory_stop (); + + Lisp_Object ret = export_log (&memory); + + if (prof_mem) + Fprofiler_memory_start (); + + return ret; } @@ -547,50 +688,15 @@ the same lambda expression, or are really unrelated function. */) return res ? Qt : Qnil; } -static Lisp_Object -cmpfn_profiler (Lisp_Object bt1, Lisp_Object bt2, struct Lisp_Hash_Table *h) -{ - if (EQ (bt1, bt2)) - return Qt; - else if (VECTORP (bt1) && VECTORP (bt2)) - { - ptrdiff_t l = ASIZE (bt1); - if (l != ASIZE (bt2)) - return Qnil; - for (ptrdiff_t i = 0; i < l; i++) - if (NILP (Ffunction_equal (AREF (bt1, i), AREF (bt2, i)))) - return Qnil; - return Qt; - } - else - return Qnil; -} - -static Lisp_Object -hashfn_profiler (Lisp_Object bt, struct Lisp_Hash_Table *h) +void +mark_profiler (void) { - EMACS_UINT hash; - if (VECTORP (bt)) - { - hash = 0; - ptrdiff_t l = ASIZE (bt); - for (ptrdiff_t i = 0; i < l; i++) - { - Lisp_Object f = AREF (bt, i); - EMACS_UINT hash1 - = (COMPILEDP (f) ? XHASH (AREF (f, COMPILED_BYTECODE)) - : (CONSP (f) && CONSP (XCDR (f)) && EQ (Qclosure, XCAR (f))) - ? XHASH (XCDR (XCDR (f))) : XHASH (f)); - hash = sxhash_combine (hash, hash1); - } - } - else - hash = XHASH (bt); - return make_ufixnum (SXHASH_REDUCE (hash)); +#ifdef PROFILER_CPU_SUPPORT + mark_log (cpu.log); +#endif + mark_log (memory.log); } -static void syms_of_profiler_for_pdumper (void); - void syms_of_profiler (void) { @@ -603,47 +709,20 @@ If the log gets full, some of the least-seen call-stacks will be evicted to make room for new entries. */); profiler_log_size = 10000; - DEFSYM (Qprofiler_backtrace_equal, "profiler-backtrace-equal"); DEFSYM (QDiscarded_Samples, "Discarded Samples"); defsubr (&Sfunction_equal); #ifdef PROFILER_CPU_SUPPORT profiler_cpu_running = NOT_RUNNING; - cpu.log = Qnil; - staticpro (&cpu.log); defsubr (&Sprofiler_cpu_start); defsubr (&Sprofiler_cpu_stop); defsubr (&Sprofiler_cpu_running_p); defsubr (&Sprofiler_cpu_log); #endif profiler_memory_running = false; - memory.log = Qnil; - staticpro (&memory.log); defsubr (&Sprofiler_memory_start); defsubr (&Sprofiler_memory_stop); defsubr (&Sprofiler_memory_running_p); defsubr (&Sprofiler_memory_log); - - pdumper_do_now_and_after_load (syms_of_profiler_for_pdumper); -} - -static void -syms_of_profiler_for_pdumper (void) -{ - if (dumped_with_pdumper_p ()) - { -#ifdef PROFILER_CPU_SUPPORT - cpu.log = Qnil; -#endif - memory.log = Qnil; - } - else - { -#ifdef PROFILER_CPU_SUPPORT - eassert (NILP (cpu.log)); -#endif - eassert (NILP (memory.log)); - } - } commit 8acd89e955f9422c5201d0db102d3a5ac05f3094 Author: Mattias Engdegård Date: Fri Dec 29 15:32:18 2023 +0100 ; * src/pdumper.c (dump_hash_table): Remove unused argument. diff --git a/src/pdumper.c b/src/pdumper.c index ba318605773..c72db7f3ea3 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2708,9 +2708,7 @@ hash_table_thaw (Lisp_Object hash) } static dump_off -dump_hash_table (struct dump_context *ctx, - Lisp_Object object, - dump_off offset) +dump_hash_table (struct dump_context *ctx, Lisp_Object object) { #if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_6D63EDB618 # error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h." @@ -3026,7 +3024,7 @@ dump_vectorlike (struct dump_context *ctx, case PVEC_BOOL_VECTOR: return dump_bool_vector(ctx, v); case PVEC_HASH_TABLE: - return dump_hash_table (ctx, lv, offset); + return dump_hash_table (ctx, lv); case PVEC_BUFFER: return dump_buffer (ctx, XBUFFER (lv)); case PVEC_SUBR: commit 228e9000181b06e5fd3d775c4c9a31c48ee2a231 Author: Mattias Engdegård Date: Mon Nov 6 13:25:07 2023 +0100 Add internal hash-table debug functions These are useful for measuring hashing and collisions. * src/fns.c (Finternal__hash_table_histogram) (Finternal__hash_table_buckets, Finternal__hash_table_index_size): New. diff --git a/src/fns.c b/src/fns.c index c03aea02397..4ce855827c9 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5560,6 +5560,68 @@ returns nil, then (funcall TEST x1 x2) also returns nil. */) return Fput (name, Qhash_table_test, list2 (test, hash)); } +DEFUN ("internal--hash-table-histogram", + Finternal__hash_table_histogram, + Sinternal__hash_table_histogram, + 1, 1, 0, + doc: /* Bucket size histogram of HASH-TABLE. Internal use only. */) + (Lisp_Object hash_table) +{ + struct Lisp_Hash_Table *h = check_hash_table (hash_table); + ptrdiff_t size = HASH_TABLE_SIZE (h); + ptrdiff_t *freq = xzalloc (size * sizeof *freq); + ptrdiff_t index_size = ASIZE (h->index); + for (ptrdiff_t i = 0; i < index_size; i++) + { + ptrdiff_t n = 0; + for (ptrdiff_t j = HASH_INDEX (h, i); j != -1; j = HASH_NEXT (h, j)) + n++; + if (n > 0) + freq[n - 1]++; + } + Lisp_Object ret = Qnil; + for (ptrdiff_t i = 0; i < size; i++) + if (freq[i] > 0) + ret = Fcons (Fcons (make_int (i + 1), make_int (freq[i])), + ret); + xfree (freq); + return Fnreverse (ret); +} + +DEFUN ("internal--hash-table-buckets", + Finternal__hash_table_buckets, + Sinternal__hash_table_buckets, + 1, 1, 0, + doc: /* (KEY . HASH) in HASH-TABLE, grouped by bucket. +Internal use only. */) + (Lisp_Object hash_table) +{ + struct Lisp_Hash_Table *h = check_hash_table (hash_table); + Lisp_Object ret = Qnil; + ptrdiff_t index_size = ASIZE (h->index); + for (ptrdiff_t i = 0; i < index_size; i++) + { + Lisp_Object bucket = Qnil; + for (ptrdiff_t j = HASH_INDEX (h, i); j != -1; j = HASH_NEXT (h, j)) + bucket = Fcons (Fcons (HASH_KEY (h, j), HASH_HASH (h, j)), + bucket); + if (!NILP (bucket)) + ret = Fcons (Fnreverse (bucket), ret); + } + return Fnreverse (ret); +} + +DEFUN ("internal--hash-table-index-size", + Finternal__hash_table_index_size, + Sinternal__hash_table_index_size, + 1, 1, 0, + doc: /* Index size of HASH-TABLE. Internal use only. */) + (Lisp_Object hash_table) +{ + struct Lisp_Hash_Table *h = check_hash_table (hash_table); + ptrdiff_t index_size = ASIZE (h->index); + return make_int (index_size); +} /************************************************************************ @@ -6250,6 +6312,9 @@ syms_of_fns (void) defsubr (&Sremhash); defsubr (&Smaphash); defsubr (&Sdefine_hash_table_test); + defsubr (&Sinternal__hash_table_histogram); + defsubr (&Sinternal__hash_table_buckets); + defsubr (&Sinternal__hash_table_index_size); defsubr (&Sstring_search); defsubr (&Sobject_intervals); defsubr (&Sline_number_at_pos); commit 10cfbda88413c8ac0d254553fd537447b890a885 Author: Michael Albinus Date: Fri Jan 12 16:19:42 2024 +0100 * src/nsfont.m (nsfont_open): Fix Ffont_xlfd_name args. diff --git a/src/nsfont.m b/src/nsfont.m index 1205fbe5263..2679a42e1e1 100644 --- a/src/nsfont.m +++ b/src/nsfont.m @@ -1035,7 +1035,7 @@ Properties to be considered are same as for list(). */ font->underline_position = lrint (font_info->underpos); font->underline_thickness = lrint (font_info->underwidth); - font->props[FONT_NAME_INDEX] = Ffont_xlfd_name (font_object, Qnil); + font->props[FONT_NAME_INDEX] = Ffont_xlfd_name (font_object, Qnil, Qnil); font->props[FONT_FULLNAME_INDEX] = build_unibyte_string (font_info->name); } unblock_input ();