comparison src/elhash.c @ 410:de805c49cfc1 r21-2-35

Import from CVS: tag r21-2-35
author cvs
date Mon, 13 Aug 2007 11:19:21 +0200
parents 2f8bb876ab1d
children 697ef44129c6
comparison
equal deleted inserted replaced
409:301b9ebbdf3b 410:de805c49cfc1
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_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_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;
352 { 353 {
353 sprintf (buf, " weakness %s", 354 sprintf (buf, " weakness %s",
354 (ht->weakness == HASH_TABLE_WEAK ? "t" : 355 (ht->weakness == HASH_TABLE_WEAK ? "t" :
355 ht->weakness == HASH_TABLE_KEY_WEAK ? "key" : 356 ht->weakness == HASH_TABLE_KEY_WEAK ? "key" :
356 ht->weakness == HASH_TABLE_VALUE_WEAK ? "value" : 357 ht->weakness == HASH_TABLE_VALUE_WEAK ? "value" :
358 ht->weakness == HASH_TABLE_KEY_VALUE_WEAK ? "key-value" :
357 "you-d-better-not-see-this")); 359 "you-d-better-not-see-this"));
358 write_c_string (buf, printcharfun); 360 write_c_string (buf, printcharfun);
359 } 361 }
360 362
361 if (ht->count) 363 if (ht->count)
540 Error_behavior errb) 542 Error_behavior errb)
541 { 543 {
542 if (EQ (value, Qnil)) return 1; 544 if (EQ (value, Qnil)) return 1;
543 if (EQ (value, Qt)) return 1; 545 if (EQ (value, Qt)) return 1;
544 if (EQ (value, Qkey)) return 1; 546 if (EQ (value, Qkey)) return 1;
547 if (EQ (value, Qkey_value)) return 1;
545 if (EQ (value, Qvalue)) return 1; 548 if (EQ (value, Qvalue)) return 1;
546 549
547 /* Following values are obsolete as of 19990901 in xemacs-21.2 */ 550 /* Following values are obsolete as of 19990901 in xemacs-21.2 */
548 if (EQ (value, Qnon_weak)) return 1; 551 if (EQ (value, Qnon_weak)) return 1;
549 if (EQ (value, Qweak)) return 1; 552 if (EQ (value, Qweak)) return 1;
550 if (EQ (value, Qkey_weak)) return 1; 553 if (EQ (value, Qkey_weak)) return 1;
554 if (EQ (value, Qkey_value_weak)) return 1;
551 if (EQ (value, Qvalue_weak)) return 1; 555 if (EQ (value, Qvalue_weak)) return 1;
552 556
553 maybe_signal_simple_error ("Invalid hash table weakness", 557 maybe_signal_simple_error ("Invalid hash table weakness",
554 value, Qhash_table, errb); 558 value, Qhash_table, errb);
555 return 0; 559 return 0;
559 decode_hash_table_weakness (Lisp_Object obj) 563 decode_hash_table_weakness (Lisp_Object obj)
560 { 564 {
561 if (EQ (obj, Qnil)) return HASH_TABLE_NON_WEAK; 565 if (EQ (obj, Qnil)) return HASH_TABLE_NON_WEAK;
562 if (EQ (obj, Qt)) return HASH_TABLE_WEAK; 566 if (EQ (obj, Qt)) return HASH_TABLE_WEAK;
563 if (EQ (obj, Qkey)) return HASH_TABLE_KEY_WEAK; 567 if (EQ (obj, Qkey)) return HASH_TABLE_KEY_WEAK;
568 if (EQ (obj, Qkey_value)) return HASH_TABLE_KEY_VALUE_WEAK;
564 if (EQ (obj, Qvalue)) return HASH_TABLE_VALUE_WEAK; 569 if (EQ (obj, Qvalue)) return HASH_TABLE_VALUE_WEAK;
565 570
566 /* Following values are obsolete as of 19990901 in xemacs-21.2 */ 571 /* Following values are obsolete as of 19990901 in xemacs-21.2 */
567 if (EQ (obj, Qnon_weak)) return HASH_TABLE_NON_WEAK; 572 if (EQ (obj, Qnon_weak)) return HASH_TABLE_NON_WEAK;
568 if (EQ (obj, Qweak)) return HASH_TABLE_WEAK; 573 if (EQ (obj, Qweak)) return HASH_TABLE_WEAK;
569 if (EQ (obj, Qkey_weak)) return HASH_TABLE_KEY_WEAK; 574 if (EQ (obj, Qkey_weak)) return HASH_TABLE_KEY_WEAK;
575 if (EQ (obj, Qkey_value_weak)) return HASH_TABLE_KEY_VALUE_WEAK;
570 if (EQ (obj, Qvalue_weak)) return HASH_TABLE_VALUE_WEAK; 576 if (EQ (obj, Qvalue_weak)) return HASH_TABLE_VALUE_WEAK;
571 577
572 signal_simple_error ("Invalid hash table weakness", obj); 578 signal_simple_error ("Invalid hash table weakness", obj);
573 return HASH_TABLE_NON_WEAK; /* not reached */ 579 return HASH_TABLE_NON_WEAK; /* not reached */
574 } 580 }
798 the factor by which to increase the size of the hash table when enlarging. 804 the factor by which to increase the size of the hash table when enlarging.
799 805
800 Keyword :rehash-threshold must be a float between 0.0 and 1.0, 806 Keyword :rehash-threshold must be a float between 0.0 and 1.0,
801 and specifies the load factor of the hash table which triggers enlarging. 807 and specifies the load factor of the hash table which triggers enlarging.
802 808
803 Non-standard keyword :weakness can be `nil' (default), `t', `key' or `value'. 809 Non-standard keyword :weakness can be `nil' (default), `t', `key', `value'
810 or `key-value'.
804 811
805 A weak hash table is one whose pointers do not count as GC referents: 812 A weak hash table is one whose pointers do not count as GC referents:
806 for any key-value pair in the hash table, if the only remaining pointer 813 for any key-value pair in the hash table, if the only remaining pointer
807 to either the key or the value is in a weak hash table, then the pair 814 to either the key or the value is in a weak hash table, then the pair
808 will be removed from the hash table, and the key and value collected. 815 will be removed from the hash table, and the key and value collected.
818 A value-weak hash table is similar to a fully-weak hash table except 825 A value-weak hash table is similar to a fully-weak hash table except
819 that a key-value pair will be removed only if the value remains 826 that a key-value pair will be removed only if the value remains
820 unmarked outside of weak hash tables. The pair will remain in the 827 unmarked outside of weak hash tables. The pair will remain in the
821 hash table if the value is pointed to by something other than a weak 828 hash table if the value is pointed to by something other than a weak
822 hash table, even if the key is not. 829 hash table, even if the key is not.
830
831 A key-value-weak hash table is similar to a fully-weak hash table except
832 that a key-value pair will be removed only if the value and the key remain
833 unmarked outside of weak hash tables. The pair will remain in the
834 hash table if the value or key are pointed to by something other than a weak
835 hash table, even if the other is not.
823 */ 836 */
824 (int nargs, Lisp_Object *args)) 837 (int nargs, Lisp_Object *args))
825 { 838 {
826 int i = 0; 839 int i = 0;
827 Lisp_Object test = Qnil; 840 Lisp_Object test = Qnil;
1115 { 1128 {
1116 switch (xhash_table (hash_table)->weakness) 1129 switch (xhash_table (hash_table)->weakness)
1117 { 1130 {
1118 case HASH_TABLE_WEAK: return Qt; 1131 case HASH_TABLE_WEAK: return Qt;
1119 case HASH_TABLE_KEY_WEAK: return Qkey; 1132 case HASH_TABLE_KEY_WEAK: return Qkey;
1133 case HASH_TABLE_KEY_VALUE_WEAK: return Qkey_value;
1120 case HASH_TABLE_VALUE_WEAK: return Qvalue; 1134 case HASH_TABLE_VALUE_WEAK: return Qvalue;
1121 default: return Qnil; 1135 default: return Qnil;
1122 } 1136 }
1123 } 1137 }
1124 1138
1131 { 1145 {
1132 switch (xhash_table (hash_table)->weakness) 1146 switch (xhash_table (hash_table)->weakness)
1133 { 1147 {
1134 case HASH_TABLE_WEAK: return Qweak; 1148 case HASH_TABLE_WEAK: return Qweak;
1135 case HASH_TABLE_KEY_WEAK: return Qkey_weak; 1149 case HASH_TABLE_KEY_WEAK: return Qkey_weak;
1150 case HASH_TABLE_KEY_VALUE_WEAK: return Qkey_value_weak;
1136 case HASH_TABLE_VALUE_WEAK: return Qvalue_weak; 1151 case HASH_TABLE_VALUE_WEAK: return Qvalue_weak;
1137 default: return Qnon_weak; 1152 default: return Qnon_weak;
1138 } 1153 }
1139 } 1154 }
1140 1155
1262 case HASH_TABLE_VALUE_WEAK: 1277 case HASH_TABLE_VALUE_WEAK:
1263 for (; e < sentinel; e++) 1278 for (; e < sentinel; e++)
1264 if (!HENTRY_CLEAR_P (e)) 1279 if (!HENTRY_CLEAR_P (e))
1265 if (marked_p (e->value)) 1280 if (marked_p (e->value))
1266 MARK_OBJ (e->key); 1281 MARK_OBJ (e->key);
1282 break;
1283
1284 case HASH_TABLE_KEY_VALUE_WEAK:
1285 for (; e < sentinel; e++)
1286 if (!HENTRY_CLEAR_P (e))
1287 {
1288 if (marked_p (e->value))
1289 MARK_OBJ (e->key);
1290 else if (marked_p (e->key))
1291 MARK_OBJ (e->value);
1292 }
1267 break; 1293 break;
1268 1294
1269 case HASH_TABLE_KEY_CAR_WEAK: 1295 case HASH_TABLE_KEY_CAR_WEAK:
1270 for (; e < sentinel; e++) 1296 for (; e < sentinel; e++)
1271 if (!HENTRY_CLEAR_P (e)) 1297 if (!HENTRY_CLEAR_P (e))
1456 defsymbol (&Qhash_tablep, "hash-table-p"); 1482 defsymbol (&Qhash_tablep, "hash-table-p");
1457 defsymbol (&Qhash_table, "hash-table"); 1483 defsymbol (&Qhash_table, "hash-table");
1458 defsymbol (&Qhashtable, "hashtable"); 1484 defsymbol (&Qhashtable, "hashtable");
1459 defsymbol (&Qweakness, "weakness"); 1485 defsymbol (&Qweakness, "weakness");
1460 defsymbol (&Qvalue, "value"); 1486 defsymbol (&Qvalue, "value");
1487 defsymbol (&Qkey_value, "key-value");
1461 defsymbol (&Qrehash_size, "rehash-size"); 1488 defsymbol (&Qrehash_size, "rehash-size");
1462 defsymbol (&Qrehash_threshold, "rehash-threshold"); 1489 defsymbol (&Qrehash_threshold, "rehash-threshold");
1463 1490
1464 defsymbol (&Qweak, "weak"); /* obsolete */ 1491 defsymbol (&Qweak, "weak"); /* obsolete */
1465 defsymbol (&Qkey_weak, "key-weak"); /* obsolete */ 1492 defsymbol (&Qkey_weak, "key-weak"); /* obsolete */
1493 defsymbol (&Qkey_value_weak, "key-value-weak"); /* obsolete */
1466 defsymbol (&Qvalue_weak, "value-weak"); /* obsolete */ 1494 defsymbol (&Qvalue_weak, "value-weak"); /* obsolete */
1467 defsymbol (&Qnon_weak, "non-weak"); /* obsolete */ 1495 defsymbol (&Qnon_weak, "non-weak"); /* obsolete */
1468 1496
1469 defkeyword (&Q_test, ":test"); 1497 defkeyword (&Q_test, ":test");
1470 defkeyword (&Q_size, ":size"); 1498 defkeyword (&Q_size, ":size");