Mercurial > hg > xemacs-beta
diff src/elhash.c @ 442:abe6d1db359e r21-2-36
Import from CVS: tag r21-2-36
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:35:02 +0200 |
parents | 8de8e3f6228a |
children | 576fb035e263 |
line wrap: on
line diff
--- a/src/elhash.c Mon Aug 13 11:33:40 2007 +0200 +++ b/src/elhash.c Mon Aug 13 11:35:02 2007 +0200 @@ -29,13 +29,14 @@ Lisp_Object Qhash_tablep; static Lisp_Object Qhashtable, Qhash_table; -static Lisp_Object Qweakness, Qvalue; +static Lisp_Object Qweakness, Qvalue, Qkey_or_value, Qkey_and_value; static Lisp_Object Vall_weak_hash_tables; static Lisp_Object Qrehash_size, Qrehash_threshold; static Lisp_Object Q_size, Q_test, Q_weakness, Q_rehash_size, Q_rehash_threshold; /* obsolete as of 19990901 in xemacs-21.2 */ -static Lisp_Object Qweak, Qkey_weak, Qvalue_weak, Qnon_weak, Q_type; +static Lisp_Object Qweak, Qkey_weak, Qvalue_weak, Qkey_or_value_weak; +static Lisp_Object Qnon_weak, Q_type; typedef struct hentry { @@ -122,7 +123,7 @@ /* 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, @@ -252,6 +253,16 @@ 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; +} + /* Printing hash tables. @@ -266,7 +277,7 @@ `size' (a natnum or nil) `rehash-size' (a float) `rehash-threshold' (a float) - `weakness' (nil, t, key or value) + `weakness' (nil, key, value, key-and-value, or key-or-value) `data' (a list) If `print-readably' is nil, then a simpler syntax is used, for example @@ -341,9 +352,10 @@ if (ht->weakness != HASH_TABLE_NON_WEAK) { sprintf (buf, " weakness %s", - (ht->weakness == HASH_TABLE_WEAK ? "t" : - ht->weakness == HASH_TABLE_KEY_WEAK ? "key" : - ht->weakness == HASH_TABLE_VALUE_WEAK ? "value" : + (ht->weakness == HASH_TABLE_WEAK ? "key-and-value" : + ht->weakness == HASH_TABLE_KEY_WEAK ? "key" : + ht->weakness == HASH_TABLE_VALUE_WEAK ? "value" : + ht->weakness == HASH_TABLE_KEY_VALUE_WEAK ? "key-or-value" : "you-d-better-not-see-this")); write_c_string (buf, printcharfun); } @@ -393,8 +405,7 @@ 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); @@ -530,16 +541,19 @@ hash_table_weakness_validate (Lisp_Object keyword, Lisp_Object value, Error_behavior errb) { - if (EQ (value, Qnil)) return 1; - if (EQ (value, Qt)) return 1; - if (EQ (value, Qkey)) return 1; - if (EQ (value, Qvalue)) return 1; + if (EQ (value, Qnil)) return 1; + if (EQ (value, Qt)) return 1; + if (EQ (value, Qkey)) return 1; + if (EQ (value, Qkey_and_value)) return 1; + if (EQ (value, Qkey_or_value)) return 1; + if (EQ (value, Qvalue)) return 1; /* Following values are obsolete as of 19990901 in xemacs-21.2 */ - if (EQ (value, Qnon_weak)) return 1; - if (EQ (value, Qweak)) return 1; - if (EQ (value, Qkey_weak)) return 1; - if (EQ (value, Qvalue_weak)) return 1; + if (EQ (value, Qnon_weak)) return 1; + if (EQ (value, Qweak)) return 1; + if (EQ (value, Qkey_weak)) return 1; + if (EQ (value, Qkey_or_value_weak)) return 1; + if (EQ (value, Qvalue_weak)) return 1; maybe_signal_simple_error ("Invalid hash table weakness", value, Qhash_table, errb); @@ -549,16 +563,19 @@ static enum hash_table_weakness decode_hash_table_weakness (Lisp_Object obj) { - if (EQ (obj, Qnil)) return HASH_TABLE_NON_WEAK; - if (EQ (obj, Qt)) return HASH_TABLE_WEAK; - if (EQ (obj, Qkey)) return HASH_TABLE_KEY_WEAK; - if (EQ (obj, Qvalue)) return HASH_TABLE_VALUE_WEAK; + if (EQ (obj, Qnil)) return HASH_TABLE_NON_WEAK; + if (EQ (obj, Qt)) return HASH_TABLE_WEAK; + if (EQ (obj, Qkey_and_value)) return HASH_TABLE_WEAK; + if (EQ (obj, Qkey)) return HASH_TABLE_KEY_WEAK; + if (EQ (obj, Qkey_or_value)) return HASH_TABLE_KEY_VALUE_WEAK; + if (EQ (obj, Qvalue)) return HASH_TABLE_VALUE_WEAK; /* Following values are obsolete as of 19990901 in xemacs-21.2 */ - if (EQ (obj, Qnon_weak)) return HASH_TABLE_NON_WEAK; - if (EQ (obj, Qweak)) return HASH_TABLE_WEAK; - if (EQ (obj, Qkey_weak)) return HASH_TABLE_KEY_WEAK; - if (EQ (obj, Qvalue_weak)) return HASH_TABLE_VALUE_WEAK; + if (EQ (obj, Qnon_weak)) return HASH_TABLE_NON_WEAK; + if (EQ (obj, Qweak)) return HASH_TABLE_WEAK; + if (EQ (obj, Qkey_weak)) return HASH_TABLE_KEY_WEAK; + if (EQ (obj, Qkey_or_value_weak)) return HASH_TABLE_KEY_VALUE_WEAK; + if (EQ (obj, Qvalue_weak)) return HASH_TABLE_VALUE_WEAK; signal_simple_error ("Invalid hash table weakness", obj); return HASH_TABLE_NON_WEAK; /* not reached */ @@ -791,14 +808,16 @@ Keyword :rehash-threshold must be a float between 0.0 and 1.0, and specifies the load factor of the hash table which triggers enlarging. -Non-standard keyword :weakness can be `nil' (default), `t', `key' or `value'. +Non-standard keyword :weakness can be `nil' (default), `t', `key-and-value', +`key', `value' or `key-or-value'. `t' is an alias for `key-and-value'. -A weak hash table is one whose pointers do not count as GC referents: -for any key-value pair in the hash table, if the only remaining pointer -to either the key or the value is in a weak hash table, then the pair -will be removed from the hash table, and the key and value collected. -A non-weak hash table (or any other pointer) would prevent the object -from being collected. +A key-and-value-weak hash table, also known as a fully-weak or simply +as a weak hash table, is one whose pointers do not count as GC +referents: for any key-value pair in the hash table, if the only +remaining pointer to either the key or the value is in a weak hash +table, then the pair will be removed from the hash table, and the key +and value collected. A non-weak hash table (or any other pointer) +would prevent the object from being collected. A key-weak hash table is similar to a fully-weak hash table except that a key-value pair will be removed only if the key remains unmarked @@ -811,6 +830,12 @@ unmarked outside of weak hash tables. The pair will remain in the hash table if the value is pointed to by something other than a weak hash table, even if the key is not. + +A key-or-value-weak hash table is similar to a fully-weak hash table except +that a key-value pair will be removed only if the value and the key remain +unmarked outside of weak hash tables. The pair will remain in the +hash table if the value or key are pointed to by something other than a weak +hash table, even if the other is not. */ (int nargs, Lisp_Object *args)) { @@ -861,7 +886,7 @@ */ (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); @@ -915,7 +940,7 @@ void pdump_reorganize_hash_table (Lisp_Object hash_table) { - CONST Lisp_Hash_Table *ht = xhash_table (hash_table); + const Lisp_Hash_Table *ht = xhash_table (hash_table); hentry *new_entries = xnew_array_and_zero (hentry, ht->size + 1); hentry *e, *sentinel; @@ -942,7 +967,7 @@ } 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; @@ -961,7 +986,7 @@ */ (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; @@ -1100,16 +1125,17 @@ DEFUN ("hash-table-weakness", Fhash_table_weakness, 1, 1, 0, /* Return the weakness of HASH-TABLE. -This can be one of `nil', `t', `key' or `value'. +This can be one of `nil', `key-and-value', `key-or-value', `key' or `value'. */ (hash_table)) { switch (xhash_table (hash_table)->weakness) { - case HASH_TABLE_WEAK: return Qt; - case HASH_TABLE_KEY_WEAK: return Qkey; - case HASH_TABLE_VALUE_WEAK: return Qvalue; - default: return Qnil; + case HASH_TABLE_WEAK: return Qkey_and_value; + case HASH_TABLE_KEY_WEAK: return Qkey; + case HASH_TABLE_KEY_VALUE_WEAK: return Qkey_or_value; + case HASH_TABLE_VALUE_WEAK: return Qvalue; + default: return Qnil; } } @@ -1122,10 +1148,11 @@ { switch (xhash_table (hash_table)->weakness) { - case HASH_TABLE_WEAK: return Qweak; - case HASH_TABLE_KEY_WEAK: return Qkey_weak; - case HASH_TABLE_VALUE_WEAK: return Qvalue_weak; - default: return Qnon_weak; + case HASH_TABLE_WEAK: return Qweak; + case HASH_TABLE_KEY_WEAK: return Qkey_weak; + case HASH_TABLE_KEY_VALUE_WEAK: return Qkey_or_value_weak; + case HASH_TABLE_VALUE_WEAK: return Qvalue_weak; + default: return Qnon_weak; } } @@ -1141,8 +1168,8 @@ */ (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)) @@ -1167,8 +1194,8 @@ 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,6 +1236,15 @@ /************************************************************************/ /* garbage collecting weak hash tables */ /************************************************************************/ +#define MARK_OBJ(obj) do { \ + Lisp_Object mo_obj = (obj); \ + if (!marked_p (mo_obj)) \ + { \ + mark_object (mo_obj); \ + did_mark = 1; \ + } \ +} while (0) + /* Complete the marking for semi-weak hash tables. */ int @@ -1221,9 +1257,9 @@ !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. */ @@ -1232,9 +1268,6 @@ /* Now, scan over all the pairs. For all pairs that are half-marked, we may need to mark the other half if we're keeping this pair. */ -#define MARK_OBJ(obj) \ -do { if (!marked_p (obj)) mark_object (obj), did_mark = 1; } while (0) - switch (ht->weakness) { case HASH_TABLE_KEY_WEAK: @@ -1251,6 +1284,17 @@ MARK_OBJ (e->key); break; + case HASH_TABLE_KEY_VALUE_WEAK: + for (; e < sentinel; e++) + if (!HENTRY_CLEAR_P (e)) + { + if (marked_p (e->value)) + MARK_OBJ (e->key); + else if (marked_p (e->key)) + MARK_OBJ (e->value); + } + break; + case HASH_TABLE_KEY_CAR_WEAK: for (; e < sentinel; e++) if (!HENTRY_CLEAR_P (e)) @@ -1328,12 +1372,13 @@ 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; } @@ -1341,7 +1386,7 @@ 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; } @@ -1374,16 +1419,9 @@ { 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); @@ -1409,7 +1447,7 @@ (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 @@ -1422,6 +1460,8 @@ void syms_of_elhash (void) { + INIT_LRECORD_IMPLEMENTATION (hash_table); + DEFSUBR (Fhash_table_p); DEFSUBR (Fmake_hash_table); DEFSUBR (Fcopy_hash_table); @@ -1447,11 +1487,14 @@ defsymbol (&Qhashtable, "hashtable"); defsymbol (&Qweakness, "weakness"); defsymbol (&Qvalue, "value"); + defsymbol (&Qkey_or_value, "key-or-value"); + defsymbol (&Qkey_and_value, "key-and-value"); defsymbol (&Qrehash_size, "rehash-size"); defsymbol (&Qrehash_threshold, "rehash-threshold"); defsymbol (&Qweak, "weak"); /* obsolete */ defsymbol (&Qkey_weak, "key-weak"); /* obsolete */ + defsymbol (&Qkey_or_value_weak, "key-or-value-weak"); /* obsolete */ defsymbol (&Qvalue_weak, "value-weak"); /* obsolete */ defsymbol (&Qnon_weak, "non-weak"); /* obsolete */