Add C macro for hash table iteration

This removes some boilerplate code and further reduces dependencies on
hash table implementation internals.

* src/lisp.h (DOHASH): New.
* 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 (Fmaphash):
* src/json.c (lisp_to_json_nonscalar_1):
* src/minibuf.c (Ftest_completion):
* src/print.c (print):
Use it instead of a hand-written loop.

(cherry picked from commit fec87a4b36a67688932e7bb7e1720bd2c4363a61)

diff --git a/src/comp.c b/src/comp.c
index 3f9e738d9a75cb3ac1f5dd0d82390e724baa9c29..25c4cb2f22ce4ed55dcb76e4a458ac9a29d10e0e 100644 (file)
--- a/src/comp.c
+++ b/src/comp.c
@@ -4330,11 +4330,10 @@ compile_function (Lisp_Object func)
   declare_block (Qentry);
   Lisp_Object blocks = CALL1I (comp-func-blocks, func);
   struct Lisp_Hash_Table *ht = XHASH_TABLE (blocks);
-  for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (ht); i++)
+  DOHASH (ht, i)
     {
       Lisp_Object block_name = HASH_KEY (ht, i);
-      if (!EQ (block_name, Qentry)
-         && !hash_unused_entry_key_p (block_name))
+      if (!EQ (block_name, Qentry))
        declare_block (block_name);
     }
 
@@ -4344,24 +4343,21 @@ compile_function (Lisp_Object func)
                                gcc_jit_lvalue_as_rvalue (comp.func_relocs));
 
 
-  for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (ht); i++)
+  DOHASH (ht, i)
     {
       Lisp_Object block_name = HASH_KEY (ht, i);
-      if (!hash_unused_entry_key_p (block_name))
+      Lisp_Object block = HASH_VALUE (ht, i);
+      Lisp_Object insns = CALL1I (comp-block-insns, block);
+      if (NILP (block) || NILP (insns))
+       xsignal1 (Qnative_ice,
+                 build_string ("basic block is missing or empty"));
+
+      comp.block = retrive_block (block_name);
+      while (CONSP (insns))
        {
-         Lisp_Object block = HASH_VALUE (ht, i);
-         Lisp_Object insns = CALL1I (comp-block-insns, block);
-         if (NILP (block) || NILP (insns))
-           xsignal1 (Qnative_ice,
-                     build_string ("basic block is missing or empty"));
-
-         comp.block = retrive_block (block_name);
-         while (CONSP (insns))
-           {
-             Lisp_Object insn = XCAR (insns);
-             emit_limple_insn (insn);
-             insns = XCDR (insns);
-           }
+         Lisp_Object insn = XCAR (insns);
+         emit_limple_insn (insn);
+         insns = XCDR (insns);
        }
     }
   const char *err =  gcc_jit_context_get_first_error (comp.ctxt);
@@ -4965,14 +4961,10 @@ 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 (!hash_unused_entry_key_p (HASH_KEY (func_h, i)))
-      declare_function (HASH_VALUE (func_h, i));
+  DOHASH (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 (!hash_unused_entry_key_p (HASH_KEY (func_h, i)))
-      compile_function (HASH_VALUE (func_h, i));
+  DOHASH (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/composite.c b/src/composite.c
index 78c884dd72dca2df4c5805ff0dc6110de145a0e6..d9233fe0cc09d1fb9610cc34fe0e31cdc1c4c195 100644 (file)
--- a/src/composite.c
+++ b/src/composite.c
@@ -687,17 +687,13 @@ composition_gstring_cache_clear_font (Lisp_Object font_object)
 {
   struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
 
-  for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i)
+  DOHASH (h, i)
     {
       Lisp_Object k = HASH_KEY (h, i);
+      Lisp_Object gstring = HASH_VALUE (h, i);
 
-      if (!hash_unused_entry_key_p (k))
-       {
-         Lisp_Object gstring = HASH_VALUE (h, i);
-
-         if (EQ (LGSTRING_FONT (gstring), font_object))
-           hash_remove_from_table (h, k);
-       }
+      if (EQ (LGSTRING_FONT (gstring), font_object))
+       hash_remove_from_table (h, k);
     }
 }
 

diff --git a/src/emacs-module.c b/src/emacs-module.c
index 00ae33dfa2ca645580f0ac1d8a04e0ec21fcbc48..77dd2b9152c50b7e593dd81e2ca44688b32da921 100644 (file)
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -410,12 +410,9 @@ module_global_reference_p (emacs_value v, ptrdiff_t *n)
   struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash);
   /* Note that we can't use `hash_lookup' because V might be a local
      reference that's identical to some global reference.  */
-  for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i)
-    {
-      if (!hash_unused_entry_key_p (HASH_KEY (h, i))
-          && &XMODULE_GLOBAL_REFERENCE (HASH_VALUE (h, i))->value == v)
-        return true;
-    }
+  DOHASH (h, i)
+    if (&XMODULE_GLOBAL_REFERENCE (HASH_VALUE (h, i))->value == v)
+      return true;
   /* Only used for debugging, so we don't care about overflow, just
      make sure the operation is defined.  */
   ckd_add (n, *n, h->count);

