XEmacs 21.2.29 "Hestia".
[chise/xemacs-chise.git.1] / src / elhash.c
index 397f65d..251e549 100644 (file)
@@ -59,7 +59,6 @@ struct Lisp_Hash_Table
   Lisp_Object next_weak;     /* Used to chain together all of the weak
                                hash tables.  Don't mark through this. */
 };
-typedef struct Lisp_Hash_Table Lisp_Hash_Table;
 
 #define HENTRY_CLEAR_P(hentry) ((*(EMACS_UINT*)(&((hentry)->key))) == 0)
 #define CLEAR_HENTRY(hentry)   \
@@ -123,7 +122,7 @@ hash_table_size (size_t requested_size)
   /* Return some prime near, but greater than or equal to, SIZE.
      Decades from the time of writing, someone will have a system large
      enough that the list below will be too short... */
-  static CONST size_t primes [] =
+  static const size_t primes [] =
   {
     19, 29, 41, 59, 79, 107, 149, 197, 263, 347, 457, 599, 787, 1031,
     1361, 1777, 2333, 3037, 3967, 5167, 6719, 8737, 11369, 14783,
@@ -253,6 +252,16 @@ hash_table_equal (Lisp_Object hash_table1, Lisp_Object hash_table2, int depth)
 
   return 1;
 }
+
+/* This is not a great hash function, but it _is_ correct and fast.
+   Examining all entries is too expensive, and examining a random
+   subset does not yield a correct hash function. */
+static hashcode_t
+hash_table_hash (Lisp_Object hash_table, int depth)
+{
+  return XHASH_TABLE (hash_table)->count;
+}
+
 \f
 /* Printing hash tables.
 
@@ -374,27 +383,27 @@ finalize_hash_table (void *header, int for_disksave)
 }
 
 static const struct lrecord_description hentry_description_1[] = {
-  { XD_LISP_OBJECT, offsetof(hentry, key), 2 },
+  { XD_LISP_OBJECT, offsetof (hentry, key) },
+  { XD_LISP_OBJECT, offsetof (hentry, value) },
   { XD_END }
 };
 
 static const struct struct_description hentry_description = {
-  sizeof(hentry),
+  sizeof (hentry),
   hentry_description_1
 };
 
 const struct lrecord_description hash_table_description[] = {
-  { XD_SIZE_T,     offsetof(Lisp_Hash_Table, size) },
-  { XD_STRUCT_PTR, offsetof(Lisp_Hash_Table, hentries), XD_INDIRECT(0, 1), &hentry_description },
-  { XD_LO_LINK,    offsetof(Lisp_Hash_Table, next_weak) },
+  { XD_SIZE_T,     offsetof (Lisp_Hash_Table, size) },
+  { XD_STRUCT_PTR, offsetof (Lisp_Hash_Table, hentries), XD_INDIRECT(0, 1), &hentry_description },
+  { XD_LO_LINK,    offsetof (Lisp_Hash_Table, next_weak) },
   { XD_END }
 };
 
 DEFINE_LRECORD_IMPLEMENTATION ("hash-table", hash_table,
                                mark_hash_table, print_hash_table,
                               finalize_hash_table,
-                              /* #### Implement hash_table_hash()! */
-                              hash_table_equal, 0,
+                              hash_table_equal, hash_table_hash,
                               hash_table_description,
                               Lisp_Hash_Table);
 
@@ -861,7 +870,7 @@ The keys and values will not themselves be copied.
 */
        (hash_table))
 {
-  CONST Lisp_Hash_Table *ht_old = xhash_table (hash_table);
+  const Lisp_Hash_Table *ht_old = xhash_table (hash_table);
   Lisp_Hash_Table *ht = alloc_lcrecord_type (Lisp_Hash_Table, &lrecord_hash_table);
 
   copy_lcrecord (ht, ht_old);
@@ -883,7 +892,7 @@ The keys and values will not themselves be copied.
 static void
 resize_hash_table (Lisp_Hash_Table *ht, size_t new_size)
 {
-  hentry *old_entries, *new_entries, *old_sentinel, *new_sentinel, *e;
+  hentry *old_entries, *new_entries, *sentinel, *e;
   size_t old_size;
 
   old_size = ht->size;
@@ -891,18 +900,12 @@ resize_hash_table (Lisp_Hash_Table *ht, size_t new_size)
 
   old_entries = ht->hentries;
 
-  ht->hentries = xnew_array (hentry, new_size + 1);
+  ht->hentries = xnew_array_and_zero (hentry, new_size + 1);
   new_entries = ht->hentries;
 
-  old_sentinel = old_entries + old_size;
-  new_sentinel = new_entries + new_size;
-
-  for (e = new_entries; e <= new_sentinel; e++)
-    CLEAR_HENTRY (e);
-
   compute_hash_table_derived_values (ht);
 
-  for (e = old_entries; e < old_sentinel; e++)
+  for (e = old_entries, sentinel = e + old_size; e < sentinel; e++)
     if (!HENTRY_CLEAR_P (e))
       {
        hentry *probe = new_entries + HASH_CODE (e->key, ht);
@@ -915,10 +918,28 @@ resize_hash_table (Lisp_Hash_Table *ht, size_t new_size)
     xfree (old_entries);
 }
 
+/* After a hash table has been saved to disk and later restored by the
+   portable dumper, it contains the same objects, but their addresses
+   and thus their HASH_CODEs have changed. */
 void
-reorganize_hash_table (Lisp_Hash_Table *ht)
+pdump_reorganize_hash_table (Lisp_Object hash_table)
 {
-  resize_hash_table (ht, ht->size);
+  const Lisp_Hash_Table *ht = xhash_table (hash_table);
+  hentry *new_entries = xnew_array_and_zero (hentry, ht->size + 1);
+  hentry *e, *sentinel;
+
+  for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++)
+    if (!HENTRY_CLEAR_P (e))
+      {
+       hentry *probe = new_entries + HASH_CODE (e->key, ht);
+       LINEAR_PROBING_LOOP (probe, new_entries, ht->size)
+         ;
+       *probe = *e;
+      }
+
+  memcpy (ht->hentries, new_entries, ht->size * sizeof (hentry));
+
+  xfree (new_entries);
 }
 
 static void
@@ -930,7 +951,7 @@ enlarge_hash_table (Lisp_Hash_Table *ht)
 }
 
 static hentry *
