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)

diff --git a/src/comp.c b/src/comp.c
index 5f28cf046b5b196a760c916495aa953ae82293e7..853757f616299355eb3c0b1996d0ebf3034df346 100644 (file)
--- 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 859df6748f7f328b82f24a4c17ef277cd7b2a116..e4fa8157000bd00b378086d32cbf3d500ff8edc9 100644 (file)
--- 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 d07d9d14e2f6161d23c5830471035a6fda703b20..c2dfd1afad5136ea3c2ab5b8bff03f930a8fb71c 100644 (file)
--- 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);