XEmacs 21.2.47 (Zephir).

[chise/xemacs-chise.git.1] / src / elhash.c

diff --git a/src/elhash.c b/src/elhash.c
index 2fb2c04..b034860 100644 (file)
--- a/src/elhash.c
+++ b/src/elhash.c
@@ -434,36 +434,54 @@ compute_hash_table_derived_values (Lisp_Hash_Table *ht)
 }
 
 Lisp_Object
-make_general_lisp_hash_table (enum hash_table_test test,
-                             size_t size,
-                             double rehash_size,
-                             double rehash_threshold,
-                             enum hash_table_weakness weakness)
+make_standard_lisp_hash_table (enum hash_table_test test,
+                              size_t size,
+                              double rehash_size,
+                              double rehash_threshold,
+                              enum hash_table_weakness weakness)
 {
-  Lisp_Object hash_table;
-  Lisp_Hash_Table *ht = alloc_lcrecord_type (Lisp_Hash_Table, &lrecord_hash_table);
+  hash_table_hash_function_t hash_function =  0;
+  hash_table_test_function_t test_function = 0;
 
   switch (test)
     {
     case HASH_TABLE_EQ:
-      ht->test_function = 0;
-      ht->hash_function = 0;
+      test_function = 0;
+      hash_function = 0;
       break;
 
     case HASH_TABLE_EQL:
-      ht->test_function = lisp_object_eql_equal;
-      ht->hash_function = lisp_object_eql_hash;
+      test_function = lisp_object_eql_equal;
+      hash_function = lisp_object_eql_hash;
       break;
 
     case HASH_TABLE_EQUAL:
-      ht->test_function = lisp_object_equal_equal;
-      ht->hash_function = lisp_object_equal_hash;
+      test_function = lisp_object_equal_equal;
+      hash_function = lisp_object_equal_hash;
       break;
 
     default:
       abort ();
     }
 
+  return make_general_lisp_hash_table (hash_function, test_function,
+                                      size, rehash_size, rehash_threshold,
+                                      weakness);
+}
+
+Lisp_Object
+make_general_lisp_hash_table (hash_table_hash_function_t hash_function,
+                             hash_table_test_function_t test_function,
+                             size_t size,
+                             double rehash_size,
+                             double rehash_threshold,
+                             enum hash_table_weakness weakness)
+{
+  Lisp_Object hash_table;
+  Lisp_Hash_Table *ht = alloc_lcrecord_type (Lisp_Hash_Table, &lrecord_hash_table);
+
+  ht->test_function = test_function;
+  ht->hash_function = hash_function;
   ht->weakness = weakness;
 
   ht->rehash_size =
@@ -482,13 +500,7 @@ make_general_lisp_hash_table (enum hash_table_test test,
   compute_hash_table_derived_values (ht);
 
   /* We leave room for one never-occupied sentinel hentry at the end.  */
-  ht->hentries = xnew_array (hentry, ht->size + 1);
-
-  {
-    hentry *e, *sentinel;
-    for (e = ht->hentries, sentinel = e + ht->size; e <= sentinel; e++)
-      CLEAR_HENTRY (e);
-  }
+  ht->hentries = xnew_array_and_zero (hentry, ht->size + 1);
 
   XSETHASH_TABLE (hash_table, ht);
 
@@ -505,7 +517,7 @@ make_lisp_hash_table (size_t size,
                      enum hash_table_weakness weakness,
                      enum hash_table_test test)
 {
-  return make_general_lisp_hash_table (test, size, -1.0, -1.0, weakness);
+  return make_standard_lisp_hash_table (test, size, -1.0, -1.0, weakness);
 }
 
 /* Pretty reading of hash tables.
@@ -722,7 +734,7 @@ hash_table_instantiate (Lisp_Object plist)
     }
 
   /* Create the hash table.  */
-  hash_table = make_general_lisp_hash_table
+  hash_table = make_standard_lisp_hash_table
     (decode_hash_table_test (test),
      decode_hash_table_size (size),
      decode_hash_table_rehash_size (rehash_size),
@@ -872,7 +884,7 @@ if (!NILP (var)) hash_table_##var##_validate (Q##var, var, ERROR_ME);
   VALIDATE_VAR (rehash_threshold);
   VALIDATE_VAR (weakness);
 
-  return make_general_lisp_hash_table
+  return make_standard_lisp_hash_table
     (decode_hash_table_test (test),
      decode_hash_table_size (size),
      decode_hash_table_rehash_size (rehash_size),
@@ -1189,6 +1201,19 @@ may remhash or puthash the entry currently being processed by FUNCTION.
   return Qnil;
 }
 
+/* #### If the Lisp function being called does a puthash and this
+   #### causes the hash table to be resized, the results will be quite
+   #### random and we will likely crash.  To fix this, either set a
+   #### flag in the hash table while we're mapping and signal an error
+   #### when new entries are added, or fix things to make this
+   #### operation work properly, like this: Store two hash tables in
+   #### each hash table object -- the second one is written to when
+   #### you do a puthash inside of a mapping operation, and the
+   #### various operations need to check both hash tables for entries.
+   #### As soon as the last maphash over a particular hash table
+   #### object terminates, the entries in the second table are added
+   #### to the first (using an unwind-protect). --ben */
+
 /* Map *C* function FUNCTION over the elements of a lisp hash table. */
 void
 elisp_maphash (maphash_function_t function,
@@ -1305,6 +1330,24 @@ finish_marking_weak_hash_tables (void)
                }
          break;
 
+         /* We seem to be sprouting new weakness types at an alarming
+            rate. At least this is not externally visible - and in
+            fact all of these KEY_CAR_* types are only used by the
+            glyph code. */
+       case HASH_TABLE_KEY_CAR_VALUE_WEAK:
+         for (; e < sentinel; e++)
+           if (!HENTRY_CLEAR_P (e))
+             {
+               if (!CONSP (e->key) || marked_p (XCAR (e->key)))
+                 {
+                   MARK_OBJ (e->key);
+                   MARK_OBJ (e->value);
+                 }
+               else if (marked_p (e->value))
+                 MARK_OBJ (e->key);
+             }
+         break;
+
        case HASH_TABLE_VALUE_CAR_WEAK:
          for (; e < sentinel; e++)
            if (!HENTRY_CLEAR_P (e))
@@ -1511,5 +1554,5 @@ vars_of_elhash (void)
 {
   /* This must NOT be staticpro'd */
   Vall_weak_hash_tables = Qnil;
-  pdump_wire_list (&Vall_weak_hash_tables);
+  dump_add_weak_object_chain (&Vall_weak_hash_tables);
 }