X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=src%2Felhash.c;h=686f78fb44aea286202b0f737eb148d75bda645b;hp=0d60ddf00afd1dc8008430150db4197cc89e1a1b;hb=d3dd71489ab2730d79536ebdc3c56cca82766e9d;hpb=6883ee56ec887c2c48abe5b06b5e66aa74031910 diff --git a/src/elhash.c b/src/elhash.c index 0d60ddf..686f78f 100644 --- a/src/elhash.c +++ b/src/elhash.c @@ -1,4 +1,4 @@ -/* Lisp interface to hash tables. +/* Implementation of the hash table lisp object type. Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. Copyright (C) 1995, 1996 Ben Wing. Copyright (C) 1997 Free Software Foundation, Inc. @@ -11,7 +11,7 @@ Free Software Foundation; either version 2, or (at your option) any later version. XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +ANY WARRANTY; without even the implied warranty of MERCNTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. @@ -24,122 +24,237 @@ Boston, MA 02111-1307, USA. */ #include #include "lisp.h" -#include "hash.h" -#include "elhash.h" #include "bytecode.h" +#include "elhash.h" -EXFUN (Fmake_weak_hashtable, 2); -EXFUN (Fmake_key_weak_hashtable, 2); -EXFUN (Fmake_value_weak_hashtable, 2); - -Lisp_Object Qhashtablep, Qhashtable; +Lisp_Object Qhash_tablep, Qhashtable, Qhash_table; Lisp_Object Qweak, Qkey_weak, Qvalue_weak, Qnon_weak; +static Lisp_Object Vall_weak_hash_tables; +static Lisp_Object Qrehash_size, Qrehash_threshold; +static Lisp_Object Q_size, Q_test, Q_type, Q_rehash_size, Q_rehash_threshold; -#define LISP_OBJECTS_PER_HENTRY (sizeof (hentry) / sizeof (Lisp_Object))/* 2 */ +typedef struct hentry +{ + Lisp_Object key; + Lisp_Object value; +} hentry; -struct hashtable +struct Lisp_Hash_Table { struct lcrecord_header header; - unsigned int fullness; - unsigned long (*hash_function) (CONST void *); - int (*test_function) (CONST void *, CONST void *); - Lisp_Object zero_entry; - Lisp_Object harray; - enum hashtable_type type; /* whether and how this hashtable is weak */ - Lisp_Object next_weak; /* Used to chain together all of the weak - hashtables. Don't mark through this. */ + size_t size; + size_t count; + size_t rehash_count; + double rehash_size; + double rehash_threshold; + size_t golden_ratio; + hash_table_hash_function_t hash_function; + hash_table_test_function_t test_function; + hentry *hentries; + enum hash_table_type type; /* whether and how this hash table is weak */ + 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) ((*(EMACS_UINT*)(&((hentry)->key))) = 0) + +#define HASH_TABLE_DEFAULT_SIZE 16 +#define HASH_TABLE_DEFAULT_REHASH_SIZE 1.3 +#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)) + +#define KEYS_EQUAL_P(key1, key2, testfun) \ + (EQ ((key1), (key2)) || ((testfun) && (testfun) ((key1), (key2)))) + +#define LINEAR_PROBING_LOOP(probe, entries, size) \ + for (; \ + !HENTRY_CLEAR_P (probe) || \ + (probe == entries + size ? \ + (probe = entries, !HENTRY_CLEAR_P (probe)) : 0); \ + probe++) + +#ifndef ERROR_CHECK_HASH_TABLE +# ifdef ERROR_CHECK_TYPECHECK +# define ERROR_CHECK_HASH_TABLE 1 +# else +# define ERROR_CHECK_HASH_TABLE 0 +# endif +#endif -static Lisp_Object Vall_weak_hashtables; - -static Lisp_Object -mark_hashtable (Lisp_Object obj, void (*markobj) (Lisp_Object)) +#if ERROR_CHECK_HASH_TABLE +static void +check_hash_table_invariants (Lisp_Hash_Table *ht) { - struct hashtable *table = XHASHTABLE (obj); + assert (ht->count < ht->size); + assert (ht->count <= ht->rehash_count); + assert (ht->rehash_count < ht->size); + assert ((double) ht->count * ht->rehash_threshold - 1 <= (double) ht->rehash_count); + assert (HENTRY_CLEAR_P (ht->hentries + ht->size)); +} +#else +#define check_hash_table_invariants(ht) +#endif + +/* We use linear probing instead of double hashing, despite its lack + of blessing by Knuth and company, because, as a result of the + increasing discrepancy between CPU speeds and memory speeds, cache + behavior is becoming increasingly important, e.g: + + For a trivial loop, the penalty for non-sequential access of an array is: + - a factor of 3-4 on Pentium Pro 200 Mhz + - a factor of 10 on Ultrasparc 300 Mhz */ - if (table->type != HASHTABLE_NONWEAK) +/* Return a suitable size for a hash table, with at least SIZE slots. */ +static size_t +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 [] = + { + 19, 29, 41, 59, 79, 107, 149, 197, 263, 347, 457, 599, 787, 1031, + 1361, 1777, 2333, 3037, 3967, 5167, 6719, 8737, 11369, 14783, + 19219, 24989, 32491, 42257, 54941, 71429, 92861, 120721, 156941, + 204047, 265271, 344857, 448321, 582821, 757693, 985003, 1280519, + 1664681, 2164111, 2813353, 3657361, 4754591, 6180989, 8035301, + 10445899, 13579681, 17653589, 22949669, 29834603, 38784989, + 50420551, 65546729, 85210757, 110774011, 144006217, 187208107, + 243370577, 316381771, 411296309, 534685237, 695090819, 903618083, + 1174703521, 1527114613, 1985248999, 2580823717UL, 3355070839UL + }; + /* We've heard of binary search. */ + int low, high; + for (low = 0, high = countof (primes) - 1; high - low > 1;) { - /* If the table is weak, we don't want to mark the keys and values - (we scan over them after everything else has been marked, - and mark or remove them as necessary). Note that we will mark - the table->harray itself at the same time; it's hard to mark - that here without also marking its contents. */ - return Qnil; + /* Loop Invariant: size < primes [high] */ + int mid = (low + high) / 2; + if (primes [mid] < requested_size) + low = mid; + else + high = mid; } - ((markobj) (table->zero_entry)); - return table->harray; + return primes [high]; } + -/* Equality of hashtables. Two hashtables are equal when they are of - the same type and test function, they have the same number of - elements, and for each key in hashtable, the values are `equal'. +#if 0 /* I don't think these are needed any more. + If using the general lisp_object_equal_*() functions + causes efficiency problems, these can be resurrected. --ben */ +/* equality and hash functions for Lisp strings */ +int +lisp_string_equal (Lisp_Object str1, Lisp_Object str2) +{ + /* This is wrong anyway. You can't use strcmp() on Lisp strings, + because they can contain zero characters. */ + return !strcmp ((char *) XSTRING_DATA (str1), (char *) XSTRING_DATA (str2)); +} - This is similar to Common Lisp `equalp' of hashtables, with the - difference that CL requires the keys to be compared with the test - function, which we don't do. Doing that would require consing, and - consing is bad idea in `equal'. Anyway, our method should provide - the same result -- if the keys are not equal according to test - function, then Fgethash() in hashtable_equal_mapper() will fail. */ -struct hashtable_equal_closure +static hashcode_t +lisp_string_hash (Lisp_Object obj) { - int depth; - int equal; - Lisp_Object other_table; -}; + return hash_string (XSTRING_DATA (str), XSTRING_LENGTH (str)); +} + +#endif /* 0 */ + +static int +lisp_object_eql_equal (Lisp_Object obj1, Lisp_Object obj2) +{ + return EQ (obj1, obj2) || (FLOATP (obj1) && internal_equal (obj1, obj2, 0)); +} + +static hashcode_t +lisp_object_eql_hash (Lisp_Object obj) +{ + return FLOATP (obj) ? internal_hash (obj, 0) : LISP_HASH (obj); +} static int -hashtable_equal_mapper (CONST void *key, void *contents, void *arg) +lisp_object_equal_equal (Lisp_Object obj1, Lisp_Object obj2) { - struct hashtable_equal_closure *closure = - (struct hashtable_equal_closure *)arg; - Lisp_Object keytem, valuetem; - Lisp_Object value_in_other; - - CVOID_TO_LISP (keytem, key); - CVOID_TO_LISP (valuetem, contents); - /* Look up the key in the other hashtable, and compare the values. */ - value_in_other = Fgethash (keytem, closure->other_table, Qunbound); - if (UNBOUNDP (value_in_other) - || !internal_equal (valuetem, value_in_other, closure->depth)) + return internal_equal (obj1, obj2, 0); +} + +static hashcode_t +lisp_object_equal_hash (Lisp_Object obj) +{ + return internal_hash (obj, 0); +} + + +static Lisp_Object +mark_hash_table (Lisp_Object obj, void (*markobj) (Lisp_Object)) +{ + Lisp_Hash_Table *ht = XHASH_TABLE (obj); + + /* If the hash table is weak, we don't want to mark the keys and + values (we scan over them after everything else has been marked, + and mark or remove them as necessary). */ + if (ht->type == HASH_TABLE_NON_WEAK) { - /* Give up. */ - closure->equal = 0; - return 1; + hentry *e, *sentinel; + + for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) + if (!HENTRY_CLEAR_P (e)) + { + markobj (e->key); + markobj (e->value); + } } - return 0; + return Qnil; } + +/* Equality of hash tables. Two hash tables are equal when they are of + the same type and test function, they have the same number of + elements, and for each key in the hash table, the values are `equal'. + This is similar to Common Lisp `equalp' of hash tables, with the + difference that CL requires the keys to be compared with the test + function, which we don't do. Doing that would require consing, and + consing is a bad idea in `equal'. Anyway, our method should provide + the same result -- if the keys are not equal according to the test + function, then Fgethash() in hash_table_equal_mapper() will fail. */ static int -hashtable_equal (Lisp_Object t1, Lisp_Object t2, int depth) +hash_table_equal (Lisp_Object hash_table1, Lisp_Object hash_table2, int depth) { - struct hashtable_equal_closure closure; - struct hashtable *table1 = XHASHTABLE (t1); - struct hashtable *table2 = XHASHTABLE (t2); - - /* The objects are `equal' if they are of the same type, so return 0 - if types or test functions are not the same. Obviously, the - number of elements must be equal, too. #### table->fullness is - broken, so we cannot use it. */ - if ((table1->test_function != table2->test_function) - || (table1->type != table2->type) - /*|| (table1->fullness != table2->fullness))*/ - ) + Lisp_Hash_Table *ht1 = XHASH_TABLE (hash_table1); + Lisp_Hash_Table *ht2 = XHASH_TABLE (hash_table2); + hentry *e, *sentinel; + + if ((ht1->test_function != ht2->test_function) || + (ht1->type != ht2->type) || + (ht1->count != ht2->count)) return 0; - closure.depth = depth + 1; - closure.equal = 1; - closure.other_table = t2; - elisp_maphash (hashtable_equal_mapper, t1, &closure); - return closure.equal; + depth++; + + for (e = ht1->hentries, sentinel = e + ht1->size; e < sentinel; e++) + if (!HENTRY_CLEAR_P (e)) + /* Look up the key in the other hash table, and compare the values. */ + { + Lisp_Object value_in_other = Fgethash (e->key, hash_table2, Qunbound); + if (UNBOUNDP (value_in_other) || + !internal_equal (e->value, value_in_other, depth)) + return 0; /* Give up */ + } + + return 1; } -/* Printing hashtables. +/* Printing hash tables. This is non-trivial, because we use a readable structure-style - syntax for hashtables. This means that a typical hashtable will be + syntax for hash tables. This means that a typical hash table will be readably printed in the form of: - #s(hashtable size 2 data (key1 value1 key2 value2)) + #s(hash-table size 2 data (key1 value1 key2 value2)) The supported keywords are `type' (non-weak (or nil), weak, key-weak and value-weak), `test' (eql (or nil), eq or equal), @@ -148,210 +263,399 @@ hashtable_equal (Lisp_Object t1, Lisp_Object t2, int depth) If `print-readably' is non-nil, then a simpler syntax is used; for instance: - # + # The data is truncated to four pairs, and the rest is shown with `...'. This printer does not cons. */ -struct print_hashtable_data_closure -{ - EMACS_INT count; /* Used to implement truncation for - non-readable printing, as well as - to avoid the unnecessary space at - the beginning. */ - Lisp_Object printcharfun; -}; - -static int -print_hashtable_data_mapper (CONST void *key, void *contents, void *arg) -{ - Lisp_Object keytem, valuetem; - struct print_hashtable_data_closure *closure = - (struct print_hashtable_data_closure *)arg; - if (closure->count < 4 || print_readably) - { - CVOID_TO_LISP (keytem, key); - CVOID_TO_LISP (valuetem, contents); - - if (closure->count) - write_c_string (" ", closure->printcharfun); - - print_internal (keytem, closure->printcharfun, 1); - write_c_string (" ", closure->printcharfun); - print_internal (valuetem, closure->printcharfun, 1); - } - ++closure->count; - return 0; -} - -/* Print the data of the hashtable. This maps through a Lisp - hashtable and prints key/value pairs using PRINTCHARFUN. */ +/* Print the data of the hash table. This maps through a Lisp + hash table and prints key/value pairs using PRINTCHARFUN. */ static void -print_hashtable_data (Lisp_Object hashtable, Lisp_Object printcharfun) +print_hash_table_data (Lisp_Hash_Table *ht, Lisp_Object printcharfun) { - struct print_hashtable_data_closure closure; - closure.count = 0; - closure.printcharfun = printcharfun; + int count = 0; + hentry *e, *sentinel; write_c_string (" data (", printcharfun); - elisp_maphash (print_hashtable_data_mapper, hashtable, &closure); - write_c_string ((!print_readably && closure.count > 4) ? " ...)" : ")", - printcharfun); -} -/* Needed for tests. */ -static int lisp_object_eql_equal (CONST void *x1, CONST void *x2); -static int lisp_object_equal_equal (CONST void *x1, CONST void *x2); + for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) + if (!HENTRY_CLEAR_P (e)) + { + if (count > 0) + write_c_string (" ", printcharfun); + if (!print_readably && count > 3) + { + write_c_string ("...", printcharfun); + break; + } + print_internal (e->key, printcharfun, 1); + write_c_string (" ", printcharfun); + print_internal (e->value, printcharfun, 1); + count++; + } + + write_c_string (")", printcharfun); +} static void -print_hashtable (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) +print_hash_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { - struct hashtable *table = XHASHTABLE (obj); + Lisp_Hash_Table *ht = XHASH_TABLE (obj); char buf[128]; - write_c_string (print_readably ? "#s(hashtable" : "#type != HASHTABLE_NONWEAK) + + if (ht->type != HASH_TABLE_NON_WEAK) { sprintf (buf, " type %s", - (table->type == HASHTABLE_WEAK ? "weak" : - table->type == HASHTABLE_KEY_WEAK ? "key-weak" : - table->type == HASHTABLE_VALUE_WEAK ? "value-weak" : + (ht->type == HASH_TABLE_WEAK ? "weak" : + ht->type == HASH_TABLE_KEY_WEAK ? "key-weak" : + ht->type == HASH_TABLE_VALUE_WEAK ? "value-weak" : "you-d-better-not-see-this")); write_c_string (buf, printcharfun); } - /* These checks have a kludgy look to them, but they are safe. Due - to nature of hashing, you cannot use arbitrary test functions - anyway. */ - if (!table->test_function) + + /* These checks have a kludgy look to them, but they are safe. + Due to nature of hashing, you cannot use arbitrary + test functions anyway. */ + if (!ht->test_function) write_c_string (" test eq", printcharfun); - else if (table->test_function == lisp_object_equal_equal) + else if (ht->test_function == lisp_object_equal_equal) write_c_string (" test equal", printcharfun); - else if (table->test_function == lisp_object_eql_equal) + else if (ht->test_function == lisp_object_eql_equal) DO_NOTHING; else abort (); - if (table->fullness || !print_readably) + + if (ht->count || !print_readably) { if (print_readably) - sprintf (buf, " size %u", table->fullness); + sprintf (buf, " size %lu", (unsigned long) ht->count); else - sprintf (buf, " size %u/%ld", table->fullness, - XVECTOR_LENGTH (table->harray) / LISP_OBJECTS_PER_HENTRY); + sprintf (buf, " size %lu/%lu", + (unsigned long) ht->count, + (unsigned long) ht->size); write_c_string (buf, printcharfun); } - if (table->fullness) - print_hashtable_data (obj, printcharfun); + + if (ht->count) + print_hash_table_data (ht, printcharfun); + if (print_readably) write_c_string (")", printcharfun); else { - sprintf (buf, " 0x%x>", table->header.uid); + sprintf (buf, " 0x%x>", ht->header.uid); write_c_string (buf, printcharfun); } } -DEFINE_LRECORD_IMPLEMENTATION ("hashtable", hashtable, - mark_hashtable, print_hashtable, 0, - /* #### Implement hashtable_hash()! */ - hashtable_equal, 0, - struct hashtable); +static void +finalize_hash_table (void *header, int for_disksave) +{ + if (!for_disksave) + { + Lisp_Hash_Table *ht = (Lisp_Hash_Table *) header; + + xfree (ht->hentries); + ht->hentries = 0; + } +} + +DEFINE_LRECORD_IMPLEMENTATION ("hash-table", hash_table, + mark_hash_table, print_hash_table, + finalize_hash_table, + /* #### Implement hash_table_hash()! */ + hash_table_equal, 0, + Lisp_Hash_Table); + +static Lisp_Hash_Table * +xhash_table (Lisp_Object hash_table) +{ + if (!gc_in_progress) + CHECK_HASH_TABLE (hash_table); + check_hash_table_invariants (XHASH_TABLE (hash_table)); + return XHASH_TABLE (hash_table); +} + -/* Pretty reading of hashtables. +/************************************************************************/ +/* Creation of Hash Tables */ +/************************************************************************/ + +/* Creation of hash tables, without error-checking. */ +static double +hash_table_rehash_threshold (Lisp_Hash_Table *ht) +{ + return + ht->rehash_threshold > 0.0 ? ht->rehash_threshold : + ht->size > 4096 && !ht->test_function ? 0.7 : 0.6; +} + +static void +compute_hash_table_derived_values (Lisp_Hash_Table *ht) +{ + ht->rehash_count = (size_t) + ((double) ht->size * hash_table_rehash_threshold (ht)); + ht->golden_ratio = (size_t) + ((double) ht->size * (.6180339887 / (double) sizeof (Lisp_Object))); +} + +Lisp_Object +make_general_lisp_hash_table (size_t size, + enum hash_table_type type, + enum hash_table_test test, + double rehash_size, + double rehash_threshold) +{ + Lisp_Object hash_table; + Lisp_Hash_Table *ht = alloc_lcrecord_type (Lisp_Hash_Table, lrecord_hash_table); + + ht->type = type; + ht->rehash_size = rehash_size; + ht->rehash_threshold = rehash_threshold; + + switch (test) + { + case HASH_TABLE_EQ: + ht->test_function = 0; + ht->hash_function = 0; + break; + + case HASH_TABLE_EQL: + ht->test_function = lisp_object_eql_equal; + ht->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; + break; + + default: + abort (); + } + + if (ht->rehash_size <= 0.0) + ht->rehash_size = HASH_TABLE_DEFAULT_REHASH_SIZE; + if (size < HASH_TABLE_MIN_SIZE) + size = HASH_TABLE_MIN_SIZE; + if (rehash_threshold < 0.0) + rehash_threshold = 0.75; + ht->size = + hash_table_size ((size_t) ((double) size / hash_table_rehash_threshold (ht)) + 1); + ht->count = 0; + 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); + } + + XSETHASH_TABLE (hash_table, ht); + + if (type == HASH_TABLE_NON_WEAK) + ht->next_weak = Qunbound; + else + ht->next_weak = Vall_weak_hash_tables, Vall_weak_hash_tables = hash_table; + + return hash_table; +} + +Lisp_Object +make_lisp_hash_table (size_t size, + enum hash_table_type type, + enum hash_table_test test) +{ + return make_general_lisp_hash_table (size, type, test, + HASH_TABLE_DEFAULT_REHASH_SIZE, -1.0); +} + +/* Pretty reading of hash tables. Here we use the existing structures mechanism (which is, unfortunately, pretty cumbersome) for validating and instantiating - the hashtables. The idea is that the side-effect of reading a - #s(hashtable PLIST) object is creation of a hashtable with desired - properties, and that the hashtable is returned. */ + the hash tables. The idea is that the side-effect of reading a + #s(hash-table PLIST) object is creation of a hash table with desired + properties, and that the hash table is returned. */ /* Validation functions: each keyword provides its own validation function. The errors should maybe be continuable, but it is unclear how this would cope with ERRB. */ static int -hashtable_type_validate (Lisp_Object keyword, Lisp_Object value, +hash_table_size_validate (Lisp_Object keyword, Lisp_Object value, Error_behavior errb) { - if (!(NILP (value) - || EQ (value, Qnon_weak) - || EQ (value, Qweak) - || EQ (value, Qkey_weak) - || EQ (value, Qvalue_weak))) - { - maybe_signal_simple_error ("Invalid hashtable type", value, - Qhashtable, errb); - return 0; - } - return 1; + if (NATNUMP (value)) + return 1; + + maybe_signal_error (Qwrong_type_argument, list2 (Qnatnump, value), + Qhash_table, errb); + return 0; +} + +static size_t +decode_hash_table_size (Lisp_Object obj) +{ + return NILP (obj) ? HASH_TABLE_DEFAULT_SIZE : XINT (obj); } static int -hashtable_test_validate (Lisp_Object keyword, Lisp_Object value, +hash_table_type_validate (Lisp_Object keyword, Lisp_Object value, Error_behavior errb) { - if (!(NILP (value) - || EQ (value, Qeq) - || EQ (value, Qeql) - || EQ (value, Qequal))) + if (EQ (value, Qnil)) 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, Qvalue_weak)) return 1; + + maybe_signal_simple_error ("Invalid hash table type", + value, Qhash_table, errb); + return 0; +} + +static enum hash_table_type +decode_hash_table_type (Lisp_Object obj) +{ + if (EQ (obj, Qnil)) return HASH_TABLE_NON_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, Qvalue_weak)) return HASH_TABLE_VALUE_WEAK; + + signal_simple_error ("Invalid hash table type", obj); + return HASH_TABLE_NON_WEAK; /* not reached */ +} + +static int +hash_table_test_validate (Lisp_Object keyword, Lisp_Object value, + Error_behavior errb) +{ + if (EQ (value, Qnil)) return 1; + if (EQ (value, Qeq)) return 1; + if (EQ (value, Qequal)) return 1; + if (EQ (value, Qeql)) return 1; + + maybe_signal_simple_error ("Invalid hash table test", + value, Qhash_table, errb); + return 0; +} + +static enum hash_table_test +decode_hash_table_test (Lisp_Object obj) +{ + if (EQ (obj, Qnil)) return HASH_TABLE_EQL; + if (EQ (obj, Qeq)) return HASH_TABLE_EQ; + if (EQ (obj, Qequal)) return HASH_TABLE_EQUAL; + if (EQ (obj, Qeql)) return HASH_TABLE_EQL; + + signal_simple_error ("Invalid hash table test", obj); + return HASH_TABLE_EQ; /* not reached */ +} + +static int +hash_table_rehash_size_validate (Lisp_Object keyword, Lisp_Object value, + Error_behavior errb) +{ + if (!FLOATP (value)) { - maybe_signal_simple_error ("Invalid hashtable test", value, - Qhashtable, errb); + maybe_signal_error (Qwrong_type_argument, list2 (Qfloatp, value), + Qhash_table, errb); return 0; } + + { + double rehash_size = XFLOAT_DATA (value); + if (rehash_size <= 1.0) + { + maybe_signal_simple_error + ("Hash table rehash size must be greater than 1.0", + value, Qhash_table, errb); + return 0; + } + } + return 1; } +static double +decode_hash_table_rehash_size (Lisp_Object rehash_size) +{ + return NILP (rehash_size) ? -1.0 : XFLOAT_DATA (rehash_size); +} + static int -hashtable_size_validate (Lisp_Object keyword, Lisp_Object value, - Error_behavior errb) +hash_table_rehash_threshold_validate (Lisp_Object keyword, Lisp_Object value, + Error_behavior errb) { - if (!NATNUMP (value)) + if (!FLOATP (value)) { - maybe_signal_error (Qwrong_type_argument, list2 (Qnatnump, value), - Qhashtable, errb); + maybe_signal_error (Qwrong_type_argument, list2 (Qfloatp, value), + Qhash_table, errb); return 0; } + + { + double rehash_threshold = XFLOAT_DATA (value); + if (rehash_threshold <= 0.0 || rehash_threshold >= 1.0) + { + maybe_signal_simple_error + ("Hash table rehash threshold must be between 0.0 and 1.0", + value, Qhash_table, errb); + return 0; + } + } + return 1; } +static double +decode_hash_table_rehash_threshold (Lisp_Object rehash_threshold) +{ + return NILP (rehash_threshold) ? -1.0 : XFLOAT_DATA (rehash_threshold); +} + static int -hashtable_data_validate (Lisp_Object keyword, Lisp_Object value, +hash_table_data_validate (Lisp_Object keyword, Lisp_Object value, Error_behavior errb) { - int num = 0; - Lisp_Object tail; + int len; - /* #### Doesn't respect ERRB! */ - EXTERNAL_LIST_LOOP (tail, value) - { - ++num; - QUIT; - } - if (num & 1) + GET_EXTERNAL_LIST_LENGTH (value, len); + + if (len & 1) { maybe_signal_simple_error - ("Hashtable data must have alternating keyword/value pairs", value, - Qhashtable, errb); + ("Hash table data must have alternating key/value pairs", + value, Qhash_table, errb); return 0; } return 1; } -/* The actual instantiation of hashtable. This does practically no +/* The actual instantiation of a hash table. This does practically no error checking, because it relies on the fact that the paranoid functions above have error-checked everything to the last details. If this assumption is wrong, we will get a crash immediately (with error-checking compiled in), and we'll know if there is a bug in the structure mechanism. So there. */ static Lisp_Object -hashtable_instantiate (Lisp_Object plist) +hash_table_instantiate (Lisp_Object plist) { - /* I'm not sure whether this can GC, but better safe than sorry. */ - Lisp_Object hashtab = Qnil; - Lisp_Object type = Qnil, test = Qnil, size = Qnil, data = Qnil; - struct gcpro gcpro1; - GCPRO1 (hashtab); + Lisp_Object hash_table; + Lisp_Object test = Qnil; + Lisp_Object type = Qnil; + Lisp_Object size = Qnil; + Lisp_Object data = Qnil; + Lisp_Object rehash_size = Qnil; + Lisp_Object rehash_threshold = Qnil; while (!NILP (plist)) { @@ -359,808 +663,596 @@ hashtable_instantiate (Lisp_Object plist) key = XCAR (plist); plist = XCDR (plist); value = XCAR (plist); plist = XCDR (plist); - if (EQ (key, Qtype)) type = value; - else if (EQ (key, Qtest)) test = value; - else if (EQ (key, Qsize)) size = value; - else if (EQ (key, Qdata)) data = value; + if (EQ (key, Qtest)) test = value; + else if (EQ (key, Qtype)) type = value; + else if (EQ (key, Qsize)) size = value; + else if (EQ (key, Qdata)) data = value; + else if (EQ (key, Qrehash_size)) rehash_size = value; + else if (EQ (key, Qrehash_threshold)) rehash_threshold = value; else abort (); } - if (NILP (type)) - type = Qnon_weak; - - if (NILP (size)) - /* Divide by two, because data is a plist. */ - size = make_int (XINT (Flength (data)) / 2); - - /* Create the hashtable. */ - if (EQ (type, Qnon_weak)) - hashtab = Fmake_hashtable (size, test); - else if (EQ (type, Qweak)) - hashtab = Fmake_weak_hashtable (size, test); - else if (EQ (type, Qkey_weak)) - hashtab = Fmake_key_weak_hashtable (size, test); - else if (EQ (type, Qvalue_weak)) - hashtab = Fmake_value_weak_hashtable (size, test); - else - abort (); + /* Create the hash table. */ + hash_table = make_general_lisp_hash_table + (decode_hash_table_size (size), + decode_hash_table_type (type), + decode_hash_table_test (test), + decode_hash_table_rehash_size (rehash_size), + decode_hash_table_rehash_threshold (rehash_threshold)); - /* And fill it with data. */ - while (!NILP (data)) - { - Lisp_Object key, value; - key = XCAR (data); data = XCDR (data); - value = XCAR (data); data = XCDR (data); - Fputhash (key, value, hashtab); - } - - UNGCPRO; - return hashtab; -} + /* I'm not sure whether this can GC, but better safe than sorry. */ + { + struct gcpro gcpro1; + GCPRO1 (hash_table); -/* Initialize the hashtable as a structure type. This is called from - emacs.c. */ -void -structure_type_create_hashtable (void) -{ - struct structure_type *st; + /* And fill it with data. */ + while (!NILP (data)) + { + Lisp_Object key, value; + key = XCAR (data); data = XCDR (data); + value = XCAR (data); data = XCDR (data); + Fputhash (key, value, hash_table); + } + UNGCPRO; + } - st = define_structure_type (Qhashtable, 0, hashtable_instantiate); - define_structure_type_keyword (st, Qtype, hashtable_type_validate); - define_structure_type_keyword (st, Qtest, hashtable_test_validate); - define_structure_type_keyword (st, Qsize, hashtable_size_validate); - define_structure_type_keyword (st, Qdata, hashtable_data_validate); + return hash_table; } - -/* Basic conversion and allocation functions. */ -/* Create a C hashtable from the data in the Lisp hashtable. The - actual vector is not copied, nor are the keys or values copied. */ static void -ht_copy_to_c (struct hashtable *ht, c_hashtable c_table) +structure_type_create_hash_table_structure_name (Lisp_Object structure_name) { - int len = XVECTOR_LENGTH (ht->harray); + struct structure_type *st; - c_table->harray = (hentry *) XVECTOR_DATA (ht->harray); - c_table->zero_set = (!GC_UNBOUNDP (ht->zero_entry)); - c_table->zero_entry = LISP_TO_VOID (ht->zero_entry); -#ifndef LRECORD_VECTOR - if (len < 0) - { - /* #### if alloc.c mark_object() changes, this must change too. */ - /* barf gag retch. When a vector is marked, its len is - made less than 0. In the prune_weak_hashtables() stage, - we are called on vectors that are like this, and we must - be able to deal. */ - assert (gc_in_progress); - len = -1 - len; - } -#endif - c_table->size = len/LISP_OBJECTS_PER_HENTRY; - c_table->fullness = ht->fullness; - c_table->hash_function = ht->hash_function; - c_table->test_function = ht->test_function; - XSETHASHTABLE (c_table->elisp_table, ht); + st = define_structure_type (structure_name, 0, hash_table_instantiate); + define_structure_type_keyword (st, Qsize, hash_table_size_validate); + define_structure_type_keyword (st, Qtest, hash_table_test_validate); + define_structure_type_keyword (st, Qtype, hash_table_type_validate); + define_structure_type_keyword (st, Qdata, hash_table_data_validate); + define_structure_type_keyword (st, Qrehash_size, hash_table_rehash_size_validate); + define_structure_type_keyword (st, Qrehash_threshold, hash_table_rehash_threshold_validate); } -static void -ht_copy_from_c (c_hashtable c_table, struct hashtable *ht) +/* Create a built-in Lisp structure type named `hash-table'. + We make #s(hashtable ...) equivalent to #s(hash-table ...), + for backward comptabibility. + This is called from emacs.c. */ +void +structure_type_create_hash_table (void) { - struct Lisp_Vector dummy; - /* C is truly hateful */ - void *vec_addr - = ((char *) c_table->harray - - ((char *) &(dummy.contents[0]) - (char *) &dummy)); - - XSETVECTOR (ht->harray, vec_addr); - if (c_table->zero_set) - VOID_TO_LISP (ht->zero_entry, c_table->zero_entry); - else - ht->zero_entry = Qunbound; - ht->fullness = c_table->fullness; + structure_type_create_hash_table_structure_name (Qhash_table); + structure_type_create_hash_table_structure_name (Qhashtable); /* compat */ } + +/************************************************************************/ +/* Definition of Lisp-visible methods */ +/************************************************************************/ -static struct hashtable * -allocate_hashtable (void) +DEFUN ("hash-table-p", Fhash_table_p, 1, 1, 0, /* +Return t if OBJECT is a hash table, else nil. +*/ + (object)) { - struct hashtable *table = - alloc_lcrecord_type (struct hashtable, lrecord_hashtable); - table->harray = Qnil; - table->zero_entry = Qunbound; - table->fullness = 0; - table->hash_function = 0; - table->test_function = 0; - return table; + return HASH_TABLEP (object) ? Qt : Qnil; } -void * -elisp_hvector_malloc (unsigned int bytes, Lisp_Object table) -{ - Lisp_Object new_vector; - struct hashtable *ht = XHASHTABLE (table); +DEFUN ("make-hash-table", Fmake_hash_table, 0, MANY, 0, /* +Return a new empty hash table object. +Use Common Lisp style keywords to specify hash table properties. + (make-hash-table &key :size :test :type :rehash-size :rehash-threshold) - assert (bytes > XVECTOR_LENGTH (ht->harray) * sizeof (Lisp_Object)); - new_vector = make_vector ((bytes / sizeof (Lisp_Object)), Qnull_pointer); - return (void *) XVECTOR_DATA (new_vector); -} +Keyword :size specifies the number of keys likely to be inserted. +This number of entries can be inserted without enlarging the hash table. -void -elisp_hvector_free (void *ptr, Lisp_Object table) -{ - struct hashtable *ht = XHASHTABLE (table); -#if defined (USE_ASSERTIONS) || defined (DEBUG_XEMACS) - Lisp_Object current_vector = ht->harray; -#endif +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'. - assert (((void *) XVECTOR_DATA (current_vector)) == ptr); - ht->harray = Qnil; /* Let GC do its job */ -} +Keyword :type can be `non-weak' (default), `weak', `key-weak' or `value-weak'. + +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 +outside of weak hash tables. The pair will remain in the hash table if +the key is pointed to by something other than a weak hash table, even +if the value is not. -DEFUN ("hashtablep", Fhashtablep, 1, 1, 0, /* -Return t if OBJ is a hashtable, else nil. -*/ - (obj)) -{ - return HASHTABLEP (obj) ? Qt : Qnil; -} +A 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 remains +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. +Keyword :rehash-size must be a float greater than 1.0, and specifies +the factor by which to increase the size of the hash table when enlarging. - +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. -#if 0 /* I don't think these are needed any more. - If using the general lisp_object_equal_*() functions - causes efficiency problems, these can be resurrected. --ben */ -/* equality and hash functions for Lisp strings */ -int -lisp_string_equal (CONST void *x1, CONST void *x2) +*/ + (int nargs, Lisp_Object *args)) { - /* This is wrong anyway. You can't use strcmp() on Lisp strings, - because they can contain zero characters. */ - Lisp_Object str1, str2; - CVOID_TO_LISP (str1, x1); - CVOID_TO_LISP (str2, x2); - return !strcmp ((char *) XSTRING_DATA (str1), (char *) XSTRING_DATA (str2)); + int j = 0; + Lisp_Object size = Qnil; + Lisp_Object type = Qnil; + Lisp_Object test = Qnil; + Lisp_Object rehash_size = Qnil; + Lisp_Object rehash_threshold = Qnil; + + while (j < nargs) + { + Lisp_Object keyword, value; + + keyword = args[j++]; + if (!KEYWORDP (keyword)) + signal_simple_error ("Invalid hash table property keyword", keyword); + if (j == nargs) + signal_simple_error ("Hash table property requires a value", keyword); + + value = args[j++]; + + if (EQ (keyword, Q_size)) size = value; + else if (EQ (keyword, Q_type)) type = value; + else if (EQ (keyword, Q_test)) test = value; + else if (EQ (keyword, Q_rehash_size)) rehash_size = value; + else if (EQ (keyword, Q_rehash_threshold)) rehash_threshold = value; + else signal_simple_error ("Invalid hash table property keyword", keyword); + } + +#define VALIDATE_VAR(var) \ +if (!NILP (var)) hash_table_##var##_validate (Q##var, var, ERROR_ME); + + VALIDATE_VAR (size); + VALIDATE_VAR (type); + VALIDATE_VAR (test); + VALIDATE_VAR (rehash_size); + VALIDATE_VAR (rehash_threshold); + + return make_general_lisp_hash_table + (decode_hash_table_size (size), + decode_hash_table_type (type), + decode_hash_table_test (test), + decode_hash_table_rehash_size (rehash_size), + decode_hash_table_rehash_threshold (rehash_threshold)); } -unsigned long -lisp_string_hash (CONST void *x) +DEFUN ("copy-hash-table", Fcopy_hash_table, 1, 1, 0, /* +Return a new hash table containing the same keys and values as HASH-TABLE. +The keys and values will not themselves be copied. +*/ + (hash_table)) { - Lisp_Object str; - CVOID_TO_LISP (str, x); - return hash_string (XSTRING_DATA (str), XSTRING_LENGTH (str)); -} + CONST Lisp_Hash_Table *ht_old = xhash_table (hash_table); + Lisp_Hash_Table *ht = alloc_lcrecord_type (Lisp_Hash_Table, lrecord_hash_table); -#endif /* 0 */ + copy_lcrecord (ht, ht_old); -static int -lisp_object_eql_equal (CONST void *x1, CONST void *x2) -{ - Lisp_Object obj1, obj2; - CVOID_TO_LISP (obj1, x1); - CVOID_TO_LISP (obj2, x2); - return FLOATP (obj1) ? internal_equal (obj1, obj2, 0) : EQ (obj1, obj2); -} + ht->hentries = xnew_array (hentry, ht_old->size + 1); + memcpy (ht->hentries, ht_old->hentries, (ht_old->size + 1) * sizeof (hentry)); -static unsigned long -lisp_object_eql_hash (CONST void *x) -{ - Lisp_Object obj; - CVOID_TO_LISP (obj, x); - if (FLOATP (obj)) - return internal_hash (obj, 0); - else - return LISP_HASH (obj); -} + XSETHASH_TABLE (hash_table, ht); -static int -lisp_object_equal_equal (CONST void *x1, CONST void *x2) -{ - Lisp_Object obj1, obj2; - CVOID_TO_LISP (obj1, x1); - CVOID_TO_LISP (obj2, x2); - return internal_equal (obj1, obj2, 0); -} + if (! EQ (ht->next_weak, Qunbound)) + { + ht->next_weak = Vall_weak_hash_tables; + Vall_weak_hash_tables = hash_table; + } -static unsigned long -lisp_object_equal_hash (CONST void *x) -{ - Lisp_Object obj; - CVOID_TO_LISP (obj, x); - return internal_hash (obj, 0); + return hash_table; } -Lisp_Object -make_lisp_hashtable (int size, - enum hashtable_type type, - enum hashtable_test_fun test) +static void +enlarge_hash_table (Lisp_Hash_Table *ht) { - Lisp_Object result; - struct hashtable *table = allocate_hashtable (); + hentry *old_entries, *new_entries, *old_sentinel, *new_sentinel, *e; + size_t old_size, new_size; - table->harray = make_vector ((compute_harray_size (size) - * LISP_OBJECTS_PER_HENTRY), - Qnull_pointer); - switch (test) - { - case HASHTABLE_EQ: - table->test_function = NULL; - table->hash_function = NULL; - break; + old_size = ht->size; + new_size = ht->size = + hash_table_size ((size_t) ((double) old_size * ht->rehash_size)); - case HASHTABLE_EQL: - table->test_function = lisp_object_eql_equal; - table->hash_function = lisp_object_eql_hash; - break; + old_entries = ht->hentries; - case HASHTABLE_EQUAL: - table->test_function = lisp_object_equal_equal; - table->hash_function = lisp_object_equal_hash; - break; + ht->hentries = xnew_array (hentry, new_size + 1); + new_entries = ht->hentries; - default: - abort (); - } + old_sentinel = old_entries + old_size; + new_sentinel = new_entries + new_size; - table->type = type; - XSETHASHTABLE (result, table); + for (e = new_entries; e <= new_sentinel; e++) + CLEAR_HENTRY (e); - if (table->type != HASHTABLE_NONWEAK) - { - table->next_weak = Vall_weak_hashtables; - Vall_weak_hashtables = result; - } - else - table->next_weak = Qunbound; + compute_hash_table_derived_values (ht); + + for (e = old_entries; e < old_sentinel; e++) + if (!HENTRY_CLEAR_P (e)) + { + hentry *probe = new_entries + HASH_CODE (e->key, ht); + LINEAR_PROBING_LOOP (probe, new_entries, new_size) + ; + *probe = *e; + } - return result; + xfree (old_entries); } -static enum hashtable_test_fun -decode_hashtable_test_fun (Lisp_Object sym) +static hentry * +find_hentry (Lisp_Object key, CONST Lisp_Hash_Table *ht) { - if (NILP (sym)) return HASHTABLE_EQL; - if (EQ (sym, Qeq)) return HASHTABLE_EQ; - if (EQ (sym, Qequal)) return HASHTABLE_EQUAL; - if (EQ (sym, Qeql)) return HASHTABLE_EQL; + hash_table_test_function_t test_function = ht->test_function; + hentry *entries = ht->hentries; + hentry *probe = entries + HASH_CODE (key, ht); - signal_simple_error ("Invalid hashtable test function", sym); - return HASHTABLE_EQ; /* not reached */ -} + LINEAR_PROBING_LOOP (probe, entries, ht->size) + if (KEYS_EQUAL_P (probe->key, key, test_function)) + break; -DEFUN ("make-hashtable", Fmake_hashtable, 1, 2, 0, /* -Return a new hashtable object of initial size SIZE. -Comparison between keys is done with TEST-FUN, which must be one of -`eq', `eql', or `equal'. The default is `eql'; i.e. two keys must -be the same object (or have the same floating-point value, for floats) -to be considered equivalent. + return probe; +} -See also `make-weak-hashtable', `make-key-weak-hashtable', and -`make-value-weak-hashtable'. +DEFUN ("gethash", Fgethash, 2, 3, 0, /* +Find hash value for KEY in HASH-TABLE. +If there is no corresponding value, return DEFAULT (which defaults to nil). */ - (size, test_fun)) + (key, hash_table, default_)) { - CHECK_NATNUM (size); - return make_lisp_hashtable (XINT (size), HASHTABLE_NONWEAK, - decode_hashtable_test_fun (test_fun)); + CONST Lisp_Hash_Table *ht = xhash_table (hash_table); + hentry *e = find_hentry (key, ht); + + return HENTRY_CLEAR_P (e) ? default_ : e->value; } -DEFUN ("copy-hashtable", Fcopy_hashtable, 1, 1, 0, /* -Return a new hashtable containing the same keys and values as HASHTABLE. -The keys and values will not themselves be copied. +DEFUN ("puthash", Fputhash, 3, 3, 0, /* +Hash KEY to VALUE in HASH-TABLE. */ - (hashtable)) + (key, value, hash_table)) { - struct _C_hashtable old_htbl; - struct _C_hashtable new_htbl; - struct hashtable *old_ht; - struct hashtable *new_ht; - Lisp_Object result; - - CHECK_HASHTABLE (hashtable); - old_ht = XHASHTABLE (hashtable); - ht_copy_to_c (old_ht, &old_htbl); - - /* we can't just call Fmake_hashtable() here because that will make a - table that is slightly larger than the one we're trying to copy, - which will make copy_hash() blow up. */ - new_ht = allocate_hashtable (); - new_ht->fullness = 0; - new_ht->zero_entry = Qunbound; - new_ht->hash_function = old_ht->hash_function; - new_ht->test_function = old_ht->test_function; - new_ht->harray = Fmake_vector (Flength (old_ht->harray), Qnull_pointer); - ht_copy_to_c (new_ht, &new_htbl); - copy_hash (&new_htbl, &old_htbl); - ht_copy_from_c (&new_htbl, new_ht); - new_ht->type = old_ht->type; - XSETHASHTABLE (result, new_ht); - - if (UNBOUNDP (old_ht->next_weak)) - new_ht->next_weak = Qunbound; - else - { - new_ht->next_weak = Vall_weak_hashtables; - Vall_weak_hashtables = result; - } + Lisp_Hash_Table *ht = xhash_table (hash_table); + hentry *e = find_hentry (key, ht); - return result; -} + if (!HENTRY_CLEAR_P (e)) + return e->value = value; + e->key = key; + e->value = value; -DEFUN ("gethash", Fgethash, 2, 3, 0, /* -Find hash value for KEY in HASHTABLE. -If there is no corresponding value, return DEFAULT (defaults to nil). -*/ - (key, hashtable, default_)) + if (++ht->count >= ht->rehash_count) + enlarge_hash_table (ht); + + return value; +} + +/* Remove hentry pointed at by PROBE. + Subsequent entries are removed and reinserted. + We don't use tombstones - too wasteful. */ +static void +remhash_1 (Lisp_Hash_Table *ht, hentry *entries, hentry *probe) { - CONST void *vval; - struct _C_hashtable htbl; - if (!gc_in_progress) - CHECK_HASHTABLE (hashtable); - ht_copy_to_c (XHASHTABLE (hashtable), &htbl); - if (gethash (LISP_TO_VOID (key), &htbl, &vval)) + size_t size = ht->size; + CLEAR_HENTRY (probe++); + ht->count--; + + LINEAR_PROBING_LOOP (probe, entries, size) { - Lisp_Object val; - CVOID_TO_LISP (val, vval); - return val; + Lisp_Object key = probe->key; + hentry *probe2 = entries + HASH_CODE (key, ht); + LINEAR_PROBING_LOOP (probe2, entries, size) + if (EQ (probe2->key, key)) + /* hentry at probe doesn't need to move. */ + goto continue_outer_loop; + /* Move hentry from probe to new home at probe2. */ + *probe2 = *probe; + CLEAR_HENTRY (probe); + continue_outer_loop: continue; } - else - return default_; } - DEFUN ("remhash", Fremhash, 2, 2, 0, /* -Remove hash value for KEY in HASHTABLE. +Remove the entry for KEY from HASH-TABLE. +Do nothing if there is no entry for KEY in HASH-TABLE. */ - (key, hashtable)) + (key, hash_table)) { - struct _C_hashtable htbl; - CHECK_HASHTABLE (hashtable); + Lisp_Hash_Table *ht = xhash_table (hash_table); + hentry *e = find_hentry (key, ht); - ht_copy_to_c (XHASHTABLE (hashtable), &htbl); - remhash (LISP_TO_VOID (key), &htbl); - ht_copy_from_c (&htbl, XHASHTABLE (hashtable)); - return Qnil; -} + if (HENTRY_CLEAR_P (e)) + return Qnil; + remhash_1 (ht, ht->hentries, e); + return Qt; +} -DEFUN ("puthash", Fputhash, 3, 3, 0, /* -Hash KEY to VAL in HASHTABLE. +DEFUN ("clrhash", Fclrhash, 1, 1, 0, /* +Remove all entries from HASH-TABLE, leaving it empty. */ - (key, val, hashtable)) + (hash_table)) { - struct hashtable *ht; - void *vkey = LISP_TO_VOID (key); + Lisp_Hash_Table *ht = xhash_table (hash_table); + hentry *e, *sentinel; - CHECK_HASHTABLE (hashtable); - ht = XHASHTABLE (hashtable); - if (!vkey) - ht->zero_entry = val; - else - { - struct gcpro gcpro1, gcpro2, gcpro3; - struct _C_hashtable htbl; - - ht_copy_to_c (XHASHTABLE (hashtable), &htbl); - GCPRO3 (key, val, hashtable); - puthash (vkey, LISP_TO_VOID (val), &htbl); - ht_copy_from_c (&htbl, XHASHTABLE (hashtable)); - UNGCPRO; - } - return val; + for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) + CLEAR_HENTRY (e); + ht->count = 0; + + return hash_table; } -DEFUN ("clrhash", Fclrhash, 1, 1, 0, /* -Remove all entries from HASHTABLE. +/************************************************************************/ +/* Accessor Functions */ +/************************************************************************/ + +DEFUN ("hash-table-count", Fhash_table_count, 1, 1, 0, /* +Return the number of entries in HASH-TABLE. */ - (hashtable)) + (hash_table)) { - struct _C_hashtable htbl; - CHECK_HASHTABLE (hashtable); - ht_copy_to_c (XHASHTABLE (hashtable), &htbl); - clrhash (&htbl); - ht_copy_from_c (&htbl, XHASHTABLE (hashtable)); - return Qnil; + return make_int (xhash_table (hash_table)->count); } -DEFUN ("hashtable-fullness", Fhashtable_fullness, 1, 1, 0, /* -Return number of entries in HASHTABLE. +DEFUN ("hash-table-size", Fhash_table_size, 1, 1, 0, /* +Return the size of HASH-TABLE. +This is the current number of slots in HASH-TABLE, whether occupied or not. */ - (hashtable)) + (hash_table)) { - struct _C_hashtable htbl; - CHECK_HASHTABLE (hashtable); - ht_copy_to_c (XHASHTABLE (hashtable), &htbl); - return make_int (htbl.fullness); + return make_int (xhash_table (hash_table)->size); } -DEFUN ("hashtable-type", Fhashtable_type, 1, 1, 0, /* -Return type of HASHTABLE. -This can be one of `non-weak', `weak', `key-weak' and `value-weak'. +DEFUN ("hash-table-type", Fhash_table_type, 1, 1, 0, /* +Return the type of HASH-TABLE. +This can be one of `non-weak', `weak', `key-weak' or `value-weak'. */ - (hashtable)) + (hash_table)) { - CHECK_HASHTABLE (hashtable); - - switch (XHASHTABLE (hashtable)->type) + switch (xhash_table (hash_table)->type) { - case HASHTABLE_WEAK: return Qweak; - case HASHTABLE_KEY_WEAK: return Qkey_weak; - case HASHTABLE_VALUE_WEAK: return Qvalue_weak; + 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; } } -DEFUN ("hashtable-test-function", Fhashtable_test_function, 1, 1, 0, /* -Return test function of HASHTABLE. +DEFUN ("hash-table-test", Fhash_table_test, 1, 1, 0, /* +Return the test function of HASH-TABLE. This can be one of `eq', `eql' or `equal'. */ - (hashtable)) + (hash_table)) { - int (*fun) (CONST void *, CONST void *); - - CHECK_HASHTABLE (hashtable); - - fun = XHASHTABLE (hashtable)->test_function; + hash_table_test_function_t fun = xhash_table (hash_table)->test_function; - if (fun == lisp_object_eql_equal) - return Qeql; - else if (fun == lisp_object_equal_equal) - return Qequal; - else - return Qeq; + return (fun == lisp_object_eql_equal ? Qeql : + fun == lisp_object_equal_equal ? Qequal : + Qeq); } -static void -verify_function (Lisp_Object function, CONST char *description) +DEFUN ("hash-table-rehash-size", Fhash_table_rehash_size, 1, 1, 0, /* +Return the current rehash size of HASH-TABLE. +This is a float greater than 1.0; the factor by which HASH-TABLE +is enlarged when the rehash threshold is exceeded. +*/ + (hash_table)) { - /* #### Unused DESCRIPTION? */ - if (SYMBOLP (function)) - { - if (NILP (function)) - return; - else - function = indirect_function (function, 1); - } - if (SUBRP (function) || COMPILED_FUNCTIONP (function)) - return; - else if (CONSP (function)) - { - Lisp_Object funcar = XCAR (function); - if ((SYMBOLP (funcar)) && (EQ (funcar, Qlambda) || - EQ (funcar, Qautoload))) - return; - } - signal_error (Qinvalid_function, list1 (function)); + return make_float (xhash_table (hash_table)->rehash_size); } -static int -lisp_maphash_function (CONST void *void_key, - void *void_val, - void *void_fn) +DEFUN ("hash-table-rehash-threshold", Fhash_table_rehash_threshold, 1, 1, 0, /* +Return the current rehash threshold of HASH-TABLE. +This is a float between 0.0 and 1.0; the maximum `load factor' of HASH-TABLE, +beyond which the HASH-TABLE is enlarged by rehashing. +*/ + (hash_table)) { - /* This function can GC */ - Lisp_Object key, val, fn; - CVOID_TO_LISP (key, void_key); - VOID_TO_LISP (val, void_val); - VOID_TO_LISP (fn, void_fn); - call2 (fn, key, val); - return 0; + return make_float (hash_table_rehash_threshold (xhash_table (hash_table))); } - +/************************************************************************/ +/* Mapping Functions */ +/************************************************************************/ DEFUN ("maphash", Fmaphash, 2, 2, 0, /* -Map FUNCTION over entries in HASHTABLE, calling it with two args, -each key and value in the table. +Map FUNCTION over entries in HASH-TABLE, calling it with two args, +each key and value in HASH-TABLE. + +FUNCTION may not modify HASH-TABLE, with the one exception that FUNCTION +may remhash or puthash the entry currently being processed by FUNCTION. */ - (function, hashtable)) + (function, hash_table)) { - struct _C_hashtable htbl; - struct gcpro gcpro1, gcpro2; - - verify_function (function, GETTEXT ("hashtable mapping function")); - CHECK_HASHTABLE (hashtable); - ht_copy_to_c (XHASHTABLE (hashtable), &htbl); - GCPRO2 (hashtable, function); - maphash (lisp_maphash_function, &htbl, LISP_TO_VOID (function)); - UNGCPRO; - return Qnil; -} + 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)) + { + Lisp_Object args[3], key; + again: + key = e->key; + args[0] = function; + args[1] = key; + args[2] = e->value; + Ffuncall (countof (args), args); + /* Has FUNCTION done a remhash? */ + if (!EQ (key, e->key) && !HENTRY_CLEAR_P (e)) + goto again; + } -/* This function is for mapping a *C* function over the elements of a - lisp hashtable. - */ -void -elisp_maphash (int (*function) (CONST void *key, void *contents, - void *extra_arg), - Lisp_Object hashtable, void *closure) -{ - struct _C_hashtable htbl; - - if (!gc_in_progress) CHECK_HASHTABLE (hashtable); - ht_copy_to_c (XHASHTABLE (hashtable), &htbl); - maphash (function, &htbl, closure); + return Qnil; } +/* Map *C* function FUNCTION over the elements of a lisp hash table. */ void -elisp_map_remhash (remhash_predicate function, Lisp_Object hashtable, - void *closure) +elisp_maphash (maphash_function_t function, + Lisp_Object hash_table, void *extra_arg) { - struct _C_hashtable htbl; + CONST Lisp_Hash_Table *ht = XHASH_TABLE (hash_table); + CONST hentry *e, *sentinel; - if (!gc_in_progress) CHECK_HASHTABLE (hashtable); - ht_copy_to_c (XHASHTABLE (hashtable), &htbl); - map_remhash (function, &htbl, closure); - ht_copy_from_c (&htbl, XHASHTABLE (hashtable)); + for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) + if (!HENTRY_CLEAR_P (e)) + { + Lisp_Object key; + again: + key = e->key; + if (function (key, e->value, extra_arg)) + return; + /* Has FUNCTION done a remhash? */ + if (!EQ (key, e->key) && !HENTRY_CLEAR_P (e)) + goto again; + } } -#if 0 +/* Remove all elements of a lisp hash table satisfying *C* predicate PREDICATE. */ void -elisp_table_op (Lisp_Object table, generic_hashtable_op op, void *arg1, - void *arg2, void *arg3) +elisp_map_remhash (maphash_function_t predicate, + Lisp_Object hash_table, void *extra_arg) { - struct _C_hashtable htbl; - CHECK_HASHTABLE (table); - ht_copy_to_c (XHASHTABLE (table), &htbl); - (*op) (&htbl, arg1, arg2, arg3); - ht_copy_from_c (&htbl, XHASHTABLE (table)); -} -#endif /* 0 */ - - - -DEFUN ("make-weak-hashtable", Fmake_weak_hashtable, 1, 2, 0, /* -Return a new fully weak hashtable object of initial size SIZE. -A weak hashtable is one whose pointers do not count as GC referents: -for any key-value pair in the hashtable, 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 table, and the key and value collected. A -non-weak hash table (or any other pointer) would prevent the object -from being collected. + Lisp_Hash_Table *ht = XHASH_TABLE (hash_table); + hentry *e, *entries, *sentinel; -You can also create semi-weak hashtables; see `make-key-weak-hashtable' -and `make-value-weak-hashtable'. -*/ - (size, test_fun)) -{ - CHECK_NATNUM (size); - return make_lisp_hashtable (XINT (size), HASHTABLE_WEAK, - decode_hashtable_test_fun (test_fun)); -} - -DEFUN ("make-key-weak-hashtable", Fmake_key_weak_hashtable, 1, 2, 0, /* -Return a new key-weak hashtable object of initial size SIZE. -A key-weak hashtable is similar to a fully-weak hashtable (see -`make-weak-hashtable') except that a key-value pair will be removed -only if the key remains unmarked outside of weak hashtables. The pair -will remain in the hashtable if the key is pointed to by something other -than a weak hashtable, even if the value is not. -*/ - (size, test_fun)) -{ - CHECK_NATNUM (size); - return make_lisp_hashtable (XINT (size), HASHTABLE_KEY_WEAK, - decode_hashtable_test_fun (test_fun)); -} - -DEFUN ("make-value-weak-hashtable", Fmake_value_weak_hashtable, 1, 2, 0, /* -Return a new value-weak hashtable object of initial size SIZE. -A value-weak hashtable is similar to a fully-weak hashtable (see -`make-weak-hashtable') except that a key-value pair will be removed only -if the value remains unmarked outside of weak hashtables. The pair will -remain in the hashtable if the value is pointed to by something other -than a weak hashtable, even if the key is not. -*/ - (size, test_fun)) -{ - CHECK_NATNUM (size); - return make_lisp_hashtable (XINT (size), HASHTABLE_VALUE_WEAK, - decode_hashtable_test_fun (test_fun)); + for (e = entries = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) + if (!HENTRY_CLEAR_P (e)) + { + again: + if (predicate (e->key, e->value, extra_arg)) + { + remhash_1 (ht, entries, e); + if (!HENTRY_CLEAR_P (e)) + goto again; + } + } } -struct marking_closure -{ - int (*obj_marked_p) (Lisp_Object); - void (*markobj) (Lisp_Object); - enum hashtable_type type; - int did_mark; -}; - -static int -marking_mapper (CONST void *key, void *contents, void *closure) -{ - Lisp_Object keytem, valuetem; - struct marking_closure *fmh = - (struct marking_closure *) closure; - - /* This function is called over each pair in the hashtable. - We complete the marking for semi-weak hashtables. */ - CVOID_TO_LISP (keytem, key); - CVOID_TO_LISP (valuetem, contents); - - switch (fmh->type) - { - case HASHTABLE_KEY_WEAK: - if ((fmh->obj_marked_p) (keytem) && - !(fmh->obj_marked_p) (valuetem)) - { - (fmh->markobj) (valuetem); - fmh->did_mark = 1; - } - break; - - case HASHTABLE_VALUE_WEAK: - if ((fmh->obj_marked_p) (valuetem) && - !(fmh->obj_marked_p) (keytem)) - { - (fmh->markobj) (keytem); - fmh->did_mark = 1; - } - break; - - case HASHTABLE_KEY_CAR_WEAK: - if (!CONSP (keytem) || (fmh->obj_marked_p) (XCAR (keytem))) - { - if (!(fmh->obj_marked_p) (keytem)) - { - (fmh->markobj) (keytem); - fmh->did_mark = 1; - } - if (!(fmh->obj_marked_p) (valuetem)) - { - (fmh->markobj) (valuetem); - fmh->did_mark = 1; - } - } - break; - - case HASHTABLE_VALUE_CAR_WEAK: - if (!CONSP (valuetem) || (fmh->obj_marked_p) (XCAR (valuetem))) - { - if (!(fmh->obj_marked_p) (keytem)) - { - (fmh->markobj) (keytem); - fmh->did_mark = 1; - } - if (!(fmh->obj_marked_p) (valuetem)) - { - (fmh->markobj) (valuetem); - fmh->did_mark = 1; - } - } - break; - - default: - abort (); /* Huh? */ - } - - return 0; -} + +/************************************************************************/ +/* garbage collecting weak hash tables */ +/************************************************************************/ +/* Complete the marking for semi-weak hash tables. */ int -finish_marking_weak_hashtables (int (*obj_marked_p) (Lisp_Object), +finish_marking_weak_hash_tables (int (*obj_marked_p) (Lisp_Object), void (*markobj) (Lisp_Object)) { - Lisp_Object rest; + Lisp_Object hash_table; int did_mark = 0; - for (rest = Vall_weak_hashtables; - !GC_NILP (rest); - rest = XHASHTABLE (rest)->next_weak) + for (hash_table = Vall_weak_hash_tables; + !GC_NILP (hash_table); + hash_table = XHASH_TABLE (hash_table)->next_weak) { - enum hashtable_type type; + CONST Lisp_Hash_Table *ht = XHASH_TABLE (hash_table); + CONST hentry *e = ht->hentries; + CONST hentry *sentinel = e + ht->size; - if (! ((*obj_marked_p) (rest))) - /* The hashtable is probably garbage. Ignore it. */ + if (! obj_marked_p (hash_table)) + /* The hash table is probably garbage. Ignore it. */ continue; - type = XHASHTABLE (rest)->type; - if (type == HASHTABLE_KEY_WEAK || - type == HASHTABLE_VALUE_WEAK || - type == HASHTABLE_KEY_CAR_WEAK || - type == HASHTABLE_VALUE_CAR_WEAK) + + /* 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 (!obj_marked_p (obj)) markobj (obj), did_mark = 1; } while (0) + + switch (ht->type) { - struct marking_closure fmh; - - fmh.obj_marked_p = obj_marked_p; - fmh.markobj = markobj; - fmh.type = type; - fmh.did_mark = 0; - /* 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. */ - elisp_maphash (marking_mapper, rest, &fmh); - if (fmh.did_mark) - did_mark = 1; + case HASH_TABLE_KEY_WEAK: + for (; e < sentinel; e++) + if (!HENTRY_CLEAR_P (e)) + if (obj_marked_p (e->key)) + MARK_OBJ (e->value); + break; + + case HASH_TABLE_VALUE_WEAK: + for (; e < sentinel; e++) + if (!HENTRY_CLEAR_P (e)) + if (obj_marked_p (e->value)) + MARK_OBJ (e->key); + break; + + case HASH_TABLE_KEY_CAR_WEAK: + for (; e < sentinel; e++) + if (!HENTRY_CLEAR_P (e)) + if (!CONSP (e->key) || obj_marked_p (XCAR (e->key))) + { + MARK_OBJ (e->key); + MARK_OBJ (e->value); + } + break; + + case HASH_TABLE_VALUE_CAR_WEAK: + for (; e < sentinel; e++) + if (!HENTRY_CLEAR_P (e)) + if (!CONSP (e->value) || obj_marked_p (XCAR (e->value))) + { + MARK_OBJ (e->key); + MARK_OBJ (e->value); + } + break; + + default: + break; } - - /* #### If alloc.c mark_object changes, this must change also... */ - { - /* Now mark the vector itself. (We don't need to call markobj - here because we know that everything *in* it is already marked, - we just need to prevent the vector itself from disappearing.) - (The remhash above has taken care of zero_entry.) - */ - struct Lisp_Vector *ptr = XVECTOR (XHASHTABLE (rest)->harray); -#ifdef LRECORD_VECTOR - if (! MARKED_RECORD_P(XHASHTABLE(rest)->harray)) - { - MARK_RECORD_HEADER(&(ptr->header.lheader)); - did_mark = 1; - } -#else - int len = vector_length (ptr); - if (len >= 0) - { - ptr->size = -1 - len; - did_mark = 1; - } -#endif - /* else it's already marked (remember, this function is iterated - until marking stops) */ - } } return did_mark; } -struct pruning_closure -{ - int (*obj_marked_p) (Lisp_Object); -}; - -static int -pruning_mapper (CONST void *key, CONST void *contents, void *closure) -{ - Lisp_Object keytem, valuetem; - struct pruning_closure *fmh = (struct pruning_closure *) closure; - - /* This function is called over each pair in the hashtable. - We remove the pairs that aren't completely marked (everything - that is going to stay ought to have been marked already - by the finish_marking stage). */ - CVOID_TO_LISP (keytem, key); - CVOID_TO_LISP (valuetem, contents); - - return ! ((*fmh->obj_marked_p) (keytem) && - (*fmh->obj_marked_p) (valuetem)); -} - void -prune_weak_hashtables (int (*obj_marked_p) (Lisp_Object)) +prune_weak_hash_tables (int (*obj_marked_p) (Lisp_Object)) { - Lisp_Object rest, prev = Qnil; - for (rest = Vall_weak_hashtables; - !GC_NILP (rest); - rest = XHASHTABLE (rest)->next_weak) + Lisp_Object hash_table, prev = Qnil; + for (hash_table = Vall_weak_hash_tables; + !GC_NILP (hash_table); + hash_table = XHASH_TABLE (hash_table)->next_weak) { - if (! ((*obj_marked_p) (rest))) + if (! obj_marked_p (hash_table)) { - /* This table itself is garbage. Remove it from the list. */ + /* This hash table itself is garbage. Remove it from the list. */ if (GC_NILP (prev)) - Vall_weak_hashtables = XHASHTABLE (rest)->next_weak; + Vall_weak_hash_tables = XHASH_TABLE (hash_table)->next_weak; else - XHASHTABLE (prev)->next_weak = XHASHTABLE (rest)->next_weak; + XHASH_TABLE (prev)->next_weak = XHASH_TABLE (hash_table)->next_weak; } else { - struct pruning_closure fmh; - fmh.obj_marked_p = obj_marked_p; /* Now, scan over all the pairs. Remove all of the pairs in which the key or value, or both, is unmarked - (depending on the type of weak hashtable). */ - elisp_map_remhash (pruning_mapper, rest, &fmh); - prev = rest; + (depending on the type of weak hash table). */ + Lisp_Hash_Table *ht = XHASH_TABLE (hash_table); + hentry *entries = ht->hentries; + hentry *sentinel = entries + ht->size; + hentry *e; + + for (e = entries; e < sentinel; e++) + if (!HENTRY_CLEAR_P (e)) + { + again: + if (!obj_marked_p (e->key) || !obj_marked_p (e->value)) + { + remhash_1 (ht, entries, e); + if (!HENTRY_CLEAR_P (e)) + goto again; + } + } + + prev = hash_table; } } } /* Return a hash value for an array of Lisp_Objects of size SIZE. */ -unsigned long +hashcode_t internal_array_hash (Lisp_Object *arr, int size, int depth) { int i; @@ -1194,7 +1286,7 @@ internal_array_hash (Lisp_Object *arr, int size, int depth) we could still take 5^5 time (a big big number) to compute a hash, but practically this won't ever happen. */ -unsigned long +hashcode_t internal_hash (Lisp_Object obj, int depth) { if (depth > 5) @@ -1206,21 +1298,23 @@ internal_hash (Lisp_Object obj, int depth) return HASH2 (internal_hash (XCAR (obj), depth + 1), internal_hash (XCDR (obj), depth + 1)); } - else if (STRINGP (obj)) - return hash_string (XSTRING_DATA (obj), XSTRING_LENGTH (obj)); - else if (VECTORP (obj)) + if (STRINGP (obj)) + { + return hash_string (XSTRING_DATA (obj), XSTRING_LENGTH (obj)); + } + if (VECTORP (obj)) { - struct Lisp_Vector *v = XVECTOR (obj); - return HASH2 (vector_length (v), - internal_array_hash (v->contents, vector_length (v), + return HASH2 (XVECTOR_LENGTH (obj), + internal_array_hash (XVECTOR_DATA (obj), + XVECTOR_LENGTH (obj), depth + 1)); } - else if (LRECORDP (obj)) + if (LRECORDP (obj)) { CONST struct lrecord_implementation *imp = XRECORD_LHEADER_IMPLEMENTATION (obj); if (imp->hash) - return (imp->hash) (obj, depth); + return imp->hash (obj, depth); } return LISP_HASH (obj); @@ -1247,34 +1341,44 @@ The value is returned as (HIGH . LOW). void syms_of_elhash (void) { - DEFSUBR (Fmake_hashtable); - DEFSUBR (Fcopy_hashtable); - DEFSUBR (Fhashtablep); + DEFSUBR (Fhash_table_p); + DEFSUBR (Fmake_hash_table); + DEFSUBR (Fcopy_hash_table); DEFSUBR (Fgethash); - DEFSUBR (Fputhash); DEFSUBR (Fremhash); + DEFSUBR (Fputhash); DEFSUBR (Fclrhash); DEFSUBR (Fmaphash); - DEFSUBR (Fhashtable_fullness); - DEFSUBR (Fhashtable_type); - DEFSUBR (Fhashtable_test_function); - DEFSUBR (Fmake_weak_hashtable); - DEFSUBR (Fmake_key_weak_hashtable); - DEFSUBR (Fmake_value_weak_hashtable); + DEFSUBR (Fhash_table_count); + DEFSUBR (Fhash_table_size); + DEFSUBR (Fhash_table_rehash_size); + DEFSUBR (Fhash_table_rehash_threshold); + DEFSUBR (Fhash_table_type); + DEFSUBR (Fhash_table_test); #if 0 DEFSUBR (Finternal_hash_value); #endif - defsymbol (&Qhashtablep, "hashtablep"); + + defsymbol (&Qhash_tablep, "hash-table-p"); + defsymbol (&Qhash_table, "hash-table"); defsymbol (&Qhashtable, "hashtable"); defsymbol (&Qweak, "weak"); defsymbol (&Qkey_weak, "key-weak"); defsymbol (&Qvalue_weak, "value-weak"); defsymbol (&Qnon_weak, "non-weak"); + defsymbol (&Qrehash_size, "rehash-size"); + defsymbol (&Qrehash_threshold, "rehash-threshold"); + + defkeyword (&Q_size, ":size"); + defkeyword (&Q_test, ":test"); + defkeyword (&Q_type, ":type"); + defkeyword (&Q_rehash_size, ":rehash-size"); + defkeyword (&Q_rehash_threshold, ":rehash-threshold"); } void vars_of_elhash (void) { /* This must NOT be staticpro'd */ - Vall_weak_hashtables = Qnil; + Vall_weak_hash_tables = Qnil; }