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 */
33 Lisp_Object Qhash_tablep;
34 static Lisp_Object Qhashtable, Qhash_table;
35 static Lisp_Object Qweakness, Qvalue, Qkey_or_value, Qkey_and_value;
36 static Lisp_Object Vall_weak_hash_tables;
37 static Lisp_Object Qrehash_size, Qrehash_threshold;
38 static Lisp_Object Q_size, Q_test, Q_weakness;
39 static Lisp_Object Q_rehash_size, Q_rehash_threshold;
41 /* obsolete as of 19990901 in xemacs-21.2 */
42 static Lisp_Object Qweak, Qkey_weak, Qvalue_weak, Qkey_or_value_weak;
43 static Lisp_Object Qnon_weak, Q_type;
46 #define HASH_TABLE_DEFAULT_SIZE 16
47 #define HASH_TABLE_DEFAULT_REHASH_SIZE 1.3
48 #define HASH_TABLE_MIN_SIZE 10
50 #define HASH_CODE(key, ht) \
51 ((((ht)->hash_function ? (ht)->hash_function (key) : LISP_HASH (key)) \
52 * (ht)->golden_ratio) \
55 #define KEYS_EQUAL_P(key1, key2, testfun) \
56 (EQ (key1, key2) || ((testfun) && (testfun) (key1, key2)))
58 #define LINEAR_PROBING_LOOP(probe, entries, size) \
60 !HENTRY_CLEAR_P (probe) || \
61 (probe == entries + size ? \
62 (probe = entries, !HENTRY_CLEAR_P (probe)) : 0); \
65 #ifndef ERROR_CHECK_HASH_TABLE
66 # ifdef ERROR_CHECK_TYPECHECK
67 # define ERROR_CHECK_HASH_TABLE 1
69 # define ERROR_CHECK_HASH_TABLE 0
73 #if ERROR_CHECK_HASH_TABLE
75 check_hash_table_invariants(hash_table_t ht)
77 assert(ht->count < ht->size);
78 assert(ht->count <= ht->rehash_count);
79 assert(ht->rehash_count < ht->size);
80 assert((fpfloat)ht->count * ht->rehash_threshold - 1 <=
81 (fpfloat)ht->rehash_count);
82 assert(HENTRY_CLEAR_P(ht->hentries + ht->size));
85 #define check_hash_table_invariants(ht)
88 /* We use linear probing instead of double hashing, despite its lack
89 of blessing by Knuth and company, because, as a result of the
90 increasing discrepancy between CPU speeds and memory speeds, cache
91 behavior is becoming increasingly important, e.g:
93 For a trivial loop, the penalty for non-sequential access of an array is:
94 - a factor of 3-4 on Pentium Pro 200 Mhz
95 - a factor of 10 on Ultrasparc 300 Mhz */
97 /* Return a suitable size for a hash table, with at least SIZE slots. */
99 hash_table_size(size_t requested_size)
101 /* Return some prime near, but greater than or equal to, SIZE.
102 Decades from the time of writing, someone will have a system large
103 enough that the list below will be too short... */
104 static const size_t primes[] = {
105 29, 41, 59, 79, 107, 149, 197, 263, 347, 457, 599, 787, 1031,
106 1361, 1777, 2333, 3037, 3967, 5167, 6719, 8737, 11369, 14783,
107 19219, 24989, 32491, 42257, 54941, 71429, 92861, 120721, 156941,
108 204047, 265271, 344857, 448321, 582821, 757693, 985003, 1280519,
109 1664681, 2164111, 2813353, 3657361, 4754591, 6180989, 8035301,
110 10445899, 13579681, 17653589, 22949669, 29834603, 38784989,
111 50420551, 65546729, 85210757, 110774011, 144006217, 187208107,
112 243370577, 316381771, 411296309, 534685237, 695090819,
114 1174703521, 1527114613, 1985248999, 2580823717UL, 3355070839UL
116 /* We've heard of binary search. */
118 for (low = 0, high = countof(primes) - 1; high - low > 1;) {
119 /* Loop Invariant: size < primes [high] */
120 int mid = (low + high) / 2;
121 if (primes[mid] < requested_size)
129 static int lisp_object_eql_equal(Lisp_Object obj1, Lisp_Object obj2)
131 return EQ(obj1, obj2) || (FLOATP(obj1)
132 && internal_equal(obj1, obj2, 0));
135 static hcode_t lisp_object_eql_hash(Lisp_Object obj)
137 return FLOATP(obj) ? internal_hash(obj, 0) : LISP_HASH(obj);
140 static int lisp_object_equal_equal(Lisp_Object obj1, Lisp_Object obj2)
142 return internal_equal(obj1, obj2, 0);
145 static hcode_t lisp_object_equal_hash(Lisp_Object obj)
147 return internal_hash(obj, 0);
150 static Lisp_Object mark_hash_table(Lisp_Object obj)
152 hash_table_t ht = XHASH_TABLE(obj);
154 /* If the hash table is weak, we don't want to mark the keys and
155 values (we scan over them after everything else has been marked,
156 and mark or remove them as necessary). */
157 if (ht->weakness == HASH_TABLE_NON_WEAK) {
158 for (hentry_t e = ht->hentries, sentinel = e + ht->size;
160 if (!HENTRY_CLEAR_P(e)) {
162 mark_object(e->value);
169 /* Equality of hash tables. Two hash tables are equal when they are of
170 the same weakness and test function, they have the same number of
171 elements, and for each key in the hash table, the values are `equal'.
173 This is similar to Common Lisp `equalp' of hash tables, with the
174 difference that CL requires the keys to be compared with the test
175 function, which we don't do. Doing that would require consing, and
176 consing is a bad idea in `equal'. Anyway, our method should provide
177 the same result -- if the keys are not equal according to the test
178 function, then Fgethash() in hash_table_equal_mapper() will fail. */
180 hash_table_equal(Lisp_Object hash_table1, Lisp_Object hash_table2, int depth)
182 hash_table_t ht1 = XHASH_TABLE(hash_table1);
183 hash_table_t ht2 = XHASH_TABLE(hash_table2);
185 if ((ht1->test_function != ht2->test_function) ||
186 (ht1->weakness != ht2->weakness) || (ht1->count != ht2->count)) {
191 for (hentry_t e = ht1->hentries, sntl = e + ht1->size; e < sntl; e++) {
192 if (!HENTRY_CLEAR_P(e)) {
193 /* Look up the key in the other hash table, and compare
195 Lisp_Object value_in_other =
196 Fgethash(e->key, hash_table2, Qunbound);
197 if (UNBOUNDP(value_in_other) ||
198 !internal_equal(e->value, value_in_other, depth)) {
199 return 0; /* Give up */
206 /* This is not a great hash function, but it _is_ correct and fast.
207 Examining all entries is too expensive, and examining a random
208 subset does not yield a correct hash function. */
209 static hcode_t hash_table_hash(Lisp_Object hash_table, int depth)
211 return XHASH_TABLE(hash_table)->count;
214 /* Printing hash tables.
216 This is non-trivial, because we use a readable structure-style
217 syntax for hash tables. This means that a typical hash table will be
218 readably printed in the form of:
220 #s(hash-table size 2 data (key1 value1 key2 value2))
222 The supported hash table structure keywords and their values are:
223 `test' (eql (or nil), eq or equal)
224 `size' (a natnum or nil)
225 `rehash-size' (a float)
226 `rehash-threshold' (a float)
227 `weakness' (nil, key, value, key-and-value, or key-or-value)
230 If `print-readably' is nil, then a simpler syntax is used, for example
232 #<hash-table size 2/13 data (key1 value1 key2 value2) 0x874d>
234 The data is truncated to four pairs, and the rest is shown with
235 `...'. This printer does not cons. */
237 /* Print the data of the hash table. This maps through a Lisp
238 hash table and prints key/value pairs using PRINTCHARFUN. */
240 print_hash_table_data(hash_table_t ht, Lisp_Object printcharfun)
244 write_c_string(" data (", printcharfun);
246 for (hentry_t e = ht->hentries, sntl = e + ht->size; e < sntl; e++) {
247 if (!HENTRY_CLEAR_P(e)) {
249 write_c_string(" ", printcharfun);
250 if (!print_readably && count > 3) {
251 write_c_string("...", printcharfun);
254 print_internal(e->key, printcharfun, 1);
255 write_c_string(" ", printcharfun);
256 print_internal(e->value, printcharfun, 1);
260 write_c_string(")", printcharfun);
264 print_hash_table(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
266 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 sprintf(buf, " size %lu", (unsigned long)ht->count);
288 sprintf(buf, " size %lu/%lu",
289 (unsigned long)ht->count,
290 (unsigned long)ht->size);
291 write_c_string(buf, printcharfun);
294 if (ht->weakness != HASH_TABLE_NON_WEAK) {
295 sprintf(buf, " weakness %s",
296 (ht->weakness == HASH_TABLE_WEAK ? "key-and-value" :
297 ht->weakness == HASH_TABLE_KEY_WEAK ? "key" :
298 ht->weakness == HASH_TABLE_VALUE_WEAK ? "value" :
300 HASH_TABLE_KEY_VALUE_WEAK ? "key-or-value" :
301 "you-d-better-not-see-this"));
302 write_c_string(buf, printcharfun);
306 print_hash_table_data(ht, printcharfun);
309 write_c_string(")", printcharfun);
311 sprintf(buf, " 0x%x>", ht->header.uid);
312 write_c_string(buf, printcharfun);
316 static void finalize_hash_table(void *header, int for_disksave)
319 hash_table_t ht = (hash_table_t ) header;
326 static const struct lrecord_description hentry_description_1[] = {
327 {XD_LISP_OBJECT, offsetof(struct hentry_s, key)},
328 {XD_LISP_OBJECT, offsetof(struct hentry_s, value)},
332 static const struct struct_description hentry_description = {
333 sizeof(struct hentry_s),
337 const struct lrecord_description hash_table_description[] = {
338 {XD_SIZE_T, offsetof(struct hash_table_s, size)},
339 {XD_STRUCT_PTR, offsetof(struct hash_table_s, hentries),
340 XD_INDIRECT(0, 1), &hentry_description},
341 {XD_LO_LINK, offsetof(struct hash_table_s, next_weak)},
345 DEFINE_LRECORD_IMPLEMENTATION(
346 "hash-table", hash_table,
347 mark_hash_table, print_hash_table, finalize_hash_table,
348 hash_table_equal, hash_table_hash, hash_table_description,
349 struct hash_table_s);
352 xhash_table(Lisp_Object hash_table)
355 CHECK_HASH_TABLE(hash_table);
356 check_hash_table_invariants(XHASH_TABLE(hash_table));
357 return XHASH_TABLE(hash_table);
360 /************************************************************************/
361 /* Creation of Hash Tables */
362 /************************************************************************/
364 /* Creation of hash tables, without error-checking. */
365 static void compute_hash_table_derived_values(hash_table_t ht)
367 ht->rehash_count = (size_t)
368 ((fpfloat)ht->size * ht->rehash_threshold);
369 ht->golden_ratio = (size_t)
370 ((fpfloat)ht->size * (.6180339887 / (fpfloat)sizeof(Lisp_Object)));
374 make_standard_lisp_hash_table(
375 enum hash_table_test test,
376 size_t size, fpfloat rehash_size, fpfloat rehash_threshold,
377 enum hash_table_weakness weakness)
379 hash_table_hash_f hash_function = 0;
380 hash_table_test_f test_function = 0;
389 test_function = lisp_object_eql_equal;
390 hash_function = lisp_object_eql_hash;
393 case HASH_TABLE_EQUAL:
394 test_function = lisp_object_equal_equal;
395 hash_function = lisp_object_equal_hash;
402 return make_general_lisp_hash_table(hash_function, test_function,
403 size, rehash_size, rehash_threshold,
408 make_general_lisp_hash_table(
409 hash_table_hash_f hash_function, hash_table_test_f test_function,
410 size_t size, fpfloat rehash_size, fpfloat rehash_threshold,
411 enum hash_table_weakness weakness)
413 Lisp_Object hash_table;
414 hash_table_t ht = alloc_lcrecord_type(
415 struct hash_table_s, &lrecord_hash_table);
417 /* the categories are actually seq and dict, but use the per-type
418 implementation for a start */
419 ht->header.lheader.morphisms = (1<<cat_mk_lc);
421 ht->test_function = test_function;
422 ht->hash_function = hash_function;
423 ht->weakness = weakness;
425 ht->rehash_size = rehash_size > 1.0
427 : HASH_TABLE_DEFAULT_REHASH_SIZE;
429 ht->rehash_threshold = rehash_threshold > 0.0
431 : size > 4096 && !ht->test_function ? 0.7 : 0.6;
433 if (size < HASH_TABLE_MIN_SIZE)
434 size = HASH_TABLE_MIN_SIZE;
435 ht->size = hash_table_size(
436 (size_t)(((fpfloat)size / ht->rehash_threshold) + 1.0));
439 compute_hash_table_derived_values(ht);
441 /* We leave room for one never-occupied sentinel hentry at the end. */
442 ht->hentries = xnew_array_and_zero(struct hentry_s, ht->size + 1);
444 XSETHASH_TABLE(hash_table, ht);
446 if (weakness == HASH_TABLE_NON_WEAK) {
447 ht->next_weak = Qunbound;
449 ht->next_weak = Vall_weak_hash_tables,
450 Vall_weak_hash_tables = hash_table;
456 make_lisp_hash_table(size_t size,
457 enum hash_table_weakness weakness,
458 enum hash_table_test test)
460 return make_standard_lisp_hash_table(test, size, -1.0, -1.0, weakness);
463 /* Pretty reading of hash tables.
465 Here we use the existing structures mechanism (which is,
466 unfortunately, pretty cumbersome) for validating and instantiating
467 the hash tables. The idea is that the side-effect of reading a
468 #s(hash-table PLIST) object is creation of a hash table with desired
469 properties, and that the hash table is returned. */
471 /* Validation functions: each keyword provides its own validation
472 function. The errors should maybe be continuable, but it is
473 unclear how this would cope with ERRB. */
475 hash_table_size_validate(Lisp_Object keyword, Lisp_Object value,
478 #ifdef WITH_NUMBER_TYPES
479 if (!NILP(Fnonnegativep(value)))
482 maybe_signal_error(Qwrong_type_argument, list2(Qnonnegativep, value),
484 #else /* !WITH_NUMBER_TYPES */
488 maybe_signal_error(Qwrong_type_argument, list2(Qnatnump, value),
490 #endif /* WITH_NUMBER_TYPES */
494 static size_t decode_hash_table_size(Lisp_Object obj)
496 #ifdef WITH_NUMBER_TYPES
497 return NILP(obj) ? HASH_TABLE_DEFAULT_SIZE :
498 XINT(Fcoerce_number(obj, Qint, Qnil));
500 return NILP(obj) ? HASH_TABLE_DEFAULT_SIZE : XINT(obj);
505 hash_table_weakness_validate(Lisp_Object keyword, Lisp_Object value,
514 if (EQ(value, Qkey_and_value))
516 if (EQ(value, Qkey_or_value))
518 if (EQ(value, Qvalue))
521 /* Following values are obsolete as of 19990901 in xemacs-21.2 */
522 if (EQ(value, Qnon_weak))
524 if (EQ(value, Qweak))
526 if (EQ(value, Qkey_weak))
528 if (EQ(value, Qkey_or_value_weak))
530 if (EQ(value, Qvalue_weak))
533 maybe_signal_simple_error("Invalid hash table weakness",
534 value, Qhash_table, errb);
538 static enum hash_table_weakness decode_hash_table_weakness(Lisp_Object obj)
541 return HASH_TABLE_NON_WEAK;
543 return HASH_TABLE_WEAK;
544 if (EQ(obj, Qkey_and_value))
545 return HASH_TABLE_WEAK;
547 return HASH_TABLE_KEY_WEAK;
548 if (EQ(obj, Qkey_or_value))
549 return HASH_TABLE_KEY_VALUE_WEAK;
551 return HASH_TABLE_VALUE_WEAK;
553 /* Following values are obsolete as of 19990901 in xemacs-21.2 */
554 if (EQ(obj, Qnon_weak))
555 return HASH_TABLE_NON_WEAK;
557 return HASH_TABLE_WEAK;
558 if (EQ(obj, Qkey_weak))
559 return HASH_TABLE_KEY_WEAK;
560 if (EQ(obj, Qkey_or_value_weak))
561 return HASH_TABLE_KEY_VALUE_WEAK;
562 if (EQ(obj, Qvalue_weak))
563 return HASH_TABLE_VALUE_WEAK;
565 signal_simple_error("Invalid hash table weakness", obj);
566 return HASH_TABLE_NON_WEAK; /* not reached */
570 hash_table_test_validate(Lisp_Object keyword, Lisp_Object value,
577 if (EQ(value, Qequal))
582 maybe_signal_simple_error("Invalid hash table test",
583 value, Qhash_table, errb);
587 static enum hash_table_test decode_hash_table_test(Lisp_Object obj)
590 return HASH_TABLE_EQL;
592 return HASH_TABLE_EQ;
594 return HASH_TABLE_EQUAL;
596 return HASH_TABLE_EQL;
598 signal_simple_error("Invalid hash table test", obj);
599 return HASH_TABLE_EQ; /* not reached */
603 hash_table_rehash_size_validate(Lisp_Object keyword, Lisp_Object value,
606 if (!FLOATP(value)) {
607 maybe_signal_error(Qwrong_type_argument, list2(Qfloatp, value),
613 fpfloat rehash_size = XFLOAT_DATA(value);
614 if (rehash_size <= 1.0) {
615 maybe_signal_simple_error
616 ("Hash table rehash size must be greater than 1.0",
617 value, Qhash_table, errb);
625 static fpfloat decode_hash_table_rehash_size(Lisp_Object rehash_size)
627 return NILP(rehash_size) ? -1.0 : XFLOAT_DATA(rehash_size);
631 hash_table_rehash_threshold_validate(Lisp_Object keyword, Lisp_Object value,
634 if (!FLOATP(value)) {
635 maybe_signal_error(Qwrong_type_argument, list2(Qfloatp, value),
641 fpfloat rehash_threshold = XFLOAT_DATA(value);
642 if (rehash_threshold <= 0.0 || rehash_threshold >= 1.0) {
643 maybe_signal_simple_error
644 ("Hash table rehash threshold must be between 0.0 and 1.0",
645 value, Qhash_table, errb);
653 static fpfloat decode_hash_table_rehash_threshold(Lisp_Object rehash_threshold)
655 return NILP(rehash_threshold) ? -1.0 : XFLOAT_DATA(rehash_threshold);
659 hash_table_data_validate(Lisp_Object keyword, Lisp_Object value,
664 GET_EXTERNAL_LIST_LENGTH(value, len);
667 maybe_signal_simple_error
668 ("Hash table data must have alternating key/value pairs",
669 value, Qhash_table, errb);
675 /* The actual instantiation of a hash table. This does practically no
676 error checking, because it relies on the fact that the paranoid
677 functions above have error-checked everything to the last details.
678 If this assumption is wrong, we will get a crash immediately (with
679 error-checking compiled in), and we'll know if there is a bug in
680 the structure mechanism. So there. */
681 static Lisp_Object hash_table_instantiate(Lisp_Object plist)
683 Lisp_Object hash_table;
684 Lisp_Object test = Qnil;
685 Lisp_Object size = Qnil;
686 Lisp_Object rehash_size = Qnil;
687 Lisp_Object rehash_threshold = Qnil;
688 Lisp_Object weakness = Qnil;
689 Lisp_Object data = Qnil;
691 while (!NILP(plist)) {
692 Lisp_Object key, value;
700 else if (EQ(key, Qsize))
702 else if (EQ(key, Qrehash_size))
704 else if (EQ(key, Qrehash_threshold))
705 rehash_threshold = value;
706 else if (EQ(key, Qweakness))
708 else if (EQ(key, Qdata))
710 else if (EQ(key, Qtype)) /*obsolete */
716 /* Create the hash table. */
717 hash_table = make_standard_lisp_hash_table
718 (decode_hash_table_test(test),
719 decode_hash_table_size(size),
720 decode_hash_table_rehash_size(rehash_size),
721 decode_hash_table_rehash_threshold(rehash_threshold),
722 decode_hash_table_weakness(weakness));
724 /* I'm not sure whether this can GC, but better safe than sorry. */
729 /* And fill it with data. */
730 while (!NILP(data)) {
731 Lisp_Object key, value;
736 Fputhash(key, value, hash_table);
745 structure_type_create_hash_table_structure_name(Lisp_Object structure_name)
747 struct structure_type *st;
749 st = define_structure_type(structure_name, 0, hash_table_instantiate);
750 define_structure_type_keyword(st, Qtest, hash_table_test_validate);
751 define_structure_type_keyword(st, Qsize, hash_table_size_validate);
752 define_structure_type_keyword(st, Qrehash_size,
753 hash_table_rehash_size_validate);
754 define_structure_type_keyword(st, Qrehash_threshold,
755 hash_table_rehash_threshold_validate);
756 define_structure_type_keyword(st, Qweakness,
757 hash_table_weakness_validate);
758 define_structure_type_keyword(st, Qdata, hash_table_data_validate);
760 /* obsolete as of 19990901 in xemacs-21.2 */
761 define_structure_type_keyword(st, Qtype, hash_table_weakness_validate);
764 /* Create a built-in Lisp structure type named `hash-table'.
765 We make #s(hashtable ...) equivalent to #s(hash-table ...),
766 for backward compatibility.
767 This is called from emacs.c. */
768 void structure_type_create_hash_table(void)
770 structure_type_create_hash_table_structure_name(Qhash_table);
771 structure_type_create_hash_table_structure_name(Qhashtable); /* compat */
774 /************************************************************************/
775 /* Definition of Lisp-visible methods */
776 /************************************************************************/
778 DEFUN("hash-table-p", Fhash_table_p, 1, 1, 0, /*
779 Return t if OBJECT is a hash table, else nil.
783 return HASH_TABLEP(object) ? Qt : Qnil;
786 DEFUN("make-hash-table", Fmake_hash_table, 0, MANY, 0, /*
787 Return a new empty hash table object.
788 Use Common Lisp style keywords to specify hash table properties.
789 (make-hash-table &key test size rehash-size rehash-threshold weakness)
791 Keyword :test can be `eq', `eql' (default) or `equal'.
792 Comparison between keys is done using this function.
793 If speed is important, consider using `eq'.
794 When hash table keys may be strings, you will likely need to use `equal'.
796 Keyword :size specifies the number of keys likely to be inserted.
797 This number of entries can be inserted without enlarging the hash table.
799 Keyword :rehash-size must be a float greater than 1.0, and specifies
800 the factor by which to increase the size of the hash table when enlarging.
802 Keyword :rehash-threshold must be a float between 0.0 and 1.0,
803 and specifies the load factor of the hash table which triggers enlarging.
805 Non-standard keyword :weakness can be `nil' (default), `t', `key-and-value',
806 `key', `value' or `key-or-value'. `t' is an alias for `key-and-value'.
808 A key-and-value-weak hash table, also known as a fully-weak or simply
809 as a weak hash table, is one whose pointers do not count as GC
810 referents: for any key-value pair in the hash table, if the only
811 remaining pointer to either the key or the value is in a weak hash
812 table, then the pair will be removed from the hash table, and the key
813 and value collected. A non-weak hash table (or any other pointer)
814 would prevent the object from being collected.
816 A key-weak hash table is similar to a fully-weak hash table except that
817 a key-value pair will be removed only if the key remains unmarked
818 outside of weak hash tables. The pair will remain in the hash table if
819 the key is pointed to by something other than a weak hash table, even
822 A value-weak hash table is similar to a fully-weak hash table except
823 that a key-value pair will be removed only if the value remains
824 unmarked outside of weak hash tables. The pair will remain in the
825 hash table if the value is pointed to by something other than a weak
826 hash table, even if the key is not.
828 A key-or-value-weak hash table is similar to a fully-weak hash table except
829 that a key-value pair will be removed only if the value and the key remain
830 unmarked outside of weak hash tables. The pair will remain in the
831 hash table if the value or key are pointed to by something other than a weak
832 hash table, even if the other is not.
834 (int nargs, Lisp_Object * args))
837 Lisp_Object test = Qnil;
838 Lisp_Object size = Qnil;
839 Lisp_Object rehash_size = Qnil;
840 Lisp_Object rehash_threshold = Qnil;
841 Lisp_Object weakness = Qnil;
843 while (i + 1 < nargs) {
844 Lisp_Object keyword = args[i++];
845 Lisp_Object value = args[i++];
847 if (EQ(keyword, Q_test))
849 else if (EQ(keyword, Q_size))
851 else if (EQ(keyword, Q_rehash_size))
853 else if (EQ(keyword, Q_rehash_threshold))
854 rehash_threshold = value;
855 else if (EQ(keyword, Q_weakness))
857 else if (EQ(keyword, Q_type)) /*obsolete */
861 ("Invalid hash table property keyword", keyword);
865 signal_simple_error("Hash table property requires a value",
868 #define VALIDATE_VAR(var) \
869 if (!NILP (var)) hash_table_##var##_validate (Q##var, var, ERROR_ME);
873 VALIDATE_VAR(rehash_size);
874 VALIDATE_VAR(rehash_threshold);
875 VALIDATE_VAR(weakness);
877 return make_standard_lisp_hash_table
878 (decode_hash_table_test(test),
879 decode_hash_table_size(size),
880 decode_hash_table_rehash_size(rehash_size),
881 decode_hash_table_rehash_threshold(rehash_threshold),
882 decode_hash_table_weakness(weakness));
885 DEFUN("copy-hash-table", Fcopy_hash_table, 1, 1, 0, /*
886 Return a new hash table containing the same keys and values as HASH-TABLE.
887 The keys and values will not themselves be copied.
891 const hash_table_t ht_old = xhash_table(hash_table);
892 hash_table_t ht = alloc_lcrecord_type(
893 struct hash_table_s, &lrecord_hash_table);
895 copy_lcrecord(ht, ht_old);
897 ht->hentries = xnew_array(struct hentry_s, ht_old->size + 1);
898 memcpy(ht->hentries, ht_old->hentries,
899 (ht_old->size + 1) * sizeof(struct hentry_s));
901 /* the categories are actually seq and dict, but use the per-type
902 implementation for a start */
903 ht->header.lheader.morphisms = (1<<cat_mk_lc);
905 XSETHASH_TABLE(hash_table, ht);
907 if (!EQ(ht->next_weak, Qunbound)) {
908 ht->next_weak = Vall_weak_hash_tables,
909 Vall_weak_hash_tables = hash_table;
915 resize_hash_table(hash_table_t ht, size_t new_size)
917 hentry_t old_entries, new_entries;
923 old_entries = ht->hentries;
925 ht->hentries = xnew_array_and_zero(struct hentry_s, new_size + 1);
926 new_entries = ht->hentries;
928 compute_hash_table_derived_values(ht);
930 for (hentry_t e = old_entries, sentinel = e + old_size;
932 if (!HENTRY_CLEAR_P(e)) {
933 hentry_t probe = new_entries + HASH_CODE(e->key, ht);
934 LINEAR_PROBING_LOOP(probe, new_entries, new_size);
938 if (!DUMPEDP(old_entries)) {
943 /* After a hash table has been saved to disk and later restored by the
944 portable dumper, it contains the same objects, but their addresses
945 and thus their HASH_CODEs have changed. */
947 pdump_reorganize_hash_table(Lisp_Object hash_table)
949 const hash_table_t ht = xhash_table(hash_table);
950 hentry_t new_entries =
951 xnew_array_and_zero(struct hentry_s, ht->size + 1);
953 for (hentry_t e = ht->hentries, sntl = e + ht->size; e < sntl; e++) {
954 if (!HENTRY_CLEAR_P(e)) {
955 hentry_t probe = new_entries + HASH_CODE(e->key, ht);
956 LINEAR_PROBING_LOOP(probe, new_entries, ht->size);
960 memcpy(ht->hentries, new_entries, ht->size * sizeof(struct hentry_s));
966 static void enlarge_hash_table(hash_table_t ht)
969 hash_table_size((size_t) ((fpfloat)ht->size * ht->rehash_size));
970 resize_hash_table(ht, new_size);
974 find_hentry(Lisp_Object key, const hash_table_t ht)
976 hash_table_test_f test_function = ht->test_function;
977 hentry_t entries = ht->hentries;
978 hentry_t probe = entries + HASH_CODE(key, ht);
980 LINEAR_PROBING_LOOP(probe, entries, ht->size)
981 if (KEYS_EQUAL_P(probe->key, key, test_function))
987 static inline Lisp_Object
988 dict_ht_get(hash_table_t ht, Lisp_Object key, Lisp_Object _default)
990 const hentry_t e = find_hentry(key, ht);
992 return HENTRY_CLEAR_P(e) ? _default : e->value;
995 DEFUN("gethash", Fgethash, 2, 3, 0, /*
996 Find hash value for KEY in HASH-TABLE.
997 If there is no corresponding value, return DEFAULT (which defaults to nil).
999 (key, hash_table, default_))
1001 return dict_ht_get(xhash_table(hash_table), key, default_);
1004 static inline Lisp_Object
1005 dict_ht_put(hash_table_t ht, Lisp_Object key, Lisp_Object value)
1007 hentry_t e = find_hentry(key, ht);
1009 if (!HENTRY_CLEAR_P(e))
1010 return e->value = value;
1015 if (++ht->count >= ht->rehash_count) {
1016 enlarge_hash_table(ht);
1022 DEFUN("puthash", Fputhash, 3, 3, 0, /*
1023 Hash KEY to VALUE in HASH-TABLE.
1025 (key, value, hash_table))
1027 return dict_ht_put(xhash_table(hash_table), key, value);
1030 /* Remove hentry pointed at by PROBE.
1031 Subsequent entries are removed and reinserted.
1032 We don't use tombstones - too wasteful. */
1033 static void remhash_1(hash_table_t ht, hentry_t entries, hentry_t probe)
1035 size_t size = ht->size;
1036 CLEAR_HENTRY(probe);
1040 LINEAR_PROBING_LOOP(probe, entries, size) {
1041 Lisp_Object key = probe->key;
1042 hentry_t probe2 = entries + HASH_CODE(key, ht);
1043 LINEAR_PROBING_LOOP(probe2, entries, size)
1044 if (EQ(probe2->key, key))
1045 /* hentry at probe doesn't need to move. */
1046 goto continue_outer_loop;
1047 /* Move hentry from probe to new home at probe2. */
1049 CLEAR_HENTRY(probe);
1050 continue_outer_loop:continue;
1054 static inline Lisp_Object
1055 dict_ht_remove(hash_table_t ht, Lisp_Object key)
1057 hentry_t e = find_hentry(key, ht);
1059 if (HENTRY_CLEAR_P(e)) {
1063 remhash_1(ht, ht->hentries, e);
1067 DEFUN("remhash", Fremhash, 2, 2, 0, /*
1068 Remove the entry for KEY from HASH-TABLE.
1069 Do nothing if there is no entry for KEY in HASH-TABLE.
1073 return dict_ht_remove(xhash_table(hash_table), key);
1076 DEFUN("clrhash", Fclrhash, 1, 1, 0, /*
1077 Remove all entries from HASH-TABLE, leaving it empty.
1081 hash_table_t ht = xhash_table(hash_table);
1083 for (hentry_t e = ht->hentries, sntl = e + ht->size; e < sntl; e++) {
1091 /************************************************************************/
1092 /* Accessor Functions */
1093 /************************************************************************/
1095 DEFUN("hash-table-count", Fhash_table_count, 1, 1, 0, /*
1096 Return the number of entries in HASH-TABLE.
1100 return make_int(xhash_table(hash_table)->count);
1103 DEFUN("hash-table-test", Fhash_table_test, 1, 1, 0, /*
1104 Return the test function of HASH-TABLE.
1105 This can be one of `eq', `eql' or `equal'.
1109 hash_table_test_f fun = xhash_table(hash_table)->test_function;
1111 return (fun == lisp_object_eql_equal ? Qeql :
1112 fun == lisp_object_equal_equal ? Qequal : Qeq);
1116 dict_ht_size(const hash_table_t ht)
1121 DEFUN("hash-table-size", Fhash_table_size, 1, 1, 0, /*
1122 Return the size of HASH-TABLE.
1123 This is the current number of slots in HASH-TABLE, whether occupied or not.
1127 return make_int(xhash_table(hash_table)->size);
1130 DEFUN("hash-table-rehash-size", Fhash_table_rehash_size, 1, 1, 0, /*
1131 Return the current rehash size of HASH-TABLE.
1132 This is a float greater than 1.0; the factor by which HASH-TABLE
1133 is enlarged when the rehash threshold is exceeded.
1137 return make_float(xhash_table(hash_table)->rehash_size);
1140 DEFUN("hash-table-rehash-threshold", Fhash_table_rehash_threshold, 1, 1, 0, /*
1141 Return the current rehash threshold of HASH-TABLE.
1142 This is a float between 0.0 and 1.0; the maximum `load factor' of HASH-TABLE,
1143 beyond which the HASH-TABLE is enlarged by rehashing.
1147 return make_float(xhash_table(hash_table)->rehash_threshold);
1150 DEFUN("hash-table-weakness", Fhash_table_weakness, 1, 1, 0, /*
1151 Return the weakness of HASH-TABLE.
1152 This can be one of `nil', `key-and-value', `key-or-value', `key' or `value'.
1156 switch (xhash_table(hash_table)->weakness) {
1157 case HASH_TABLE_WEAK:
1158 return Qkey_and_value;
1159 case HASH_TABLE_KEY_WEAK:
1161 case HASH_TABLE_KEY_VALUE_WEAK:
1162 return Qkey_or_value;
1163 case HASH_TABLE_VALUE_WEAK:
1167 case HASH_TABLE_NON_WEAK:
1168 case HASH_TABLE_KEY_CAR_WEAK:
1169 case HASH_TABLE_VALUE_CAR_WEAK:
1170 case HASH_TABLE_KEY_CAR_VALUE_WEAK:
1177 /* obsolete as of 19990901 in xemacs-21.2 */
1178 DEFUN("hash-table-type", Fhash_table_type, 1, 1, 0, /*
1179 Return the type of HASH-TABLE.
1180 This can be one of `non-weak', `weak', `key-weak' or `value-weak'.
1184 switch (xhash_table(hash_table)->weakness) {
1185 case HASH_TABLE_WEAK:
1187 case HASH_TABLE_KEY_WEAK:
1189 case HASH_TABLE_KEY_VALUE_WEAK:
1190 return Qkey_or_value_weak;
1191 case HASH_TABLE_VALUE_WEAK:
1194 /* the bloody rest */
1195 case HASH_TABLE_NON_WEAK:
1196 case HASH_TABLE_KEY_CAR_WEAK:
1197 case HASH_TABLE_VALUE_CAR_WEAK:
1198 case HASH_TABLE_KEY_CAR_VALUE_WEAK:
1205 /************************************************************************/
1206 /* Mapping Functions */
1207 /************************************************************************/
1208 DEFUN("maphash", Fmaphash, 2, 2, 0, /*
1209 Map FUNCTION over entries in HASH-TABLE, calling it with two args,
1210 each key and value in HASH-TABLE.
1212 FUNCTION may not modify HASH-TABLE, with the one exception that FUNCTION
1213 may remhash or puthash the entry currently being processed by FUNCTION.
1215 (function, hash_table))
1217 const hash_table_t ht = xhash_table(hash_table);
1219 for (hentry_t e = ht->hentries, sntl = e + ht->size; e < sntl; e++) {
1220 if (!HENTRY_CLEAR_P(e)) {
1221 Lisp_Object args[3], key;
1227 Ffuncall(countof(args), args);
1228 /* Has FUNCTION done a remhash? */
1229 if (!EQ(key, e->key) && !HENTRY_CLEAR_P(e))
1236 /* #### If the Lisp function being called does a puthash and this
1237 #### causes the hash table to be resized, the results will be quite
1238 #### random and we will likely crash. To fix this, either set a
1239 #### flag in the hash table while we're mapping and signal an error
1240 #### when new entries are added, or fix things to make this
1241 #### operation work properly, like this: Store two hash tables in
1242 #### each hash table object -- the second one is written to when
1243 #### you do a puthash inside of a mapping operation, and the
1244 #### various operations need to check both hash tables for entries.
1245 #### As soon as the last maphash over a particular hash table
1246 #### object terminates, the entries in the second table are added
1247 #### to the first (using an unwind-protect). --ben */
1249 /* Map *C* function FUNCTION over the elements of a lisp hash table. */
1251 elisp_maphash(maphash_f function, Lisp_Object hash_table, void *extra_arg)
1253 const hash_table_t ht = XHASH_TABLE(hash_table);
1255 for (hentry_t e = ht->hentries, sntl = e + ht->size; e < sntl; e++) {
1256 if (!HENTRY_CLEAR_P(e)) {
1260 if (function(key, e->value, extra_arg)) {
1263 /* Has FUNCTION done a remhash? */
1264 if (!EQ(key, e->key) && !HENTRY_CLEAR_P(e)) {
1271 /* Remove all elements of a lisp hash table satisfying *C* predicate
1274 elisp_map_remhash(maphash_f predicate, Lisp_Object hash_table, void *extra_arg)
1276 hash_table_t ht = XHASH_TABLE(hash_table);
1279 for (hentry_t e = entries = ht->hentries, sentinel = e + ht->size;
1280 e < sentinel; e++) {
1281 if (!HENTRY_CLEAR_P(e)) {
1283 if (predicate(e->key, e->value, extra_arg)) {
1284 remhash_1(ht, entries, e);
1285 if (!HENTRY_CLEAR_P(e)) {
1293 /************************************************************************/
1294 /* garbage collecting weak hash tables */
1295 /************************************************************************/
1296 #define MARK_OBJ(obj) \
1298 Lisp_Object mo_obj = (obj); \
1299 if (!marked_p (mo_obj)) { \
1300 mark_object (mo_obj); \
1305 /* Complete the marking for semi-weak hash tables. */
1306 int finish_marking_weak_hash_tables(void)
1308 Lisp_Object hash_table;
1311 for (hash_table = Vall_weak_hash_tables;
1313 hash_table = XHASH_TABLE(hash_table)->next_weak) {
1314 const hash_table_t ht = XHASH_TABLE(hash_table);
1315 hentry_t e = ht->hentries;
1316 const hentry_t sentinel = e + ht->size;
1318 if (!marked_p(hash_table)) {
1319 /* The hash table is probably garbage. Ignore it. */
1323 /* Now, scan over all the pairs. For all pairs that are
1324 half-marked, we may need to mark the other half if we're
1325 keeping this pair. */
1326 switch (ht->weakness) {
1327 case HASH_TABLE_KEY_WEAK:
1328 for (; e < sentinel; e++) {
1329 if (!HENTRY_CLEAR_P(e)) {
1330 if (marked_p(e->key)) {
1337 case HASH_TABLE_VALUE_WEAK:
1338 for (; e < sentinel; e++) {
1339 if (!HENTRY_CLEAR_P(e)) {
1340 if (marked_p(e->value)) {
1347 case HASH_TABLE_KEY_VALUE_WEAK:
1348 for (; e < sentinel; e++) {
1349 if (!HENTRY_CLEAR_P(e)) {
1350 if (marked_p(e->value)) {
1352 } else if (marked_p(e->key)) {
1359 case HASH_TABLE_KEY_CAR_WEAK:
1360 for (; e < sentinel; e++) {
1361 if (!HENTRY_CLEAR_P(e)) {
1363 || marked_p(XCAR(e->key))) {
1371 /* We seem to be sprouting new weakness types at an
1372 alarming rate. At least this is not externally
1373 visible - and in fact all of these KEY_CAR_* types
1374 are only used by the glyph code. */
1375 case HASH_TABLE_KEY_CAR_VALUE_WEAK:
1376 for (; e < sentinel; e++) {
1377 if (!HENTRY_CLEAR_P(e)) {
1379 || marked_p(XCAR(e->key))) {
1382 } else if (marked_p(e->value)) {
1389 case HASH_TABLE_VALUE_CAR_WEAK:
1390 for (; e < sentinel; e++) {
1391 if (!HENTRY_CLEAR_P(e)) {
1392 if (!CONSP(e->value)
1393 || marked_p(XCAR(e->value))) {
1402 case HASH_TABLE_NON_WEAK:
1403 case HASH_TABLE_WEAK:
1412 void prune_weak_hash_tables(void)
1414 Lisp_Object hash_table, prev = Qnil;
1416 for (hash_table = Vall_weak_hash_tables; !NILP(hash_table);
1417 hash_table = XHASH_TABLE(hash_table)->next_weak) {
1418 if (!marked_p(hash_table)) {
1419 /* This hash table itself is garbage. Remove it from
1422 Vall_weak_hash_tables =
1423 XHASH_TABLE(hash_table)->next_weak;
1425 XHASH_TABLE(prev)->next_weak =
1426 XHASH_TABLE(hash_table)->next_weak;
1428 /* Now, scan over all the pairs. Remove all of the pairs
1429 in which the key or value, or both, is unmarked
1430 (depending on the weakness of the hash table). */
1431 hash_table_t ht = XHASH_TABLE(hash_table);
1432 hentry_t entries = ht->hentries;
1433 hentry_t sentinel = entries + ht->size;
1435 for (hentry_t e = entries; e < sentinel; e++) {
1436 if (!HENTRY_CLEAR_P(e)) {
1438 if (!marked_p(e->key) ||
1439 !marked_p(e->value)) {
1440 remhash_1(ht, entries, e);
1441 if (!HENTRY_CLEAR_P(e)) {
1454 /* Return a hash value for an array of Lisp_Objects of size SIZE. */
1457 internal_array_hash(const Lisp_Object *arr, size_t size, int depth)
1463 for (size_t i = 0; i < size; i++) {
1464 hash = HASH2(hash, internal_hash(arr[i], depth));
1469 /* just pick five elements scattered throughout the array.
1470 A slightly better approach would be to offset by some
1471 noise factor from the points chosen below. */
1472 for (int i = 0; i < 5; i++) {
1473 hash = HASH2(hash, internal_hash(arr[i * size / 5], depth));
1478 /* Return a hash value for a Lisp_Object. This is for use when hashing
1479 objects with the comparison being `equal' (for `eq', you can just
1480 use the Lisp_Object itself as the hash value). You need to make a
1481 tradeoff between the speed of the hash function and how good the
1482 hashing is. In particular, the hash function needs to be FAST,
1483 so you can't just traipse down the whole tree hashing everything
1484 together. Most of the time, objects will differ in the first
1485 few elements you hash. Thus, we only go to a short depth (5)
1486 and only hash at most 5 elements out of a vector. Theoretically
1487 we could still take 5^5 time (a big big number) to compute a
1488 hash, but practically this won't ever happen. */
1491 internal_hash(const Lisp_Object obj, int depth)
1495 if (CONSP(obj) && !CONSP(XCDR(obj))) {
1496 /* special case for '(a . b) conses */
1497 return HASH2(internal_hash(XCAR(obj), depth + 1),
1498 internal_hash(XCDR(obj), depth + 1));
1499 } else if (CONSP(obj)) {
1500 /* no point in worrying about tail recursion, since we're not
1502 Lisp_Object o = obj;
1504 hcode_t hash = internal_hash(XCAR(o), depth+1);
1507 for (int s = 1; s < 6 && CONSP(o); o = XCDR(o), s++) {
1508 hcode_t h = internal_hash(XCAR(o), depth+1);
1509 hash = HASH3(hash, h, s);
1514 return hash_string(XSTRING_DATA(obj), XSTRING_LENGTH(obj));
1516 if (LRECORDP(obj)) {
1517 const struct lrecord_implementation
1518 *imp = XRECORD_LHEADER_IMPLEMENTATION(obj);
1520 return imp->hash(obj, depth);
1523 return LISP_HASH(obj);
1526 DEFUN("sxhash", Fsxhash, 1, 1, 0, /*
1527 Return a hash value for OBJECT.
1528 \(equal obj1 obj2) implies (= (sxhash obj1) (sxhash obj2)).
1532 return make_int(internal_hash(object, 0));
1536 /* the seq/dict implementation */
1537 /* iterator stuff, only needed for dict so make it static */
1539 ht_iter_init(dict_t d, dict_iter_t di)
1541 const hash_table_t ht = (hash_table_t)d;
1544 for (hentry_t e = ht->hentries, sntl = e + ht->size; e < sntl; e++) {
1545 if (!HENTRY_CLEAR_P(e)) {
1555 ht_iter_fini(dict_iter_t di)
1557 di->dict = di->data = NULL;
1562 ht_diter_next(dict_iter_t di, Lisp_Object *key, Lisp_Object *val)
1564 hentry_t e = di->data;
1565 const hash_table_t ht = (hash_table_t)di->dict;
1567 if (UNLIKELY(e == NULL)) {
1568 *key = *val = Qnull_pointer;
1575 /* wind to next hentry */
1576 for (const hentry_t last = ht->hentries + ht->size; ++e < last;) {
1577 if (!HENTRY_CLEAR_P(e)) {
1587 ht_siter_next(seq_iter_t si, void **elm)
1589 hentry_t e = si->data;
1590 const hash_table_t ht = (hash_table_t)si->seq;
1592 if (UNLIKELY(e == NULL)) {
1593 *elm = Qnull_pointer;
1597 *elm = (void*)e->key;
1599 /* wind to next hentry */
1600 for (const hentry_t last = ht->hentries + ht->size; ++e < last;) {
1601 if (!HENTRY_CLEAR_P(e)) {
1611 ht_iter_reset(seq_iter_t si)
1613 const hash_table_t ht = (hash_table_t)si->seq;
1615 for (hentry_t e = ht->hentries, sntl = e + ht->size; e < sntl; e++) {
1616 if (!HENTRY_CLEAR_P(e)) {
1626 ht_explode(void *restrict tgt[], size_t ntgt, seq_t s)
1628 volatile size_t i = 0;
1629 const hash_table_t ht = (hash_table_t)s;
1631 for (hentry_t e = ht->hentries, sntl = e + ht->size;
1632 e < sntl && i < ntgt; e++) {
1633 if (!HENTRY_CLEAR_P(e)) {
1634 tgt[i++] = (void*)e->key;
1641 /************************************************************************/
1642 /* initialization */
1643 /************************************************************************/
1645 static struct seq_impl_s __shash_table = {
1646 .length_f = (seq_length_f)dict_ht_size,
1647 .iter_init_f = (seq_iter_init_f)ht_iter_init,
1648 .iter_next_f = ht_siter_next,
1649 .iter_fini_f = (seq_iter_fini_f)ht_iter_fini,
1650 .iter_reset_f = ht_iter_reset,
1651 .explode_f = ht_explode,
1654 static struct dict_impl_s __dhash_table = {
1655 .size_f = (dict_size_f)dict_ht_size,
1656 .put_f = (dict_put_f)dict_ht_put,
1657 .get_f = (dict_get_f)dict_ht_get,
1658 .remove_f = (dict_remove_f)dict_ht_remove,
1659 .iter_init_f = ht_iter_init,
1660 .iter_next_f = ht_diter_next,
1661 .iter_fini_f = ht_iter_fini,
1664 /* deal with seq interface */
1665 const seq_impl_t seq_hash_table = &__shash_table;
1666 /* deal with dict interface */
1667 const dict_impl_t dict_hash_table = &__dhash_table;
1669 void syms_of_elhash(void)
1671 INIT_LRECORD_IMPLEMENTATION(hash_table);
1673 DEFSUBR(Fhash_table_p);
1674 DEFSUBR(Fmake_hash_table);
1675 DEFSUBR(Fcopy_hash_table);
1681 DEFSUBR(Fhash_table_count);
1682 DEFSUBR(Fhash_table_test);
1683 DEFSUBR(Fhash_table_size);
1684 DEFSUBR(Fhash_table_rehash_size);
1685 DEFSUBR(Fhash_table_rehash_threshold);
1686 DEFSUBR(Fhash_table_weakness);
1687 DEFSUBR(Fhash_table_type); /* obsolete */
1690 DEFSUBR(Finternal_hash_value);
1693 defsymbol(&Qhash_tablep, "hash-table-p");
1694 defsymbol(&Qhash_table, "hash-table");
1695 defsymbol(&Qhashtable, "hashtable");
1696 defsymbol(&Qweakness, "weakness");
1697 defsymbol(&Qvalue, "value");
1698 defsymbol(&Qkey_or_value, "key-or-value");
1699 defsymbol(&Qkey_and_value, "key-and-value");
1700 defsymbol(&Qrehash_size, "rehash-size");
1701 defsymbol(&Qrehash_threshold, "rehash-threshold");
1703 defsymbol(&Qweak, "weak"); /* obsolete */
1704 defsymbol(&Qkey_weak, "key-weak"); /* obsolete */
1705 defsymbol(&Qkey_or_value_weak, "key-or-value-weak"); /* obsolete */
1706 defsymbol(&Qvalue_weak, "value-weak"); /* obsolete */
1707 defsymbol(&Qnon_weak, "non-weak"); /* obsolete */
1709 defkeyword(&Q_test, ":test");
1710 defkeyword(&Q_size, ":size");
1711 defkeyword(&Q_rehash_size, ":rehash-size");
1712 defkeyword(&Q_rehash_threshold, ":rehash-threshold");
1713 defkeyword(&Q_weakness, ":weakness");
1714 defkeyword(&Q_type, ":type"); /* obsolete */
1720 morphisms[lrecord_type_hash_table].seq_impl = seq_hash_table;
1721 morphisms[lrecord_type_hash_table].aset_impl = dict_hash_table;
1725 void vars_of_elhash(void)
1727 /* This must NOT be staticpro'd */
1728 Vall_weak_hash_tables = Qnil;
1729 dump_add_weak_object_chain(&Vall_weak_hash_tables);
1732 /* elhash.c ends here */