Mercurial > hg > xemacs-beta
annotate src/elhash.c @ 4614:afbfad080ddd
The URLs in our current config.guess and config.sub files are obsolete.
Update to the latest upstream release to get correct URLs, as well as fixes
and enhancements to those scripts.
| author | Jerry James <james@xemacs.org> |
|---|---|
| date | Wed, 11 Feb 2009 11:09:35 -0700 |
| parents | 871eb054b34a |
| children | 80cd90837ac5 |
| rev | line source |
|---|---|
| 428 | 1 /* Implementation of the hash table lisp object type. |
| 2 Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. | |
| 2421 | 3 Copyright (C) 1995, 1996, 2002, 2004 Ben Wing. |
| 428 | 4 Copyright (C) 1997 Free Software Foundation, Inc. |
| 5 | |
| 6 This file is part of XEmacs. | |
| 7 | |
| 8 XEmacs is free software; you can redistribute it and/or modify it | |
| 9 under the terms of the GNU General Public License as published by the | |
| 10 Free Software Foundation; either version 2, or (at your option) any | |
| 11 later version. | |
| 12 | |
| 13 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 14 ANY WARRANTY; without even the implied warranty of MERCNTABILITY or | |
| 15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 16 for more details. | |
| 17 | |
| 18 You should have received a copy of the GNU General Public License | |
| 19 along with XEmacs; see the file COPYING. If not, write to | |
| 20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 21 Boston, MA 02111-1307, USA. */ | |
| 22 | |
| 23 /* Synched up with: Not in FSF. */ | |
| 24 | |
| 1292 | 25 /* Author: Lost in the mists of history. At least back to Lucid 19.3, |
| 26 circa Sep 1992. Early hash table implementation allowed only `eq' as a | |
| 27 test -- other tests possible only when these objects were created from | |
| 28 the C code. | |
| 29 | |
| 30 Expansion to allow general `equal'-test Lisp-creatable tables, and hash | |
| 31 methods for the various Lisp objects in existence at the time, added | |
| 32 during 19.12 I think (early 1995?), by Ben Wing. | |
| 33 | |
| 34 Weak hash tables added by Jamie (maybe?) early on, perhaps around 19.6, | |
| 35 maybe earlier; again, only possible through the C code, and only | |
| 36 supported fully weak hash tables. Expansion to other kinds of weakness, | |
| 37 and exporting of the interface to Lisp, by Ben Wing during 19.12 | |
| 38 (early-mid 1995) or maybe 19.13 cycle (mid 1995). | |
| 39 | |
| 40 Expansion to full Common Lisp spec and interface, redoing of the | |
| 41 implementation, by Martin Buchholz, 1997? (Former hash table | |
| 42 implementation used "double hashing", I'm pretty sure, and was weirdly | |
| 43 tied into the generic hash.c code. Martin completely separated them.) | |
| 44 */ | |
| 45 | |
| 489 | 46 /* This file implements the hash table lisp object type. |
| 47 | |
| 504 | 48 This implementation was mostly written by Martin Buchholz in 1997. |
| 49 | |
| 50 The Lisp-level API (derived from Common Lisp) is almost completely | |
| 51 compatible with GNU Emacs 21, even though the implementations are | |
| 52 totally independent. | |
| 53 | |
| 489 | 54 The hash table technique used is "linear probing". Collisions are |
| 55 resolved by putting the item in the next empty place in the array | |
| 56 following the collision. Finding a hash entry performs a linear | |
| 57 search in the cluster starting at the hash value. | |
| 58 | |
| 59 On deletions from the hash table, the entries immediately following | |
| 60 the deleted entry are re-entered in the hash table. We do not have | |
| 61 a special way to mark deleted entries (known as "tombstones"). | |
| 62 | |
| 63 At the end of the hash entries ("hentries"), we leave room for an | |
| 64 entry that is always empty (the "sentinel"). | |
| 65 | |
| 66 The traditional literature on hash table implementation | |
| 67 (e.g. Knuth) suggests that too much "primary clustering" occurs | |
| 68 with linear probing. However, this literature was written when | |
| 69 locality of reference was not a factor. The discrepancy between | |
| 70 CPU speeds and memory speeds is increasing, and the speed of access | |
| 71 to memory is highly dependent on memory caches which work best when | |
| 72 there is high locality of data reference. Random access to memory | |
| 73 is up to 20 times as expensive as access to the nearest address | |
| 74 (and getting worse). So linear probing makes sense. | |
| 75 | |
| 76 But the representation doesn't actually matter that much with the | |
| 77 current elisp engine. Funcall is sufficiently slow that the choice | |
| 78 of hash table implementation is noise. */ | |
| 79 | |
| 428 | 80 #include <config.h> |
| 81 #include "lisp.h" | |
| 82 #include "bytecode.h" | |
| 83 #include "elhash.h" | |
| 489 | 84 #include "opaque.h" |
| 428 | 85 |
| 86 Lisp_Object Qhash_tablep; | |
| 87 static Lisp_Object Qhashtable, Qhash_table; | |
| 442 | 88 static Lisp_Object Qweakness, Qvalue, Qkey_or_value, Qkey_and_value; |
| 428 | 89 static Lisp_Object Vall_weak_hash_tables; |
| 90 static Lisp_Object Qrehash_size, Qrehash_threshold; | |
| 91 static Lisp_Object Q_size, Q_test, Q_weakness, Q_rehash_size, Q_rehash_threshold; | |
| 92 | |
| 93 /* obsolete as of 19990901 in xemacs-21.2 */ | |
| 442 | 94 static Lisp_Object Qweak, Qkey_weak, Qvalue_weak, Qkey_or_value_weak; |
| 95 static Lisp_Object Qnon_weak, Q_type; | |
| 428 | 96 |
| 97 struct Lisp_Hash_Table | |
| 98 { | |
| 3017 | 99 struct LCRECORD_HEADER header; |
| 665 | 100 Elemcount size; |
| 101 Elemcount count; | |
| 102 Elemcount rehash_count; | |
| 428 | 103 double rehash_size; |
| 104 double rehash_threshold; | |
| 665 | 105 Elemcount golden_ratio; |
| 428 | 106 hash_table_hash_function_t hash_function; |
| 107 hash_table_test_function_t test_function; | |
| 1204 | 108 htentry *hentries; |
| 428 | 109 enum hash_table_weakness weakness; |
| 110 Lisp_Object next_weak; /* Used to chain together all of the weak | |
| 111 hash tables. Don't mark through this. */ | |
| 112 }; | |
| 113 | |
| 1204 | 114 #define CLEAR_HTENTRY(htentry) \ |
| 115 ((*(EMACS_UINT*)(&((htentry)->key))) = 0, \ | |
| 116 (*(EMACS_UINT*)(&((htentry)->value))) = 0) | |
| 428 | 117 |
| 118 #define HASH_TABLE_DEFAULT_SIZE 16 | |
| 119 #define HASH_TABLE_DEFAULT_REHASH_SIZE 1.3 | |
| 120 #define HASH_TABLE_MIN_SIZE 10 | |
| 121 | |
| 665 | 122 #define HASHCODE(key, ht) \ |
| 444 | 123 ((((ht)->hash_function ? (ht)->hash_function (key) : LISP_HASH (key)) \ |
| 124 * (ht)->golden_ratio) \ | |
| 125 % (ht)->size) | |
| 428 | 126 |
| 127 #define KEYS_EQUAL_P(key1, key2, testfun) \ | |
| 434 | 128 (EQ (key1, key2) || ((testfun) && (testfun) (key1, key2))) |
| 428 | 129 |
| 130 #define LINEAR_PROBING_LOOP(probe, entries, size) \ | |
| 131 for (; \ | |
| 1204 | 132 !HTENTRY_CLEAR_P (probe) || \ |
| 428 | 133 (probe == entries + size ? \ |
| 1204 | 134 (probe = entries, !HTENTRY_CLEAR_P (probe)) : 0); \ |
| 428 | 135 probe++) |
| 136 | |
| 800 | 137 #ifdef ERROR_CHECK_STRUCTURES |
| 428 | 138 static void |
| 139 check_hash_table_invariants (Lisp_Hash_Table *ht) | |
| 140 { | |
| 141 assert (ht->count < ht->size); | |
| 142 assert (ht->count <= ht->rehash_count); | |
| 143 assert (ht->rehash_count < ht->size); | |
| 144 assert ((double) ht->count * ht->rehash_threshold - 1 <= (double) ht->rehash_count); | |
| 1204 | 145 assert (HTENTRY_CLEAR_P (ht->hentries + ht->size)); |
| 428 | 146 } |
| 147 #else | |
| 148 #define check_hash_table_invariants(ht) | |
| 149 #endif | |
| 150 | |
| 151 /* Return a suitable size for a hash table, with at least SIZE slots. */ | |
| 665 | 152 static Elemcount |
| 153 hash_table_size (Elemcount requested_size) | |
| 428 | 154 { |
| 155 /* Return some prime near, but greater than or equal to, SIZE. | |
| 156 Decades from the time of writing, someone will have a system large | |
| 157 enough that the list below will be too short... */ | |
| 665 | 158 static const Elemcount primes [] = |
| 428 | 159 { |
| 160 19, 29, 41, 59, 79, 107, 149, 197, 263, 347, 457, 599, 787, 1031, | |
| 161 1361, 1777, 2333, 3037, 3967, 5167, 6719, 8737, 11369, 14783, | |
| 162 19219, 24989, 32491, 42257, 54941, 71429, 92861, 120721, 156941, | |
| 163 204047, 265271, 344857, 448321, 582821, 757693, 985003, 1280519, | |
| 164 1664681, 2164111, 2813353, 3657361, 4754591, 6180989, 8035301, | |
| 165 10445899, 13579681, 17653589, 22949669, 29834603, 38784989, | |
| 166 50420551, 65546729, 85210757, 110774011, 144006217, 187208107, | |
| 167 243370577, 316381771, 411296309, 534685237, 695090819, 903618083, | |
| 647 | 168 1174703521, 1527114613, 1985248999 /* , 2580823717UL, 3355070839UL */ |
| 428 | 169 }; |
| 170 /* We've heard of binary search. */ | |
| 171 int low, high; | |
| 172 for (low = 0, high = countof (primes) - 1; high - low > 1;) | |
| 173 { | |
| 174 /* Loop Invariant: size < primes [high] */ | |
| 175 int mid = (low + high) / 2; | |
| 176 if (primes [mid] < requested_size) | |
| 177 low = mid; | |
| 178 else | |
| 179 high = mid; | |
| 180 } | |
| 181 return primes [high]; | |
| 182 } | |
| 183 | |
| 184 | |
| 185 #if 0 /* I don't think these are needed any more. | |
| 186 If using the general lisp_object_equal_*() functions | |
| 187 causes efficiency problems, these can be resurrected. --ben */ | |
| 188 /* equality and hash functions for Lisp strings */ | |
| 189 int | |
| 190 lisp_string_equal (Lisp_Object str1, Lisp_Object str2) | |
| 191 { | |
| 192 /* This is wrong anyway. You can't use strcmp() on Lisp strings, | |
| 193 because they can contain zero characters. */ | |
| 194 return !strcmp ((char *) XSTRING_DATA (str1), (char *) XSTRING_DATA (str2)); | |
| 195 } | |
| 196 | |
| 665 | 197 static Hashcode |
| 428 | 198 lisp_string_hash (Lisp_Object obj) |
| 199 { | |
| 200 return hash_string (XSTRING_DATA (str), XSTRING_LENGTH (str)); | |
| 201 } | |
| 202 | |
| 203 #endif /* 0 */ | |
| 204 | |
| 205 static int | |
| 206 lisp_object_eql_equal (Lisp_Object obj1, Lisp_Object obj2) | |
| 207 { | |
| 208 return EQ (obj1, obj2) || (FLOATP (obj1) && internal_equal (obj1, obj2, 0)); | |
| 209 } | |
| 210 | |
| 665 | 211 static Hashcode |
| 428 | 212 lisp_object_eql_hash (Lisp_Object obj) |
| 213 { | |
| 214 return FLOATP (obj) ? internal_hash (obj, 0) : LISP_HASH (obj); | |
| 215 } | |
| 216 | |
| 217 static int | |
| 218 lisp_object_equal_equal (Lisp_Object obj1, Lisp_Object obj2) | |
| 219 { | |
| 220 return internal_equal (obj1, obj2, 0); | |
| 221 } | |
| 222 | |
| 665 | 223 static Hashcode |
| 428 | 224 lisp_object_equal_hash (Lisp_Object obj) |
| 225 { | |
| 226 return internal_hash (obj, 0); | |
| 227 } | |
| 228 | |
| 229 | |
| 230 static Lisp_Object | |
| 231 mark_hash_table (Lisp_Object obj) | |
| 232 { | |
| 233 Lisp_Hash_Table *ht = XHASH_TABLE (obj); | |
| 234 | |
| 235 /* If the hash table is weak, we don't want to mark the keys and | |
| 236 values (we scan over them after everything else has been marked, | |
| 237 and mark or remove them as necessary). */ | |
| 238 if (ht->weakness == HASH_TABLE_NON_WEAK) | |
| 239 { | |
| 1204 | 240 htentry *e, *sentinel; |
| 428 | 241 |
| 242 for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) | |
| 1204 | 243 if (!HTENTRY_CLEAR_P (e)) |
| 428 | 244 { |
| 245 mark_object (e->key); | |
| 246 mark_object (e->value); | |
| 247 } | |
| 248 } | |
| 249 return Qnil; | |
| 250 } | |
| 251 | |
| 252 /* Equality of hash tables. Two hash tables are equal when they are of | |
| 253 the same weakness and test function, they have the same number of | |
| 254 elements, and for each key in the hash table, the values are `equal'. | |
| 255 | |
| 256 This is similar to Common Lisp `equalp' of hash tables, with the | |
| 257 difference that CL requires the keys to be compared with the test | |
| 258 function, which we don't do. Doing that would require consing, and | |
| 259 consing is a bad idea in `equal'. Anyway, our method should provide | |
| 260 the same result -- if the keys are not equal according to the test | |
| 261 function, then Fgethash() in hash_table_equal_mapper() will fail. */ | |
| 262 static int | |
| 263 hash_table_equal (Lisp_Object hash_table1, Lisp_Object hash_table2, int depth) | |
| 264 { | |
| 265 Lisp_Hash_Table *ht1 = XHASH_TABLE (hash_table1); | |
| 266 Lisp_Hash_Table *ht2 = XHASH_TABLE (hash_table2); | |
| 1204 | 267 htentry *e, *sentinel; |
| 428 | 268 |
| 269 if ((ht1->test_function != ht2->test_function) || | |
| 270 (ht1->weakness != ht2->weakness) || | |
| 271 (ht1->count != ht2->count)) | |
| 272 return 0; | |
| 273 | |
| 274 depth++; | |
| 275 | |
| 276 for (e = ht1->hentries, sentinel = e + ht1->size; e < sentinel; e++) | |
| 1204 | 277 if (!HTENTRY_CLEAR_P (e)) |
| 428 | 278 /* Look up the key in the other hash table, and compare the values. */ |
| 279 { | |
| 280 Lisp_Object value_in_other = Fgethash (e->key, hash_table2, Qunbound); | |
| 281 if (UNBOUNDP (value_in_other) || | |
| 282 !internal_equal (e->value, value_in_other, depth)) | |
| 283 return 0; /* Give up */ | |
| 284 } | |
| 285 | |
| 286 return 1; | |
| 287 } | |
| 442 | 288 |
| 289 /* This is not a great hash function, but it _is_ correct and fast. | |
| 290 Examining all entries is too expensive, and examining a random | |
| 291 subset does not yield a correct hash function. */ | |
| 665 | 292 static Hashcode |
| 2286 | 293 hash_table_hash (Lisp_Object hash_table, int UNUSED (depth)) |
| 442 | 294 { |
| 295 return XHASH_TABLE (hash_table)->count; | |
| 296 } | |
| 297 | |
| 428 | 298 |
| 299 /* Printing hash tables. | |
| 300 | |
| 301 This is non-trivial, because we use a readable structure-style | |
| 302 syntax for hash tables. This means that a typical hash table will be | |
| 303 readably printed in the form of: | |
| 304 | |
| 305 #s(hash-table size 2 data (key1 value1 key2 value2)) | |
| 306 | |
| 307 The supported hash table structure keywords and their values are: | |
| 308 `test' (eql (or nil), eq or equal) | |
| 309 `size' (a natnum or nil) | |
| 310 `rehash-size' (a float) | |
| 311 `rehash-threshold' (a float) | |
| 442 | 312 `weakness' (nil, key, value, key-and-value, or key-or-value) |
| 428 | 313 `data' (a list) |
| 314 | |
| 430 | 315 If `print-readably' is nil, then a simpler syntax is used, for example |
| 428 | 316 |
| 317 #<hash-table size 2/13 data (key1 value1 key2 value2) 0x874d> | |
| 318 | |
| 319 The data is truncated to four pairs, and the rest is shown with | |
| 320 `...'. This printer does not cons. */ | |
| 321 | |
| 322 | |
| 323 /* Print the data of the hash table. This maps through a Lisp | |
| 324 hash table and prints key/value pairs using PRINTCHARFUN. */ | |
| 325 static void | |
| 326 print_hash_table_data (Lisp_Hash_Table *ht, Lisp_Object printcharfun) | |
| 327 { | |
| 328 int count = 0; | |
| 1204 | 329 htentry *e, *sentinel; |
| 428 | 330 |
| 826 | 331 write_c_string (printcharfun, " data ("); |
| 428 | 332 |
| 333 for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) | |
| 1204 | 334 if (!HTENTRY_CLEAR_P (e)) |
| 428 | 335 { |
| 336 if (count > 0) | |
| 826 | 337 write_c_string (printcharfun, " "); |
| 428 | 338 if (!print_readably && count > 3) |
| 339 { | |
| 826 | 340 write_c_string (printcharfun, "..."); |
| 428 | 341 break; |
| 342 } | |
| 343 print_internal (e->key, printcharfun, 1); | |
| 800 | 344 write_fmt_string_lisp (printcharfun, " %S", 1, e->value); |
| 428 | 345 count++; |
| 346 } | |
| 347 | |
| 826 | 348 write_c_string (printcharfun, ")"); |
| 428 | 349 } |
| 350 | |
| 351 static void | |
| 2286 | 352 print_hash_table (Lisp_Object obj, Lisp_Object printcharfun, |
| 353 int UNUSED (escapeflag)) | |
| 428 | 354 { |
| 355 Lisp_Hash_Table *ht = XHASH_TABLE (obj); | |
| 356 | |
| 826 | 357 write_c_string (printcharfun, |
| 358 print_readably ? "#s(hash-table" : "#<hash-table"); | |
| 428 | 359 |
| 360 /* These checks have a kludgy look to them, but they are safe. | |
| 361 Due to nature of hashing, you cannot use arbitrary | |
| 362 test functions anyway. */ | |
| 363 if (!ht->test_function) | |
| 826 | 364 write_c_string (printcharfun, " test eq"); |
| 428 | 365 else if (ht->test_function == lisp_object_equal_equal) |
| 826 | 366 write_c_string (printcharfun, " test equal"); |
| 428 | 367 else if (ht->test_function == lisp_object_eql_equal) |
| 368 DO_NOTHING; | |
| 369 else | |
| 2500 | 370 ABORT (); |
| 428 | 371 |
| 372 if (ht->count || !print_readably) | |
| 373 { | |
| 374 if (print_readably) | |
| 800 | 375 write_fmt_string (printcharfun, " size %ld", (long) ht->count); |
| 428 | 376 else |
| 800 | 377 write_fmt_string (printcharfun, " size %ld/%ld", (long) ht->count, |
| 378 (long) ht->size); | |
| 428 | 379 } |
| 380 | |
| 381 if (ht->weakness != HASH_TABLE_NON_WEAK) | |
| 382 { | |
| 800 | 383 write_fmt_string |
| 384 (printcharfun, " weakness %s", | |
| 385 (ht->weakness == HASH_TABLE_WEAK ? "key-and-value" : | |
| 386 ht->weakness == HASH_TABLE_KEY_WEAK ? "key" : | |
| 387 ht->weakness == HASH_TABLE_VALUE_WEAK ? "value" : | |
| 388 ht->weakness == HASH_TABLE_KEY_VALUE_WEAK ? "key-or-value" : | |
| 389 "you-d-better-not-see-this")); | |
| 428 | 390 } |
| 391 | |
| 392 if (ht->count) | |
| 393 print_hash_table_data (ht, printcharfun); | |
| 394 | |
| 395 if (print_readably) | |
| 826 | 396 write_c_string (printcharfun, ")"); |
| 428 | 397 else |
| 2421 | 398 write_fmt_string (printcharfun, " 0x%x>", ht->header.uid); |
| 428 | 399 } |
| 400 | |
| 4117 | 401 #ifndef NEW_GC |
| 428 | 402 static void |
| 4117 | 403 free_hentries (htentry *hentries, |
| 2333 | 404 #ifdef ERROR_CHECK_STRUCTURES |
| 405 size_t size | |
| 4117 | 406 #else /* not ERROR_CHECK_STRUCTURES) */ |
| 2333 | 407 size_t UNUSED (size) |
| 4117 | 408 #endif /* not ERROR_CHECK_STRUCTURES) */ |
| 2333 | 409 ) |
| 489 | 410 { |
| 800 | 411 #ifdef ERROR_CHECK_STRUCTURES |
| 489 | 412 /* Ensure a crash if other code uses the discarded entries afterwards. */ |
| 1204 | 413 htentry *e, *sentinel; |
| 489 | 414 |
| 415 for (e = hentries, sentinel = e + size; e < sentinel; e++) | |
| 1204 | 416 * (unsigned long *) e = 0xdeadbeef; /* -559038737 base 10 */ |
| 489 | 417 #endif |
| 418 | |
| 419 if (!DUMPEDP (hentries)) | |
| 1726 | 420 xfree (hentries, htentry *); |
| 489 | 421 } |
| 422 | |
| 423 static void | |
| 428 | 424 finalize_hash_table (void *header, int for_disksave) |
| 425 { | |
| 426 if (!for_disksave) | |
| 427 { | |
| 428 Lisp_Hash_Table *ht = (Lisp_Hash_Table *) header; | |
| 489 | 429 free_hentries (ht->hentries, ht->size); |
| 428 | 430 ht->hentries = 0; |
| 431 } | |
| 432 } | |
| 3263 | 433 #endif /* not NEW_GC */ |
| 428 | 434 |
| 1204 | 435 static const struct memory_description htentry_description_1[] = { |
| 436 { XD_LISP_OBJECT, offsetof (htentry, key) }, | |
| 437 { XD_LISP_OBJECT, offsetof (htentry, value) }, | |
| 428 | 438 { XD_END } |
| 439 }; | |
| 440 | |
| 1204 | 441 static const struct sized_memory_description htentry_description = { |
| 442 sizeof (htentry), | |
| 443 htentry_description_1 | |
| 428 | 444 }; |
| 445 | |
| 3092 | 446 #ifdef NEW_GC |
| 447 static const struct memory_description htentry_weak_description_1[] = { | |
| 448 { XD_LISP_OBJECT, offsetof (htentry, key), 0, { 0 }, XD_FLAG_NO_KKCC}, | |
| 449 { XD_LISP_OBJECT, offsetof (htentry, value), 0, { 0 }, XD_FLAG_NO_KKCC}, | |
| 450 { XD_END } | |
| 451 }; | |
| 452 | |
| 453 static const struct sized_memory_description htentry_weak_description = { | |
| 454 sizeof (htentry), | |
| 455 htentry_weak_description_1 | |
| 456 }; | |
| 457 | |
| 458 DEFINE_LRECORD_IMPLEMENTATION ("hash-table-entry", hash_table_entry, | |
| 459 1, /*dumpable-flag*/ | |
| 460 0, 0, 0, 0, 0, | |
| 461 htentry_description_1, | |
| 462 Lisp_Hash_Table_Entry); | |
| 463 #endif /* NEW_GC */ | |
| 464 | |
| 1204 | 465 static const struct memory_description htentry_union_description_1[] = { |
| 466 /* Note: XD_INDIRECT in this table refers to the surrounding table, | |
| 467 and so this will work. */ | |
| 3092 | 468 #ifdef NEW_GC |
| 469 { XD_LISP_OBJECT_BLOCK_PTR, HASH_TABLE_NON_WEAK, | |
| 470 XD_INDIRECT (0, 1), { &htentry_description } }, | |
| 471 { XD_LISP_OBJECT_BLOCK_PTR, 0, XD_INDIRECT (0, 1), | |
| 472 { &htentry_weak_description }, XD_FLAG_UNION_DEFAULT_ENTRY }, | |
| 473 #else /* not NEW_GC */ | |
| 2367 | 474 { XD_BLOCK_PTR, HASH_TABLE_NON_WEAK, XD_INDIRECT (0, 1), |
| 2551 | 475 { &htentry_description } }, |
| 476 { XD_BLOCK_PTR, 0, XD_INDIRECT (0, 1), { &htentry_description }, | |
| 1204 | 477 XD_FLAG_UNION_DEFAULT_ENTRY | XD_FLAG_NO_KKCC }, |
| 3092 | 478 #endif /* not NEW_GC */ |
| 1204 | 479 { XD_END } |
| 480 }; | |
| 481 | |
| 482 static const struct sized_memory_description htentry_union_description = { | |
| 483 sizeof (htentry *), | |
| 484 htentry_union_description_1 | |
| 485 }; | |
| 486 | |
| 487 const struct memory_description hash_table_description[] = { | |
| 488 { XD_ELEMCOUNT, offsetof (Lisp_Hash_Table, size) }, | |
| 489 { XD_INT, offsetof (Lisp_Hash_Table, weakness) }, | |
| 490 { XD_UNION, offsetof (Lisp_Hash_Table, hentries), XD_INDIRECT (1, 0), | |
| 2551 | 491 { &htentry_union_description } }, |
| 440 | 492 { XD_LO_LINK, offsetof (Lisp_Hash_Table, next_weak) }, |
| 428 | 493 { XD_END } |
| 494 }; | |
| 495 | |
| 3263 | 496 #ifdef NEW_GC |
| 497 DEFINE_LRECORD_IMPLEMENTATION ("hash-table", hash_table, | |
| 498 1, /*dumpable-flag*/ | |
| 499 mark_hash_table, print_hash_table, | |
| 500 0, hash_table_equal, hash_table_hash, | |
| 501 hash_table_description, | |
| 502 Lisp_Hash_Table); | |
| 503 #else /* not NEW_GC */ | |
| 934 | 504 DEFINE_LRECORD_IMPLEMENTATION ("hash-table", hash_table, |
| 505 1, /*dumpable-flag*/ | |
| 506 mark_hash_table, print_hash_table, | |
| 507 finalize_hash_table, | |
| 508 hash_table_equal, hash_table_hash, | |
| 509 hash_table_description, | |
| 510 Lisp_Hash_Table); | |
| 3263 | 511 #endif /* not NEW_GC */ |
| 428 | 512 |
| 513 static Lisp_Hash_Table * | |
| 514 xhash_table (Lisp_Object hash_table) | |
| 515 { | |
| 1123 | 516 /* #### What's going on here? Why the gc_in_progress check? */ |
| 428 | 517 if (!gc_in_progress) |
| 518 CHECK_HASH_TABLE (hash_table); | |
| 519 check_hash_table_invariants (XHASH_TABLE (hash_table)); | |
| 520 return XHASH_TABLE (hash_table); | |
| 521 } | |
| 522 | |
| 523 | |
| 524 /************************************************************************/ | |
| 525 /* Creation of Hash Tables */ | |
| 526 /************************************************************************/ | |
| 527 | |
| 528 /* Creation of hash tables, without error-checking. */ | |
| 529 static void | |
| 530 compute_hash_table_derived_values (Lisp_Hash_Table *ht) | |
| 531 { | |
| 665 | 532 ht->rehash_count = (Elemcount) |
| 438 | 533 ((double) ht->size * ht->rehash_threshold); |
| 665 | 534 ht->golden_ratio = (Elemcount) |
| 428 | 535 ((double) ht->size * (.6180339887 / (double) sizeof (Lisp_Object))); |
| 536 } | |
| 537 | |
| 538 Lisp_Object | |
| 450 | 539 make_standard_lisp_hash_table (enum hash_table_test test, |
| 665 | 540 Elemcount size, |
| 450 | 541 double rehash_size, |
| 542 double rehash_threshold, | |
| 543 enum hash_table_weakness weakness) | |
| 544 { | |
| 462 | 545 hash_table_hash_function_t hash_function = 0; |
| 450 | 546 hash_table_test_function_t test_function = 0; |
| 547 | |
| 548 switch (test) | |
| 549 { | |
| 550 case HASH_TABLE_EQ: | |
| 551 test_function = 0; | |
| 552 hash_function = 0; | |
| 553 break; | |
| 554 | |
| 555 case HASH_TABLE_EQL: | |
| 556 test_function = lisp_object_eql_equal; | |
| 557 hash_function = lisp_object_eql_hash; | |
| 558 break; | |
| 559 | |
| 560 case HASH_TABLE_EQUAL: | |
| 561 test_function = lisp_object_equal_equal; | |
| 562 hash_function = lisp_object_equal_hash; | |
| 563 break; | |
| 564 | |
| 565 default: | |
| 2500 | 566 ABORT (); |
| 450 | 567 } |
| 568 | |
| 569 return make_general_lisp_hash_table (hash_function, test_function, | |
| 570 size, rehash_size, rehash_threshold, | |
| 571 weakness); | |
| 572 } | |
| 573 | |
| 574 Lisp_Object | |
| 575 make_general_lisp_hash_table (hash_table_hash_function_t hash_function, | |
| 576 hash_table_test_function_t test_function, | |
| 665 | 577 Elemcount size, |
| 428 | 578 double rehash_size, |
| 579 double rehash_threshold, | |
| 580 enum hash_table_weakness weakness) | |
| 581 { | |
| 582 Lisp_Object hash_table; | |
| 3017 | 583 Lisp_Hash_Table *ht = ALLOC_LCRECORD_TYPE (Lisp_Hash_Table, &lrecord_hash_table); |
| 428 | 584 |
| 450 | 585 ht->test_function = test_function; |
| 586 ht->hash_function = hash_function; | |
| 438 | 587 ht->weakness = weakness; |
| 588 | |
| 589 ht->rehash_size = | |
| 590 rehash_size > 1.0 ? rehash_size : HASH_TABLE_DEFAULT_REHASH_SIZE; | |
| 591 | |
| 592 ht->rehash_threshold = | |
| 593 rehash_threshold > 0.0 ? rehash_threshold : | |
| 594 size > 4096 && !ht->test_function ? 0.7 : 0.6; | |
| 595 | |
| 428 | 596 if (size < HASH_TABLE_MIN_SIZE) |
| 597 size = HASH_TABLE_MIN_SIZE; | |
| 665 | 598 ht->size = hash_table_size ((Elemcount) (((double) size / ht->rehash_threshold) |
| 438 | 599 + 1.0)); |
| 428 | 600 ht->count = 0; |
| 438 | 601 |
| 428 | 602 compute_hash_table_derived_values (ht); |
| 603 | |
| 1204 | 604 /* We leave room for one never-occupied sentinel htentry at the end. */ |
| 3092 | 605 #ifdef NEW_GC |
| 606 ht->hentries = (htentry *) alloc_lrecord_array (sizeof (htentry), | |
| 607 ht->size + 1, | |
| 608 &lrecord_hash_table_entry); | |
| 609 #else /* not NEW_GC */ | |
| 1204 | 610 ht->hentries = xnew_array_and_zero (htentry, ht->size + 1); |
| 3092 | 611 #endif /* not NEW_GC */ |
| 428 | 612 |
| 793 | 613 hash_table = wrap_hash_table (ht); |
| 428 | 614 |
| 615 if (weakness == HASH_TABLE_NON_WEAK) | |
| 616 ht->next_weak = Qunbound; | |
| 617 else | |
| 618 ht->next_weak = Vall_weak_hash_tables, Vall_weak_hash_tables = hash_table; | |
| 619 | |
| 620 return hash_table; | |
| 621 } | |
| 622 | |
| 623 Lisp_Object | |
| 665 | 624 make_lisp_hash_table (Elemcount size, |
| 428 | 625 enum hash_table_weakness weakness, |
| 626 enum hash_table_test test) | |
| 627 { | |
| 450 | 628 return make_standard_lisp_hash_table (test, size, -1.0, -1.0, weakness); |
| 428 | 629 } |
| 630 | |
| 631 /* Pretty reading of hash tables. | |
| 632 | |
| 633 Here we use the existing structures mechanism (which is, | |
| 634 unfortunately, pretty cumbersome) for validating and instantiating | |
| 635 the hash tables. The idea is that the side-effect of reading a | |
| 636 #s(hash-table PLIST) object is creation of a hash table with desired | |
| 637 properties, and that the hash table is returned. */ | |
| 638 | |
| 639 /* Validation functions: each keyword provides its own validation | |
| 640 function. The errors should maybe be continuable, but it is | |
| 641 unclear how this would cope with ERRB. */ | |
| 642 static int | |
| 2286 | 643 hash_table_size_validate (Lisp_Object UNUSED (keyword), Lisp_Object value, |
| 644 Error_Behavior errb) | |
| 428 | 645 { |
| 646 if (NATNUMP (value)) | |
| 647 return 1; | |
| 648 | |
| 563 | 649 maybe_signal_error_1 (Qwrong_type_argument, list2 (Qnatnump, value), |
| 2286 | 650 Qhash_table, errb); |
| 428 | 651 return 0; |
| 652 } | |
| 653 | |
| 665 | 654 static Elemcount |
| 428 | 655 decode_hash_table_size (Lisp_Object obj) |
| 656 { | |
| 657 return NILP (obj) ? HASH_TABLE_DEFAULT_SIZE : XINT (obj); | |
| 658 } | |
| 659 | |
| 660 static int | |
| 2286 | 661 hash_table_weakness_validate (Lisp_Object UNUSED (keyword), Lisp_Object value, |
| 578 | 662 Error_Behavior errb) |
| 428 | 663 { |
| 442 | 664 if (EQ (value, Qnil)) return 1; |
| 665 if (EQ (value, Qt)) return 1; | |
| 666 if (EQ (value, Qkey)) return 1; | |
| 667 if (EQ (value, Qkey_and_value)) return 1; | |
| 668 if (EQ (value, Qkey_or_value)) return 1; | |
| 669 if (EQ (value, Qvalue)) return 1; | |
| 428 | 670 |
| 671 /* Following values are obsolete as of 19990901 in xemacs-21.2 */ | |
| 442 | 672 if (EQ (value, Qnon_weak)) return 1; |
| 673 if (EQ (value, Qweak)) return 1; | |
| 674 if (EQ (value, Qkey_weak)) return 1; | |
| 675 if (EQ (value, Qkey_or_value_weak)) return 1; | |
| 676 if (EQ (value, Qvalue_weak)) return 1; | |
| 428 | 677 |
| 563 | 678 maybe_invalid_constant ("Invalid hash table weakness", |
| 428 | 679 value, Qhash_table, errb); |
| 680 return 0; | |
| 681 } | |
| 682 | |
| 683 static enum hash_table_weakness | |
| 684 decode_hash_table_weakness (Lisp_Object obj) | |
| 685 { | |
| 442 | 686 if (EQ (obj, Qnil)) return HASH_TABLE_NON_WEAK; |
| 687 if (EQ (obj, Qt)) return HASH_TABLE_WEAK; | |
| 688 if (EQ (obj, Qkey_and_value)) return HASH_TABLE_WEAK; | |
| 689 if (EQ (obj, Qkey)) return HASH_TABLE_KEY_WEAK; | |
| 690 if (EQ (obj, Qkey_or_value)) return HASH_TABLE_KEY_VALUE_WEAK; | |
| 691 if (EQ (obj, Qvalue)) return HASH_TABLE_VALUE_WEAK; | |
| 428 | 692 |
| 693 /* Following values are obsolete as of 19990901 in xemacs-21.2 */ | |
| 442 | 694 if (EQ (obj, Qnon_weak)) return HASH_TABLE_NON_WEAK; |
| 695 if (EQ (obj, Qweak)) return HASH_TABLE_WEAK; | |
| 696 if (EQ (obj, Qkey_weak)) return HASH_TABLE_KEY_WEAK; | |
| 697 if (EQ (obj, Qkey_or_value_weak)) return HASH_TABLE_KEY_VALUE_WEAK; | |
| 698 if (EQ (obj, Qvalue_weak)) return HASH_TABLE_VALUE_WEAK; | |
| 428 | 699 |
| 563 | 700 invalid_constant ("Invalid hash table weakness", obj); |
| 1204 | 701 RETURN_NOT_REACHED (HASH_TABLE_NON_WEAK); |
| 428 | 702 } |
| 703 | |
| 704 static int | |
| 2286 | 705 hash_table_test_validate (Lisp_Object UNUSED (keyword), Lisp_Object value, |
| 706 Error_Behavior errb) | |
| 428 | 707 { |
| 708 if (EQ (value, Qnil)) return 1; | |
| 709 if (EQ (value, Qeq)) return 1; | |
| 710 if (EQ (value, Qequal)) return 1; | |
| 711 if (EQ (value, Qeql)) return 1; | |
| 712 | |
| 563 | 713 maybe_invalid_constant ("Invalid hash table test", |
| 2286 | 714 value, Qhash_table, errb); |
| 428 | 715 return 0; |
| 716 } | |
| 717 | |
| 718 static enum hash_table_test | |
| 719 decode_hash_table_test (Lisp_Object obj) | |
| 720 { | |
| 721 if (EQ (obj, Qnil)) return HASH_TABLE_EQL; | |
| 722 if (EQ (obj, Qeq)) return HASH_TABLE_EQ; | |
| 723 if (EQ (obj, Qequal)) return HASH_TABLE_EQUAL; | |
| 724 if (EQ (obj, Qeql)) return HASH_TABLE_EQL; | |
| 725 | |
| 563 | 726 invalid_constant ("Invalid hash table test", obj); |
| 1204 | 727 RETURN_NOT_REACHED (HASH_TABLE_EQ); |
| 428 | 728 } |
| 729 | |
| 730 static int | |
| 2286 | 731 hash_table_rehash_size_validate (Lisp_Object UNUSED (keyword), |
| 732 Lisp_Object value, Error_Behavior errb) | |
| 428 | 733 { |
| 734 if (!FLOATP (value)) | |
| 735 { | |
| 563 | 736 maybe_signal_error_1 (Qwrong_type_argument, list2 (Qfloatp, value), |
| 428 | 737 Qhash_table, errb); |
| 738 return 0; | |
| 739 } | |
| 740 | |
| 741 { | |
| 742 double rehash_size = XFLOAT_DATA (value); | |
| 743 if (rehash_size <= 1.0) | |
| 744 { | |
| 563 | 745 maybe_invalid_argument |
| 428 | 746 ("Hash table rehash size must be greater than 1.0", |
| 747 value, Qhash_table, errb); | |
| 748 return 0; | |
| 749 } | |
| 750 } | |
| 751 | |
| 752 return 1; | |
| 753 } | |
| 754 | |
| 755 static double | |
| 756 decode_hash_table_rehash_size (Lisp_Object rehash_size) | |
| 757 { | |
|
4585
871eb054b34a
Document non-obvious usages.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4410
diff
changeset
|
758 /* -1.0 signals make_general_lisp_hash_table to use the default. */ |
| 428 | 759 return NILP (rehash_size) ? -1.0 : XFLOAT_DATA (rehash_size); |
| 760 } | |
| 761 | |
| 762 static int | |
| 2286 | 763 hash_table_rehash_threshold_validate (Lisp_Object UNUSED (keyword), |
| 764 Lisp_Object value, Error_Behavior errb) | |
| 428 | 765 { |
| 766 if (!FLOATP (value)) | |
| 767 { | |
| 563 | 768 maybe_signal_error_1 (Qwrong_type_argument, list2 (Qfloatp, value), |
| 428 | 769 Qhash_table, errb); |
| 770 return 0; | |
| 771 } | |
| 772 | |
| 773 { | |
| 774 double rehash_threshold = XFLOAT_DATA (value); | |
| 775 if (rehash_threshold <= 0.0 || rehash_threshold >= 1.0) | |
| 776 { | |
| 563 | 777 maybe_invalid_argument |
| 428 | 778 ("Hash table rehash threshold must be between 0.0 and 1.0", |
| 779 value, Qhash_table, errb); | |
| 780 return 0; | |
| 781 } | |
| 782 } | |
| 783 | |
| 784 return 1; | |
| 785 } | |
| 786 | |
| 787 static double | |
| 788 decode_hash_table_rehash_threshold (Lisp_Object rehash_threshold) | |
| 789 { | |
|
4585
871eb054b34a
Document non-obvious usages.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4410
diff
changeset
|
790 /* -1.0 signals make_general_lisp_hash_table to use the default. */ |
| 428 | 791 return NILP (rehash_threshold) ? -1.0 : XFLOAT_DATA (rehash_threshold); |
| 792 } | |
| 793 | |
| 794 static int | |
| 2286 | 795 hash_table_data_validate (Lisp_Object UNUSED (keyword), Lisp_Object value, |
| 796 Error_Behavior errb) | |
| 428 | 797 { |
| 798 int len; | |
| 799 | |
|
4585
871eb054b34a
Document non-obvious usages.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4410
diff
changeset
|
800 /* Check for improper lists while getting length. */ |
| 428 | 801 GET_EXTERNAL_LIST_LENGTH (value, len); |
| 802 | |
| 803 if (len & 1) | |
| 804 { | |
| 563 | 805 maybe_sferror |
| 428 | 806 ("Hash table data must have alternating key/value pairs", |
| 807 value, Qhash_table, errb); | |
| 808 return 0; | |
| 809 } | |
|
4585
871eb054b34a
Document non-obvious usages.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4410
diff
changeset
|
810 |
| 428 | 811 return 1; |
| 812 } | |
| 813 | |
| 814 /* The actual instantiation of a hash table. This does practically no | |
| 815 error checking, because it relies on the fact that the paranoid | |
| 816 functions above have error-checked everything to the last details. | |
| 817 If this assumption is wrong, we will get a crash immediately (with | |
| 818 error-checking compiled in), and we'll know if there is a bug in | |
| 819 the structure mechanism. So there. */ | |
| 820 static Lisp_Object | |
| 821 hash_table_instantiate (Lisp_Object plist) | |
| 822 { | |
| 823 Lisp_Object hash_table; | |
| 824 Lisp_Object test = Qnil; | |
| 825 Lisp_Object size = Qnil; | |
| 826 Lisp_Object rehash_size = Qnil; | |
| 827 Lisp_Object rehash_threshold = Qnil; | |
| 828 Lisp_Object weakness = Qnil; | |
| 829 Lisp_Object data = Qnil; | |
| 830 | |
| 2421 | 831 PROPERTY_LIST_LOOP_3 (key, value, plist) |
| 428 | 832 { |
| 833 if (EQ (key, Qtest)) test = value; | |
| 834 else if (EQ (key, Qsize)) size = value; | |
| 835 else if (EQ (key, Qrehash_size)) rehash_size = value; | |
| 836 else if (EQ (key, Qrehash_threshold)) rehash_threshold = value; | |
| 837 else if (EQ (key, Qweakness)) weakness = value; | |
| 838 else if (EQ (key, Qdata)) data = value; | |
| 839 else if (EQ (key, Qtype))/*obsolete*/ weakness = value; | |
| 840 else | |
| 2500 | 841 ABORT (); |
| 428 | 842 } |
| 843 | |
| 844 /* Create the hash table. */ | |
| 450 | 845 hash_table = make_standard_lisp_hash_table |
| 428 | 846 (decode_hash_table_test (test), |
| 847 decode_hash_table_size (size), | |
| 848 decode_hash_table_rehash_size (rehash_size), | |
| 849 decode_hash_table_rehash_threshold (rehash_threshold), | |
| 850 decode_hash_table_weakness (weakness)); | |
| 851 | |
| 852 /* I'm not sure whether this can GC, but better safe than sorry. */ | |
| 853 { | |
| 854 struct gcpro gcpro1; | |
| 855 GCPRO1 (hash_table); | |
| 856 | |
| 857 /* And fill it with data. */ | |
| 858 while (!NILP (data)) | |
| 859 { | |
| 860 Lisp_Object key, value; | |
| 861 key = XCAR (data); data = XCDR (data); | |
| 862 value = XCAR (data); data = XCDR (data); | |
| 863 Fputhash (key, value, hash_table); | |
| 864 } | |
| 865 UNGCPRO; | |
| 866 } | |
| 867 | |
| 868 return hash_table; | |
| 869 } | |
| 870 | |
| 871 static void | |
| 872 structure_type_create_hash_table_structure_name (Lisp_Object structure_name) | |
| 873 { | |
| 874 struct structure_type *st; | |
| 875 | |
| 876 st = define_structure_type (structure_name, 0, hash_table_instantiate); | |
| 877 define_structure_type_keyword (st, Qtest, hash_table_test_validate); | |
| 878 define_structure_type_keyword (st, Qsize, hash_table_size_validate); | |
| 879 define_structure_type_keyword (st, Qrehash_size, hash_table_rehash_size_validate); | |
| 880 define_structure_type_keyword (st, Qrehash_threshold, hash_table_rehash_threshold_validate); | |
| 881 define_structure_type_keyword (st, Qweakness, hash_table_weakness_validate); | |
| 882 define_structure_type_keyword (st, Qdata, hash_table_data_validate); | |
| 883 | |
| 884 /* obsolete as of 19990901 in xemacs-21.2 */ | |
| 885 define_structure_type_keyword (st, Qtype, hash_table_weakness_validate); | |
| 886 } | |
| 887 | |
| 888 /* Create a built-in Lisp structure type named `hash-table'. | |
| 889 We make #s(hashtable ...) equivalent to #s(hash-table ...), | |
| 890 for backward compatibility. | |
| 891 This is called from emacs.c. */ | |
| 892 void | |
| 893 structure_type_create_hash_table (void) | |
| 894 { | |
| 895 structure_type_create_hash_table_structure_name (Qhash_table); | |
| 896 structure_type_create_hash_table_structure_name (Qhashtable); /* compat */ | |
| 897 } | |
| 898 | |
| 899 | |
| 900 /************************************************************************/ | |
| 901 /* Definition of Lisp-visible methods */ | |
| 902 /************************************************************************/ | |
| 903 | |
| 904 DEFUN ("hash-table-p", Fhash_table_p, 1, 1, 0, /* | |
| 905 Return t if OBJECT is a hash table, else nil. | |
| 906 */ | |
| 907 (object)) | |
| 908 { | |
| 909 return HASH_TABLEP (object) ? Qt : Qnil; | |
| 910 } | |
| 911 | |
| 912 DEFUN ("make-hash-table", Fmake_hash_table, 0, MANY, 0, /* | |
| 913 Return a new empty hash table object. | |
| 914 Use Common Lisp style keywords to specify hash table properties. | |
| 915 (make-hash-table &key test size rehash-size rehash-threshold weakness) | |
| 916 | |
| 917 Keyword :test can be `eq', `eql' (default) or `equal'. | |
| 918 Comparison between keys is done using this function. | |
| 919 If speed is important, consider using `eq'. | |
| 920 When storing strings in the hash table, you will likely need to use `equal'. | |
| 921 | |
| 922 Keyword :size specifies the number of keys likely to be inserted. | |
| 923 This number of entries can be inserted without enlarging the hash table. | |
| 924 | |
| 925 Keyword :rehash-size must be a float greater than 1.0, and specifies | |
| 926 the factor by which to increase the size of the hash table when enlarging. | |
| 927 | |
| 928 Keyword :rehash-threshold must be a float between 0.0 and 1.0, | |
| 929 and specifies the load factor of the hash table which triggers enlarging. | |
| 930 | |
| 442 | 931 Non-standard keyword :weakness can be `nil' (default), `t', `key-and-value', |
| 932 `key', `value' or `key-or-value'. `t' is an alias for `key-and-value'. | |
| 428 | 933 |
| 442 | 934 A key-and-value-weak hash table, also known as a fully-weak or simply |
| 935 as a weak hash table, is one whose pointers do not count as GC | |
| 936 referents: for any key-value pair in the hash table, if the only | |
| 937 remaining pointer to either the key or the value is in a weak hash | |
| 938 table, then the pair will be removed from the hash table, and the key | |
| 939 and value collected. A non-weak hash table (or any other pointer) | |
| 940 would prevent the object from being collected. | |
| 428 | 941 |
| 942 A key-weak hash table is similar to a fully-weak hash table except that | |
| 943 a key-value pair will be removed only if the key remains unmarked | |
| 944 outside of weak hash tables. The pair will remain in the hash table if | |
| 945 the key is pointed to by something other than a weak hash table, even | |
| 946 if the value is not. | |
| 947 | |
| 948 A value-weak hash table is similar to a fully-weak hash table except | |
| 949 that a key-value pair will be removed only if the value remains | |
| 950 unmarked outside of weak hash tables. The pair will remain in the | |
| 951 hash table if the value is pointed to by something other than a weak | |
| 952 hash table, even if the key is not. | |
| 442 | 953 |
| 954 A key-or-value-weak hash table is similar to a fully-weak hash table except | |
| 955 that a key-value pair will be removed only if the value and the key remain | |
| 956 unmarked outside of weak hash tables. The pair will remain in the | |
| 957 hash table if the value or key are pointed to by something other than a weak | |
| 958 hash table, even if the other is not. | |
| 428 | 959 */ |
| 960 (int nargs, Lisp_Object *args)) | |
| 961 { | |
| 962 int i = 0; | |
| 963 Lisp_Object test = Qnil; | |
| 964 Lisp_Object size = Qnil; | |
| 965 Lisp_Object rehash_size = Qnil; | |
| 966 Lisp_Object rehash_threshold = Qnil; | |
| 967 Lisp_Object weakness = Qnil; | |
| 968 | |
| 969 while (i + 1 < nargs) | |
| 970 { | |
| 971 Lisp_Object keyword = args[i++]; | |
| 972 Lisp_Object value = args[i++]; | |
| 973 | |
| 974 if (EQ (keyword, Q_test)) test = value; | |
| 975 else if (EQ (keyword, Q_size)) size = value; | |
| 976 else if (EQ (keyword, Q_rehash_size)) rehash_size = value; | |
| 977 else if (EQ (keyword, Q_rehash_threshold)) rehash_threshold = value; | |
| 978 else if (EQ (keyword, Q_weakness)) weakness = value; | |
| 979 else if (EQ (keyword, Q_type))/*obsolete*/ weakness = value; | |
| 563 | 980 else invalid_constant ("Invalid hash table property keyword", keyword); |
| 428 | 981 } |
| 982 | |
| 983 if (i < nargs) | |
| 563 | 984 sferror ("Hash table property requires a value", args[i]); |
| 428 | 985 |
| 986 #define VALIDATE_VAR(var) \ | |
| 987 if (!NILP (var)) hash_table_##var##_validate (Q##var, var, ERROR_ME); | |
| 988 | |
| 989 VALIDATE_VAR (test); | |
| 990 VALIDATE_VAR (size); | |
| 991 VALIDATE_VAR (rehash_size); | |
| 992 VALIDATE_VAR (rehash_threshold); | |
| 993 VALIDATE_VAR (weakness); | |
| 994 | |
| 450 | 995 return make_standard_lisp_hash_table |
| 428 | 996 (decode_hash_table_test (test), |
| 997 decode_hash_table_size (size), | |
| 998 decode_hash_table_rehash_size (rehash_size), | |
| 999 decode_hash_table_rehash_threshold (rehash_threshold), | |
| 1000 decode_hash_table_weakness (weakness)); | |
| 1001 } | |
| 1002 | |
| 1003 DEFUN ("copy-hash-table", Fcopy_hash_table, 1, 1, 0, /* | |
| 1004 Return a new hash table containing the same keys and values as HASH-TABLE. | |
| 1005 The keys and values will not themselves be copied. | |
| 1006 */ | |
| 1007 (hash_table)) | |
| 1008 { | |
| 442 | 1009 const Lisp_Hash_Table *ht_old = xhash_table (hash_table); |
| 3017 | 1010 Lisp_Hash_Table *ht = ALLOC_LCRECORD_TYPE (Lisp_Hash_Table, &lrecord_hash_table); |
| 1011 COPY_LCRECORD (ht, ht_old); | |
| 428 | 1012 |
| 3092 | 1013 #ifdef NEW_GC |
| 1014 ht->hentries = (htentry *) alloc_lrecord_array (sizeof (htentry), | |
| 1015 ht_old->size + 1, | |
| 1016 &lrecord_hash_table_entry); | |
| 1017 #else /* not NEW_GC */ | |
| 1204 | 1018 ht->hentries = xnew_array (htentry, ht_old->size + 1); |
| 3092 | 1019 #endif /* not NEW_GC */ |
| 1204 | 1020 memcpy (ht->hentries, ht_old->hentries, (ht_old->size + 1) * sizeof (htentry)); |
| 428 | 1021 |
| 793 | 1022 hash_table = wrap_hash_table (ht); |
| 428 | 1023 |
| 1024 if (! EQ (ht->next_weak, Qunbound)) | |
| 1025 { | |
| 1026 ht->next_weak = Vall_weak_hash_tables; | |
| 1027 Vall_weak_hash_tables = hash_table; | |
| 1028 } | |
| 1029 | |
| 1030 return hash_table; | |
| 1031 } | |
| 1032 | |
| 1033 static void | |
| 665 | 1034 resize_hash_table (Lisp_Hash_Table *ht, Elemcount new_size) |
| 428 | 1035 { |
| 1204 | 1036 htentry *old_entries, *new_entries, *sentinel, *e; |
| 665 | 1037 Elemcount old_size; |
| 428 | 1038 |
| 1039 old_size = ht->size; | |
| 1040 ht->size = new_size; | |
| 1041 | |
| 1042 old_entries = ht->hentries; | |
| 1043 | |
| 3092 | 1044 #ifdef NEW_GC |
| 1045 ht->hentries = (htentry *) alloc_lrecord_array (sizeof (htentry), | |
| 1046 new_size + 1, | |
| 1047 &lrecord_hash_table_entry); | |
| 1048 #else /* not NEW_GC */ | |
| 1204 | 1049 ht->hentries = xnew_array_and_zero (htentry, new_size + 1); |
| 3092 | 1050 #endif /* not NEW_GC */ |
| 428 | 1051 new_entries = ht->hentries; |
| 1052 | |
| 1053 compute_hash_table_derived_values (ht); | |
| 1054 | |
| 440 | 1055 for (e = old_entries, sentinel = e + old_size; e < sentinel; e++) |
| 1204 | 1056 if (!HTENTRY_CLEAR_P (e)) |
| 428 | 1057 { |
| 1204 | 1058 htentry *probe = new_entries + HASHCODE (e->key, ht); |
| 428 | 1059 LINEAR_PROBING_LOOP (probe, new_entries, new_size) |
| 1060 ; | |
| 1061 *probe = *e; | |
| 1062 } | |
| 1063 | |
| 4117 | 1064 #ifndef NEW_GC |
| 489 | 1065 free_hentries (old_entries, old_size); |
| 4117 | 1066 #endif /* not NEW_GC */ |
| 428 | 1067 } |
| 1068 | |
| 440 | 1069 /* After a hash table has been saved to disk and later restored by the |
| 1070 portable dumper, it contains the same objects, but their addresses | |
| 665 | 1071 and thus their HASHCODEs have changed. */ |
| 428 | 1072 void |
| 440 | 1073 pdump_reorganize_hash_table (Lisp_Object hash_table) |
| 428 | 1074 { |
| 442 | 1075 const Lisp_Hash_Table *ht = xhash_table (hash_table); |
| 3092 | 1076 #ifdef NEW_GC |
| 1077 htentry *new_entries = | |
| 1078 (htentry *) alloc_lrecord_array (sizeof (htentry), ht->size + 1, | |
| 1079 &lrecord_hash_table_entry); | |
| 1080 #else /* not NEW_GC */ | |
| 1204 | 1081 htentry *new_entries = xnew_array_and_zero (htentry, ht->size + 1); |
| 3092 | 1082 #endif /* not NEW_GC */ |
| 1204 | 1083 htentry *e, *sentinel; |
| 440 | 1084 |
| 1085 for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) | |
| 1204 | 1086 if (!HTENTRY_CLEAR_P (e)) |
| 440 | 1087 { |
| 1204 | 1088 htentry *probe = new_entries + HASHCODE (e->key, ht); |
| 440 | 1089 LINEAR_PROBING_LOOP (probe, new_entries, ht->size) |
| 1090 ; | |
| 1091 *probe = *e; | |
| 1092 } | |
| 1093 | |
| 1204 | 1094 memcpy (ht->hentries, new_entries, ht->size * sizeof (htentry)); |
| 440 | 1095 |
| 4117 | 1096 #ifndef NEW_GC |
| 1726 | 1097 xfree (new_entries, htentry *); |
| 3092 | 1098 #endif /* not NEW_GC */ |
| 428 | 1099 } |
| 1100 | |
| 1101 static void | |
| 1102 enlarge_hash_table (Lisp_Hash_Table *ht) | |
| 1103 { | |
| 665 | 1104 Elemcount new_size = |
| 1105 hash_table_size ((Elemcount) ((double) ht->size * ht->rehash_size)); | |
| 428 | 1106 resize_hash_table (ht, new_size); |
| 1107 } | |
| 1108 | |
| 4072 | 1109 htentry * |
| 1204 | 1110 find_htentry (Lisp_Object key, const Lisp_Hash_Table *ht) |
| 428 | 1111 { |
| 1112 hash_table_test_function_t test_function = ht->test_function; | |
| 1204 | 1113 htentry *entries = ht->hentries; |
| 1114 htentry *probe = entries + HASHCODE (key, ht); | |
| 428 | 1115 |
| 1116 LINEAR_PROBING_LOOP (probe, entries, ht->size) | |
| 1117 if (KEYS_EQUAL_P (probe->key, key, test_function)) | |
| 1118 break; | |
| 1119 | |
| 1120 return probe; | |
| 1121 } | |
| 1122 | |
| 2421 | 1123 /* A version of Fputhash() that increments the value by the specified |
| 1124 amount and dispenses will all error checks. Assumes that tables does | |
| 1125 comparison using EQ. Used by the profiling routines to avoid | |
| 1126 overhead -- profiling overhead was being recorded at up to 15% of the | |
| 1127 total time. */ | |
| 1128 | |
| 1129 void | |
| 1130 inchash_eq (Lisp_Object key, Lisp_Object table, EMACS_INT offset) | |
| 1131 { | |
| 1132 Lisp_Hash_Table *ht = XHASH_TABLE (table); | |
| 1133 htentry *entries = ht->hentries; | |
| 1134 htentry *probe = entries + HASHCODE (key, ht); | |
| 1135 | |
| 1136 LINEAR_PROBING_LOOP (probe, entries, ht->size) | |
| 1137 if (EQ (probe->key, key)) | |
| 1138 break; | |
| 1139 | |
| 1140 if (!HTENTRY_CLEAR_P (probe)) | |
| 1141 probe->value = make_int (XINT (probe->value) + offset); | |
| 1142 else | |
| 1143 { | |
| 1144 probe->key = key; | |
| 1145 probe->value = make_int (offset); | |
| 1146 | |
| 1147 if (++ht->count >= ht->rehash_count) | |
| 1148 enlarge_hash_table (ht); | |
| 1149 } | |
| 1150 } | |
| 1151 | |
| 428 | 1152 DEFUN ("gethash", Fgethash, 2, 3, 0, /* |
| 1153 Find hash value for KEY in HASH-TABLE. | |
| 1154 If there is no corresponding value, return DEFAULT (which defaults to nil). | |
| 1155 */ | |
| 1156 (key, hash_table, default_)) | |
| 1157 { | |
| 442 | 1158 const Lisp_Hash_Table *ht = xhash_table (hash_table); |
| 1204 | 1159 htentry *e = find_htentry (key, ht); |
| 428 | 1160 |
| 1204 | 1161 return HTENTRY_CLEAR_P (e) ? default_ : e->value; |
| 428 | 1162 } |
| 1163 | |
| 1164 DEFUN ("puthash", Fputhash, 3, 3, 0, /* | |
|
4410
aae1994dfeec
Document return values for #'puthash, #'clrhash.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4398
diff
changeset
|
1165 Hash KEY to VALUE in HASH-TABLE, and return VALUE. |
| 428 | 1166 */ |
| 1167 (key, value, hash_table)) | |
| 1168 { | |
| 1169 Lisp_Hash_Table *ht = xhash_table (hash_table); | |
| 1204 | 1170 htentry *e = find_htentry (key, ht); |
| 428 | 1171 |
| 1204 | 1172 if (!HTENTRY_CLEAR_P (e)) |
| 428 | 1173 return e->value = value; |
| 1174 | |
| 1175 e->key = key; | |
| 1176 e->value = value; | |
| 1177 | |
| 1178 if (++ht->count >= ht->rehash_count) | |
| 1179 enlarge_hash_table (ht); | |
| 1180 | |
| 1181 return value; | |
| 1182 } | |
| 1183 | |
| 1204 | 1184 /* Remove htentry pointed at by PROBE. |
| 428 | 1185 Subsequent entries are removed and reinserted. |
| 1186 We don't use tombstones - too wasteful. */ | |
| 1187 static void | |
| 1204 | 1188 remhash_1 (Lisp_Hash_Table *ht, htentry *entries, htentry *probe) |
| 428 | 1189 { |
| 665 | 1190 Elemcount size = ht->size; |
| 1204 | 1191 CLEAR_HTENTRY (probe); |
| 428 | 1192 probe++; |
| 1193 ht->count--; | |
| 1194 | |
| 1195 LINEAR_PROBING_LOOP (probe, entries, size) | |
| 1196 { | |
| 1197 Lisp_Object key = probe->key; | |
| 1204 | 1198 htentry *probe2 = entries + HASHCODE (key, ht); |
| 428 | 1199 LINEAR_PROBING_LOOP (probe2, entries, size) |
| 1200 if (EQ (probe2->key, key)) | |
| 1204 | 1201 /* htentry at probe doesn't need to move. */ |
| 428 | 1202 goto continue_outer_loop; |
| 1204 | 1203 /* Move htentry from probe to new home at probe2. */ |
| 428 | 1204 *probe2 = *probe; |
| 1204 | 1205 CLEAR_HTENTRY (probe); |
| 428 | 1206 continue_outer_loop: continue; |
| 1207 } | |
| 1208 } | |
| 1209 | |
| 1210 DEFUN ("remhash", Fremhash, 2, 2, 0, /* | |
| 1211 Remove the entry for KEY from HASH-TABLE. | |
| 1212 Do nothing if there is no entry for KEY in HASH-TABLE. | |
| 617 | 1213 Return non-nil if an entry was removed. |
| 428 | 1214 */ |
| 1215 (key, hash_table)) | |
| 1216 { | |
| 1217 Lisp_Hash_Table *ht = xhash_table (hash_table); | |
| 1204 | 1218 htentry *e = find_htentry (key, ht); |
| 428 | 1219 |
| 1204 | 1220 if (HTENTRY_CLEAR_P (e)) |
| 428 | 1221 return Qnil; |
| 1222 | |
| 1223 remhash_1 (ht, ht->hentries, e); | |
| 1224 return Qt; | |
| 1225 } | |
| 1226 | |
| 1227 DEFUN ("clrhash", Fclrhash, 1, 1, 0, /* | |
| 1228 Remove all entries from HASH-TABLE, leaving it empty. | |
|
4410
aae1994dfeec
Document return values for #'puthash, #'clrhash.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4398
diff
changeset
|
1229 Return HASH-TABLE. |
| 428 | 1230 */ |
| 1231 (hash_table)) | |
| 1232 { | |
| 1233 Lisp_Hash_Table *ht = xhash_table (hash_table); | |
| 1204 | 1234 htentry *e, *sentinel; |
| 428 | 1235 |
| 1236 for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) | |
| 1204 | 1237 CLEAR_HTENTRY (e); |
| 428 | 1238 ht->count = 0; |
| 1239 | |
| 1240 return hash_table; | |
| 1241 } | |
| 1242 | |
| 1243 /************************************************************************/ | |
| 1244 /* Accessor Functions */ | |
| 1245 /************************************************************************/ | |
| 1246 | |
| 1247 DEFUN ("hash-table-count", Fhash_table_count, 1, 1, 0, /* | |
| 1248 Return the number of entries in HASH-TABLE. | |
| 1249 */ | |
| 1250 (hash_table)) | |
| 1251 { | |
| 1252 return make_int (xhash_table (hash_table)->count); | |
| 1253 } | |
| 1254 | |
| 1255 DEFUN ("hash-table-test", Fhash_table_test, 1, 1, 0, /* | |
| 1256 Return the test function of HASH-TABLE. | |
| 1257 This can be one of `eq', `eql' or `equal'. | |
| 1258 */ | |
| 1259 (hash_table)) | |
| 1260 { | |
| 1261 hash_table_test_function_t fun = xhash_table (hash_table)->test_function; | |
| 1262 | |
| 1263 return (fun == lisp_object_eql_equal ? Qeql : | |
| 1264 fun == lisp_object_equal_equal ? Qequal : | |
| 1265 Qeq); | |
| 1266 } | |
| 1267 | |
| 1268 DEFUN ("hash-table-size", Fhash_table_size, 1, 1, 0, /* | |
| 1269 Return the size of HASH-TABLE. | |
| 1270 This is the current number of slots in HASH-TABLE, whether occupied or not. | |
| 1271 */ | |
| 1272 (hash_table)) | |
| 1273 { | |
| 1274 return make_int (xhash_table (hash_table)->size); | |
| 1275 } | |
| 1276 | |
| 1277 DEFUN ("hash-table-rehash-size", Fhash_table_rehash_size, 1, 1, 0, /* | |
| 1278 Return the current rehash size of HASH-TABLE. | |
| 1279 This is a float greater than 1.0; the factor by which HASH-TABLE | |
| 1280 is enlarged when the rehash threshold is exceeded. | |
| 1281 */ | |
| 1282 (hash_table)) | |
| 1283 { | |
| 1284 return make_float (xhash_table (hash_table)->rehash_size); | |
| 1285 } | |
| 1286 | |
| 1287 DEFUN ("hash-table-rehash-threshold", Fhash_table_rehash_threshold, 1, 1, 0, /* | |
| 1288 Return the current rehash threshold of HASH-TABLE. | |
| 1289 This is a float between 0.0 and 1.0; the maximum `load factor' of HASH-TABLE, | |
| 1290 beyond which the HASH-TABLE is enlarged by rehashing. | |
| 1291 */ | |
| 1292 (hash_table)) | |
| 1293 { | |
| 438 | 1294 return make_float (xhash_table (hash_table)->rehash_threshold); |
| 428 | 1295 } |
| 1296 | |
| 1297 DEFUN ("hash-table-weakness", Fhash_table_weakness, 1, 1, 0, /* | |
| 1298 Return the weakness of HASH-TABLE. | |
| 442 | 1299 This can be one of `nil', `key-and-value', `key-or-value', `key' or `value'. |
| 428 | 1300 */ |
| 1301 (hash_table)) | |
| 1302 { | |
| 1303 switch (xhash_table (hash_table)->weakness) | |
| 1304 { | |
| 442 | 1305 case HASH_TABLE_WEAK: return Qkey_and_value; |
| 1306 case HASH_TABLE_KEY_WEAK: return Qkey; | |
| 1307 case HASH_TABLE_KEY_VALUE_WEAK: return Qkey_or_value; | |
| 1308 case HASH_TABLE_VALUE_WEAK: return Qvalue; | |
| 1309 default: return Qnil; | |
| 428 | 1310 } |
| 1311 } | |
| 1312 | |
| 1313 /* obsolete as of 19990901 in xemacs-21.2 */ | |
| 1314 DEFUN ("hash-table-type", Fhash_table_type, 1, 1, 0, /* | |
| 1315 Return the type of HASH-TABLE. | |
| 1316 This can be one of `non-weak', `weak', `key-weak' or `value-weak'. | |
| 1317 */ | |
| 1318 (hash_table)) | |
| 1319 { | |
| 1320 switch (xhash_table (hash_table)->weakness) | |
| 1321 { | |
| 442 | 1322 case HASH_TABLE_WEAK: return Qweak; |
| 1323 case HASH_TABLE_KEY_WEAK: return Qkey_weak; | |
| 1324 case HASH_TABLE_KEY_VALUE_WEAK: return Qkey_or_value_weak; | |
| 1325 case HASH_TABLE_VALUE_WEAK: return Qvalue_weak; | |
| 1326 default: return Qnon_weak; | |
| 428 | 1327 } |
| 1328 } | |
| 1329 | |
| 1330 /************************************************************************/ | |
| 1331 /* Mapping Functions */ | |
| 1332 /************************************************************************/ | |
| 489 | 1333 |
| 1334 /* We need to be careful when mapping over hash tables because the | |
| 1335 hash table might be modified during the mapping operation: | |
| 1336 - by the mapping function | |
| 1337 - by gc (if the hash table is weak) | |
| 1338 | |
| 1339 So we make a copy of the hentries at the beginning of the mapping | |
| 497 | 1340 operation, and iterate over the copy. Naturally, this is |
| 1341 expensive, but not as expensive as you might think, because no | |
| 1342 actual memory has to be collected by our notoriously inefficient | |
| 1343 GC; we use an unwind-protect instead to free the memory directly. | |
| 1344 | |
| 1345 We could avoid the copying by having the hash table modifiers | |
| 1346 puthash and remhash check for currently active mapping functions. | |
| 1347 Disadvantages: it's hard to get right, and IMO hash mapping | |
| 1348 functions are basically rare, and no extra space in the hash table | |
| 1349 object and no extra cpu in puthash or remhash should be wasted to | |
| 1350 make maphash 3% faster. From a design point of view, the basic | |
| 1351 functions gethash, puthash and remhash should be implementable | |
| 1352 without having to think about maphash. | |
| 1353 | |
| 1354 Note: We don't (yet) have Common Lisp's with-hash-table-iterator. | |
| 1355 If you implement this naively, you cannot have more than one | |
| 1356 concurrently active iterator over the same hash table. The `each' | |
| 1357 function in perl has this limitation. | |
| 1358 | |
| 1359 Note: We GCPRO memory on the heap, not on the stack. There is no | |
| 1360 obvious reason why this is bad, but as of this writing this is the | |
| 1361 only known occurrence of this technique in the code. | |
| 504 | 1362 |
| 1363 -- Martin | |
| 1364 */ | |
| 1365 | |
| 1366 /* Ben disagrees with the "copying hentries" design, and says: | |
| 1367 | |
| 1368 Another solution is the same as I've already proposed -- when | |
| 1369 mapping, mark the table as "change-unsafe", and in this case, use a | |
| 1370 secondary table to maintain changes. this could be basically a | |
| 1371 standard hash table, but with entries only for added or deleted | |
| 1372 entries in the primary table, and a marker like Qunbound to | |
| 1373 indicate a deleted entry. puthash, gethash and remhash need a | |
| 1374 single extra check for this secondary table -- totally | |
| 1375 insignificant speedwise. if you really cared about making | |
| 1376 recursive maphashes completely correct, you'd have to do a bit of | |
| 1377 extra work here -- when maphashing, if the secondary table exists, | |
| 1378 make a copy of it, and use the copy in conjunction with the primary | |
| 1379 table when mapping. the advantages of this are | |
| 1380 | |
| 1381 [a] easy to demonstrate correct, even with weak hashtables. | |
| 1382 | |
| 1383 [b] no extra overhead in the general maphash case -- only when you | |
| 1384 modify the table while maphashing, and even then the overhead is | |
| 1385 very small. | |
| 497 | 1386 */ |
| 1387 | |
| 489 | 1388 static Lisp_Object |
| 1389 maphash_unwind (Lisp_Object unwind_obj) | |
| 1390 { | |
| 1391 void *ptr = (void *) get_opaque_ptr (unwind_obj); | |
| 1726 | 1392 xfree (ptr, void *); |
| 489 | 1393 free_opaque_ptr (unwind_obj); |
| 1394 return Qnil; | |
| 1395 } | |
| 1396 | |
| 1397 /* Return a malloced array of alternating key/value pairs from HT. */ | |
| 1398 static Lisp_Object * | |
| 1399 copy_compress_hentries (const Lisp_Hash_Table *ht) | |
| 1400 { | |
| 1401 Lisp_Object * const objs = | |
| 1402 /* If the hash table is empty, ht->count could be 0. */ | |
| 1403 xnew_array (Lisp_Object, 2 * (ht->count > 0 ? ht->count : 1)); | |
| 1204 | 1404 const htentry *e, *sentinel; |
| 489 | 1405 Lisp_Object *pobj; |
| 1406 | |
| 1407 for (e = ht->hentries, sentinel = e + ht->size, pobj = objs; e < sentinel; e++) | |
| 1204 | 1408 if (!HTENTRY_CLEAR_P (e)) |
| 489 | 1409 { |
| 1410 *(pobj++) = e->key; | |
| 1411 *(pobj++) = e->value; | |
| 1412 } | |
| 1413 | |
| 1414 type_checking_assert (pobj == objs + 2 * ht->count); | |
| 1415 | |
| 1416 return objs; | |
| 1417 } | |
| 1418 | |
| 428 | 1419 DEFUN ("maphash", Fmaphash, 2, 2, 0, /* |
| 1420 Map FUNCTION over entries in HASH-TABLE, calling it with two args, | |
| 1421 each key and value in HASH-TABLE. | |
| 1422 | |
| 489 | 1423 FUNCTION must not modify HASH-TABLE, with the one exception that FUNCTION |
| 428 | 1424 may remhash or puthash the entry currently being processed by FUNCTION. |
| 1425 */ | |
| 1426 (function, hash_table)) | |
| 1427 { | |
| 489 | 1428 const Lisp_Hash_Table * const ht = xhash_table (hash_table); |
| 1429 Lisp_Object * const objs = copy_compress_hentries (ht); | |
| 1430 Lisp_Object args[3]; | |
| 1431 const Lisp_Object *pobj, *end; | |
| 1432 int speccount = specpdl_depth (); | |
| 1433 struct gcpro gcpro1; | |
| 1434 | |
| 1435 record_unwind_protect (maphash_unwind, make_opaque_ptr ((void *)objs)); | |
| 1436 GCPRO1 (objs[0]); | |
| 1437 gcpro1.nvars = 2 * ht->count; | |
| 428 | 1438 |
| 489 | 1439 args[0] = function; |
| 1440 | |
| 1441 for (pobj = objs, end = pobj + 2 * ht->count; pobj < end; pobj += 2) | |
| 1442 { | |
| 1443 args[1] = pobj[0]; | |
| 1444 args[2] = pobj[1]; | |
| 1445 Ffuncall (countof (args), args); | |
| 1446 } | |
| 1447 | |
| 771 | 1448 unbind_to (speccount); |
| 489 | 1449 UNGCPRO; |
| 428 | 1450 |
| 1451 return Qnil; | |
| 1452 } | |
| 1453 | |
| 489 | 1454 /* Map *C* function FUNCTION over the elements of a non-weak lisp hash table. |
| 1455 FUNCTION must not modify HASH-TABLE, with the one exception that FUNCTION | |
| 1456 may puthash the entry currently being processed by FUNCTION. | |
| 1457 Mapping terminates if FUNCTION returns something other than 0. */ | |
| 428 | 1458 void |
| 489 | 1459 elisp_maphash_unsafe (maphash_function_t function, |
| 428 | 1460 Lisp_Object hash_table, void *extra_arg) |
| 1461 { | |
| 442 | 1462 const Lisp_Hash_Table *ht = XHASH_TABLE (hash_table); |
| 1204 | 1463 const htentry *e, *sentinel; |
| 428 | 1464 |
| 1465 for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) | |
| 1204 | 1466 if (!HTENTRY_CLEAR_P (e)) |
| 489 | 1467 if (function (e->key, e->value, extra_arg)) |
| 1468 return; | |
| 428 | 1469 } |
| 1470 | |
| 489 | 1471 /* Map *C* function FUNCTION over the elements of a lisp hash table. |
| 1472 It is safe for FUNCTION to modify HASH-TABLE. | |
| 1473 Mapping terminates if FUNCTION returns something other than 0. */ | |
| 1474 void | |
| 1475 elisp_maphash (maphash_function_t function, | |
| 1476 Lisp_Object hash_table, void *extra_arg) | |
| 1477 { | |
| 1478 const Lisp_Hash_Table * const ht = xhash_table (hash_table); | |
| 1479 Lisp_Object * const objs = copy_compress_hentries (ht); | |
| 1480 const Lisp_Object *pobj, *end; | |
| 1481 int speccount = specpdl_depth (); | |
| 1482 struct gcpro gcpro1; | |
| 1483 | |
| 1484 record_unwind_protect (maphash_unwind, make_opaque_ptr ((void *)objs)); | |
| 1485 GCPRO1 (objs[0]); | |
| 1486 gcpro1.nvars = 2 * ht->count; | |
| 1487 | |
| 1488 for (pobj = objs, end = pobj + 2 * ht->count; pobj < end; pobj += 2) | |
| 1489 if (function (pobj[0], pobj[1], extra_arg)) | |
| 1490 break; | |
| 1491 | |
| 771 | 1492 unbind_to (speccount); |
| 489 | 1493 UNGCPRO; |
| 1494 } | |
| 1495 | |
| 1496 /* Remove all elements of a lisp hash table satisfying *C* predicate PREDICATE. | |
| 1497 PREDICATE must not modify HASH-TABLE. */ | |
| 428 | 1498 void |
| 1499 elisp_map_remhash (maphash_function_t predicate, | |
| 1500 Lisp_Object hash_table, void *extra_arg) | |
| 1501 { | |
| 489 | 1502 const Lisp_Hash_Table * const ht = xhash_table (hash_table); |
| 1503 Lisp_Object * const objs = copy_compress_hentries (ht); | |
| 1504 const Lisp_Object *pobj, *end; | |
| 1505 int speccount = specpdl_depth (); | |
| 1506 struct gcpro gcpro1; | |
| 428 | 1507 |
| 489 | 1508 record_unwind_protect (maphash_unwind, make_opaque_ptr ((void *)objs)); |
| 1509 GCPRO1 (objs[0]); | |
| 1510 gcpro1.nvars = 2 * ht->count; | |
| 1511 | |
| 1512 for (pobj = objs, end = pobj + 2 * ht->count; pobj < end; pobj += 2) | |
| 1513 if (predicate (pobj[0], pobj[1], extra_arg)) | |
| 1514 Fremhash (pobj[0], hash_table); | |
| 1515 | |
| 771 | 1516 unbind_to (speccount); |
| 489 | 1517 UNGCPRO; |
| 428 | 1518 } |
| 1519 | |
| 1520 | |
| 1521 /************************************************************************/ | |
| 1522 /* garbage collecting weak hash tables */ | |
| 1523 /************************************************************************/ | |
| 1598 | 1524 #ifdef USE_KKCC |
| 2645 | 1525 #define MARK_OBJ(obj) do { \ |
| 1526 Lisp_Object mo_obj = (obj); \ | |
| 1527 if (!marked_p (mo_obj)) \ | |
| 1528 { \ | |
| 1529 kkcc_gc_stack_push_lisp_object (mo_obj, 0, -1); \ | |
| 1530 did_mark = 1; \ | |
| 1531 } \ | |
| 1598 | 1532 } while (0) |
| 1533 | |
| 1534 #else /* NO USE_KKCC */ | |
| 1535 | |
| 442 | 1536 #define MARK_OBJ(obj) do { \ |
| 1537 Lisp_Object mo_obj = (obj); \ | |
| 1538 if (!marked_p (mo_obj)) \ | |
| 1539 { \ | |
| 1540 mark_object (mo_obj); \ | |
| 1541 did_mark = 1; \ | |
| 1542 } \ | |
| 1543 } while (0) | |
| 1598 | 1544 #endif /*NO USE_KKCC */ |
| 442 | 1545 |
| 428 | 1546 |
| 1547 /* Complete the marking for semi-weak hash tables. */ | |
| 1548 int | |
| 1549 finish_marking_weak_hash_tables (void) | |
| 1550 { | |
| 1551 Lisp_Object hash_table; | |
| 1552 int did_mark = 0; | |
| 1553 | |
| 1554 for (hash_table = Vall_weak_hash_tables; | |
| 1555 !NILP (hash_table); | |
| 1556 hash_table = XHASH_TABLE (hash_table)->next_weak) | |
| 1557 { | |
| 442 | 1558 const Lisp_Hash_Table *ht = XHASH_TABLE (hash_table); |
| 1204 | 1559 const htentry *e = ht->hentries; |
| 1560 const htentry *sentinel = e + ht->size; | |
| 428 | 1561 |
| 1562 if (! marked_p (hash_table)) | |
| 1563 /* The hash table is probably garbage. Ignore it. */ | |
| 1564 continue; | |
| 1565 | |
| 1566 /* Now, scan over all the pairs. For all pairs that are | |
| 1567 half-marked, we may need to mark the other half if we're | |
| 1568 keeping this pair. */ | |
| 1569 switch (ht->weakness) | |
| 1570 { | |
| 1571 case HASH_TABLE_KEY_WEAK: | |
| 1572 for (; e < sentinel; e++) | |
| 1204 | 1573 if (!HTENTRY_CLEAR_P (e)) |
| 428 | 1574 if (marked_p (e->key)) |
| 1575 MARK_OBJ (e->value); | |
| 1576 break; | |
| 1577 | |
| 1578 case HASH_TABLE_VALUE_WEAK: | |
| 1579 for (; e < sentinel; e++) | |
| 1204 | 1580 if (!HTENTRY_CLEAR_P (e)) |
| 428 | 1581 if (marked_p (e->value)) |
| 1582 MARK_OBJ (e->key); | |
| 1583 break; | |
| 1584 | |
| 442 | 1585 case HASH_TABLE_KEY_VALUE_WEAK: |
| 1586 for (; e < sentinel; e++) | |
| 1204 | 1587 if (!HTENTRY_CLEAR_P (e)) |
| 442 | 1588 { |
| 1589 if (marked_p (e->value)) | |
| 1590 MARK_OBJ (e->key); | |
| 1591 else if (marked_p (e->key)) | |
| 1592 MARK_OBJ (e->value); | |
| 1593 } | |
| 1594 break; | |
| 1595 | |
| 428 | 1596 case HASH_TABLE_KEY_CAR_WEAK: |
| 1597 for (; e < sentinel; e++) | |
| 1204 | 1598 if (!HTENTRY_CLEAR_P (e)) |
| 428 | 1599 if (!CONSP (e->key) || marked_p (XCAR (e->key))) |
| 1600 { | |
| 1601 MARK_OBJ (e->key); | |
| 1602 MARK_OBJ (e->value); | |
| 1603 } | |
| 1604 break; | |
| 1605 | |
| 450 | 1606 /* We seem to be sprouting new weakness types at an alarming |
| 1607 rate. At least this is not externally visible - and in | |
| 1608 fact all of these KEY_CAR_* types are only used by the | |
| 1609 glyph code. */ | |
| 1610 case HASH_TABLE_KEY_CAR_VALUE_WEAK: | |
| 1611 for (; e < sentinel; e++) | |
| 1204 | 1612 if (!HTENTRY_CLEAR_P (e)) |
| 450 | 1613 { |
| 1614 if (!CONSP (e->key) || marked_p (XCAR (e->key))) | |
| 1615 { | |
| 1616 MARK_OBJ (e->key); | |
| 1617 MARK_OBJ (e->value); | |
| 1618 } | |
| 1619 else if (marked_p (e->value)) | |
| 1620 MARK_OBJ (e->key); | |
| 1621 } | |
| 1622 break; | |
| 1623 | |
| 428 | 1624 case HASH_TABLE_VALUE_CAR_WEAK: |
| 1625 for (; e < sentinel; e++) | |
| 1204 | 1626 if (!HTENTRY_CLEAR_P (e)) |
| 428 | 1627 if (!CONSP (e->value) || marked_p (XCAR (e->value))) |
| 1628 { | |
| 1629 MARK_OBJ (e->key); | |
| 1630 MARK_OBJ (e->value); | |
| 1631 } | |
| 1632 break; | |
| 1633 | |
| 1634 default: | |
| 1635 break; | |
| 1636 } | |
| 1637 } | |
| 1638 | |
| 1639 return did_mark; | |
| 1640 } | |
| 1641 | |
| 1642 void | |
| 1643 prune_weak_hash_tables (void) | |
| 1644 { | |
| 1645 Lisp_Object hash_table, prev = Qnil; | |
| 1646 for (hash_table = Vall_weak_hash_tables; | |
| 1647 !NILP (hash_table); | |
| 1648 hash_table = XHASH_TABLE (hash_table)->next_weak) | |
| 1649 { | |
| 1650 if (! marked_p (hash_table)) | |
| 1651 { | |
| 1652 /* This hash table itself is garbage. Remove it from the list. */ | |
| 1653 if (NILP (prev)) | |
| 1654 Vall_weak_hash_tables = XHASH_TABLE (hash_table)->next_weak; | |
| 1655 else | |
| 1656 XHASH_TABLE (prev)->next_weak = XHASH_TABLE (hash_table)->next_weak; | |
| 1657 } | |
| 1658 else | |
| 1659 { | |
| 1660 /* Now, scan over all the pairs. Remove all of the pairs | |
| 1661 in which the key or value, or both, is unmarked | |
| 1662 (depending on the weakness of the hash table). */ | |
| 1663 Lisp_Hash_Table *ht = XHASH_TABLE (hash_table); | |
| 1204 | 1664 htentry *entries = ht->hentries; |
| 1665 htentry *sentinel = entries + ht->size; | |
| 1666 htentry *e; | |
| 428 | 1667 |
| 1668 for (e = entries; e < sentinel; e++) | |
| 1204 | 1669 if (!HTENTRY_CLEAR_P (e)) |
| 428 | 1670 { |
| 1671 again: | |
| 1672 if (!marked_p (e->key) || !marked_p (e->value)) | |
| 1673 { | |
| 1674 remhash_1 (ht, entries, e); | |
| 1204 | 1675 if (!HTENTRY_CLEAR_P (e)) |
| 428 | 1676 goto again; |
| 1677 } | |
| 1678 } | |
| 1679 | |
| 1680 prev = hash_table; | |
| 1681 } | |
| 1682 } | |
| 1683 } | |
| 1684 | |
| 1685 /* Return a hash value for an array of Lisp_Objects of size SIZE. */ | |
| 1686 | |
| 665 | 1687 Hashcode |
| 428 | 1688 internal_array_hash (Lisp_Object *arr, int size, int depth) |
| 1689 { | |
| 1690 int i; | |
| 665 | 1691 Hashcode hash = 0; |
| 442 | 1692 depth++; |
| 428 | 1693 |
| 1694 if (size <= 5) | |
| 1695 { | |
| 1696 for (i = 0; i < size; i++) | |
| 442 | 1697 hash = HASH2 (hash, internal_hash (arr[i], depth)); |
| 428 | 1698 return hash; |
| 1699 } | |
| 1700 | |
| 1701 /* just pick five elements scattered throughout the array. | |
| 1702 A slightly better approach would be to offset by some | |
| 1703 noise factor from the points chosen below. */ | |
| 1704 for (i = 0; i < 5; i++) | |
| 442 | 1705 hash = HASH2 (hash, internal_hash (arr[i*size/5], depth)); |
| 428 | 1706 |
| 1707 return hash; | |
| 1708 } | |
| 1709 | |
| 1710 /* Return a hash value for a Lisp_Object. This is for use when hashing | |
| 1711 objects with the comparison being `equal' (for `eq', you can just | |
| 1712 use the Lisp_Object itself as the hash value). You need to make a | |
| 1713 tradeoff between the speed of the hash function and how good the | |
| 1714 hashing is. In particular, the hash function needs to be FAST, | |
| 1715 so you can't just traipse down the whole tree hashing everything | |
| 1716 together. Most of the time, objects will differ in the first | |
| 1717 few elements you hash. Thus, we only go to a short depth (5) | |
| 1718 and only hash at most 5 elements out of a vector. Theoretically | |
| 1719 we could still take 5^5 time (a big big number) to compute a | |
| 1720 hash, but practically this won't ever happen. */ | |
| 1721 | |
| 665 | 1722 Hashcode |
| 428 | 1723 internal_hash (Lisp_Object obj, int depth) |
| 1724 { | |
| 1725 if (depth > 5) | |
| 1726 return 0; | |
|
4398
479443c0f95a
Have list hashes depend on the order of the contents, as is the case for vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
1727 |
|
479443c0f95a
Have list hashes depend on the order of the contents, as is the case for vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
1728 if (CONSP(obj)) |
| 428 | 1729 { |
|
4398
479443c0f95a
Have list hashes depend on the order of the contents, as is the case for vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
1730 Hashcode hash, h; |
|
479443c0f95a
Have list hashes depend on the order of the contents, as is the case for vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
1731 int s; |
|
479443c0f95a
Have list hashes depend on the order of the contents, as is the case for vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
1732 |
|
479443c0f95a
Have list hashes depend on the order of the contents, as is the case for vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
1733 depth += 1; |
|
479443c0f95a
Have list hashes depend on the order of the contents, as is the case for vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
1734 |
|
479443c0f95a
Have list hashes depend on the order of the contents, as is the case for vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
1735 if (!CONSP(XCDR(obj))) |
|
479443c0f95a
Have list hashes depend on the order of the contents, as is the case for vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
1736 { |
|
479443c0f95a
Have list hashes depend on the order of the contents, as is the case for vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
1737 /* special case for '(a . b) conses */ |
|
479443c0f95a
Have list hashes depend on the order of the contents, as is the case for vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
1738 return HASH2(internal_hash(XCAR(obj), depth), |
|
479443c0f95a
Have list hashes depend on the order of the contents, as is the case for vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
1739 internal_hash(XCDR(obj), depth)); |
|
479443c0f95a
Have list hashes depend on the order of the contents, as is the case for vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
1740 } |
|
479443c0f95a
Have list hashes depend on the order of the contents, as is the case for vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
1741 |
|
479443c0f95a
Have list hashes depend on the order of the contents, as is the case for vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
1742 /* Don't simply tail recurse; we want to hash lists with the |
|
479443c0f95a
Have list hashes depend on the order of the contents, as is the case for vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
1743 same contents in distinct orders differently. */ |
|
479443c0f95a
Have list hashes depend on the order of the contents, as is the case for vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
1744 hash = internal_hash(XCAR(obj), depth); |
|
479443c0f95a
Have list hashes depend on the order of the contents, as is the case for vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
1745 |
|
479443c0f95a
Have list hashes depend on the order of the contents, as is the case for vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
1746 obj = XCDR(obj); |
|
479443c0f95a
Have list hashes depend on the order of the contents, as is the case for vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
1747 for (s = 1; s < 6 && CONSP(obj); obj = XCDR(obj), s++) |
|
479443c0f95a
Have list hashes depend on the order of the contents, as is the case for vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
1748 { |
|
479443c0f95a
Have list hashes depend on the order of the contents, as is the case for vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
1749 h = internal_hash(XCAR(obj), depth); |
|
479443c0f95a
Have list hashes depend on the order of the contents, as is the case for vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
1750 hash = HASH3(hash, h, s); |
|
479443c0f95a
Have list hashes depend on the order of the contents, as is the case for vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
1751 } |
|
479443c0f95a
Have list hashes depend on the order of the contents, as is the case for vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
1752 |
|
479443c0f95a
Have list hashes depend on the order of the contents, as is the case for vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
1753 return hash; |
| 428 | 1754 } |
| 1755 if (STRINGP (obj)) | |
| 1756 { | |
| 1757 return hash_string (XSTRING_DATA (obj), XSTRING_LENGTH (obj)); | |
| 1758 } | |
| 1759 if (LRECORDP (obj)) | |
| 1760 { | |
| 442 | 1761 const struct lrecord_implementation |
| 428 | 1762 *imp = XRECORD_LHEADER_IMPLEMENTATION (obj); |
| 1763 if (imp->hash) | |
| 1764 return imp->hash (obj, depth); | |
| 1765 } | |
| 1766 | |
| 1767 return LISP_HASH (obj); | |
| 1768 } | |
| 1769 | |
| 1770 DEFUN ("sxhash", Fsxhash, 1, 1, 0, /* | |
| 1771 Return a hash value for OBJECT. | |
| 444 | 1772 \(equal obj1 obj2) implies (= (sxhash obj1) (sxhash obj2)). |
| 428 | 1773 */ |
| 1774 (object)) | |
| 1775 { | |
| 1776 return make_int (internal_hash (object, 0)); | |
| 1777 } | |
| 1778 | |
| 1779 #if 0 | |
| 826 | 1780 DEFUN ("internal-hash-value", Finternal_hash_value, 1, 1, 0, /* |
| 428 | 1781 Hash value of OBJECT. For debugging. |
| 1782 The value is returned as (HIGH . LOW). | |
| 1783 */ | |
| 1784 (object)) | |
| 1785 { | |
| 1786 /* This function is pretty 32bit-centric. */ | |
| 665 | 1787 Hashcode hash = internal_hash (object, 0); |
| 428 | 1788 return Fcons (hash >> 16, hash & 0xffff); |
| 1789 } | |
| 1790 #endif | |
| 1791 | |
| 1792 | |
| 1793 /************************************************************************/ | |
| 1794 /* initialization */ | |
| 1795 /************************************************************************/ | |
| 1796 | |
| 1797 void | |
| 1798 syms_of_elhash (void) | |
| 1799 { | |
| 1800 DEFSUBR (Fhash_table_p); | |
| 1801 DEFSUBR (Fmake_hash_table); | |
| 1802 DEFSUBR (Fcopy_hash_table); | |
| 1803 DEFSUBR (Fgethash); | |
| 1804 DEFSUBR (Fremhash); | |
| 1805 DEFSUBR (Fputhash); | |
| 1806 DEFSUBR (Fclrhash); | |
| 1807 DEFSUBR (Fmaphash); | |
| 1808 DEFSUBR (Fhash_table_count); | |
| 1809 DEFSUBR (Fhash_table_test); | |
| 1810 DEFSUBR (Fhash_table_size); | |
| 1811 DEFSUBR (Fhash_table_rehash_size); | |
| 1812 DEFSUBR (Fhash_table_rehash_threshold); | |
| 1813 DEFSUBR (Fhash_table_weakness); | |
| 1814 DEFSUBR (Fhash_table_type); /* obsolete */ | |
| 1815 DEFSUBR (Fsxhash); | |
| 1816 #if 0 | |
| 1817 DEFSUBR (Finternal_hash_value); | |
| 1818 #endif | |
| 1819 | |
| 563 | 1820 DEFSYMBOL_MULTIWORD_PREDICATE (Qhash_tablep); |
| 1821 DEFSYMBOL (Qhash_table); | |
| 1822 DEFSYMBOL (Qhashtable); | |
| 1823 DEFSYMBOL (Qweakness); | |
| 1824 DEFSYMBOL (Qvalue); | |
| 1825 DEFSYMBOL (Qkey_or_value); | |
| 1826 DEFSYMBOL (Qkey_and_value); | |
| 1827 DEFSYMBOL (Qrehash_size); | |
| 1828 DEFSYMBOL (Qrehash_threshold); | |
| 428 | 1829 |
| 563 | 1830 DEFSYMBOL (Qweak); /* obsolete */ |
| 1831 DEFSYMBOL (Qkey_weak); /* obsolete */ | |
| 1832 DEFSYMBOL (Qkey_or_value_weak); /* obsolete */ | |
| 1833 DEFSYMBOL (Qvalue_weak); /* obsolete */ | |
| 1834 DEFSYMBOL (Qnon_weak); /* obsolete */ | |
| 428 | 1835 |
| 563 | 1836 DEFKEYWORD (Q_test); |
| 1837 DEFKEYWORD (Q_size); | |
| 1838 DEFKEYWORD (Q_rehash_size); | |
| 1839 DEFKEYWORD (Q_rehash_threshold); | |
| 1840 DEFKEYWORD (Q_weakness); | |
| 1841 DEFKEYWORD (Q_type); /* obsolete */ | |
| 428 | 1842 } |
| 1843 | |
| 1844 void | |
| 771 | 1845 init_elhash_once_early (void) |
| 428 | 1846 { |
| 771 | 1847 INIT_LRECORD_IMPLEMENTATION (hash_table); |
| 3092 | 1848 #ifdef NEW_GC |
| 1849 INIT_LRECORD_IMPLEMENTATION (hash_table_entry); | |
| 1850 #endif /* NEW_GC */ | |
| 771 | 1851 |
| 428 | 1852 /* This must NOT be staticpro'd */ |
| 1853 Vall_weak_hash_tables = Qnil; | |
| 452 | 1854 dump_add_weak_object_chain (&Vall_weak_hash_tables); |
| 428 | 1855 } |