1 /* Implementation of the hash table lisp object type.
2 Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
3 Copyright (C) 1995, 1996 Ben Wing.
4 Copyright (C) 1997 Free Software Foundation, Inc.
6 This file is part of SXEmacs
8 SXEmacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 SXEmacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with this program. If not, see <http://www.gnu.org/licenses/>. */
22 /* Synched up with: Not in FSF. */
28 /* for the category subsystem */
34 Lisp_Object Qhash_tablep;
35 static Lisp_Object Qhashtable, Qhash_table;
36 static Lisp_Object Qweakness, Qvalue, Qkey_or_value, Qkey_and_value;
37 static Lisp_Object Vall_weak_hash_tables;
38 static Lisp_Object Qrehash_size, Qrehash_threshold;
39 static Lisp_Object Q_size, Q_test, Q_weakness;
40 static Lisp_Object Q_rehash_size, Q_rehash_threshold;
42 /* obsolete as of 19990901 in xemacs-21.2 */
43 static Lisp_Object Qweak, Qkey_weak, Qvalue_weak, Qkey_or_value_weak;
44 static Lisp_Object Qnon_weak, Q_type;
47 #define HASH_TABLE_DEFAULT_SIZE 16
48 #define HASH_TABLE_DEFAULT_REHASH_SIZE 1.3
49 #define HASH_TABLE_MIN_SIZE 10
51 #define HASH_CODE(key, ht) \
52 ((((ht)->hash_function ? (ht)->hash_function (key) : LISP_HASH (key)) \
53 * (ht)->golden_ratio) \
56 #define KEYS_EQUAL_P(key1, key2, testfun) \
57 (EQ (key1, key2) || ((testfun) && (testfun) (key1, key2)))
59 #define LINEAR_PROBING_LOOP(probe, entries, size) \
61 !HENTRY_CLEAR_P (probe) || \
62 (probe == entries + size ? \
63 (probe = entries, !HENTRY_CLEAR_P (probe)) : 0); \
66 #ifndef ERROR_CHECK_HASH_TABLE
67 # ifdef ERROR_CHECK_TYPECHECK
68 # define ERROR_CHECK_HASH_TABLE 1
70 # define ERROR_CHECK_HASH_TABLE 0
74 #if ERROR_CHECK_HASH_TABLE
76 check_hash_table_invariants(hash_table_t ht)
78 assert(ht->count < ht->size);
79 assert(ht->count <= ht->rehash_count);
80 assert(ht->rehash_count < ht->size);
81 assert((fpfloat)ht->count * ht->rehash_threshold - 1 <=
82 (fpfloat)ht->rehash_count);
83 assert(HENTRY_CLEAR_P(ht->hentries + ht->size));
86 #define check_hash_table_invariants(ht)
89 /* We use linear probing instead of double hashing, despite its lack
90 of blessing by Knuth and company, because, as a result of the
91 increasing discrepancy between CPU speeds and memory speeds, cache
92 behavior is becoming increasingly important, e.g:
94 For a trivial loop, the penalty for non-sequential access of an array is:
95 - a factor of 3-4 on Pentium Pro 200 Mhz
96 - a factor of 10 on Ultrasparc 300 Mhz */
98 /* Return a suitable size for a hash table, with at least SIZE slots. */
100 hash_table_size(size_t requested_size)
102 /* Return some prime near, but greater than or equal to, SIZE.
103 Decades from the time of writing, someone will have a system large
104 enough that the list below will be too short... */
105 static const size_t primes[] = {
106 29, 41, 59, 79, 107, 149, 197, 263, 347, 457, 599, 787, 1031,
107 1361, 1777, 2333, 3037, 3967, 5167, 6719, 8737, 11369, 14783,
108 19219, 24989, 32491, 42257, 54941, 71429, 92861, 120721, 156941,
109 204047, 265271, 344857, 448321, 582821, 757693, 985003, 1280519,
110 1664681, 2164111, 2813353, 3657361, 4754591, 6180989, 8035301,
111 10445899, 13579681, 17653589, 22949669, 29834603, 38784989,
112 50420551, 65546729, 85210757, 110774011, 144006217, 187208107,
113 243370577, 316381771, 411296309, 534685237, 695090819,
115 1174703521, 1527114613, 1985248999, 2580823717UL, 3355070839UL
117 /* We've heard of binary search. */
119 for (low = 0, high = countof(primes) - 1; high - low > 1;) {
120 /* Loop Invariant: size < primes [high] */
121 int mid = (low + high) / 2;
122 if (primes[mid] < requested_size)
130 static int lisp_object_eql_equal(Lisp_Object obj1, Lisp_Object obj2)
132 return EQ(obj1, obj2) || (FLOATP(obj1)
133 && internal_equal(obj1, obj2, 0));
136 static hcode_t lisp_object_eql_hash(Lisp_Object obj)
138 return FLOATP(obj) ? internal_hash(obj, 0) : LISP_HASH(obj);
141 static int lisp_object_equal_equal(Lisp_Object obj1, Lisp_Object obj2)
143 return internal_equal(obj1, obj2, 0);
146 static hcode_t lisp_object_equal_hash(Lisp_Object obj)
148 return internal_hash(obj, 0);
151 static Lisp_Object mark_hash_table(Lisp_Object obj)
153 hash_table_t ht = XHASH_TABLE(obj);
155 /* If the hash table is weak, we don't want to mark the keys and
156 values (we scan over them after everything else has been marked,
157 and mark or remove them as necessary). */
158 if (ht->weakness == HASH_TABLE_NON_WEAK) {
159 for (hentry_t e = ht->hentries, sentinel = e + ht->size;
161 if (!HENTRY_CLEAR_P(e)) {
163 mark_object(e->value);
170 /* Equality of hash tables. Two hash tables are equal when they are of
171 the same weakness and test function, they have the same number of
172 elements, and for each key in the hash table, the values are `equal'.
174 This is similar to Common Lisp `equalp' of hash tables, with the
175 difference that CL requires the keys to be compared with the test
176 function, which we don't do. Doing that would require consing, and
177 consing is a bad idea in `equal'. Anyway, our method should provide
178 the same result -- if the keys are not equal according to the test
179 function, then Fgethash() in hash_table_equal_mapper() will fail. */
181 hash_table_equal(Lisp_Object hash_table1, Lisp_Object hash_table2, int depth)
183 hash_table_t ht1 = XHASH_TABLE(hash_table1);
184 hash_table_t ht2 = XHASH_TABLE(hash_table2);
186 if ((ht1->test_function != ht2->test_function) ||
187 (ht1->weakness != ht2->weakness) || (ht1->count != ht2->count)) {
192 for (hentry_t e = ht1->hentries, sntl = e + ht1->size; e < sntl; e++) {
193 if (!HENTRY_CLEAR_P(e)) {
194 /* Look up the key in the other hash table, and compare
196 Lisp_Object value_in_other =
197 Fgethash(e->key, hash_table2, Qunbound);
198 if (UNBOUNDP(value_in_other) ||
199 !internal_equal(e->value, value_in_other, depth)) {
200 return 0; /* Give up */
207 /* This is not a great hash function, but it _is_ correct and fast.
208 Examining all entries is too expensive, and examining a random
209 subset does not yield a correct hash function. */
210 static hcode_t hash_table_hash(Lisp_Object hash_table, int depth)
212 return XHASH_TABLE(hash_table)->count;
215 /* Printing hash tables.
217 This is non-trivial, because we use a readable structure-style
218 syntax for hash tables. This means that a typical hash table will be
219 readably printed in the form of:
221 #s(hash-table size 2 data (key1 value1 key2 value2))
223 The supported hash table structure keywords and their values are:
224 `test' (eql (or nil), eq or equal)
225 `size' (a natnum or nil)
226 `rehash-size' (a float)
227 `rehash-threshold' (a float)
228 `weakness' (nil, key, value, key-and-value, or key-or-value)
231 If `print-readably' is nil, then a simpler syntax is used, for example
233 #<hash-table size 2/13 data (key1 value1 key2 value2) 0x874d>
235 The data is truncated to four pairs, and the rest is shown with
236 `...'. This printer does not cons. */
238 /* Print the data of the hash table. This maps through a Lisp
239 hash table and prints key/value pairs using PRINTCHARFUN. */
241 print_hash_table_data(hash_table_t ht, Lisp_Object printcharfun)
245 write_c_string(" data (", printcharfun);
247 for (hentry_t e = ht->hentries, sntl = e + ht->size; e < sntl; e++) {
248 if (!HENTRY_CLEAR_P(e)) {
250 write_c_string(" ", printcharfun);
251 if (!print_readably && count > 3) {
252 write_c_string("...", printcharfun);
255 print_internal(e->key, printcharfun, 1);
256 write_c_string(" ", printcharfun);
257 print_internal(e->value, printcharfun, 1);
261 write_c_string(")", printcharfun);
265 print_hash_table(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
267 hash_table_t ht = XHASH_TABLE(obj);
269 write_c_string(print_readably ? "#s(hash-table" : "#<hash-table",
272 /* These checks have a kludgy look to them, but they are safe.
273 Due to nature of hashing, you cannot use arbitrary
274 test functions anyway. */
275 if (!ht->test_function)
276 write_c_string(" test eq", printcharfun);
277 else if (ht->test_function == lisp_object_equal_equal)
278 write_c_string(" test equal", printcharfun);
279 else if (ht->test_function == lisp_object_eql_equal)
284 if (ht->count || !print_readably) {
286 write_fmt_str(printcharfun, " size %lu", (unsigned long)ht->count);
288 write_fmt_str(printcharfun, " size %lu/%lu",
289 (unsigned long)ht->count,
290 (unsigned long)ht->size);
293 if (ht->weakness != HASH_TABLE_NON_WEAK) {
294 write_fmt_str(printcharfun, " weakness %s",
295 (ht->weakness == HASH_TABLE_WEAK ? "key-and-value" :
296 ht->weakness == HASH_TABLE_KEY_WEAK ? "key" :
297 ht->weakness == HASH_TABLE_VALUE_WEAK ? "value" :
299 HASH_TABLE_KEY_VALUE_WEAK ? "key-or-value" :
300 "you-d-better-not-see-this"));
304 print_hash_table_data(ht, printcharfun);
307 write_c_string(")", printcharfun);
309 write_fmt_str(printcharfun, " 0x%x>", ht->header.uid);
312 static void finalize_hash_table(void *header, int for_disksave)
315 hash_table_t ht = (hash_table_t ) header;
322 static const struct lrecord_description hentry_description_1[] = {
323 {XD_LISP_OBJECT, offsetof(struct hentry_s, key)},
324 {XD_LISP_OBJECT, offsetof(struct hentry_s, value)},
328 static const struct struct_description hentry_description = {
329 sizeof(struct hentry_s),
333 const struct lrecord_description hash_table_description[] = {
334 {XD_SIZE_T, offsetof(struct hash_table_s, size)},
335 {XD_STRUCT_PTR, offsetof(struct hash_table_s, hentries),
336 XD_INDIRECT(0, 1), &hentry_description},
337 {XD_LO_LINK, offsetof(struct hash_table_s, next_weak)},
341 DEFINE_LRECORD_IMPLEMENTATION(
342 "hash-table", hash_table,
343 mark_hash_table, print_hash_table, finalize_hash_table,
344 hash_table_equal, hash_table_hash, hash_table_description,
345 struct hash_table_s);
348 xhash_table(Lisp_Object hash_table)
351 CHECK_HASH_TABLE(hash_table);
352 check_hash_table_invariants(XHASH_TABLE(hash_table));
353 return XHASH_TABLE(hash_table);
356 /************************************************************************/
357 /* Creation of Hash Tables */
358 /************************************************************************/
360 /* Creation of hash tables, without error-checking. */
361 static void compute_hash_table_derived_values(hash_table_t ht)
363 ht->rehash_count = (size_t)
364 ((fpfloat)ht->size * ht->rehash_threshold);
365 ht->golden_ratio = (size_t)
366 ((fpfloat)ht->size * (.6180339887 / (fpfloat)sizeof(Lisp_Object)));
370 make_standard_lisp_hash_table(
371 enum hash_table_test test,
372 size_t size, fpfloat rehash_size, fpfloat rehash_threshold,
373 enum hash_table_weakness weakness)
375 hash_table_hash_f hash_function = 0;
376 hash_table_test_f test_function = 0;
385 test_function = lisp_object_eql_equal;
386 hash_function = lisp_object_eql_hash;
389 case HASH_TABLE_EQUAL:
390 test_function = lisp_object_equal_equal;
391 hash_function = lisp_object_equal_hash;
398 return make_general_lisp_hash_table(hash_function, test_function,
399 size, rehash_size, rehash_threshold,
404 make_general_lisp_hash_table(
405 hash_table_hash_f hash_function, hash_table_test_f test_function,
406 size_t size, fpfloat rehash_size, fpfloat rehash_threshold,
407 enum hash_table_weakness weakness)
409 Lisp_Object hash_table;
410 hash_table_t ht = alloc_lcrecord_type(
411 struct hash_table_s, &lrecord_hash_table);
413 /* the categories are actually seq and dict, but use the per-type
414 implementation for a start */
415 ht->header.lheader.morphisms = (1<<cat_mk_lc);
417 ht->test_function = test_function;
418 ht->hash_function = hash_function;
419 ht->weakness = weakness;
421 ht->rehash_size = rehash_size > 1.0
423 : HASH_TABLE_DEFAULT_REHASH_SIZE;
425 ht->rehash_threshold = rehash_threshold > 0.0
427 : size > 4096 && !ht->test_function ? 0.7 : 0.6;
429 if (size < HASH_TABLE_MIN_SIZE)
430 size = HASH_TABLE_MIN_SIZE;
431 ht->size = hash_table_size(
432 (size_t)(((fpfloat)size / ht->rehash_threshold) + 1.0));
435 compute_hash_table_derived_values(ht);
437 /* We leave room for one never-occupied sentinel hentry at the end. */
438 ht->hentries = xnew_array_and_zero(struct hentry_s, ht->size + 1);
440 XSETHASH_TABLE(hash_table, ht);
442 if (weakness == HASH_TABLE_NON_WEAK) {
443 ht->next_weak = Qunbound;
445 ht->next_weak = Vall_weak_hash_tables,
446 Vall_weak_hash_tables = hash_table;
452 make_lisp_hash_table(size_t size,
453 enum hash_table_weakness weakness,
454 enum hash_table_test test)
456 return make_standard_lisp_hash_table(test, size, -1.0, -1.0, weakness);
459 /* Pretty reading of hash tables.
461 Here we use the existing structures mechanism (which is,
462 unfortunately, pretty cumbersome) for validating and instantiating
463 the hash tables. The idea is that the side-effect of reading a
464 #s(hash-table PLIST) object is creation of a hash table with desired
465 properties, and that the hash table is returned. */
467 /* Validation functions: each keyword provides its own validation
468 function. The errors should maybe be continuable, but it is
469 unclear how this would cope with ERRB. */
471 hash_table_size_validate(Lisp_Object keyword, Lisp_Object value,
474 #ifdef WITH_NUMBER_TYPES
475 if (!NILP(Fnonnegativep(value)))
478 maybe_signal_error(Qwrong_type_argument, list2(Qnonnegativep, value),
480 #else /* !WITH_NUMBER_TYPES */
484 maybe_signal_error(Qwrong_type_argument, list2(Qnatnump, value),
486 #endif /* WITH_NUMBER_TYPES */
490 static size_t decode_hash_table_size(Lisp_Object obj)
492 #ifdef WITH_NUMBER_TYPES
493 return NILP(obj) ? HASH_TABLE_DEFAULT_SIZE :
494 XINT(Fcoerce_number(obj, Qint, Qnil));
496 return NILP(obj) ? HASH_TABLE_DEFAULT_SIZE : XINT(obj);
501 hash_table_weakness_validate(Lisp_Object keyword, Lisp_Object value,
510 if (EQ(value, Qkey_and_value))
512 if (EQ(value, Qkey_or_value))
514 if (EQ(value, Qvalue))
517 /* Following values are obsolete as of 19990901 in xemacs-21.2 */
518 if (EQ(value, Qnon_weak))
520 if (EQ(value, Qweak))
522 if (EQ(value, Qkey_weak))
524 if (EQ(value, Qkey_or_value_weak))
526 if (EQ(value, Qvalue_weak))
529 maybe_signal_simple_error("Invalid hash table weakness",
530 value, Qhash_table, errb);
534 static enum hash_table_weakness decode_hash_table_weakness(Lisp_Object obj)
537 return HASH_TABLE_NON_WEAK;
539 return HASH_TABLE_WEAK;
540 if (EQ(obj, Qkey_and_value))
541 return HASH_TABLE_WEAK;
543 return HASH_TABLE_KEY_WEAK;
544 if (EQ(obj, Qkey_or_value))
545 return HASH_TABLE_KEY_VALUE_WEAK;
547 return HASH_TABLE_VALUE_WEAK;
549 /* Following values are obsolete as of 19990901 in xemacs-21.2 */
550 if (EQ(obj, Qnon_weak))
551 return HASH_TABLE_NON_WEAK;
553 return HASH_TABLE_WEAK;
554 if (EQ(obj, Qkey_weak))
555 return HASH_TABLE_KEY_WEAK;
556 if (EQ(obj, Qkey_or_value_weak))
557 return HASH_TABLE_KEY_VALUE_WEAK;
558 if (EQ(obj, Qvalue_weak))
559 return HASH_TABLE_VALUE_WEAK;
561 signal_simple_error("Invalid hash table weakness", obj);
562 return HASH_TABLE_NON_WEAK; /* not reached */
566 hash_table_test_validate(Lisp_Object keyword, Lisp_Object value,
573 if (EQ(value, Qequal))
578 maybe_signal_simple_error("Invalid hash table test",
579 value, Qhash_table, errb);
583 static enum hash_table_test decode_hash_table_test(Lisp_Object obj)
586 return HASH_TABLE_EQL;
588 return HASH_TABLE_EQ;
590 return HASH_TABLE_EQUAL;
592 return HASH_TABLE_EQL;
594 signal_simple_error("Invalid hash table test", obj);
595 return HASH_TABLE_EQ; /* not reached */
599 hash_table_rehash_size_validate(Lisp_Object keyword, Lisp_Object value,
602 if (!FLOATP(value)) {
603 maybe_signal_error(Qwrong_type_argument, list2(Qfloatp, value),
609 fpfloat rehash_size = XFLOAT_DATA(value);
610 if (rehash_size <= 1.0) {
611 maybe_signal_simple_error
612 ("Hash table rehash size must be greater than 1.0",
613 value, Qhash_table, errb);
621 static fpfloat decode_hash_table_rehash_size(Lisp_Object rehash_size)
623 return NILP(rehash_size) ? -1.0 : XFLOAT_DATA(rehash_size);
627 hash_table_rehash_threshold_validate(Lisp_Object keyword, Lisp_Object value,
630 if (!FLOATP(value)) {
631 maybe_signal_error(Qwrong_type_argument, list2(Qfloatp, value),
637 fpfloat rehash_threshold = XFLOAT_DATA(value);
638 if (rehash_threshold <= 0.0 || rehash_threshold >= 1.0) {
639 maybe_signal_simple_error
640 ("Hash table rehash threshold must be between 0.0 and 1.0",
641 value, Qhash_table, errb);
649 static fpfloat decode_hash_table_rehash_threshold(Lisp_Object rehash_threshold)
651 return NILP(rehash_threshold) ? -1.0 : XFLOAT_DATA(rehash_threshold);
655 hash_table_data_validate(Lisp_Object keyword, Lisp_Object value,
660 GET_EXTERNAL_LIST_LENGTH(value, len);
663 maybe_signal_simple_error
664 ("Hash table data must have alternating key/value pairs",
665 value, Qhash_table, errb);
671 /* The actual instantiation of a hash table. This does practically no
672 error checking, because it relies on the fact that the paranoid
673 functions above have error-checked everything to the last details.
674 If this assumption is wrong, we will get a crash immediately (with
675 error-checking compiled in), and we'll know if there is a bug in
676 the structure mechanism. So there. */
677 static Lisp_Object hash_table_instantiate(Lisp_Object plist)
679 Lisp_Object hash_table;
680 Lisp_Object test = Qnil;
681 Lisp_Object size = Qnil;
682 Lisp_Object rehash_size = Qnil;
683 Lisp_Object rehash_threshold = Qnil;
684 Lisp_Object weakness = Qnil;
685 Lisp_Object data = Qnil;
687 while (!NILP(plist)) {
688 Lisp_Object key, value;
696 else if (EQ(key, Qsize))
698 else if (EQ(key, Qrehash_size))
700 else if (EQ(key, Qrehash_threshold))
701 rehash_threshold = value;
702 else if (EQ(key, Qweakness))
704 else if (EQ(key, Qdata))
706 else if (EQ(key, Qtype)) /*obsolete */
712 /* Create the hash table. */
713 hash_table = make_standard_lisp_hash_table
714 (decode_hash_table_test(test),
715 decode_hash_table_size(size),
716 decode_hash_table_rehash_size(rehash_size),
717 decode_hash_table_rehash_threshold(rehash_threshold),
718 decode_hash_table_weakness(weakness));
720 /* I'm not sure whether this can GC, but better safe than sorry. */
725 /* And fill it with data. */
726 while (!NILP(data)) {
727 Lisp_Object key, value;
732 Fputhash(key, value, hash_table);
741 structure_type_create_hash_table_structure_name(Lisp_Object structure_name)
743 struct structure_type *st;
745 st = define_structure_type(structure_name, 0, hash_table_instantiate);
746 define_structure_type_keyword(st, Qtest, hash_table_test_validate);
747 define_structure_type_keyword(st, Qsize, hash_table_size_validate);
748 define_structure_type_keyword(st, Qrehash_size,
749 hash_table_rehash_size_validate);
750 define_structure_type_keyword(st, Qrehash_threshold,
751 hash_table_rehash_threshold_validate);
752 define_structure_type_keyword(st, Qweakness,
753 hash_table_weakness_validate);
754 define_structure_type_keyword(st, Qdata, hash_table_data_validate);
756 /* obsolete as of 19990901 in xemacs-21.2 */
757 define_structure_type_keyword(st, Qtype, hash_table_weakness_validate);
760 /* Create a built-in Lisp structure type named `hash-table'.
761 We make #s(hashtable ...) equivalent to #s(hash-table ...),
762 for backward compatibility.
763 This is called from emacs.c. */
764 void structure_type_create_hash_table(void)
766 structure_type_create_hash_table_structure_name(Qhash_table);
767 structure_type_create_hash_table_structure_name(Qhashtable); /* compat */
770 /************************************************************************/
771 /* Definition of Lisp-visible methods */
772 /************************************************************************/
774 DEFUN("hash-table-p", Fhash_table_p, 1, 1, 0, /*
775 Return t if OBJECT is a hash table, else nil.
779 return HASH_TABLEP(object) ? Qt : Qnil;
782 DEFUN("make-hash-table", Fmake_hash_table, 0, MANY, 0, /*
783 Return a new empty hash table object.
784 Use Common Lisp style keywords to specify hash table properties.
785 (make-hash-table &key test size rehash-size rehash-threshold weakness)
787 Keyword :test can be `eq', `eql' (default) or `equal'.
788 Comparison between keys is done using this function.
789 If speed is important, consider using `eq'.
790 When hash table keys may be strings, you will likely need to use `equal'.
792 Keyword :size specifies the number of keys likely to be inserted.
793 This number of entries can be inserted without enlarging the hash table.
795 Keyword :rehash-size must be a float greater than 1.0, and specifies
796 the factor by which to increase the size of the hash table when enlarging.
798 Keyword :rehash-threshold must be a float between 0.0 and 1.0,
799 and specifies the load factor of the hash table which triggers enlarging.
801 Non-standard keyword :weakness can be `nil' (default), `t', `key-and-value',
802 `key', `value' or `key-or-value'. `t' is an alias for `key-and-value'.
804 A key-and-value-weak hash table, also known as a fully-weak or simply
805 as a weak hash table, is one whose pointers do not count as GC
806 referents: for any key-value pair in the hash table, if the only
807 remaining pointer to either the key or the value is in a weak hash
808 table, then the pair will be removed from the hash table, and the key
809 and value collected. A non-weak hash table (or any other pointer)
810 would prevent the object from being collected.
812 A key-weak hash table is similar to a fully-weak hash table except that
813 a key-value pair will be removed only if the key remains unmarked
814 outside of weak hash tables. The pair will remain in the hash table if
815 the key is pointed to by something other than a weak hash table, even
818 A value-weak hash table is similar to a fully-weak hash table except
819 that a key-value pair will be removed only if the value remains
820 unmarked outside of weak hash tables. The pair will remain in the
821 hash table if the value is pointed to by something other than a weak
822 hash table, even if the key is not.
824 A key-or-value-weak hash table is similar to a fully-weak hash table except
825 that a key-value pair will be removed only if the value and the key remain
826 unmarked outside of weak hash tables. The pair will remain in the
827 hash table if the value or key are pointed to by something other than a weak
828 hash table, even if the other is not.
830 (int nargs, Lisp_Object * args))
833 Lisp_Object test = Qnil;
834 Lisp_Object size = Qnil;
835 Lisp_Object rehash_size = Qnil;
836 Lisp_Object rehash_threshold = Qnil;
837 Lisp_Object weakness = Qnil;
839 while (i + 1 < nargs) {
840 Lisp_Object keyword = args[i++];
841 Lisp_Object value = args[i++];
843 if (EQ(keyword, Q_test))
845 else if (EQ(keyword, Q_size))
847 else if (EQ(keyword, Q_rehash_size))
849 else if (EQ(keyword, Q_rehash_threshold))
850 rehash_threshold = value;
851 else if (EQ(keyword, Q_weakness))
853 else if (EQ(keyword, Q_type)) /*obsolete */
857 ("Invalid hash table property keyword", keyword);
861 signal_simple_error("Hash table property requires a value",
864 #define VALIDATE_VAR(var) \
865 if (!NILP (var)) hash_table_##var##_validate (Q##var, var, ERROR_ME);
869 VALIDATE_VAR(rehash_size);
870 VALIDATE_VAR(rehash_threshold);
871 VALIDATE_VAR(weakness);
873 return make_standard_lisp_hash_table
874 (decode_hash_table_test(test),
875 decode_hash_table_size(size),
876 decode_hash_table_rehash_size(rehash_size),
877 decode_hash_table_rehash_threshold(rehash_threshold),
878 decode_hash_table_weakness(weakness));
881 DEFUN("copy-hash-table", Fcopy_hash_table, 1, 1, 0, /*
882 Return a new hash table containing the same keys and values as HASH-TABLE.
883 The keys and values will not themselves be copied.
887 const hash_table_t ht_old = xhash_table(hash_table);
888 hash_table_t ht = alloc_lcrecord_type(
889 struct hash_table_s, &lrecord_hash_table);
891 copy_lcrecord(ht, ht_old);
893 ht->hentries = xnew_array(struct hentry_s, ht_old->size + 1);
894 memcpy(ht->hentries, ht_old->hentries,
895 (ht_old->size + 1) * sizeof(struct hentry_s));
897 /* the categories are actually seq and dict, but use the per-type
898 implementation for a start */
899 ht->header.lheader.morphisms = (1<<cat_mk_lc);
901 XSETHASH_TABLE(hash_table, ht);
903 if (!EQ(ht->next_weak, Qunbound)) {
904 ht->next_weak = Vall_weak_hash_tables,
905 Vall_weak_hash_tables = hash_table;
911 resize_hash_table(hash_table_t ht, size_t new_size)
913 hentry_t old_entries, new_entries;
919 old_entries = ht->hentries;
921 ht->hentries = xnew_array_and_zero(struct hentry_s, new_size + 1);
922 new_entries = ht->hentries;
924 compute_hash_table_derived_values(ht);
926 for (hentry_t e = old_entries, sentinel = e + old_size;
928 if (!HENTRY_CLEAR_P(e)) {
929 hentry_t probe = new_entries + HASH_CODE(e->key, ht);
930 LINEAR_PROBING_LOOP(probe, new_entries, new_size);
934 if (!DUMPEDP(old_entries)) {
939 /* After a hash table has been saved to disk and later restored by the
940 portable dumper, it contains the same objects, but their addresses
941 and thus their HASH_CODEs have changed. */
943 pdump_reorganize_hash_table(Lisp_Object hash_table)
945 const hash_table_t ht = xhash_table(hash_table);
946 hentry_t new_entries =
947 xnew_array_and_zero(struct hentry_s, ht->size + 1);
949 for (hentry_t e = ht->hentries, sntl = e + ht->size; e < sntl; e++) {
950 if (!HENTRY_CLEAR_P(e)) {
951 hentry_t probe = new_entries + HASH_CODE(e->key, ht);
952 LINEAR_PROBING_LOOP(probe, new_entries, ht->size);
956 memcpy(ht->hentries, new_entries, ht->size * sizeof(struct hentry_s));
962 static void enlarge_hash_table(hash_table_t ht)
965 hash_table_size((size_t) ((fpfloat)ht->size * ht->rehash_size));
966 resize_hash_table(ht, new_size);
970 find_hentry(Lisp_Object key, const hash_table_t ht)
972 hash_table_test_f test_function = ht->test_function;
973 hentry_t entries = ht->hentries;
974 hentry_t probe = entries + HASH_CODE(key, ht);
976 LINEAR_PROBING_LOOP(probe, entries, ht->size)
977 if (KEYS_EQUAL_P(probe->key, key, test_function))
983 static inline Lisp_Object
984 dict_ht_get(hash_table_t ht, Lisp_Object key, Lisp_Object _default)
986 const hentry_t e = find_hentry(key, ht);
988 return HENTRY_CLEAR_P(e) ? _default : e->value;
991 DEFUN("gethash", Fgethash, 2, 3, 0, /*
992 Find hash value for KEY in HASH-TABLE.
993 If there is no corresponding value, return DEFAULT (which defaults to nil).
995 (key, hash_table, default_))
997 return dict_ht_get(xhash_table(hash_table), key, default_);
1000 static inline Lisp_Object
1001 dict_ht_put(hash_table_t ht, Lisp_Object key, Lisp_Object value)
1003 hentry_t e = find_hentry(key, ht);
1005 if (!HENTRY_CLEAR_P(e))
1006 return e->value = value;
1011 if (++ht->count >= ht->rehash_count) {
1012 enlarge_hash_table(ht);
1018 DEFUN("puthash", Fputhash, 3, 3, 0, /*
1019 Hash KEY to VALUE in HASH-TABLE.
1021 (key, value, hash_table))
1023 return dict_ht_put(xhash_table(hash_table), key, value);
1026 /* Remove hentry pointed at by PROBE.
1027 Subsequent entries are removed and reinserted.
1028 We don't use tombstones - too wasteful. */
1029 static void remhash_1(hash_table_t ht, hentry_t entries, hentry_t probe)
1031 size_t size = ht->size;
1032 CLEAR_HENTRY(probe);
1036 LINEAR_PROBING_LOOP(probe, entries, size) {
1037 Lisp_Object key = probe->key;
1038 hentry_t probe2 = entries + HASH_CODE(key, ht);
1039 LINEAR_PROBING_LOOP(probe2, entries, size)
1040 if (EQ(probe2->key, key))
1041 /* hentry at probe doesn't need to move. */
1042 goto continue_outer_loop;
1043 /* Move hentry from probe to new home at probe2. */
1045 CLEAR_HENTRY(probe);
1046 continue_outer_loop:continue;
1050 static inline Lisp_Object
1051 dict_ht_remove(hash_table_t ht, Lisp_Object key)
1053 hentry_t e = find_hentry(key, ht);
1055 if (HENTRY_CLEAR_P(e)) {
1059 remhash_1(ht, ht->hentries, e);
1063 DEFUN("remhash", Fremhash, 2, 2, 0, /*
1064 Remove the entry for KEY from HASH-TABLE.
1065 Do nothing if there is no entry for KEY in HASH-TABLE.
1069 return dict_ht_remove(xhash_table(hash_table), key);
1072 DEFUN("clrhash", Fclrhash, 1, 1, 0, /*
1073 Remove all entries from HASH-TABLE, leaving it empty.
1077 hash_table_t ht = xhash_table(hash_table);
1079 for (hentry_t e = ht->hentries, sntl = e + ht->size; e < sntl; e++) {
1087 /************************************************************************/
1088 /* Accessor Functions */
1089 /************************************************************************/
1091 DEFUN("hash-table-count", Fhash_table_count, 1, 1, 0, /*
1092 Return the number of entries in HASH-TABLE.
1096 return make_int(xhash_table(hash_table)->count);
1099 DEFUN("hash-table-test", Fhash_table_test, 1, 1, 0, /*
1100 Return the test function of HASH-TABLE.
1101 This can be one of `eq', `eql' or `equal'.
1105 hash_table_test_f fun = xhash_table(hash_table)->test_function;
1107 return (fun == lisp_object_eql_equal ? Qeql :
1108 fun == lisp_object_equal_equal ? Qequal : Qeq);
1112 dict_ht_size(const hash_table_t ht)
1117 DEFUN("hash-table-size", Fhash_table_size, 1, 1, 0, /*
1118 Return the size of HASH-TABLE.
1119 This is the current number of slots in HASH-TABLE, whether occupied or not.
1123 return make_int(xhash_table(hash_table)->size);
1126 DEFUN("hash-table-rehash-size", Fhash_table_rehash_size, 1, 1, 0, /*
1127 Return the current rehash size of HASH-TABLE.
1128 This is a float greater than 1.0; the factor by which HASH-TABLE
1129 is enlarged when the rehash threshold is exceeded.
1133 return make_float(xhash_table(hash_table)->rehash_size);
1136 DEFUN("hash-table-rehash-threshold", Fhash_table_rehash_threshold, 1, 1, 0, /*
1137 Return the current rehash threshold of HASH-TABLE.
1138 This is a float between 0.0 and 1.0; the maximum `load factor' of HASH-TABLE,
1139 beyond which the HASH-TABLE is enlarged by rehashing.
1143 return make_float(xhash_table(hash_table)->rehash_threshold);
1146 DEFUN("hash-table-weakness", Fhash_table_weakness, 1, 1, 0, /*
1147 Return the weakness of HASH-TABLE.
1148 This can be one of `nil', `key-and-value', `key-or-value', `key' or `value'.
1152 switch (xhash_table(hash_table)->weakness) {
1153 case HASH_TABLE_WEAK:
1154 return Qkey_and_value;
1155 case HASH_TABLE_KEY_WEAK:
1157 case HASH_TABLE_KEY_VALUE_WEAK:
1158 return Qkey_or_value;
1159 case HASH_TABLE_VALUE_WEAK:
1163 case HASH_TABLE_NON_WEAK:
1164 case HASH_TABLE_KEY_CAR_WEAK:
1165 case HASH_TABLE_VALUE_CAR_WEAK:
1166 case HASH_TABLE_KEY_CAR_VALUE_WEAK:
1173 /* obsolete as of 19990901 in xemacs-21.2 */
1174 DEFUN("hash-table-type", Fhash_table_type, 1, 1, 0, /*
1175 Return the type of HASH-TABLE.
1176 This can be one of `non-weak', `weak', `key-weak' or `value-weak'.
1180 switch (xhash_table(hash_table)->weakness) {
1181 case HASH_TABLE_WEAK:
1183 case HASH_TABLE_KEY_WEAK:
1185 case HASH_TABLE_KEY_VALUE_WEAK:
1186 return Qkey_or_value_weak;
1187 case HASH_TABLE_VALUE_WEAK:
1190 /* the bloody rest */
1191 case HASH_TABLE_NON_WEAK:
1192 case HASH_TABLE_KEY_CAR_WEAK:
1193 case HASH_TABLE_VALUE_CAR_WEAK:
1194 case HASH_TABLE_KEY_CAR_VALUE_WEAK:
1201 /************************************************************************/
1202 /* Mapping Functions */
1203 /************************************************************************/
1204 DEFUN("maphash", Fmaphash, 2, 2, 0, /*
1205 Map FUNCTION over entries in HASH-TABLE, calling it with two args,
1206 each key and value in HASH-TABLE.
1208 FUNCTION may not modify HASH-TABLE, with the one exception that FUNCTION
1209 may remhash or puthash the entry currently being processed by FUNCTION.
1211 (function, hash_table))
1213 const hash_table_t ht = xhash_table(hash_table);
1215 for (hentry_t e = ht->hentries, sntl = e + ht->size; e < sntl; e++) {
1216 if (!HENTRY_CLEAR_P(e)) {
1217 Lisp_Object args[3], key;
1223 Ffuncall(countof(args), args);
1224 /* Has FUNCTION done a remhash? */
1225 if (!EQ(key, e->key) && !HENTRY_CLEAR_P(e))
1232 /* #### If the Lisp function being called does a puthash and this
1233 #### causes the hash table to be resized, the results will be quite
1234 #### random and we will likely crash. To fix this, either set a
1235 #### flag in the hash table while we're mapping and signal an error
1236 #### when new entries are added, or fix things to make this
1237 #### operation work properly, like this: Store two hash tables in
1238 #### each hash table object -- the second one is written to when
1239 #### you do a puthash inside of a mapping operation, and the
1240 #### various operations need to check both hash tables for entries.
1241 #### As soon as the last maphash over a particular hash table
1242 #### object terminates, the entries in the second table are added
1243 #### to the first (using an unwind-protect). --ben */
1245 /* Map *C* function FUNCTION over the elements of a lisp hash table. */
1247 elisp_maphash(maphash_f function, Lisp_Object hash_table, void *extra_arg)
1249 const hash_table_t ht = XHASH_TABLE(hash_table);
1251 for (hentry_t e = ht->hentries, sntl = e + ht->size; e < sntl; e++) {
1252 if (!HENTRY_CLEAR_P(e)) {
1256 if (function(key, e->value, extra_arg)) {
1259 /* Has FUNCTION done a remhash? */
1260 if (!EQ(key, e->key) && !HENTRY_CLEAR_P(e)) {
1267 /* Remove all elements of a lisp hash table satisfying *C* predicate
1270 elisp_map_remhash(maphash_f predicate, Lisp_Object hash_table, void *extra_arg)
1272 hash_table_t ht = XHASH_TABLE(hash_table);
1275 for (hentry_t e = entries = ht->hentries, sentinel = e + ht->size;
1276 e < sentinel; e++) {
1277 if (!HENTRY_CLEAR_P(e)) {
1279 if (predicate(e->key, e->value, extra_arg)) {
1280 remhash_1(ht, entries, e);
1281 if (!HENTRY_CLEAR_P(e)) {
1289 /************************************************************************/
1290 /* garbage collecting weak hash tables */
1291 /************************************************************************/
1292 #define MARK_OBJ(obj) \
1294 Lisp_Object mo_obj = (obj); \
1295 if (!marked_p (mo_obj)) { \
1296 mark_object (mo_obj); \
1301 /* Complete the marking for semi-weak hash tables. */
1302 int finish_marking_weak_hash_tables(void)
1304 Lisp_Object hash_table;
1307 for (hash_table = Vall_weak_hash_tables;
1309 hash_table = XHASH_TABLE(hash_table)->next_weak) {
1310 const hash_table_t ht = XHASH_TABLE(hash_table);
1311 hentry_t e = ht->hentries;
1312 const hentry_t sentinel = e + ht->size;
1314 if (!marked_p(hash_table)) {
1315 /* The hash table is probably garbage. Ignore it. */
1319 /* Now, scan over all the pairs. For all pairs that are
1320 half-marked, we may need to mark the other half if we're
1321 keeping this pair. */
1322 switch (ht->weakness) {
1323 case HASH_TABLE_KEY_WEAK:
1324 for (; e < sentinel; e++) {
1325 if (!HENTRY_CLEAR_P(e)) {
1326 if (marked_p(e->key)) {
1333 case HASH_TABLE_VALUE_WEAK:
1334 for (; e < sentinel; e++) {
1335 if (!HENTRY_CLEAR_P(e)) {
1336 if (marked_p(e->value)) {
1343 case HASH_TABLE_KEY_VALUE_WEAK:
1344 for (; e < sentinel; e++) {
1345 if (!HENTRY_CLEAR_P(e)) {
1346 if (marked_p(e->value)) {
1348 } else if (marked_p(e->key)) {
1355 case HASH_TABLE_KEY_CAR_WEAK:
1356 for (; e < sentinel; e++) {
1357 if (!HENTRY_CLEAR_P(e)) {
1359 || marked_p(XCAR(e->key))) {
1367 /* We seem to be sprouting new weakness types at an
1368 alarming rate. At least this is not externally
1369 visible - and in fact all of these KEY_CAR_* types
1370 are only used by the glyph code. */
1371 case HASH_TABLE_KEY_CAR_VALUE_WEAK:
1372 for (; e < sentinel; e++) {
1373 if (!HENTRY_CLEAR_P(e)) {
1375 || marked_p(XCAR(e->key))) {
1378 } else if (marked_p(e->value)) {
1385 case HASH_TABLE_VALUE_CAR_WEAK:
1386 for (; e < sentinel; e++) {
1387 if (!HENTRY_CLEAR_P(e)) {
1388 if (!CONSP(e->value)
1389 || marked_p(XCAR(e->value))) {
1398 case HASH_TABLE_NON_WEAK:
1399 case HASH_TABLE_WEAK:
1408 void prune_weak_hash_tables(void)
1410 Lisp_Object hash_table, prev = Qnil;
1412 for (hash_table = Vall_weak_hash_tables; !NILP(hash_table);
1413 hash_table = XHASH_TABLE(hash_table)->next_weak) {
1414 if (!marked_p(hash_table)) {
1415 /* This hash table itself is garbage. Remove it from
1418 Vall_weak_hash_tables =
1419 XHASH_TABLE(hash_table)->next_weak;
1421 XHASH_TABLE(prev)->next_weak =
1422 XHASH_TABLE(hash_table)->next_weak;
1424 /* Now, scan over all the pairs. Remove all of the pairs
1425 in which the key or value, or both, is unmarked
1426 (depending on the weakness of the hash table). */
1427 hash_table_t ht = XHASH_TABLE(hash_table);
1428 hentry_t entries = ht->hentries;
1429 hentry_t sentinel = entries + ht->size;
1431 for (hentry_t e = entries; e < sentinel; e++) {
1432 if (!HENTRY_CLEAR_P(e)) {
1434 if (!marked_p(e->key) ||
1435 !marked_p(e->value)) {
1436 remhash_1(ht, entries, e);
1437 if (!HENTRY_CLEAR_P(e)) {
1450 /* Return a hash value for an array of Lisp_Objects of size SIZE. */
1453 internal_array_hash(const Lisp_Object *arr, size_t size, int depth)
1459 for (size_t i = 0; i < size; i++) {
1460 hash = HASH2(hash, internal_hash(arr[i], depth));
1465 /* just pick five elements scattered throughout the array.
1466 A slightly better approach would be to offset by some
1467 noise factor from the points chosen below. */
1468 for (int i = 0; i < 5; i++) {
1469 hash = HASH2(hash, internal_hash(arr[i * size / 5], depth));
1474 /* Return a hash value for a Lisp_Object. This is for use when hashing
1475 objects with the comparison being `equal' (for `eq', you can just
1476 use the Lisp_Object itself as the hash value). You need to make a
1477 tradeoff between the speed of the hash function and how good the
1478 hashing is. In particular, the hash function needs to be FAST,
1479 so you can't just traipse down the whole tree hashing everything
1480 together. Most of the time, objects will differ in the first
1481 few elements you hash. Thus, we only go to a short depth (5)
1482 and only hash at most 5 elements out of a vector. Theoretically
1483 we could still take 5^5 time (a big big number) to compute a
1484 hash, but practically this won't ever happen. */
1487 internal_hash(const Lisp_Object obj, int depth)
1491 if (CONSP(obj) && !CONSP(XCDR(obj))) {
1492 /* special case for '(a . b) conses */
1493 return HASH2(internal_hash(XCAR(obj), depth + 1),
1494 internal_hash(XCDR(obj), depth + 1));
1495 } else if (CONSP(obj)) {
1496 /* no point in worrying about tail recursion, since we're not
1498 Lisp_Object o = obj;
1500 hcode_t hash = internal_hash(XCAR(o), depth+1);
1503 for (int s = 1; s < 6 && CONSP(o); o = XCDR(o), s++) {
1504 hcode_t h = internal_hash(XCAR(o), depth+1);
1505 hash = HASH3(hash, h, s);
1510 return hash_string(XSTRING_DATA(obj), XSTRING_LENGTH(obj));
1512 if (LRECORDP(obj)) {
1513 const struct lrecord_implementation
1514 *imp = XRECORD_LHEADER_IMPLEMENTATION(obj);
1516 return imp->hash(obj, depth);
1519 return LISP_HASH(obj);
1522 DEFUN("sxhash", Fsxhash, 1, 1, 0, /*
1523 Return a hash value for OBJECT.
1524 \(equal obj1 obj2) implies (= (sxhash obj1) (sxhash obj2)).
1528 return make_int(internal_hash(object, 0));
1532 /* the seq/dict implementation */
1533 /* iterator stuff, only needed for dict so make it static */
1535 ht_iter_init(dict_t d, dict_iter_t di)
1537 const hash_table_t ht = (hash_table_t)d;
1540 for (hentry_t e = ht->hentries, sntl = e + ht->size; e < sntl; e++) {
1541 if (!HENTRY_CLEAR_P(e)) {
1551 ht_iter_fini(dict_iter_t di)
1553 di->dict = di->data = NULL;
1558 ht_diter_next(dict_iter_t di, Lisp_Object *key, Lisp_Object *val)
1560 hentry_t e = di->data;
1561 const hash_table_t ht = (hash_table_t)di->dict;
1563 if (UNLIKELY(e == NULL)) {
1564 *key = *val = Qnull_pointer;
1571 /* wind to next hentry */
1572 for (const hentry_t last = ht->hentries + ht->size; ++e < last;) {
1573 if (!HENTRY_CLEAR_P(e)) {
1583 ht_siter_next(seq_iter_t si, void **elm)
1585 hentry_t e = si->data;
1586 const hash_table_t ht = (hash_table_t)si->seq;
1588 if (UNLIKELY(e == NULL)) {
1589 *elm = Qnull_pointer;
1593 *elm = (void*)e->key;
1595 /* wind to next hentry */
1596 for (const hentry_t last = ht->hentries + ht->size; ++e < last;) {
1597 if (!HENTRY_CLEAR_P(e)) {
1607 ht_iter_reset(seq_iter_t si)
1609 const hash_table_t ht = (hash_table_t)si->seq;
1611 for (hentry_t e = ht->hentries, sntl = e + ht->size; e < sntl; e++) {
1612 if (!HENTRY_CLEAR_P(e)) {
1622 ht_explode(void *restrict tgt[], size_t ntgt, seq_t s)
1624 volatile size_t i = 0;
1625 const hash_table_t ht = (hash_table_t)s;
1627 for (hentry_t e = ht->hentries, sntl = e + ht->size;
1628 e < sntl && i < ntgt; e++) {
1629 if (!HENTRY_CLEAR_P(e)) {
1630 tgt[i++] = (void*)e->key;
1637 /************************************************************************/
1638 /* initialization */
1639 /************************************************************************/
1641 static struct seq_impl_s __shash_table = {
1642 .length_f = (seq_length_f)dict_ht_size,
1643 .iter_init_f = (seq_iter_init_f)ht_iter_init,
1644 .iter_next_f = ht_siter_next,
1645 .iter_fini_f = (seq_iter_fini_f)ht_iter_fini,
1646 .iter_reset_f = ht_iter_reset,
1647 .explode_f = ht_explode,
1650 static struct dict_impl_s __dhash_table = {
1651 .size_f = (dict_size_f)dict_ht_size,
1652 .put_f = (dict_put_f)dict_ht_put,
1653 .get_f = (dict_get_f)dict_ht_get,
1654 .remove_f = (dict_remove_f)dict_ht_remove,
1655 .iter_init_f = ht_iter_init,
1656 .iter_next_f = ht_diter_next,
1657 .iter_fini_f = ht_iter_fini,
1660 /* deal with seq interface */
1661 const seq_impl_t seq_hash_table = &__shash_table;
1662 /* deal with dict interface */
1663 const dict_impl_t dict_hash_table = &__dhash_table;
1665 void syms_of_elhash(void)
1667 INIT_LRECORD_IMPLEMENTATION(hash_table);
1669 DEFSUBR(Fhash_table_p);
1670 DEFSUBR(Fmake_hash_table);
1671 DEFSUBR(Fcopy_hash_table);
1677 DEFSUBR(Fhash_table_count);
1678 DEFSUBR(Fhash_table_test);
1679 DEFSUBR(Fhash_table_size);
1680 DEFSUBR(Fhash_table_rehash_size);
1681 DEFSUBR(Fhash_table_rehash_threshold);
1682 DEFSUBR(Fhash_table_weakness);
1683 DEFSUBR(Fhash_table_type); /* obsolete */
1686 DEFSUBR(Finternal_hash_value);
1689 defsymbol(&Qhash_tablep, "hash-table-p");
1690 defsymbol(&Qhash_table, "hash-table");
1691 defsymbol(&Qhashtable, "hashtable");
1692 defsymbol(&Qweakness, "weakness");
1693 defsymbol(&Qvalue, "value");
1694 defsymbol(&Qkey_or_value, "key-or-value");
1695 defsymbol(&Qkey_and_value, "key-and-value");
1696 defsymbol(&Qrehash_size, "rehash-size");
1697 defsymbol(&Qrehash_threshold, "rehash-threshold");
1699 defsymbol(&Qweak, "weak"); /* obsolete */
1700 defsymbol(&Qkey_weak, "key-weak"); /* obsolete */
1701 defsymbol(&Qkey_or_value_weak, "key-or-value-weak"); /* obsolete */
1702 defsymbol(&Qvalue_weak, "value-weak"); /* obsolete */
1703 defsymbol(&Qnon_weak, "non-weak"); /* obsolete */
1705 defkeyword(&Q_test, ":test");
1706 defkeyword(&Q_size, ":size");
1707 defkeyword(&Q_rehash_size, ":rehash-size");
1708 defkeyword(&Q_rehash_threshold, ":rehash-threshold");
1709 defkeyword(&Q_weakness, ":weakness");
1710 defkeyword(&Q_type, ":type"); /* obsolete */
1716 morphisms[lrecord_type_hash_table].seq_impl = seq_hash_table;
1717 morphisms[lrecord_type_hash_table].aset_impl = dict_hash_table;
1721 void vars_of_elhash(void)
1723 /* This must NOT be staticpro'd */
1724 Vall_weak_hash_tables = Qnil;
1725 dump_add_weak_object_chain(&Vall_weak_hash_tables);
1728 /* elhash.c ends here */