Mercurial > hg > xemacs-beta

comparison src/elhash.c @ 442:abe6d1db359e r21-2-36

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-36
author cvs
date Mon, 13 Aug 2007 11:35:02 +0200
parents 8de8e3f6228a
children 576fb035e263
comparison
equal deleted inserted replaced
441:72a7cfa4a488 442:abe6d1db359e
27 #include "bytecode.h" 27 #include "bytecode.h"
28 #include "elhash.h" 28 #include "elhash.h"
29 29
30 Lisp_Object Qhash_tablep; 30 Lisp_Object Qhash_tablep;
31 static Lisp_Object Qhashtable, Qhash_table; 31 static Lisp_Object Qhashtable, Qhash_table;
32 static Lisp_Object Qweakness, Qvalue; 32 static Lisp_Object Qweakness, Qvalue, Qkey_or_value, Qkey_and_value;
33 static Lisp_Object Vall_weak_hash_tables; 33 static Lisp_Object Vall_weak_hash_tables;
34 static Lisp_Object Qrehash_size, Qrehash_threshold; 34 static Lisp_Object Qrehash_size, Qrehash_threshold;
35 static Lisp_Object Q_size, Q_test, Q_weakness, Q_rehash_size, Q_rehash_threshold; 35 static Lisp_Object Q_size, Q_test, Q_weakness, Q_rehash_size, Q_rehash_threshold;
36 36
37 /* obsolete as of 19990901 in xemacs-21.2 */ 37 /* obsolete as of 19990901 in xemacs-21.2 */
38 static Lisp_Object Qweak, Qkey_weak, Qvalue_weak, Qnon_weak, Q_type; 38 static Lisp_Object Qweak, Qkey_weak, Qvalue_weak, Qkey_or_value_weak;
39 static Lisp_Object Qnon_weak, Q_type;
39 40
40 typedef struct hentry 41 typedef struct hentry
41 { 42 {
42 Lisp_Object key; 43 Lisp_Object key;
43 Lisp_Object value; 44 Lisp_Object value;
120 hash_table_size (size_t requested_size) 121 hash_table_size (size_t requested_size)
121 { 122 {
122 /* Return some prime near, but greater than or equal to, SIZE. 123 /* Return some prime near, but greater than or equal to, SIZE.
123 Decades from the time of writing, someone will have a system large 124 Decades from the time of writing, someone will have a system large
124 enough that the list below will be too short... */ 125 enough that the list below will be too short... */
125 static CONST size_t primes [] = 126 static const size_t primes [] =
126 { 127 {
127 19, 29, 41, 59, 79, 107, 149, 197, 263, 347, 457, 599, 787, 1031, 128 19, 29, 41, 59, 79, 107, 149, 197, 263, 347, 457, 599, 787, 1031,
128 1361, 1777, 2333, 3037, 3967, 5167, 6719, 8737, 11369, 14783, 129 1361, 1777, 2333, 3037, 3967, 5167, 6719, 8737, 11369, 14783,
129 19219, 24989, 32491, 42257, 54941, 71429, 92861, 120721, 156941, 130 19219, 24989, 32491, 42257, 54941, 71429, 92861, 120721, 156941,
130 204047, 265271, 344857, 448321, 582821, 757693, 985003, 1280519, 131 204047, 265271, 344857, 448321, 582821, 757693, 985003, 1280519,
250 return 0; /* Give up */ 251 return 0; /* Give up */
251 } 252 }
252 253
253 return 1; 254 return 1;
254 } 255 }
256
257 /* This is not a great hash function, but it _is_ correct and fast.
258 Examining all entries is too expensive, and examining a random
259 subset does not yield a correct hash function. */
260 static hashcode_t
261 hash_table_hash (Lisp_Object hash_table, int depth)
262 {
263 return XHASH_TABLE (hash_table)->count;
264 }
265
255 266
256 /* Printing hash tables. 267 /* Printing hash tables.
257 268
258 This is non-trivial, because we use a readable structure-style 269 This is non-trivial, because we use a readable structure-style
259 syntax for hash tables. This means that a typical hash table will be 270 syntax for hash tables. This means that a typical hash table will be
264 The supported hash table structure keywords and their values are: 275 The supported hash table structure keywords and their values are:
265 `test' (eql (or nil), eq or equal) 276 `test' (eql (or nil), eq or equal)
266 `size' (a natnum or nil) 277 `size' (a natnum or nil)
267 `rehash-size' (a float) 278 `rehash-size' (a float)
268 `rehash-threshold' (a float) 279 `rehash-threshold' (a float)
269 `weakness' (nil, t, key or value) 280 `weakness' (nil, key, value, key-and-value, or key-or-value)
270 `data' (a list) 281 `data' (a list)
271 282
272 If `print-readably' is nil, then a simpler syntax is used, for example 283 If `print-readably' is nil, then a simpler syntax is used, for example
273 284
274 #<hash-table size 2/13 data (key1 value1 key2 value2) 0x874d> 285 #<hash-table size 2/13 data (key1 value1 key2 value2) 0x874d>
339 } 350 }
340 351
341 if (ht->weakness != HASH_TABLE_NON_WEAK) 352 if (ht->weakness != HASH_TABLE_NON_WEAK)
342 { 353 {
343 sprintf (buf, " weakness %s", 354 sprintf (buf, " weakness %s",
344 (ht->weakness == HASH_TABLE_WEAK ? "t" : 355 (ht->weakness == HASH_TABLE_WEAK ? "key-and-value" :
345 ht->weakness == HASH_TABLE_KEY_WEAK ? "key" : 356 ht->weakness == HASH_TABLE_KEY_WEAK ? "key" :
346 ht->weakness == HASH_TABLE_VALUE_WEAK ? "value" : 357 ht->weakness == HASH_TABLE_VALUE_WEAK ? "value" :
358 ht->weakness == HASH_TABLE_KEY_VALUE_WEAK ? "key-or-value" :
347 "you-d-better-not-see-this")); 359 "you-d-better-not-see-this"));
348 write_c_string (buf, printcharfun); 360 write_c_string (buf, printcharfun);
349 } 361 }
350 362
351 if (ht->count) 363 if (ht->count)
391 }; 403 };
392 404
393 DEFINE_LRECORD_IMPLEMENTATION ("hash-table", hash_table, 405 DEFINE_LRECORD_IMPLEMENTATION ("hash-table", hash_table,
394 mark_hash_table, print_hash_table, 406 mark_hash_table, print_hash_table,
395 finalize_hash_table, 407 finalize_hash_table,
396 /* #### Implement hash_table_hash()! */ 408 hash_table_equal, hash_table_hash,
397 hash_table_equal, 0,
398 hash_table_description, 409 hash_table_description,
399 Lisp_Hash_Table); 410 Lisp_Hash_Table);
400 411
401 static Lisp_Hash_Table * 412 static Lisp_Hash_Table *
402 xhash_table (Lisp_Object hash_table) 413 xhash_table (Lisp_Object hash_table)
528 539
529 static int 540 static int
530 hash_table_weakness_validate (Lisp_Object keyword, Lisp_Object value, 541 hash_table_weakness_validate (Lisp_Object keyword, Lisp_Object value,
531 Error_behavior errb) 542 Error_behavior errb)
532 { 543 {
533 if (EQ (value, Qnil)) return 1; 544 if (EQ (value, Qnil)) return 1;
534 if (EQ (value, Qt)) return 1; 545 if (EQ (value, Qt)) return 1;
535 if (EQ (value, Qkey)) return 1; 546 if (EQ (value, Qkey)) return 1;
536 if (EQ (value, Qvalue)) return 1; 547 if (EQ (value, Qkey_and_value)) return 1;
548 if (EQ (value, Qkey_or_value)) return 1;
549 if (EQ (value, Qvalue)) return 1;
537 550
538 /* Following values are obsolete as of 19990901 in xemacs-21.2 */ 551 /* Following values are obsolete as of 19990901 in xemacs-21.2 */
539 if (EQ (value, Qnon_weak)) return 1; 552 if (EQ (value, Qnon_weak)) return 1;
540 if (EQ (value, Qweak)) return 1; 553 if (EQ (value, Qweak)) return 1;
541 if (EQ (value, Qkey_weak)) return 1; 554 if (EQ (value, Qkey_weak)) return 1;
542 if (EQ (value, Qvalue_weak)) return 1; 555 if (EQ (value, Qkey_or_value_weak)) return 1;
556 if (EQ (value, Qvalue_weak)) return 1;
543 557
544 maybe_signal_simple_error ("Invalid hash table weakness", 558 maybe_signal_simple_error ("Invalid hash table weakness",
545 value, Qhash_table, errb); 559 value, Qhash_table, errb);
546 return 0; 560 return 0;
547 } 561 }
548 562
549 static enum hash_table_weakness 563 static enum hash_table_weakness
550 decode_hash_table_weakness (Lisp_Object obj) 564 decode_hash_table_weakness (Lisp_Object obj)
551 { 565 {
552 if (EQ (obj, Qnil)) return HASH_TABLE_NON_WEAK; 566 if (EQ (obj, Qnil)) return HASH_TABLE_NON_WEAK;
553 if (EQ (obj, Qt)) return HASH_TABLE_WEAK; 567 if (EQ (obj, Qt)) return HASH_TABLE_WEAK;
554 if (EQ (obj, Qkey)) return HASH_TABLE_KEY_WEAK; 568 if (EQ (obj, Qkey_and_value)) return HASH_TABLE_WEAK;
555 if (EQ (obj, Qvalue)) return HASH_TABLE_VALUE_WEAK; 569 if (EQ (obj, Qkey)) return HASH_TABLE_KEY_WEAK;
570 if (EQ (obj, Qkey_or_value)) return HASH_TABLE_KEY_VALUE_WEAK;
571 if (EQ (obj, Qvalue)) return HASH_TABLE_VALUE_WEAK;
556 572
557 /* Following values are obsolete as of 19990901 in xemacs-21.2 */ 573 /* Following values are obsolete as of 19990901 in xemacs-21.2 */
558 if (EQ (obj, Qnon_weak)) return HASH_TABLE_NON_WEAK; 574 if (EQ (obj, Qnon_weak)) return HASH_TABLE_NON_WEAK;
559 if (EQ (obj, Qweak)) return HASH_TABLE_WEAK; 575 if (EQ (obj, Qweak)) return HASH_TABLE_WEAK;
560 if (EQ (obj, Qkey_weak)) return HASH_TABLE_KEY_WEAK; 576 if (EQ (obj, Qkey_weak)) return HASH_TABLE_KEY_WEAK;
561 if (EQ (obj, Qvalue_weak)) return HASH_TABLE_VALUE_WEAK; 577 if (EQ (obj, Qkey_or_value_weak)) return HASH_TABLE_KEY_VALUE_WEAK;
578 if (EQ (obj, Qvalue_weak)) return HASH_TABLE_VALUE_WEAK;
562 579
563 signal_simple_error ("Invalid hash table weakness", obj); 580 signal_simple_error ("Invalid hash table weakness", obj);
564 return HASH_TABLE_NON_WEAK; /* not reached */ 581 return HASH_TABLE_NON_WEAK; /* not reached */
565 } 582 }
566 583
789 the factor by which to increase the size of the hash table when enlarging. 806 the factor by which to increase the size of the hash table when enlarging.
790 807
791 Keyword :rehash-threshold must be a float between 0.0 and 1.0, 808 Keyword :rehash-threshold must be a float between 0.0 and 1.0,
792 and specifies the load factor of the hash table which triggers enlarging. 809 and specifies the load factor of the hash table which triggers enlarging.
793 810
794 Non-standard keyword :weakness can be `nil' (default), `t', `key' or `value'. 811 Non-standard keyword :weakness can be `nil' (default), `t', `key-and-value',
795 812 `key', `value' or `key-or-value'. `t' is an alias for `key-and-value'.
796 A weak hash table is one whose pointers do not count as GC referents: 813
797 for any key-value pair in the hash table, if the only remaining pointer 814 A key-and-value-weak hash table, also known as a fully-weak or simply
798 to either the key or the value is in a weak hash table, then the pair 815 as a weak hash table, is one whose pointers do not count as GC
799 will be removed from the hash table, and the key and value collected. 816 referents: for any key-value pair in the hash table, if the only
800 A non-weak hash table (or any other pointer) would prevent the object 817 remaining pointer to either the key or the value is in a weak hash
801 from being collected. 818 table, then the pair will be removed from the hash table, and the key
819 and value collected. A non-weak hash table (or any other pointer)
820 would prevent the object from being collected.
802 821
803 A key-weak hash table is similar to a fully-weak hash table except that 822 A key-weak hash table is similar to a fully-weak hash table except that
804 a key-value pair will be removed only if the key remains unmarked 823 a key-value pair will be removed only if the key remains unmarked
805 outside of weak hash tables. The pair will remain in the hash table if 824 outside of weak hash tables. The pair will remain in the hash table if
806 the key is pointed to by something other than a weak hash table, even 825 the key is pointed to by something other than a weak hash table, even
809 A value-weak hash table is similar to a fully-weak hash table except 828 A value-weak hash table is similar to a fully-weak hash table except
810 that a key-value pair will be removed only if the value remains 829 that a key-value pair will be removed only if the value remains
811 unmarked outside of weak hash tables. The pair will remain in the 830 unmarked outside of weak hash tables. The pair will remain in the
812 hash table if the value is pointed to by something other than a weak 831 hash table if the value is pointed to by something other than a weak
813 hash table, even if the key is not. 832 hash table, even if the key is not.
833
834 A key-or-value-weak hash table is similar to a fully-weak hash table except
835 that a key-value pair will be removed only if the value and the key remain
836 unmarked outside of weak hash tables. The pair will remain in the
837 hash table if the value or key are pointed to by something other than a weak
838 hash table, even if the other is not.
814 */ 839 */
815 (int nargs, Lisp_Object *args)) 840 (int nargs, Lisp_Object *args))
816 { 841 {
817 int i = 0; 842 int i = 0;
818 Lisp_Object test = Qnil; 843 Lisp_Object test = Qnil;
859 Return a new hash table containing the same keys and values as HASH-TABLE. 884 Return a new hash table containing the same keys and values as HASH-TABLE.
860 The keys and values will not themselves be copied. 885 The keys and values will not themselves be copied.
861 */ 886 */
862 (hash_table)) 887 (hash_table))
863 { 888 {
864 CONST Lisp_Hash_Table *ht_old = xhash_table (hash_table); 889 const Lisp_Hash_Table *ht_old = xhash_table (hash_table);
865 Lisp_Hash_Table *ht = alloc_lcrecord_type (Lisp_Hash_Table, &lrecord_hash_table); 890 Lisp_Hash_Table *ht = alloc_lcrecord_type (Lisp_Hash_Table, &lrecord_hash_table);
866 891
867 copy_lcrecord (ht, ht_old); 892 copy_lcrecord (ht, ht_old);
868 893
869 ht->hentries = xnew_array (hentry, ht_old->size + 1); 894 ht->hentries = xnew_array (hentry, ht_old->size + 1);
913 portable dumper, it contains the same objects, but their addresses 938 portable dumper, it contains the same objects, but their addresses
914 and thus their HASH_CODEs have changed. */ 939 and thus their HASH_CODEs have changed. */
915 void 940 void
916 pdump_reorganize_hash_table (Lisp_Object hash_table) 941 pdump_reorganize_hash_table (Lisp_Object hash_table)
917 { 942 {
918 CONST Lisp_Hash_Table *ht = xhash_table (hash_table); 943 const Lisp_Hash_Table *ht = xhash_table (hash_table);
919 hentry *new_entries = xnew_array_and_zero (hentry, ht->size + 1); 944 hentry *new_entries = xnew_array_and_zero (hentry, ht->size + 1);
920 hentry *e, *sentinel; 945 hentry *e, *sentinel;
921 946
922 for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) 947 for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++)
923 if (!HENTRY_CLEAR_P (e)) 948 if (!HENTRY_CLEAR_P (e))
940 hash_table_size ((size_t) ((double) ht->size * ht->rehash_size)); 965 hash_table_size ((size_t) ((double) ht->size * ht->rehash_size));
941 resize_hash_table (ht, new_size); 966 resize_hash_table (ht, new_size);
942 } 967 }
943 968
944 static hentry * 969 static hentry *
945 find_hentry (Lisp_Object key, CONST Lisp_Hash_Table *ht) 970 find_hentry (Lisp_Object key, const Lisp_Hash_Table *ht)
946 { 971 {
947 hash_table_test_function_t test_function = ht->test_function; 972 hash_table_test_function_t test_function = ht->test_function;
948 hentry *entries = ht->hentries; 973 hentry *entries = ht->hentries;
949 hentry *probe = entries + HASH_CODE (key, ht); 974 hentry *probe = entries + HASH_CODE (key, ht);
950 975
959 Find hash value for KEY in HASH-TABLE. 984 Find hash value for KEY in HASH-TABLE.
960 If there is no corresponding value, return DEFAULT (which defaults to nil). 985 If there is no corresponding value, return DEFAULT (which defaults to nil).
961 */ 986 */
962 (key, hash_table, default_)) 987 (key, hash_table, default_))
963 { 988 {
964 CONST Lisp_Hash_Table *ht = xhash_table (hash_table); 989 const Lisp_Hash_Table *ht = xhash_table (hash_table);
965 hentry *e = find_hentry (key, ht); 990 hentry *e = find_hentry (key, ht);
966 991
967 return HENTRY_CLEAR_P (e) ? default_ : e->value; 992 return HENTRY_CLEAR_P (e) ? default_ : e->value;
968 } 993 }
969 994
1098 return make_float (xhash_table (hash_table)->rehash_threshold); 1123 return make_float (xhash_table (hash_table)->rehash_threshold);
1099 } 1124 }
1100 1125
1101 DEFUN ("hash-table-weakness", Fhash_table_weakness, 1, 1, 0, /* 1126 DEFUN ("hash-table-weakness", Fhash_table_weakness, 1, 1, 0, /*
1102 Return the weakness of HASH-TABLE. 1127 Return the weakness of HASH-TABLE.
1103 This can be one of `nil', `t', `key' or `value'. 1128 This can be one of `nil', `key-and-value', `key-or-value', `key' or `value'.
1104 */ 1129 */
1105 (hash_table)) 1130 (hash_table))
1106 { 1131 {
1107 switch (xhash_table (hash_table)->weakness) 1132 switch (xhash_table (hash_table)->weakness)
1108 { 1133 {
1109 case HASH_TABLE_WEAK: return Qt; 1134 case HASH_TABLE_WEAK: return Qkey_and_value;
1110 case HASH_TABLE_KEY_WEAK: return Qkey; 1135 case HASH_TABLE_KEY_WEAK: return Qkey;
1111 case HASH_TABLE_VALUE_WEAK: return Qvalue; 1136 case HASH_TABLE_KEY_VALUE_WEAK: return Qkey_or_value;
1112 default: return Qnil; 1137 case HASH_TABLE_VALUE_WEAK: return Qvalue;
1138 default: return Qnil;
1113 } 1139 }
1114 } 1140 }
1115 1141
1116 /* obsolete as of 19990901 in xemacs-21.2 */ 1142 /* obsolete as of 19990901 in xemacs-21.2 */
1117 DEFUN ("hash-table-type", Fhash_table_type, 1, 1, 0, /* 1143 DEFUN ("hash-table-type", Fhash_table_type, 1, 1, 0, /*
1120 */ 1146 */
1121 (hash_table)) 1147 (hash_table))
1122 { 1148 {
1123 switch (xhash_table (hash_table)->weakness) 1149 switch (xhash_table (hash_table)->weakness)
1124 { 1150 {
1125 case HASH_TABLE_WEAK: return Qweak; 1151 case HASH_TABLE_WEAK: return Qweak;
1126 case HASH_TABLE_KEY_WEAK: return Qkey_weak; 1152 case HASH_TABLE_KEY_WEAK: return Qkey_weak;
1127 case HASH_TABLE_VALUE_WEAK: return Qvalue_weak; 1153 case HASH_TABLE_KEY_VALUE_WEAK: return Qkey_or_value_weak;
1128 default: return Qnon_weak; 1154 case HASH_TABLE_VALUE_WEAK: return Qvalue_weak;
1155 default: return Qnon_weak;
1129 } 1156 }
1130 } 1157 }
1131 1158
1132 /************************************************************************/ 1159 /************************************************************************/
1133 /* Mapping Functions */ 1160 /* Mapping Functions */
1139 FUNCTION may not modify HASH-TABLE, with the one exception that FUNCTION 1166 FUNCTION may not modify HASH-TABLE, with the one exception that FUNCTION
1140 may remhash or puthash the entry currently being processed by FUNCTION. 1167 may remhash or puthash the entry currently being processed by FUNCTION.
1141 */ 1168 */
1142 (function, hash_table)) 1169 (function, hash_table))
1143 { 1170 {
1144 CONST Lisp_Hash_Table *ht = xhash_table (hash_table); 1171 const Lisp_Hash_Table *ht = xhash_table (hash_table);
1145 CONST hentry *e, *sentinel; 1172 const hentry *e, *sentinel;
1146 1173
1147 for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) 1174 for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++)
1148 if (!HENTRY_CLEAR_P (e)) 1175 if (!HENTRY_CLEAR_P (e))
1149 { 1176 {
1150 Lisp_Object args[3], key; 1177 Lisp_Object args[3], key;
1165 /* Map *C* function FUNCTION over the elements of a lisp hash table. */ 1192 /* Map *C* function FUNCTION over the elements of a lisp hash table. */
1166 void 1193 void
1167 elisp_maphash (maphash_function_t function, 1194 elisp_maphash (maphash_function_t function,
1168 Lisp_Object hash_table, void *extra_arg) 1195 Lisp_Object hash_table, void *extra_arg)
1169 { 1196 {
1170 CONST Lisp_Hash_Table *ht = XHASH_TABLE (hash_table); 1197 const Lisp_Hash_Table *ht = XHASH_TABLE (hash_table);
1171 CONST hentry *e, *sentinel; 1198 const hentry *e, *sentinel;
1172 1199
1173 for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) 1200 for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++)
1174 if (!HENTRY_CLEAR_P (e)) 1201 if (!HENTRY_CLEAR_P (e))
1175 { 1202 {
1176 Lisp_Object key; 1203 Lisp_Object key;
1207 1234
1208 1235
1209 /************************************************************************/ 1236 /************************************************************************/
1210 /* garbage collecting weak hash tables */ 1237 /* garbage collecting weak hash tables */
1211 /************************************************************************/ 1238 /************************************************************************/
1239 #define MARK_OBJ(obj) do { \
1240 Lisp_Object mo_obj = (obj); \
1241 if (!marked_p (mo_obj)) \
1242 { \
1243 mark_object (mo_obj); \
1244 did_mark = 1; \
1245 } \
1246 } while (0)
1247
1212 1248
1213 /* Complete the marking for semi-weak hash tables. */ 1249 /* Complete the marking for semi-weak hash tables. */
1214 int 1250 int
1215 finish_marking_weak_hash_tables (void) 1251 finish_marking_weak_hash_tables (void)
1216 { 1252 {
1219 1255
1220 for (hash_table = Vall_weak_hash_tables; 1256 for (hash_table = Vall_weak_hash_tables;
1221 !NILP (hash_table); 1257 !NILP (hash_table);
1222 hash_table = XHASH_TABLE (hash_table)->next_weak) 1258 hash_table = XHASH_TABLE (hash_table)->next_weak)
1223 { 1259 {
1224 CONST Lisp_Hash_Table *ht = XHASH_TABLE (hash_table); 1260 const Lisp_Hash_Table *ht = XHASH_TABLE (hash_table);
1225 CONST hentry *e = ht->hentries; 1261 const hentry *e = ht->hentries;
1226 CONST hentry *sentinel = e + ht->size; 1262 const hentry *sentinel = e + ht->size;
1227 1263
1228 if (! marked_p (hash_table)) 1264 if (! marked_p (hash_table))
1229 /* The hash table is probably garbage. Ignore it. */ 1265 /* The hash table is probably garbage. Ignore it. */
1230 continue; 1266 continue;
1231 1267
1232 /* Now, scan over all the pairs. For all pairs that are 1268 /* Now, scan over all the pairs. For all pairs that are
1233 half-marked, we may need to mark the other half if we're 1269 half-marked, we may need to mark the other half if we're
1234 keeping this pair. */ 1270 keeping this pair. */
1235 #define MARK_OBJ(obj) \
1236 do { if (!marked_p (obj)) mark_object (obj), did_mark = 1; } while (0)
1237
1238 switch (ht->weakness) 1271 switch (ht->weakness)
1239 { 1272 {
1240 case HASH_TABLE_KEY_WEAK: 1273 case HASH_TABLE_KEY_WEAK:
1241 for (; e < sentinel; e++) 1274 for (; e < sentinel; e++)
1242 if (!HENTRY_CLEAR_P (e)) 1275 if (!HENTRY_CLEAR_P (e))
1247 case HASH_TABLE_VALUE_WEAK: 1280 case HASH_TABLE_VALUE_WEAK:
1248 for (; e < sentinel; e++) 1281 for (; e < sentinel; e++)
1249 if (!HENTRY_CLEAR_P (e)) 1282 if (!HENTRY_CLEAR_P (e))
1250 if (marked_p (e->value)) 1283 if (marked_p (e->value))
1251 MARK_OBJ (e->key); 1284 MARK_OBJ (e->key);
1285 break;
1286
1287 case HASH_TABLE_KEY_VALUE_WEAK:
1288 for (; e < sentinel; e++)
1289 if (!HENTRY_CLEAR_P (e))
1290 {
1291 if (marked_p (e->value))
1292 MARK_OBJ (e->key);
1293 else if (marked_p (e->key))
1294 MARK_OBJ (e->value);
1295 }
1252 break; 1296 break;
1253 1297
1254 case HASH_TABLE_KEY_CAR_WEAK: 1298 case HASH_TABLE_KEY_CAR_WEAK:
1255 for (; e < sentinel; e++) 1299 for (; e < sentinel; e++)
1256 if (!HENTRY_CLEAR_P (e)) 1300 if (!HENTRY_CLEAR_P (e))
1326 1370
1327 hashcode_t 1371 hashcode_t
1328 internal_array_hash (Lisp_Object *arr, int size, int depth) 1372 internal_array_hash (Lisp_Object *arr, int size, int depth)
1329 { 1373 {
1330 int i; 1374 int i;
1331 unsigned long hash = 0; 1375 hashcode_t hash = 0;
1376 depth++;
1332 1377
1333 if (size <= 5) 1378 if (size <= 5)
1334 { 1379 {
1335 for (i = 0; i < size; i++) 1380 for (i = 0; i < size; i++)
1336 hash = HASH2 (hash, internal_hash (arr[i], depth + 1)); 1381 hash = HASH2 (hash, internal_hash (arr[i], depth));
1337 return hash; 1382 return hash;
1338 } 1383 }
1339 1384
1340 /* just pick five elements scattered throughout the array. 1385 /* just pick five elements scattered throughout the array.
1341 A slightly better approach would be to offset by some 1386 A slightly better approach would be to offset by some
1342 noise factor from the points chosen below. */ 1387 noise factor from the points chosen below. */
1343 for (i = 0; i < 5; i++) 1388 for (i = 0; i < 5; i++)
1344 hash = HASH2 (hash, internal_hash (arr[i*size/5], depth + 1)); 1389 hash = HASH2 (hash, internal_hash (arr[i*size/5], depth));
1345 1390
1346 return hash; 1391 return hash;
1347 } 1392 }
1348 1393
1349 /* Return a hash value for a Lisp_Object. This is for use when hashing 1394 /* Return a hash value for a Lisp_Object. This is for use when hashing
1372 } 1417 }
1373 if (STRINGP (obj)) 1418 if (STRINGP (obj))
1374 { 1419 {
1375 return hash_string (XSTRING_DATA (obj), XSTRING_LENGTH (obj)); 1420 return hash_string (XSTRING_DATA (obj), XSTRING_LENGTH (obj));
1376 } 1421 }
1377 if (VECTORP (obj))
1378 {
1379 return HASH2 (XVECTOR_LENGTH (obj),
1380 internal_array_hash (XVECTOR_DATA (obj),
1381 XVECTOR_LENGTH (obj),
1382 depth + 1));
1383 }
1384 if (LRECORDP (obj)) 1422 if (LRECORDP (obj))
1385 { 1423 {
1386 CONST struct lrecord_implementation 1424 const struct lrecord_implementation
1387 *imp = XRECORD_LHEADER_IMPLEMENTATION (obj); 1425 *imp = XRECORD_LHEADER_IMPLEMENTATION (obj);
1388 if (imp->hash) 1426 if (imp->hash)
1389 return imp->hash (obj, depth); 1427 return imp->hash (obj, depth);
1390 } 1428 }
1391 1429
1407 The value is returned as (HIGH . LOW). 1445 The value is returned as (HIGH . LOW).
1408 */ 1446 */
1409 (object)) 1447 (object))
1410 { 1448 {
1411 /* This function is pretty 32bit-centric. */ 1449 /* This function is pretty 32bit-centric. */
1412 unsigned long hash = internal_hash (object, 0); 1450 hashcode_t hash = internal_hash (object, 0);
1413 return Fcons (hash >> 16, hash & 0xffff); 1451 return Fcons (hash >> 16, hash & 0xffff);
1414 } 1452 }
1415 #endif 1453 #endif
1416 1454
1417 1455
1420 /************************************************************************/ 1458 /************************************************************************/
1421 1459
1422 void 1460 void
1423 syms_of_elhash (void) 1461 syms_of_elhash (void)
1424 { 1462 {
1463 INIT_LRECORD_IMPLEMENTATION (hash_table);
1464
1425 DEFSUBR (Fhash_table_p); 1465 DEFSUBR (Fhash_table_p);
1426 DEFSUBR (Fmake_hash_table); 1466 DEFSUBR (Fmake_hash_table);
1427 DEFSUBR (Fcopy_hash_table); 1467 DEFSUBR (Fcopy_hash_table);
1428 DEFSUBR (Fgethash); 1468 DEFSUBR (Fgethash);
1429 DEFSUBR (Fremhash); 1469 DEFSUBR (Fremhash);
1445 defsymbol (&Qhash_tablep, "hash-table-p"); 1485 defsymbol (&Qhash_tablep, "hash-table-p");
1446 defsymbol (&Qhash_table, "hash-table"); 1486 defsymbol (&Qhash_table, "hash-table");
1447 defsymbol (&Qhashtable, "hashtable"); 1487 defsymbol (&Qhashtable, "hashtable");
1448 defsymbol (&Qweakness, "weakness"); 1488 defsymbol (&Qweakness, "weakness");
1449 defsymbol (&Qvalue, "value"); 1489 defsymbol (&Qvalue, "value");
1490 defsymbol (&Qkey_or_value, "key-or-value");
1491 defsymbol (&Qkey_and_value, "key-and-value");
1450 defsymbol (&Qrehash_size, "rehash-size"); 1492 defsymbol (&Qrehash_size, "rehash-size");
1451 defsymbol (&Qrehash_threshold, "rehash-threshold"); 1493 defsymbol (&Qrehash_threshold, "rehash-threshold");
1452 1494
1453 defsymbol (&Qweak, "weak"); /* obsolete */ 1495 defsymbol (&Qweak, "weak"); /* obsolete */
1454 defsymbol (&Qkey_weak, "key-weak"); /* obsolete */ 1496 defsymbol (&Qkey_weak, "key-weak"); /* obsolete */
1497 defsymbol (&Qkey_or_value_weak, "key-or-value-weak"); /* obsolete */
1455 defsymbol (&Qvalue_weak, "value-weak"); /* obsolete */ 1498 defsymbol (&Qvalue_weak, "value-weak"); /* obsolete */
1456 defsymbol (&Qnon_weak, "non-weak"); /* obsolete */ 1499 defsymbol (&Qnon_weak, "non-weak"); /* obsolete */
1457 1500
1458 defkeyword (&Q_test, ":test"); 1501 defkeyword (&Q_test, ":test");
1459 defkeyword (&Q_size, ":size"); 1502 defkeyword (&Q_size, ":size");