diff --git a/src/fns.c b/src/fns.c
index 15bbd270311416e0e84c2a7532099ecb9cae3ac1..4531b23782473992134d6024751e54fccdb2dd45 100644 (file)
--- a/src/fns.c
+++ b/src/fns.c
@@ -5655,14 +5655,7 @@ FUNCTION is called with two arguments, KEY and VALUE.
   (Lisp_Object function, Lisp_Object table)
 {
   struct Lisp_Hash_Table *h = check_hash_table (table);
-
-  for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i)
-    {
-      Lisp_Object k = HASH_KEY (h, i);
-      if (!hash_unused_entry_key_p (k))
-        call2 (function, k, HASH_VALUE (h, i));
-    }
-
+  DOHASH (h, i) call2 (function, HASH_KEY (h, i), HASH_VALUE (h, i));
   return Qnil;
 }
 

diff --git a/src/json.c b/src/json.c
index 266905f1c34ff4b11a04af3df119dba763e69624..5434780ba136cdb36e664256164118904c0708ed 100644 (file)
--- a/src/json.c
+++ b/src/json.c
@@ -361,33 +361,30 @@ lisp_to_json_nonscalar_1 (Lisp_Object lisp,
       json = json_check (json_object ());
       count = SPECPDL_INDEX ();
       record_unwind_protect_ptr (json_release_object, json);
-      for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i)
+      DOHASH (h, i)
         {
           Lisp_Object key = HASH_KEY (h, i);
-          if (!hash_unused_entry_key_p (key))
-            {
-              CHECK_STRING (key);
-              Lisp_Object ekey = json_encode (key);
-              /* We can't specify the length, so the string must be
-                null-terminated.  */
-              check_string_without_embedded_nulls (ekey);
-              const char *key_str = SSDATA (ekey);
-              /* Reject duplicate keys.  These are possible if the hash
-                table test is not `equal'.  */
-              if (json_object_get (json, key_str) != NULL)
-                wrong_type_argument (Qjson_value_p, lisp);
-              int status
-                = json_object_set_new (json, key_str,
-                                       lisp_to_json (HASH_VALUE (h, i), conf));
-              if (status == -1)
-                {
-                  /* A failure can be caused either by an invalid key or
-                   by low memory.  */
-                  json_check_utf8 (ekey);
-                  json_out_of_memory ();
-                }
-            }
-        }
+         CHECK_STRING (key);
+         Lisp_Object ekey = json_encode (key);
+         /* We can't specify the length, so the string must be
+            null-terminated.  */
+         check_string_without_embedded_nulls (ekey);
+         const char *key_str = SSDATA (ekey);
+         /* Reject duplicate keys.  These are possible if the hash
+            table test is not `equal'.  */
+         if (json_object_get (json, key_str) != NULL)
+           wrong_type_argument (Qjson_value_p, lisp);
+         int status
+           = json_object_set_new (json, key_str,
+                                  lisp_to_json (HASH_VALUE (h, i), conf));
+         if (status == -1)
+           {
+             /* A failure can be caused either by an invalid key or
+                by low memory.  */
+             json_check_utf8 (ekey);
+             json_out_of_memory ();
+           }
+       }
     }
   else if (NILP (lisp))
     return json_check (json_object ());

diff --git a/src/lisp.h b/src/lisp.h
index f0beafba42c269a7d942c7cbb3de8f5e1054234d..edea7cc23bb84df820d404bf6d1f55371c35fc3f 100644 (file)
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2579,6 +2579,14 @@ hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key)
   return h->test->hashfn (key, h);
 }
 
+/* Hash table iteration construct (roughly an inlined maphash):
+   Iterate IDXVAR as index over valid entries of TABLE.
+   The body may remove the current entry or alter its value slot, but not
+   mutate TABLE in any other way.  */
+#define DOHASH(TABLE, IDXVAR)                                          \
+  for (ptrdiff_t IDXVAR = 0; IDXVAR < (TABLE)->table_size; IDXVAR++)   \
+    if (!hash_unused_entry_key_p (HASH_KEY (TABLE, IDXVAR)))
+
 void hash_table_thaw (Lisp_Object hash_table);
 
 /* Default size for hash tables if not specified.  */

diff --git a/src/minibuf.c b/src/minibuf.c
index 0e64e537682e6e188635d1deb273d4bcfe78ef08..f3420815d5915e4cc782c002bc081dda0935d011 100644 (file)
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -2114,10 +2114,10 @@ the values STRING, PREDICATE and `lambda'.  */)
           goto found_matching_key;
         }
       else
-       for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
+       DOHASH (h, j)
           {
+           i = j;
             tem = HASH_KEY (h, i);
-            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 61999c096aafbd7810b671de32527e123240de4d..c61fb3cd574512620d5c0419cde6dda0eef0990e 100644 (file)
--- a/src/print.c
+++ b/src/print.c
@@ -1285,15 +1285,9 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
        { /* Remove unnecessary objects, which appear only once in OBJ;
             that is, whose status is Qt.  */
          struct Lisp_Hash_Table *h = XHASH_TABLE (Vprint_number_table);
-         ptrdiff_t i;
-
-         for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
-            {
-              Lisp_Object key =  HASH_KEY (h, i);
-             if (!hash_unused_entry_key_p (key)
-                 && EQ (HASH_VALUE (h, i), Qt))
-               Fremhash (key, Vprint_number_table);
-            }
+         DOHASH (h, i)
+           if (EQ (HASH_VALUE (h, i), Qt))
+             Fremhash (HASH_KEY (h, i), Vprint_number_table);
        }
     }