From 98629066fa6d4f9fc108d4e93c60ab06339506e7 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 25 Jan 2024 18:56:03 +0100 Subject: [PATCH] Add DOHASH_SAFE, make DOHASH faster (bug#68690) Revert DOHASH to the fast (field-caching) implementation but with an assertion to detect misuses. Add DOHASH_SAFE for use in code that must tolerate arbitrary mutation of the table being iterated through. * src/lisp.h (DOHASH): Go back to fast design that only allows restricted mutation, but with a checking assertion. (DOHASH_SAFE): New macro that tolerates arbitrary mutation while being much simpler (and acceptably fast). * src/fns.c (Fmaphash): * src/comp.c (compile_function, Fcomp__compile_ctxt_to_file): Use DOHASH_SAFE. (cherry picked from commit da726c6de201cdb9123bd99e22206dbed5fdc50f) --- src/comp.c | 21 +++++++++++++-------- src/fns.c | 7 +++++-- src/lisp.h | 54 ++++++++++++++++++++++++++++++------------------------ 3 files changed, 48 insertions(+), 34 deletions(-) diff --git a/src/comp.c b/src/comp.c index 5f28cf046b5..853757f6162 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4330,9 +4330,12 @@ compile_function (Lisp_Object func) declare_block (Qentry); Lisp_Object blocks = CALL1I (comp-func-blocks, func); struct Lisp_Hash_Table *ht = XHASH_TABLE (blocks); - DOHASH (ht, block_name, block) - if (!EQ (block_name, Qentry)) - declare_block (block_name); + DOHASH_SAFE (ht, i) + { + Lisp_Object block_name = HASH_KEY (ht, i); + if (!EQ (block_name, Qentry)) + declare_block (block_name); + } gcc_jit_block_add_assignment (retrive_block (Qentry), NULL, @@ -4340,8 +4343,10 @@ compile_function (Lisp_Object func) gcc_jit_lvalue_as_rvalue (comp.func_relocs)); - DOHASH (ht, block_name, block) + DOHASH_SAFE (ht, i) { + Lisp_Object block_name = HASH_KEY (ht, i); + Lisp_Object block = HASH_VALUE (ht, i); Lisp_Object insns = CALL1I (comp-block-insns, block); if (NILP (block) || NILP (insns)) xsignal1 (Qnative_ice, @@ -4956,12 +4961,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)); - DOHASH (func_h, k, v) - declare_function (v); + DOHASH_SAFE (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. */ - DOHASH (func_h, k, v) - compile_function (v); + DOHASH_SAFE (func_h, i) + compile_function (HASH_VALUE (func_h, i)); /* Work around bug#46495 (GCC PR99126). */ #if defined (WIDE_EMACS_INT) \ diff --git a/src/fns.c b/src/fns.c index 859df6748f7..e4fa8157000 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5662,8 +5662,11 @@ set a new value for KEY, or `remhash' to remove KEY. (Lisp_Object function, Lisp_Object table) { struct Lisp_Hash_Table *h = check_hash_table (table); - DOHASH (h, k, v) - call2 (function, k, v); + /* We can't use DOHASH here since FUNCTION may violate the rules and + we shouldn't crash as a result (although the effects are + unpredictable). */ + DOHASH_SAFE (h, i) + call2 (function, HASH_KEY (h, i), HASH_VALUE (h, i)); return Qnil; } diff --git a/src/lisp.h b/src/lisp.h index d07d9d14e2f..c2dfd1afad5 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2604,32 +2604,38 @@ hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key) } /* Iterate K and V as key and value of valid entries in hash table H. - The body may mutate the hash-table. */ -#define DOHASH(h, k, v) \ - for (Lisp_Object *dohash_##k##_##v##_base = (h)->key_and_value, \ - *dohash_##k##_##v##_kv = dohash_##k##_##v##_base, \ - *dohash_##k##_##v##_end = dohash_##k##_##v##_base \ - + 2 * HASH_TABLE_SIZE (h), \ - k, v; \ - dohash_##k##_##v##_kv < dohash_##k##_##v##_end \ - && (dohash_##k##_##v##_base == (h)->key_and_value \ - /* The `key_and_value` table has been reallocated! */ \ - || (dohash_##k##_##v##_kv \ - = (dohash_##k##_##v##_kv - dohash_##k##_##v##_base) \ - + (h)->key_and_value, \ - dohash_##k##_##v##_base = (h)->key_and_value, \ - dohash_##k##_##v##_end = dohash_##k##_##v##_base \ - + 2 * HASH_TABLE_SIZE (h), \ - /* Check again, in case the table has shrunk. */ \ - dohash_##k##_##v##_kv < dohash_##k##_##v##_end)) \ - && (k = dohash_##k##_##v##_kv[0], \ - v = dohash_##k##_##v##_kv[1], /*maybe unused*/ (void)v, \ - true); \ - dohash_##k##_##v##_kv += 2) \ - if (hash_unused_entry_key_p (k)) \ - ; \ + The body may remove the current entry or alter its value slot, but not + mutate TABLE in any other way. */ +#define DOHASH(h, k, v) \ + for (Lisp_Object *dohash_##k##_##v##_kv = (h)->key_and_value, \ + *dohash_##k##_##v##_end = dohash_##k##_##v##_kv \ + + 2 * HASH_TABLE_SIZE (h), \ + *dohash_##k##_##v##_base = dohash_##k##_##v##_kv, \ + k, v; \ + dohash_##k##_##v##_kv < dohash_##k##_##v##_end \ + && (k = dohash_##k##_##v##_kv[0], \ + v = dohash_##k##_##v##_kv[1], /*maybe unused*/ (void)v, \ + true); \ + eassert (dohash_##k##_##v##_base == (h)->key_and_value \ + && dohash_##k##_##v##_end \ + == dohash_##k##_##v##_base \ + + 2 * HASH_TABLE_SIZE (h)), \ + dohash_##k##_##v##_kv += 2) \ + if (hash_unused_entry_key_p (k)) \ + ; \ else +/* Iterate I as index of valid entries in hash table H. + Unlike DOHASH, this construct copes with arbitrary table mutations + in the body. The consequences of such mutations are limited to + whether and in what order entries are encountered by the loop + (which is usually bad enough), but not crashing or corrupting the + Lisp state. */ +#define DOHASH_SAFE(h, i) \ + for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); i++) \ + if (hash_unused_entry_key_p (HASH_KEY (h, i))) \ + ; \ + else void hash_table_thaw (Lisp_Object hash_table); -- 2.39.5