Mercurial > hg > xemacs-beta

comparison src/elhash.c @ 5133:444a448b2f53

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge branch ben-lisp-object into default branch
author Ben Wing <ben@xemacs.org>
date Sun, 07 Mar 2010 06:47:37 -0600
parents 7be849cb8828
children f965e31a35f0
comparison
equal deleted inserted replaced
5113:b2dcf6a6d8ab 5133:444a448b2f53
1 /* Implementation of the hash table lisp object type. 1 /* Implementation of the hash table lisp object type.
2 Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. 2 Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
3 Copyright (C) 1995, 1996, 2002, 2004 Ben Wing. 3 Copyright (C) 1995, 1996, 2002, 2004, 2010 Ben Wing.
4 Copyright (C) 1997 Free Software Foundation, Inc. 4 Copyright (C) 1997 Free Software Foundation, Inc.
5 5
6 This file is part of XEmacs. 6 This file is part of XEmacs.
7 7
8 XEmacs is free software; you can redistribute it and/or modify it 8 XEmacs is free software; you can redistribute it and/or modify it
94 static Lisp_Object Qweak, Qkey_weak, Qvalue_weak, Qkey_or_value_weak; 94 static Lisp_Object Qweak, Qkey_weak, Qvalue_weak, Qkey_or_value_weak;
95 static Lisp_Object Qnon_weak, Q_type, Q_data; 95 static Lisp_Object Qnon_weak, Q_type, Q_data;
96 96
97 struct Lisp_Hash_Table 97 struct Lisp_Hash_Table
98 { 98 {
99 struct LCRECORD_HEADER header; 99 NORMAL_LISP_OBJECT_HEADER header;
100 Elemcount size; 100 Elemcount size;
101 Elemcount count; 101 Elemcount count;
102 Elemcount rehash_count; 102 Elemcount rehash_count;
103 double rehash_size; 103 double rehash_size;
104 double rehash_threshold; 104 double rehash_threshold;
419 if (!DUMPEDP (hentries)) 419 if (!DUMPEDP (hentries))
420 xfree (hentries); 420 xfree (hentries);
421 } 421 }
422 422
423 static void 423 static void
424 finalize_hash_table (void *header, int for_disksave) 424 finalize_hash_table (Lisp_Object obj)
425 { 425 {
426 if (!for_disksave) 426 Lisp_Hash_Table *ht = XHASH_TABLE (obj);
427 { 427 free_hentries (ht->hentries, ht->size);
428 Lisp_Hash_Table *ht = (Lisp_Hash_Table *) header; 428 ht->hentries = 0;
429 free_hentries (ht->hentries, ht->size);
430 ht->hentries = 0;
431 }
432 } 429 }
433 #endif /* not NEW_GC */ 430 #endif /* not NEW_GC */
434 431
435 static const struct memory_description htentry_description_1[] = { 432 static const struct memory_description htentry_description_1[] = {
436 { XD_LISP_OBJECT, offsetof (htentry, key) }, 433 { XD_LISP_OBJECT, offsetof (htentry, key) },
453 static const struct sized_memory_description htentry_weak_description = { 450 static const struct sized_memory_description htentry_weak_description = {
454 sizeof (htentry), 451 sizeof (htentry),
455 htentry_weak_description_1 452 htentry_weak_description_1
456 }; 453 };
457 454
458 DEFINE_LRECORD_IMPLEMENTATION ("hash-table-entry", hash_table_entry, 455 DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("hash-table-entry", hash_table_entry,
459 1, /*dumpable-flag*/ 456 0, htentry_description_1,
460 0, 0, 0, 0, 0, 457 Lisp_Hash_Table_Entry);
461 htentry_description_1,
462 Lisp_Hash_Table_Entry);
463 #endif /* NEW_GC */ 458 #endif /* NEW_GC */
464 459
465 static const struct memory_description htentry_union_description_1[] = { 460 static const struct memory_description htentry_union_description_1[] = {
466 /* Note: XD_INDIRECT in this table refers to the surrounding table, 461 /* Note: XD_INDIRECT in this table refers to the surrounding table,
467 and so this will work. */ 462 and so this will work. */
492 { XD_LO_LINK, offsetof (Lisp_Hash_Table, next_weak) }, 487 { XD_LO_LINK, offsetof (Lisp_Hash_Table, next_weak) },
493 { XD_END } 488 { XD_END }
494 }; 489 };
495 490
496 #ifdef NEW_GC 491 #ifdef NEW_GC
497 DEFINE_LRECORD_IMPLEMENTATION ("hash-table", hash_table, 492 DEFINE_DUMPABLE_LISP_OBJECT ("hash-table", hash_table,
498 1, /*dumpable-flag*/ 493 mark_hash_table, print_hash_table,
499 mark_hash_table, print_hash_table, 494 0, hash_table_equal, hash_table_hash,
500 0, hash_table_equal, hash_table_hash, 495 hash_table_description,
501 hash_table_description, 496 Lisp_Hash_Table);
502 Lisp_Hash_Table);
503 #else /* not NEW_GC */ 497 #else /* not NEW_GC */
504 DEFINE_LRECORD_IMPLEMENTATION ("hash-table", hash_table, 498 DEFINE_DUMPABLE_LISP_OBJECT ("hash-table", hash_table,
505 1, /*dumpable-flag*/ 499 mark_hash_table, print_hash_table,
506 mark_hash_table, print_hash_table, 500 finalize_hash_table,
507 finalize_hash_table, 501 hash_table_equal, hash_table_hash,
508 hash_table_equal, hash_table_hash, 502 hash_table_description,
509 hash_table_description, 503 Lisp_Hash_Table);
510 Lisp_Hash_Table);
511 #endif /* not NEW_GC */ 504 #endif /* not NEW_GC */
512 505
513 static Lisp_Hash_Table * 506 static Lisp_Hash_Table *
514 xhash_table (Lisp_Object hash_table) 507 xhash_table (Lisp_Object hash_table)
515 { 508 {
531 { 524 {
532 ht->rehash_count = (Elemcount) 525 ht->rehash_count = (Elemcount)
533 ((double) ht->size * ht->rehash_threshold); 526 ((double) ht->size * ht->rehash_threshold);
534 ht->golden_ratio = (Elemcount) 527 ht->golden_ratio = (Elemcount)
535 ((double) ht->size * (.6180339887 / (double) sizeof (Lisp_Object))); 528 ((double) ht->size * (.6180339887 / (double) sizeof (Lisp_Object)));
529 }
530
531 static htentry *
532 allocate_hash_table_entries (Elemcount size)
533 {
534 #ifdef NEW_GC
535 return XHASH_TABLE_ENTRY (alloc_lrecord_array
536 (size, &lrecord_hash_table_entry));
537 #else /* not NEW_GC */
538 return xnew_array_and_zero (htentry, size);
539 #endif /* not NEW_GC */
536 } 540 }
537 541
538 Lisp_Object 542 Lisp_Object
539 make_standard_lisp_hash_table (enum hash_table_test test, 543 make_standard_lisp_hash_table (enum hash_table_test test,
540 Elemcount size, 544 Elemcount size,
577 Elemcount size, 581 Elemcount size,
578 double rehash_size, 582 double rehash_size,
579 double rehash_threshold, 583 double rehash_threshold,
580 enum hash_table_weakness weakness) 584 enum hash_table_weakness weakness)
581 { 585 {
582 Lisp_Object hash_table; 586 Lisp_Object hash_table = ALLOC_NORMAL_LISP_OBJECT (hash_table);
583 Lisp_Hash_Table *ht = ALLOC_LCRECORD_TYPE (Lisp_Hash_Table, &lrecord_hash_table); 587 Lisp_Hash_Table *ht = XHASH_TABLE (hash_table);
584 588
585 ht->test_function = test_function; 589 ht->test_function = test_function;
586 ht->hash_function = hash_function; 590 ht->hash_function = hash_function;
587 ht->weakness = weakness; 591 ht->weakness = weakness;
588 592
600 ht->count = 0; 604 ht->count = 0;
601 605
602 compute_hash_table_derived_values (ht); 606 compute_hash_table_derived_values (ht);
603 607
604 /* We leave room for one never-occupied sentinel htentry at the end. */ 608 /* We leave room for one never-occupied sentinel htentry at the end. */
605 #ifdef NEW_GC 609 ht->hentries = allocate_hash_table_entries (ht->size + 1);
606 ht->hentries = (htentry *) alloc_lrecord_array (sizeof (htentry),
607 ht->size + 1,
608 &lrecord_hash_table_entry);
609 #else /* not NEW_GC */
610 ht->hentries = xnew_array_and_zero (htentry, ht->size + 1);
611 #endif /* not NEW_GC */
612
613 hash_table = wrap_hash_table (ht);
614 610
615 if (weakness == HASH_TABLE_NON_WEAK) 611 if (weakness == HASH_TABLE_NON_WEAK)
616 ht->next_weak = Qunbound; 612 ht->next_weak = Qunbound;
617 else 613 else
618 ht->next_weak = Vall_weak_hash_tables, Vall_weak_hash_tables = hash_table; 614 ht->next_weak = Vall_weak_hash_tables, Vall_weak_hash_tables = hash_table;
1037 The keys and values will not themselves be copied. 1033 The keys and values will not themselves be copied.
1038 */ 1034 */
1039 (hash_table)) 1035 (hash_table))
1040 { 1036 {
1041 const Lisp_Hash_Table *ht_old = xhash_table (hash_table); 1037 const Lisp_Hash_Table *ht_old = xhash_table (hash_table);
1042 Lisp_Hash_Table *ht = ALLOC_LCRECORD_TYPE (Lisp_Hash_Table, &lrecord_hash_table); 1038 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (hash_table);
1043 COPY_LCRECORD (ht, ht_old); 1039 Lisp_Hash_Table *ht = XHASH_TABLE (obj);
1044 1040 copy_lisp_object (obj, hash_table);
1045 #ifdef NEW_GC 1041
1046 ht->hentries = (htentry *) alloc_lrecord_array (sizeof (htentry), 1042 /* We leave room for one never-occupied sentinel htentry at the end. */
1047 ht_old->size + 1, 1043 ht->hentries = allocate_hash_table_entries (ht_old->size + 1);
1048 &lrecord_hash_table_entry);
1049 #else /* not NEW_GC */
1050 ht->hentries = xnew_array (htentry, ht_old->size + 1);
1051 #endif /* not NEW_GC */
1052 memcpy (ht->hentries, ht_old->hentries, (ht_old->size + 1) * sizeof (htentry)); 1044 memcpy (ht->hentries, ht_old->hentries, (ht_old->size + 1) * sizeof (htentry));
1053 1045
1054 hash_table = wrap_hash_table (ht);
1055
1056 if (! EQ (ht->next_weak, Qunbound)) 1046 if (! EQ (ht->next_weak, Qunbound))
1057 { 1047 {
1058 ht->next_weak = Vall_weak_hash_tables; 1048 ht->next_weak = Vall_weak_hash_tables;
1059 Vall_weak_hash_tables = hash_table; 1049 Vall_weak_hash_tables = obj;
1060 } 1050 }
1061 1051
1062 return hash_table; 1052 return obj;
1063 } 1053 }
1064 1054
1065 static void 1055 static void
1066 resize_hash_table (Lisp_Hash_Table *ht, Elemcount new_size) 1056 resize_hash_table (Lisp_Hash_Table *ht, Elemcount new_size)
1067 { 1057 {
1071 old_size = ht->size; 1061 old_size = ht->size;
1072 ht->size = new_size; 1062 ht->size = new_size;
1073 1063
1074 old_entries = ht->hentries; 1064 old_entries = ht->hentries;
1075 1065
1076 #ifdef NEW_GC 1066 /* We leave room for one never-occupied sentinel htentry at the end. */
1077 ht->hentries = (htentry *) alloc_lrecord_array (sizeof (htentry), 1067 ht->hentries = allocate_hash_table_entries (new_size + 1);
1078 new_size + 1,
1079 &lrecord_hash_table_entry);
1080 #else /* not NEW_GC */
1081 ht->hentries = xnew_array_and_zero (htentry, new_size + 1);
1082 #endif /* not NEW_GC */
1083 new_entries = ht->hentries; 1068 new_entries = ht->hentries;
1084 1069
1085 compute_hash_table_derived_values (ht); 1070 compute_hash_table_derived_values (ht);
1086 1071
1087 for (e = old_entries, sentinel = e + old_size; e < sentinel; e++) 1072 for (e = old_entries, sentinel = e + old_size; e < sentinel; e++)
1103 and thus their HASHCODEs have changed. */ 1088 and thus their HASHCODEs have changed. */
1104 void 1089 void
1105 pdump_reorganize_hash_table (Lisp_Object hash_table) 1090 pdump_reorganize_hash_table (Lisp_Object hash_table)
1106 { 1091 {
1107 const Lisp_Hash_Table *ht = xhash_table (hash_table); 1092 const Lisp_Hash_Table *ht = xhash_table (hash_table);
1108 #ifdef NEW_GC 1093 /* We leave room for one never-occupied sentinel htentry at the end. */
1109 htentry *new_entries = 1094 htentry *new_entries = allocate_hash_table_entries (ht->size + 1);
1110 (htentry *) alloc_lrecord_array (sizeof (htentry), ht->size + 1,
1111 &lrecord_hash_table_entry);
1112 #else /* not NEW_GC */
1113 htentry *new_entries = xnew_array_and_zero (htentry, ht->size + 1);
1114 #endif /* not NEW_GC */
1115 htentry *e, *sentinel; 1095 htentry *e, *sentinel;
1116 1096
1117 for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) 1097 for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++)
1118 if (!HTENTRY_CLEAR_P (e)) 1098 if (!HTENTRY_CLEAR_P (e))
1119 { 1099 {
1876 } 1856 }
1877 1857
1878 void 1858 void
1879 init_elhash_once_early (void) 1859 init_elhash_once_early (void)
1880 { 1860 {
1881 INIT_LRECORD_IMPLEMENTATION (hash_table); 1861 INIT_LISP_OBJECT (hash_table);
1882 #ifdef NEW_GC 1862 #ifdef NEW_GC
1883 INIT_LRECORD_IMPLEMENTATION (hash_table_entry); 1863 INIT_LISP_OBJECT (hash_table_entry);
1884 #endif /* NEW_GC */ 1864 #endif /* NEW_GC */
1885 1865
1886 /* This must NOT be staticpro'd */ 1866 /* This must NOT be staticpro'd */
1887 Vall_weak_hash_tables = Qnil; 1867 Vall_weak_hash_tables = Qnil;
1888 dump_add_weak_object_chain (&Vall_weak_hash_tables); 1868 dump_add_weak_object_chain (&Vall_weak_hash_tables);