X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Felhash.c;h=9055e93836cc05f32feb10455134396f72949481;hb=a8db5b00f8ae5743db3198c67917ce04eff1a198;hp=36b51de0c33bdfa85067934b9f8fc7d57c20f8a5;hpb=59eec5f21669e81977b5b1fe9bf717cab49cf7fb;p=chise%2Fxemacs-chise.git.1

diff --git a/src/elhash.c b/src/elhash.c
index 36b51de..9055e93 100644
--- a/src/elhash.c
+++ b/src/elhash.c
@@ -71,9 +71,9 @@ struct Lisp_Hash_Table
 #define HASH_TABLE_MIN_SIZE 10
 
 #define HASH_CODE(key, ht)						\
-((((ht)->hash_function ? (ht)->hash_function (key) : LISP_HASH (key))	\
-  * (ht)->golden_ratio)							\
- % (ht)->size)
+  ((((ht)->hash_function ? (ht)->hash_function (key) : LISP_HASH (key))	\
+    * (ht)->golden_ratio)						\
+   % (ht)->size)
 
 #define KEYS_EQUAL_P(key1, key2, testfun) \
   (EQ (key1, key2) || ((testfun) && (testfun) (key1, key2)))
@@ -336,7 +336,7 @@ print_hash_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
   else if (ht->test_function == lisp_object_eql_equal)
     DO_NOTHING;
   else
-    abort ();
+    ABORT ();
 
   if (ht->count || !print_readably)
     {
@@ -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 ();
+      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.
@@ -718,11 +730,11 @@ hash_table_instantiate (Lisp_Object plist)
       else if (EQ (key, Qdata))		    data	     = value;
       else if (EQ (key, Qtype))/*obsolete*/ weakness	     = value;
       else
-	abort ();
+	ABORT ();
     }
 
   /* 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),
@@ -797,7 +809,7 @@ Use Common Lisp style keywords to specify hash table properties.
 Keyword :test can be `eq', `eql' (default) or `equal'.
 Comparison between keys is done using this function.
 If speed is important, consider using `eq'.
-When storing strings in the hash table, you will likely need to use `equal'.
+When hash table keys may be strings, you will likely need to use `equal'.
 
 Keyword :size specifies the number of keys likely to be inserted.
 This number of entries can be inserted without enlarging the hash table.
@@ -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))
@@ -1432,7 +1475,7 @@ internal_hash (Lisp_Object obj, int depth)
 
 DEFUN ("sxhash", Fsxhash, 1, 1, 0, /*
 Return a hash value for OBJECT.
-(equal obj1 obj2) implies (= (sxhash obj1) (sxhash obj2)).
+\(equal obj1 obj2) implies (= (sxhash obj1) (sxhash obj2)).
 */
        (object))
 {
@@ -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);
 }