-find_hentry (Lisp_Object key, CONST Lisp_Hash_Table *ht)
+find_hentry (Lisp_Object key, const Lisp_Hash_Table *ht)
 {
   hash_table_test_function_t test_function = ht->test_function;
   hentry *entries = ht->hentries;
@@ -949,7 +970,7 @@ If there is no corresponding value, return DEFAULT (which defaults to nil).
 */
        (key, hash_table, default_))
 {
-  CONST Lisp_Hash_Table *ht = xhash_table (hash_table);
+  const Lisp_Hash_Table *ht = xhash_table (hash_table);
   hentry *e = find_hentry (key, ht);
 
   return HENTRY_CLEAR_P (e) ? default_ : e->value;
@@ -1129,8 +1150,8 @@ may remhash or puthash the entry currently being processed by FUNCTION.
 */
        (function, hash_table))
 {
-  CONST Lisp_Hash_Table *ht = xhash_table (hash_table);
-  CONST hentry *e, *sentinel;
+  const Lisp_Hash_Table *ht = xhash_table (hash_table);
+  const hentry *e, *sentinel;
 
   for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++)
     if (!HENTRY_CLEAR_P (e))
@@ -1155,8 +1176,8 @@ void
 elisp_maphash (maphash_function_t function,
               Lisp_Object hash_table, void *extra_arg)
 {
-  CONST Lisp_Hash_Table *ht = XHASH_TABLE (hash_table);
-  CONST hentry *e, *sentinel;
+  const Lisp_Hash_Table *ht = XHASH_TABLE (hash_table);
+  const hentry *e, *sentinel;
 
   for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++)
     if (!HENTRY_CLEAR_P (e))
@@ -1209,9 +1230,9 @@ finish_marking_weak_hash_tables (void)
        !NILP (hash_table);
        hash_table = XHASH_TABLE (hash_table)->next_weak)
     {
-      CONST Lisp_Hash_Table *ht = XHASH_TABLE (hash_table);
-      CONST hentry *e = ht->hentries;
-      CONST hentry *sentinel = e + ht->size;
+      const Lisp_Hash_Table *ht = XHASH_TABLE (hash_table);
+      const hentry *e = ht->hentries;
+      const hentry *sentinel = e + ht->size;
 
       if (! marked_p (hash_table))
        /* The hash table is probably garbage.  Ignore it. */
@@ -1316,12 +1337,13 @@ hashcode_t
 internal_array_hash (Lisp_Object *arr, int size, int depth)
 {
   int i;
-  unsigned long hash = 0;
+  hashcode_t hash = 0;
+  depth++;
 
   if (size <= 5)
     {
       for (i = 0; i < size; i++)
-       hash = HASH2 (hash, internal_hash (arr[i], depth + 1));
+       hash = HASH2 (hash, internal_hash (arr[i], depth));
       return hash;
     }
 
@@ -1329,7 +1351,7 @@ internal_array_hash (Lisp_Object *arr, int size, int depth)
      A slightly better approach would be to offset by some
      noise factor from the points chosen below. */
   for (i = 0; i < 5; i++)
-    hash = HASH2 (hash, internal_hash (arr[i*size/5], depth + 1));
+    hash = HASH2 (hash, internal_hash (arr[i*size/5], depth));
 
   return hash;
 }
@@ -1362,16 +1384,9 @@ internal_hash (Lisp_Object obj, int depth)
     {
       return hash_string (XSTRING_DATA (obj), XSTRING_LENGTH (obj));
     }
-  if (VECTORP (obj))
-    {
-      return HASH2 (XVECTOR_LENGTH (obj),
-                   internal_array_hash (XVECTOR_DATA (obj),
-                                        XVECTOR_LENGTH (obj),
-                                        depth + 1));
-    }
   if (LRECORDP (obj))
     {
-      CONST struct lrecord_implementation
+      const struct lrecord_implementation
        *imp = XRECORD_LHEADER_IMPLEMENTATION (obj);
       if (imp->hash)
        return imp->hash (obj, depth);
@@ -1397,7 +1412,7 @@ The value is returned as (HIGH . LOW).
        (object))
 {
   /* This function is pretty 32bit-centric. */
-  unsigned long hash = internal_hash (object, 0);
+  hashcode_t hash = internal_hash (object, 0);
   return Fcons (hash >> 16, hash & 0xffff);
 }
 #endif