Mercurial > hg > xemacs-beta
annotate src/elhash.c @ 5602:c9e5612f5424
Support the MP library on recent FreeBSD, have it pass relevant tests.
src/ChangeLog addition:
2011-11-26 Aidan Kehoe <kehoea@parhasard.net>
* number-mp.c (bignum_to_string):
Don't overwrite the accumulator we've just set up for this
function.
* number-mp.c (BIGNUM_TO_TYPE):
mp_itom() doesn't necessarily do what this code used to think with
negative numbers, it can treat them as unsigned ints. Subtract
numbers from bignum_zero instead of multiplying them by -1 to
convert them to their negative equivalents.
* number-mp.c (bignum_to_int):
* number-mp.c (bignum_to_uint):
* number-mp.c (bignum_to_long):
* number-mp.c (bignum_to_ulong):
* number-mp.c (bignum_to_double):
Use the changed BIGNUM_TO_TYPE() in these functions.
* number-mp.c (bignum_ceil):
* number-mp.c (bignum_floor):
In these functions, be more careful about rounding to positive and
negative infinity, respectively. Don't use the sign of QUOTIENT
when working out out whether to add or subtract one, rather use
the sign QUOTIENT would have if arbitrary-precision division were
done.
* number-mp.h:
* number-mp.h (MP_GCD):
Wrap #include <mp.h> in BEGIN_C_DECLS/END_C_DECLS.
* number.c (Fbigfloat_get_precision):
* number.c (Fbigfloat_set_precision):
Don't attempt to call XBIGFLOAT_GET_PREC if this build doesn't
support big floats.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 26 Nov 2011 17:59:14 +0000 |
| parents | 56144c8593a8 |
| children | 3192994c49ca |
| rev | line source |
|---|---|
| 428 | 1 /* Implementation of the hash table lisp object type. |
| 2 Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
3 Copyright (C) 1995, 1996, 2002, 2004, 2010 Ben Wing. |
| 428 | 4 Copyright (C) 1997 Free Software Foundation, Inc. |
| 5 | |
| 6 This file is part of XEmacs. | |
| 7 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5277
diff
changeset
|
8 XEmacs is free software: you can redistribute it and/or modify it |
| 428 | 9 under the terms of the GNU General Public License as published by the |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5277
diff
changeset
|
10 Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5277
diff
changeset
|
11 option) any later version. |
| 428 | 12 |
| 13 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
|
5232
33899241a6a8
Fix typo in permission notice of elhash.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5222
diff
changeset
|
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
| 428 | 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 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5277
diff
changeset
|
19 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
| 428 | 20 |
| 21 /* Synched up with: Not in FSF. */ | |
| 22 | |
| 1292 | 23 /* Author: Lost in the mists of history. At least back to Lucid 19.3, |
| 24 circa Sep 1992. Early hash table implementation allowed only `eq' as a | |
| 25 test -- other tests possible only when these objects were created from | |
| 26 the C code. | |
| 27 | |
| 28 Expansion to allow general `equal'-test Lisp-creatable tables, and hash | |
| 29 methods for the various Lisp objects in existence at the time, added | |
| 30 during 19.12 I think (early 1995?), by Ben Wing. | |
| 31 | |
| 32 Weak hash tables added by Jamie (maybe?) early on, perhaps around 19.6, | |
| 33 maybe earlier; again, only possible through the C code, and only | |
| 34 supported fully weak hash tables. Expansion to other kinds of weakness, | |
| 35 and exporting of the interface to Lisp, by Ben Wing during 19.12 | |
| 36 (early-mid 1995) or maybe 19.13 cycle (mid 1995). | |
| 37 | |
| 38 Expansion to full Common Lisp spec and interface, redoing of the | |
| 39 implementation, by Martin Buchholz, 1997? (Former hash table | |
| 40 implementation used "double hashing", I'm pretty sure, and was weirdly | |
| 41 tied into the generic hash.c code. Martin completely separated them.) | |
| 42 */ | |
| 43 | |
| 489 | 44 /* This file implements the hash table lisp object type. |
| 45 | |
| 504 | 46 This implementation was mostly written by Martin Buchholz in 1997. |
| 47 | |
| 48 The Lisp-level API (derived from Common Lisp) is almost completely | |
| 49 compatible with GNU Emacs 21, even though the implementations are | |
| 50 totally independent. | |
| 51 | |
| 489 | 52 The hash table technique used is "linear probing". Collisions are |
| 53 resolved by putting the item in the next empty place in the array | |
| 54 following the collision. Finding a hash entry performs a linear | |
| 55 search in the cluster starting at the hash value. | |
| 56 | |
| 57 On deletions from the hash table, the entries immediately following | |
| 58 the deleted entry are re-entered in the hash table. We do not have | |
| 59 a special way to mark deleted entries (known as "tombstones"). | |
| 60 | |
| 61 At the end of the hash entries ("hentries"), we leave room for an | |
| 62 entry that is always empty (the "sentinel"). | |
| 63 | |
| 64 The traditional literature on hash table implementation | |
| 65 (e.g. Knuth) suggests that too much "primary clustering" occurs | |
| 66 with linear probing. However, this literature was written when | |
| 67 locality of reference was not a factor. The discrepancy between | |
| 68 CPU speeds and memory speeds is increasing, and the speed of access | |
| 69 to memory is highly dependent on memory caches which work best when | |
| 70 there is high locality of data reference. Random access to memory | |
| 71 is up to 20 times as expensive as access to the nearest address | |
| 72 (and getting worse). So linear probing makes sense. | |
| 73 | |
| 74 But the representation doesn't actually matter that much with the | |
| 75 current elisp engine. Funcall is sufficiently slow that the choice | |
| 76 of hash table implementation is noise. */ | |
| 77 | |
| 428 | 78 #include <config.h> |
| 79 #include "lisp.h" | |
| 80 #include "bytecode.h" | |
| 81 #include "elhash.h" | |
|
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
82 #include "gc.h" |
| 489 | 83 #include "opaque.h" |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
84 #include "buffer.h" |
| 428 | 85 |
| 86 Lisp_Object Qhash_tablep; | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
87 Lisp_Object Qeq, Qeql, Qequal, Qequalp; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
88 Lisp_Object Qeq_hash, Qeql_hash, Qequal_hash, Qequalp_hash; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
89 |
|
5084
6afe991b8135
Add a PARSE_KEYWORDS macro, use it in #'make-hash-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
90 static Lisp_Object Qhashtable, Qhash_table, Qmake_hash_table; |
| 442 | 91 static Lisp_Object Qweakness, Qvalue, Qkey_or_value, Qkey_and_value; |
| 428 | 92 static Lisp_Object Vall_weak_hash_tables; |
| 93 static Lisp_Object Qrehash_size, Qrehash_threshold; | |
|
5320
31be2a3d121d
Move Qcount, Q_default, Q_test to general-slots.h; add SYMBOL_KEYWORD_GENERAL()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
94 static Lisp_Object Q_size, Q_weakness, Q_rehash_size, Q_rehash_threshold; |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
95 static Lisp_Object Vhash_table_test_eq, Vhash_table_test_eql; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
96 static Lisp_Object Vhash_table_test_weak_list; |
| 428 | 97 |
| 98 /* obsolete as of 19990901 in xemacs-21.2 */ | |
| 442 | 99 static Lisp_Object Qweak, Qkey_weak, Qvalue_weak, Qkey_or_value_weak; |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5193
diff
changeset
|
100 static Lisp_Object Qnon_weak; |
| 428 | 101 |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
102 /* A hash table test, with its associated hash function. equal_function may |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
103 call lisp_equal_function, and hash_function similarly may call |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
104 lisp_hash_function. */ |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
105 struct Hash_Table_Test |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
106 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
107 NORMAL_LISP_OBJECT_HEADER header; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
108 Lisp_Object name; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
109 hash_table_equal_function_t equal_function; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
110 hash_table_hash_function_t hash_function; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
111 Lisp_Object lisp_equal_function; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
112 Lisp_Object lisp_hash_function; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
113 }; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
114 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
115 static Lisp_Object |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
116 mark_hash_table_test (Lisp_Object obj) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
117 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
118 Hash_Table_Test *http = XHASH_TABLE_TEST (obj); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
119 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
120 mark_object (http->name); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
121 mark_object (http->lisp_equal_function); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
122 mark_object (http->lisp_hash_function); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
123 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
124 return Qnil; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
125 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
126 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
127 static const struct memory_description hash_table_test_description_1[] = |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
128 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
129 { XD_LISP_OBJECT, offsetof (struct Hash_Table_Test, name) }, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
130 { XD_LISP_OBJECT, offsetof (struct Hash_Table_Test, lisp_equal_function) }, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
131 { XD_LISP_OBJECT, offsetof (struct Hash_Table_Test, lisp_hash_function) }, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
132 { XD_END } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
133 }; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
134 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
135 static const struct sized_memory_description hash_table_test_description = |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
136 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
137 sizeof (struct Hash_Table_Test), |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
138 hash_table_test_description_1 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
139 }; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
140 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
141 DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("hash-table-test", hash_table_test, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
142 mark_hash_table_test, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
143 hash_table_test_description_1, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
144 Hash_Table_Test); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
145 /* A hash table. */ |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
146 |
| 428 | 147 struct Lisp_Hash_Table |
| 148 { | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
149 NORMAL_LISP_OBJECT_HEADER header; |
| 665 | 150 Elemcount size; |
| 151 Elemcount count; | |
| 152 Elemcount rehash_count; | |
| 428 | 153 double rehash_size; |
| 154 double rehash_threshold; | |
| 665 | 155 Elemcount golden_ratio; |
| 1204 | 156 htentry *hentries; |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
157 Lisp_Object test; |
| 428 | 158 enum hash_table_weakness weakness; |
| 159 Lisp_Object next_weak; /* Used to chain together all of the weak | |
| 160 hash tables. Don't mark through this. */ | |
| 161 }; | |
| 162 | |
| 1204 | 163 #define CLEAR_HTENTRY(htentry) \ |
| 164 ((*(EMACS_UINT*)(&((htentry)->key))) = 0, \ | |
| 165 (*(EMACS_UINT*)(&((htentry)->value))) = 0) | |
| 428 | 166 |
| 167 #define HASH_TABLE_DEFAULT_SIZE 16 | |
| 168 #define HASH_TABLE_DEFAULT_REHASH_SIZE 1.3 | |
| 169 #define HASH_TABLE_MIN_SIZE 10 | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
170 #define HASH_TABLE_DEFAULT_REHASH_THRESHOLD(size, test) \ |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
171 (((size) > 4096 && EQ (Vhash_table_test_eq, test)) ? 0.7 : 0.6) |
| 428 | 172 |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
173 #define HASHCODE(key, ht, http) \ |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
174 ((((!EQ (Vhash_table_test_eq, ht->test)) ? \ |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
175 (http)->hash_function (http, key) : \ |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
176 LISP_HASH (key)) * (ht)->golden_ratio) % (ht)->size) |
| 428 | 177 |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
178 #define KEYS_EQUAL_P(key1, key2, test, http) \ |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
179 (EQ (key1, key2) || ((!EQ (Vhash_table_test_eq, test) && \ |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
180 (http->equal_function) (http, key1, key2)))) |
| 428 | 181 |
| 182 #define LINEAR_PROBING_LOOP(probe, entries, size) \ | |
| 183 for (; \ | |
| 1204 | 184 !HTENTRY_CLEAR_P (probe) || \ |
| 428 | 185 (probe == entries + size ? \ |
| 1204 | 186 (probe = entries, !HTENTRY_CLEAR_P (probe)) : 0); \ |
| 428 | 187 probe++) |
| 188 | |
| 800 | 189 #ifdef ERROR_CHECK_STRUCTURES |
| 428 | 190 static void |
| 191 check_hash_table_invariants (Lisp_Hash_Table *ht) | |
| 192 { | |
| 193 assert (ht->count < ht->size); | |
| 194 assert (ht->count <= ht->rehash_count); | |
| 195 assert (ht->rehash_count < ht->size); | |
| 196 assert ((double) ht->count * ht->rehash_threshold - 1 <= (double) ht->rehash_count); | |
| 1204 | 197 assert (HTENTRY_CLEAR_P (ht->hentries + ht->size)); |
| 428 | 198 } |
| 199 #else | |
| 200 #define check_hash_table_invariants(ht) | |
| 201 #endif | |
| 202 | |
| 203 /* Return a suitable size for a hash table, with at least SIZE slots. */ | |
| 665 | 204 static Elemcount |
| 205 hash_table_size (Elemcount requested_size) | |
| 428 | 206 { |
| 207 /* Return some prime near, but greater than or equal to, SIZE. | |
| 208 Decades from the time of writing, someone will have a system large | |
| 209 enough that the list below will be too short... */ | |
| 665 | 210 static const Elemcount primes [] = |
| 428 | 211 { |
| 212 19, 29, 41, 59, 79, 107, 149, 197, 263, 347, 457, 599, 787, 1031, | |
| 213 1361, 1777, 2333, 3037, 3967, 5167, 6719, 8737, 11369, 14783, | |
| 214 19219, 24989, 32491, 42257, 54941, 71429, 92861, 120721, 156941, | |
| 215 204047, 265271, 344857, 448321, 582821, 757693, 985003, 1280519, | |
| 216 1664681, 2164111, 2813353, 3657361, 4754591, 6180989, 8035301, | |
| 217 10445899, 13579681, 17653589, 22949669, 29834603, 38784989, | |
| 218 50420551, 65546729, 85210757, 110774011, 144006217, 187208107, | |
| 219 243370577, 316381771, 411296309, 534685237, 695090819, 903618083, | |
| 647 | 220 1174703521, 1527114613, 1985248999 /* , 2580823717UL, 3355070839UL */ |
| 428 | 221 }; |
| 222 /* We've heard of binary search. */ | |
| 223 int low, high; | |
| 224 for (low = 0, high = countof (primes) - 1; high - low > 1;) | |
| 225 { | |
| 226 /* Loop Invariant: size < primes [high] */ | |
| 227 int mid = (low + high) / 2; | |
| 228 if (primes [mid] < requested_size) | |
| 229 low = mid; | |
| 230 else | |
| 231 high = mid; | |
| 232 } | |
| 233 return primes [high]; | |
| 234 } | |
| 235 | |
| 236 | |
| 237 | |
| 238 static int | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
239 lisp_object_eql_equal (const Hash_Table_Test *UNUSED (http), Lisp_Object obj1, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
240 Lisp_Object obj2) |
| 428 | 241 { |
|
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4820
diff
changeset
|
242 return EQ (obj1, obj2) || |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4820
diff
changeset
|
243 (NON_FIXNUM_NUMBER_P (obj1) && internal_equal (obj1, obj2, 0)); |
| 428 | 244 } |
| 245 | |
| 665 | 246 static Hashcode |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
247 lisp_object_eql_hash (const Hash_Table_Test *UNUSED (http), Lisp_Object obj) |
| 428 | 248 { |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
249 return NON_FIXNUM_NUMBER_P (obj) ? |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
250 internal_hash (obj, 0, 0) : LISP_HASH (obj); |
| 428 | 251 } |
| 252 | |
| 253 static int | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
254 lisp_object_equal_equal (const Hash_Table_Test *UNUSED (http), |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
255 Lisp_Object obj1, Lisp_Object obj2) |
| 428 | 256 { |
| 257 return internal_equal (obj1, obj2, 0); | |
| 258 } | |
| 259 | |
| 665 | 260 static Hashcode |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
261 lisp_object_equal_hash (const Hash_Table_Test *UNUSED (http), Lisp_Object obj) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
262 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
263 return internal_hash (obj, 0, 0); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
264 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
265 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
266 static Hashcode |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
267 lisp_object_equalp_hash (const Hash_Table_Test *UNUSED (http), Lisp_Object obj) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
268 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
269 return internal_hash (obj, 0, 1); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
270 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
271 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
272 static int |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
273 lisp_object_equalp_equal (const Hash_Table_Test *UNUSED (http), |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
274 Lisp_Object obj1, Lisp_Object obj2) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
275 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
276 return internal_equalp (obj1, obj2, 0); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
277 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
278 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
279 static Hashcode |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
280 lisp_object_general_hash (const Hash_Table_Test *http, Lisp_Object obj) |
| 428 | 281 { |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
282 struct gcpro gcpro1; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
283 Lisp_Object args[2] = { http->lisp_hash_function, obj }, res; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
284 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
285 /* Make sure any weakly referenced objects don't get collected before the |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
286 funcall: */ |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
287 GCPRO1 (args[0]); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
288 gcpro1.nvars = countof (args); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
289 res = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args)); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
290 UNGCPRO; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
291 |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
292 if (FIXNUMP (res)) |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
293 { |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
294 return (Hashcode) (XFIXNUM (res)); |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
295 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
296 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
297 #ifdef HAVE_BIGNUM |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
298 if (BIGNUMP (res)) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
299 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
300 if (bignum_fits_emacs_int_p (XBIGNUM_DATA (res))) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
301 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
302 return (Hashcode) bignum_to_emacs_int (XBIGNUM_DATA (res)); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
303 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
304 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
305 signal_error (Qrange_error, "Not a valid hash code", res); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
306 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
307 #endif |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
308 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
309 dead_wrong_type_argument (Qintegerp, res); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
310 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
311 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
312 static int |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
313 lisp_object_general_equal (const Hash_Table_Test *http, Lisp_Object obj1, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
314 Lisp_Object obj2) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
315 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
316 struct gcpro gcpro1; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
317 Lisp_Object args[] = { http->lisp_equal_function, obj1, obj2 }, res; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
318 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
319 GCPRO1 (args[0]); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
320 gcpro1.nvars = countof (args); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
321 res = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args)); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
322 UNGCPRO; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
323 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
324 return !(NILP (res)); |
| 428 | 325 } |
| 326 | |
| 327 | |
| 328 static Lisp_Object | |
| 329 mark_hash_table (Lisp_Object obj) | |
| 330 { | |
| 331 Lisp_Hash_Table *ht = XHASH_TABLE (obj); | |
| 332 | |
| 333 /* If the hash table is weak, we don't want to mark the keys and | |
| 334 values (we scan over them after everything else has been marked, | |
| 335 and mark or remove them as necessary). */ | |
| 336 if (ht->weakness == HASH_TABLE_NON_WEAK) | |
| 337 { | |
| 1204 | 338 htentry *e, *sentinel; |
| 428 | 339 |
| 340 for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) | |
| 1204 | 341 if (!HTENTRY_CLEAR_P (e)) |
| 428 | 342 { |
| 343 mark_object (e->key); | |
| 344 mark_object (e->value); | |
| 345 } | |
| 346 } | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
347 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
348 mark_object (ht->test); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
349 |
| 428 | 350 return Qnil; |
| 351 } | |
| 352 | |
|
5560
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
353 static int |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
354 nsubst_structures_map_hash_table (Lisp_Object key, Lisp_Object value, |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
355 void *extra_arg) |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
356 { |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
357 Lisp_Object number_table |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
358 = ((nsubst_structures_info_t *) extra_arg)->number_table; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
359 Lisp_Object new_ = ((nsubst_structures_info_t *) extra_arg)->new_; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
360 Lisp_Object old = ((nsubst_structures_info_t *) extra_arg)->old; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
361 Lisp_Object hash_table |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
362 = ((nsubst_structures_info_t *) extra_arg)->current_object; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
363 Boolint test_not_unboundp |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
364 = ((nsubst_structures_info_t *) extra_arg)->test_not_unboundp; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
365 |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
366 if (EQ (old, key) == test_not_unboundp) |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
367 { |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
368 Fremhash (key, hash_table); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
369 Fputhash (new_, value, hash_table); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
370 } |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
371 else if (LRECORDP (key) && |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
372 HAS_OBJECT_METH_P (key, nsubst_structures_descend)) |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
373 { |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
374 nsubst_structures_descend (new_, old, key, number_table, |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
375 test_not_unboundp); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
376 } |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
377 |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
378 if (EQ (old, value) == test_not_unboundp) |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
379 { |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
380 Fputhash (key, new_, hash_table); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
381 } |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
382 else if (LRECORDP (value) && |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
383 HAS_OBJECT_METH_P (value, nsubst_structures_descend)) |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
384 { |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
385 nsubst_structures_descend (new_, old, value, number_table, |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
386 test_not_unboundp); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
387 } |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
388 |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
389 return 0; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
390 } |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
391 |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
392 static void |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
393 hash_table_nsubst_structures_descend (Lisp_Object new_, Lisp_Object old, |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
394 Lisp_Object object, |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
395 Lisp_Object number_table, |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
396 Boolint test_not_unboundp) |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
397 { |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
398 nsubst_structures_info_t nsubst_structures_info |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
399 = { number_table, new_, old, object, test_not_unboundp }; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
400 |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
401 /* If we're happy with limiting nsubst_structures to use in the Lisp |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
402 reader, we don't have to worry about the hash table test here, because |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
403 the only point where NEW_ can be the test will be forms like so: |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
404 #%d=#:SOME-GENSYM, in which case OLD will most definitively not include |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
405 a hash table anywhere in its structure. */ |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
406 |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
407 elisp_maphash (nsubst_structures_map_hash_table, object, |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
408 &nsubst_structures_info); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
409 } |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
410 |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
411 static int |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
412 print_preprocess_mapper (Lisp_Object key, Lisp_Object value, void *extra_arg) |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
413 { |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
414 Lisp_Object print_number_table = ((preprocess_info_t *) extra_arg)->table; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
415 Elemcount *seen_number_count = ((preprocess_info_t *) extra_arg)->count; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
416 |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
417 PRINT_PREPROCESS (key, print_number_table, seen_number_count); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
418 PRINT_PREPROCESS (value, print_number_table, seen_number_count); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
419 |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
420 return 0; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
421 } |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
422 |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
423 static void |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
424 hash_table_print_preprocess (Lisp_Object obj, Lisp_Object number_table, |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
425 Elemcount *seen_object_count) |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
426 { |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
427 preprocess_info_t preprocess_info = { number_table, |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
428 seen_object_count }; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
429 |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
430 print_preprocess (XHASH_TABLE_TEST (XHASH_TABLE (obj)->test)->name, |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
431 number_table, seen_object_count); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
432 |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
433 elisp_maphash_unsafe (print_preprocess_mapper, obj, &preprocess_info); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
434 } |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
435 |
| 428 | 436 /* Equality of hash tables. Two hash tables are equal when they are of |
| 437 the same weakness and test function, they have the same number of | |
| 438 elements, and for each key in the hash table, the values are `equal'. | |
| 439 | |
| 440 This is similar to Common Lisp `equalp' of hash tables, with the | |
| 441 difference that CL requires the keys to be compared with the test | |
| 442 function, which we don't do. Doing that would require consing, and | |
| 443 consing is a bad idea in `equal'. Anyway, our method should provide | |
| 444 the same result -- if the keys are not equal according to the test | |
| 445 function, then Fgethash() in hash_table_equal_mapper() will fail. */ | |
| 446 static int | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4885
diff
changeset
|
447 hash_table_equal (Lisp_Object hash_table1, Lisp_Object hash_table2, int depth, |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4885
diff
changeset
|
448 int foldcase) |
| 428 | 449 { |
| 450 Lisp_Hash_Table *ht1 = XHASH_TABLE (hash_table1); | |
| 451 Lisp_Hash_Table *ht2 = XHASH_TABLE (hash_table2); | |
| 1204 | 452 htentry *e, *sentinel; |
| 428 | 453 |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
454 if (!(EQ (ht1->test, ht2->test)) || |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
455 (ht1->weakness != ht2->weakness) || |
| 428 | 456 (ht1->count != ht2->count)) |
| 457 return 0; | |
| 458 | |
| 459 depth++; | |
| 460 | |
| 461 for (e = ht1->hentries, sentinel = e + ht1->size; e < sentinel; e++) | |
| 1204 | 462 if (!HTENTRY_CLEAR_P (e)) |
| 428 | 463 /* Look up the key in the other hash table, and compare the values. */ |
| 464 { | |
| 465 Lisp_Object value_in_other = Fgethash (e->key, hash_table2, Qunbound); | |
| 466 if (UNBOUNDP (value_in_other) || | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4885
diff
changeset
|
467 !internal_equal_0 (e->value, value_in_other, depth, foldcase)) |
| 428 | 468 return 0; /* Give up */ |
| 469 } | |
| 470 | |
| 471 return 1; | |
| 472 } | |
| 442 | 473 |
| 474 /* This is not a great hash function, but it _is_ correct and fast. | |
| 475 Examining all entries is too expensive, and examining a random | |
| 476 subset does not yield a correct hash function. */ | |
| 665 | 477 static Hashcode |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
478 hash_table_hash (Lisp_Object hash_table, int UNUSED (depth), |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
479 int UNUSED (equalp)) |
| 442 | 480 { |
| 481 return XHASH_TABLE (hash_table)->count; | |
| 482 } | |
| 483 | |
|
5158
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
484 #ifdef MEMORY_USAGE_STATS |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
485 |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
486 struct hash_table_stats |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
487 { |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
488 struct usage_stats u; |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
489 Bytecount hentries; |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
490 }; |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
491 |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
492 static void |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
493 hash_table_memory_usage (Lisp_Object hashtab, |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
494 struct generic_usage_stats *gustats) |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
495 { |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
496 Lisp_Hash_Table *ht = XHASH_TABLE (hashtab); |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
497 struct hash_table_stats *stats = (struct hash_table_stats *) gustats; |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
498 stats->hentries += |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
499 malloced_storage_size (ht->hentries, |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
500 sizeof (htentry) * (ht->size + 1), |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
501 &stats->u); |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
502 } |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
503 |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
504 #endif /* MEMORY_USAGE_STATS */ |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
505 |
| 428 | 506 |
| 507 /* Printing hash tables. | |
| 508 | |
| 509 This is non-trivial, because we use a readable structure-style | |
| 510 syntax for hash tables. This means that a typical hash table will be | |
| 511 readably printed in the form of: | |
| 512 | |
|
4820
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
513 #s(hash-table :size 2 :data (key1 value1 key2 value2)) |
| 428 | 514 |
| 515 The supported hash table structure keywords and their values are: | |
|
4820
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
516 `:test' (eql (or nil), eq or equal) |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
517 `:size' (a natnum or nil) |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
518 `:rehash-size' (a float) |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
519 `:rehash-threshold' (a float) |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
520 `:weakness' (nil, key, value, key-and-value, or key-or-value) |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
521 `:data' (a list) |
| 428 | 522 |
| 430 | 523 If `print-readably' is nil, then a simpler syntax is used, for example |
| 428 | 524 |
| 525 #<hash-table size 2/13 data (key1 value1 key2 value2) 0x874d> | |
| 526 | |
| 527 The data is truncated to four pairs, and the rest is shown with | |
| 528 `...'. This printer does not cons. */ | |
| 529 | |
| 530 | |
| 531 /* Print the data of the hash table. This maps through a Lisp | |
| 532 hash table and prints key/value pairs using PRINTCHARFUN. */ | |
| 533 static void | |
| 534 print_hash_table_data (Lisp_Hash_Table *ht, Lisp_Object printcharfun) | |
| 535 { | |
| 536 int count = 0; | |
| 1204 | 537 htentry *e, *sentinel; |
| 428 | 538 |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4820
diff
changeset
|
539 write_ascstring (printcharfun, " :data ("); |
| 428 | 540 |
| 541 for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) | |
| 1204 | 542 if (!HTENTRY_CLEAR_P (e)) |
| 428 | 543 { |
| 544 if (count > 0) | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4820
diff
changeset
|
545 write_ascstring (printcharfun, " "); |
| 428 | 546 if (!print_readably && count > 3) |
| 547 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4820
diff
changeset
|
548 write_ascstring (printcharfun, "..."); |
| 428 | 549 break; |
| 550 } | |
| 551 print_internal (e->key, printcharfun, 1); | |
| 800 | 552 write_fmt_string_lisp (printcharfun, " %S", 1, e->value); |
| 428 | 553 count++; |
| 554 } | |
| 555 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4820
diff
changeset
|
556 write_ascstring (printcharfun, ")"); |
| 428 | 557 } |
| 558 | |
| 559 static void | |
| 2286 | 560 print_hash_table (Lisp_Object obj, Lisp_Object printcharfun, |
| 561 int UNUSED (escapeflag)) | |
| 428 | 562 { |
| 563 Lisp_Hash_Table *ht = XHASH_TABLE (obj); | |
|
4777
c69aeb86b2a3
Serialise non-default hash table rehash thresholds correctly; use this.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4693
diff
changeset
|
564 Ascbyte pigbuf[350]; |
| 428 | 565 |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4820
diff
changeset
|
566 write_ascstring (printcharfun, |
| 826 | 567 print_readably ? "#s(hash-table" : "#<hash-table"); |
| 428 | 568 |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
569 if (!(EQ (ht->test, Vhash_table_test_eql))) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
570 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
571 write_fmt_string_lisp (printcharfun, " :test %S", |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
572 1, XHASH_TABLE_TEST (ht->test)->name); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
573 } |
| 428 | 574 |
| 575 if (ht->count || !print_readably) | |
| 576 { | |
| 577 if (print_readably) | |
|
4820
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
578 write_fmt_string (printcharfun, " :size %ld", (long) ht->count); |
| 428 | 579 else |
|
4820
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
580 write_fmt_string (printcharfun, " :size %ld/%ld", (long) ht->count, |
| 800 | 581 (long) ht->size); |
| 428 | 582 } |
| 583 | |
| 584 if (ht->weakness != HASH_TABLE_NON_WEAK) | |
| 585 { | |
| 800 | 586 write_fmt_string |
|
4820
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
587 (printcharfun, " :weakness %s", |
| 800 | 588 (ht->weakness == HASH_TABLE_WEAK ? "key-and-value" : |
| 589 ht->weakness == HASH_TABLE_KEY_WEAK ? "key" : | |
| 590 ht->weakness == HASH_TABLE_VALUE_WEAK ? "value" : | |
| 591 ht->weakness == HASH_TABLE_KEY_VALUE_WEAK ? "key-or-value" : | |
| 592 "you-d-better-not-see-this")); | |
| 428 | 593 } |
| 594 | |
|
4777
c69aeb86b2a3
Serialise non-default hash table rehash thresholds correctly; use this.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4693
diff
changeset
|
595 if (ht->rehash_size != HASH_TABLE_DEFAULT_REHASH_SIZE) |
|
c69aeb86b2a3
Serialise non-default hash table rehash thresholds correctly; use this.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4693
diff
changeset
|
596 { |
|
c69aeb86b2a3
Serialise non-default hash table rehash thresholds correctly; use this.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4693
diff
changeset
|
597 float_to_string (pigbuf, ht->rehash_size); |
|
4820
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
598 write_fmt_string (printcharfun, " :rehash-size %s", pigbuf); |
|
4777
c69aeb86b2a3
Serialise non-default hash table rehash thresholds correctly; use this.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4693
diff
changeset
|
599 } |
|
c69aeb86b2a3
Serialise non-default hash table rehash thresholds correctly; use this.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4693
diff
changeset
|
600 |
|
c69aeb86b2a3
Serialise non-default hash table rehash thresholds correctly; use this.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4693
diff
changeset
|
601 if (ht->rehash_threshold |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
602 != HASH_TABLE_DEFAULT_REHASH_THRESHOLD (ht->size, ht->test)) |
|
4777
c69aeb86b2a3
Serialise non-default hash table rehash thresholds correctly; use this.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4693
diff
changeset
|
603 { |
|
c69aeb86b2a3
Serialise non-default hash table rehash thresholds correctly; use this.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4693
diff
changeset
|
604 float_to_string (pigbuf, ht->rehash_threshold); |
|
4820
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
605 write_fmt_string (printcharfun, " :rehash-threshold %s", pigbuf); |
|
4777
c69aeb86b2a3
Serialise non-default hash table rehash thresholds correctly; use this.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4693
diff
changeset
|
606 } |
|
c69aeb86b2a3
Serialise non-default hash table rehash thresholds correctly; use this.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4693
diff
changeset
|
607 |
| 428 | 608 if (ht->count) |
| 609 print_hash_table_data (ht, printcharfun); | |
| 610 | |
| 611 if (print_readably) | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4820
diff
changeset
|
612 write_ascstring (printcharfun, ")"); |
| 428 | 613 else |
|
5146
88bd4f3ef8e4
make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents:
5142
diff
changeset
|
614 write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); |
| 428 | 615 } |
| 616 | |
|
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
617 #ifdef ERROR_CHECK_STRUCTURES |
|
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
618 #define USED_IF_ERROR_CHECK_STRUCTURES(x) x |
|
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
619 #else |
|
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
620 #define USED_IF_ERROR_CHECK_STRUCTURES(x) UNUSED (x) |
|
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
621 #endif |
|
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
622 |
| 4117 | 623 #ifndef NEW_GC |
| 428 | 624 static void |
| 4117 | 625 free_hentries (htentry *hentries, |
|
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
626 Elemcount USED_IF_ERROR_CHECK_STRUCTURES (size)) |
| 489 | 627 { |
| 800 | 628 #ifdef ERROR_CHECK_STRUCTURES |
| 489 | 629 /* Ensure a crash if other code uses the discarded entries afterwards. */ |
|
5146
88bd4f3ef8e4
make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents:
5142
diff
changeset
|
630 deadbeef_memory (hentries, |
|
88bd4f3ef8e4
make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents:
5142
diff
changeset
|
631 (Rawbyte *) (hentries + size) - (Rawbyte *) hentries); |
| 489 | 632 #endif |
| 633 | |
| 634 if (!DUMPEDP (hentries)) | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
635 xfree (hentries); |
| 489 | 636 } |
| 637 | |
| 638 static void | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
639 finalize_hash_table (Lisp_Object obj) |
| 428 | 640 { |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
641 Lisp_Hash_Table *ht = XHASH_TABLE (obj); |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
642 free_hentries (ht->hentries, ht->size); |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
643 ht->hentries = 0; |
| 428 | 644 } |
| 3263 | 645 #endif /* not NEW_GC */ |
| 428 | 646 |
| 1204 | 647 static const struct memory_description htentry_description_1[] = { |
| 648 { XD_LISP_OBJECT, offsetof (htentry, key) }, | |
| 649 { XD_LISP_OBJECT, offsetof (htentry, value) }, | |
| 428 | 650 { XD_END } |
| 651 }; | |
| 652 | |
| 1204 | 653 static const struct sized_memory_description htentry_description = { |
| 654 sizeof (htentry), | |
| 655 htentry_description_1 | |
| 428 | 656 }; |
| 657 | |
| 3092 | 658 #ifdef NEW_GC |
| 659 static const struct memory_description htentry_weak_description_1[] = { | |
| 660 { XD_LISP_OBJECT, offsetof (htentry, key), 0, { 0 }, XD_FLAG_NO_KKCC}, | |
| 661 { XD_LISP_OBJECT, offsetof (htentry, value), 0, { 0 }, XD_FLAG_NO_KKCC}, | |
| 662 { XD_END } | |
| 663 }; | |
| 664 | |
| 665 static const struct sized_memory_description htentry_weak_description = { | |
| 666 sizeof (htentry), | |
| 667 htentry_weak_description_1 | |
| 668 }; | |
| 669 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
670 DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("hash-table-entry", hash_table_entry, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
671 0, htentry_description_1, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
672 Lisp_Hash_Table_Entry); |
| 3092 | 673 #endif /* NEW_GC */ |
| 674 | |
| 1204 | 675 static const struct memory_description htentry_union_description_1[] = { |
| 676 /* Note: XD_INDIRECT in this table refers to the surrounding table, | |
| 677 and so this will work. */ | |
| 3092 | 678 #ifdef NEW_GC |
|
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
679 { XD_INLINE_LISP_OBJECT_BLOCK_PTR, HASH_TABLE_NON_WEAK, |
| 3092 | 680 XD_INDIRECT (0, 1), { &htentry_description } }, |
|
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
681 { XD_INLINE_LISP_OBJECT_BLOCK_PTR, 0, XD_INDIRECT (0, 1), |
| 3092 | 682 { &htentry_weak_description }, XD_FLAG_UNION_DEFAULT_ENTRY }, |
| 683 #else /* not NEW_GC */ | |
| 2367 | 684 { XD_BLOCK_PTR, HASH_TABLE_NON_WEAK, XD_INDIRECT (0, 1), |
| 2551 | 685 { &htentry_description } }, |
| 686 { XD_BLOCK_PTR, 0, XD_INDIRECT (0, 1), { &htentry_description }, | |
| 1204 | 687 XD_FLAG_UNION_DEFAULT_ENTRY | XD_FLAG_NO_KKCC }, |
| 3092 | 688 #endif /* not NEW_GC */ |
| 1204 | 689 { XD_END } |
| 690 }; | |
| 691 | |
| 692 static const struct sized_memory_description htentry_union_description = { | |
| 693 sizeof (htentry *), | |
| 694 htentry_union_description_1 | |
| 695 }; | |
| 696 | |
| 697 const struct memory_description hash_table_description[] = { | |
| 698 { XD_ELEMCOUNT, offsetof (Lisp_Hash_Table, size) }, | |
| 699 { XD_INT, offsetof (Lisp_Hash_Table, weakness) }, | |
| 700 { XD_UNION, offsetof (Lisp_Hash_Table, hentries), XD_INDIRECT (1, 0), | |
| 2551 | 701 { &htentry_union_description } }, |
| 440 | 702 { XD_LO_LINK, offsetof (Lisp_Hash_Table, next_weak) }, |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
703 { XD_LISP_OBJECT,offsetof (Lisp_Hash_Table, test) }, |
| 428 | 704 { XD_END } |
| 705 }; | |
| 706 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
707 DEFINE_DUMPABLE_LISP_OBJECT ("hash-table", hash_table, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
708 mark_hash_table, print_hash_table, |
|
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
709 IF_OLD_GC (finalize_hash_table), |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
710 hash_table_equal, hash_table_hash, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
711 hash_table_description, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
712 Lisp_Hash_Table); |
| 428 | 713 |
| 714 static Lisp_Hash_Table * | |
| 715 xhash_table (Lisp_Object hash_table) | |
| 716 { | |
| 1123 | 717 /* #### What's going on here? Why the gc_in_progress check? */ |
| 428 | 718 if (!gc_in_progress) |
| 719 CHECK_HASH_TABLE (hash_table); | |
| 720 check_hash_table_invariants (XHASH_TABLE (hash_table)); | |
| 721 return XHASH_TABLE (hash_table); | |
| 722 } | |
| 723 | |
| 724 | |
| 725 /************************************************************************/ | |
| 726 /* Creation of Hash Tables */ | |
| 727 /************************************************************************/ | |
| 728 | |
| 729 /* Creation of hash tables, without error-checking. */ | |
| 730 static void | |
| 731 compute_hash_table_derived_values (Lisp_Hash_Table *ht) | |
| 732 { | |
| 665 | 733 ht->rehash_count = (Elemcount) |
| 438 | 734 ((double) ht->size * ht->rehash_threshold); |
| 665 | 735 ht->golden_ratio = (Elemcount) |
| 428 | 736 ((double) ht->size * (.6180339887 / (double) sizeof (Lisp_Object))); |
| 737 } | |
| 738 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
739 static htentry * |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
740 allocate_hash_table_entries (Elemcount size) |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
741 { |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
742 #ifdef NEW_GC |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
743 return XHASH_TABLE_ENTRY (alloc_lrecord_array |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
744 (size, &lrecord_hash_table_entry)); |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
745 #else /* not NEW_GC */ |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
746 return xnew_array_and_zero (htentry, size); |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
747 #endif /* not NEW_GC */ |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
748 } |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
749 |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
750 static Lisp_Object decode_hash_table_test (Lisp_Object obj); |
| 450 | 751 |
| 752 Lisp_Object | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
753 make_general_lisp_hash_table (Lisp_Object test, |
| 665 | 754 Elemcount size, |
| 428 | 755 double rehash_size, |
| 756 double rehash_threshold, | |
| 757 enum hash_table_weakness weakness) | |
| 758 { | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
759 Lisp_Object hash_table = ALLOC_NORMAL_LISP_OBJECT (hash_table); |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
760 Lisp_Hash_Table *ht = XHASH_TABLE (hash_table); |
| 428 | 761 |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
762 assert (HASH_TABLE_TESTP (test)); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
763 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
764 ht->test = test; |
| 438 | 765 ht->weakness = weakness; |
| 766 | |
| 767 ht->rehash_size = | |
| 768 rehash_size > 1.0 ? rehash_size : HASH_TABLE_DEFAULT_REHASH_SIZE; | |
| 769 | |
| 770 ht->rehash_threshold = | |
| 771 rehash_threshold > 0.0 ? rehash_threshold : | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
772 HASH_TABLE_DEFAULT_REHASH_THRESHOLD (size, ht->test); |
| 438 | 773 |
| 428 | 774 if (size < HASH_TABLE_MIN_SIZE) |
| 775 size = HASH_TABLE_MIN_SIZE; | |
| 665 | 776 ht->size = hash_table_size ((Elemcount) (((double) size / ht->rehash_threshold) |
| 438 | 777 + 1.0)); |
| 428 | 778 ht->count = 0; |
| 438 | 779 |
| 428 | 780 compute_hash_table_derived_values (ht); |
| 781 | |
| 1204 | 782 /* We leave room for one never-occupied sentinel htentry at the end. */ |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
783 ht->hentries = allocate_hash_table_entries (ht->size + 1); |
| 428 | 784 |
| 785 if (weakness == HASH_TABLE_NON_WEAK) | |
| 786 ht->next_weak = Qunbound; | |
| 787 else | |
| 788 ht->next_weak = Vall_weak_hash_tables, Vall_weak_hash_tables = hash_table; | |
| 789 | |
| 790 return hash_table; | |
| 791 } | |
| 792 | |
| 793 Lisp_Object | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
794 make_lisp_hash_table (Elemcount size, enum hash_table_weakness weakness, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
795 Lisp_Object test) |
| 428 | 796 { |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
797 test = decode_hash_table_test (test); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
798 return make_general_lisp_hash_table (test, size, -1.0, -1.0, weakness); |
| 428 | 799 } |
| 800 | |
| 801 /* Pretty reading of hash tables. | |
| 802 | |
| 803 Here we use the existing structures mechanism (which is, | |
| 804 unfortunately, pretty cumbersome) for validating and instantiating | |
| 805 the hash tables. The idea is that the side-effect of reading a | |
| 806 #s(hash-table PLIST) object is creation of a hash table with desired | |
| 807 properties, and that the hash table is returned. */ | |
| 808 | |
| 809 /* Validation functions: each keyword provides its own validation | |
| 810 function. The errors should maybe be continuable, but it is | |
| 811 unclear how this would cope with ERRB. */ | |
| 812 static int | |
| 2286 | 813 hash_table_size_validate (Lisp_Object UNUSED (keyword), Lisp_Object value, |
| 814 Error_Behavior errb) | |
| 428 | 815 { |
| 816 if (NATNUMP (value)) | |
|
5307
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
817 { |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
818 if (BIGNUMP (value)) |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
819 { |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
820 /* hash_table_size() can't handle excessively large sizes. */ |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
821 maybe_signal_error_1 (Qargs_out_of_range, |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
822 list3 (value, Qzero, |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
823 make_integer (MOST_POSITIVE_FIXNUM)), |
|
5307
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
824 Qhash_table, errb); |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
825 return 0; |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
826 } |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
827 else |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
828 { |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
829 return 1; |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
830 } |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
831 } |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
832 else |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
833 { |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
834 maybe_signal_error_1 (Qwrong_type_argument, list2 (Qnatnump, value), |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
835 Qhash_table, errb); |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
836 } |
| 428 | 837 |
| 838 return 0; | |
| 839 } | |
| 840 | |
| 665 | 841 static Elemcount |
| 428 | 842 decode_hash_table_size (Lisp_Object obj) |
| 843 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
844 return NILP (obj) ? HASH_TABLE_DEFAULT_SIZE : XFIXNUM (obj); |
| 428 | 845 } |
| 846 | |
| 847 static int | |
| 2286 | 848 hash_table_weakness_validate (Lisp_Object UNUSED (keyword), Lisp_Object value, |
| 578 | 849 Error_Behavior errb) |
| 428 | 850 { |
| 442 | 851 if (EQ (value, Qnil)) return 1; |
| 852 if (EQ (value, Qt)) return 1; | |
| 853 if (EQ (value, Qkey)) return 1; | |
| 854 if (EQ (value, Qkey_and_value)) return 1; | |
| 855 if (EQ (value, Qkey_or_value)) return 1; | |
| 856 if (EQ (value, Qvalue)) return 1; | |
| 428 | 857 |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5193
diff
changeset
|
858 #ifdef NEED_TO_HANDLE_21_4_CODE |
| 428 | 859 /* Following values are obsolete as of 19990901 in xemacs-21.2 */ |
| 442 | 860 if (EQ (value, Qnon_weak)) return 1; |
| 861 if (EQ (value, Qweak)) return 1; | |
| 862 if (EQ (value, Qkey_weak)) return 1; | |
| 863 if (EQ (value, Qkey_or_value_weak)) return 1; | |
| 864 if (EQ (value, Qvalue_weak)) return 1; | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
865 #endif |
| 428 | 866 |
| 563 | 867 maybe_invalid_constant ("Invalid hash table weakness", |
| 428 | 868 value, Qhash_table, errb); |
| 869 return 0; | |
| 870 } | |
| 871 | |
| 872 static enum hash_table_weakness | |
| 873 decode_hash_table_weakness (Lisp_Object obj) | |
| 874 { | |
| 442 | 875 if (EQ (obj, Qnil)) return HASH_TABLE_NON_WEAK; |
| 876 if (EQ (obj, Qt)) return HASH_TABLE_WEAK; | |
| 877 if (EQ (obj, Qkey_and_value)) return HASH_TABLE_WEAK; | |
| 878 if (EQ (obj, Qkey)) return HASH_TABLE_KEY_WEAK; | |
| 879 if (EQ (obj, Qkey_or_value)) return HASH_TABLE_KEY_VALUE_WEAK; | |
| 880 if (EQ (obj, Qvalue)) return HASH_TABLE_VALUE_WEAK; | |
| 428 | 881 |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5193
diff
changeset
|
882 #ifdef NEED_TO_HANDLE_21_4_CODE |
| 428 | 883 /* Following values are obsolete as of 19990901 in xemacs-21.2 */ |
| 442 | 884 if (EQ (obj, Qnon_weak)) return HASH_TABLE_NON_WEAK; |
| 885 if (EQ (obj, Qweak)) return HASH_TABLE_WEAK; | |
| 886 if (EQ (obj, Qkey_weak)) return HASH_TABLE_KEY_WEAK; | |
| 887 if (EQ (obj, Qkey_or_value_weak)) return HASH_TABLE_KEY_VALUE_WEAK; | |
| 888 if (EQ (obj, Qvalue_weak)) return HASH_TABLE_VALUE_WEAK; | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
889 #endif |
| 428 | 890 |
| 563 | 891 invalid_constant ("Invalid hash table weakness", obj); |
| 1204 | 892 RETURN_NOT_REACHED (HASH_TABLE_NON_WEAK); |
| 428 | 893 } |
| 894 | |
| 895 static int | |
| 2286 | 896 hash_table_test_validate (Lisp_Object UNUSED (keyword), Lisp_Object value, |
| 897 Error_Behavior errb) | |
| 428 | 898 { |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
899 Lisp_Object lookup; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
900 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
901 if (NILP (value)) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
902 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
903 return 1; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
904 } |
| 428 | 905 |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
906 lookup = Fassq (value, XWEAK_LIST_LIST (Vhash_table_test_weak_list)); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
907 if (NILP (lookup)) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
908 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
909 maybe_invalid_constant ("Invalid hash table test", |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
910 value, Qhash_table, errb); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
911 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
912 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
913 return 1; |
| 428 | 914 } |
| 915 | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
916 static Lisp_Object |
| 428 | 917 decode_hash_table_test (Lisp_Object obj) |
| 918 { | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
919 Lisp_Object result; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
920 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
921 if (NILP (obj)) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
922 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
923 obj = Qeql; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
924 } |
| 428 | 925 |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
926 result = Fassq (obj, XWEAK_LIST_LIST (Vhash_table_test_weak_list)); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
927 if (NILP (result)) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
928 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
929 invalid_constant ("Invalid hash table test", obj); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
930 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
931 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
932 return XCDR (result); |
| 428 | 933 } |
| 934 | |
| 935 static int | |
| 2286 | 936 hash_table_rehash_size_validate (Lisp_Object UNUSED (keyword), |
| 937 Lisp_Object value, Error_Behavior errb) | |
| 428 | 938 { |
| 939 if (!FLOATP (value)) | |
| 940 { | |
| 563 | 941 maybe_signal_error_1 (Qwrong_type_argument, list2 (Qfloatp, value), |
| 428 | 942 Qhash_table, errb); |
| 943 return 0; | |
| 944 } | |
| 945 | |
| 946 { | |
| 947 double rehash_size = XFLOAT_DATA (value); | |
| 948 if (rehash_size <= 1.0) | |
| 949 { | |
| 563 | 950 maybe_invalid_argument |
| 428 | 951 ("Hash table rehash size must be greater than 1.0", |
| 952 value, Qhash_table, errb); | |
| 953 return 0; | |
| 954 } | |
| 955 } | |
| 956 | |
| 957 return 1; | |
| 958 } | |
| 959 | |
| 960 static double | |
| 961 decode_hash_table_rehash_size (Lisp_Object rehash_size) | |
| 962 { | |
|
4585
871eb054b34a
Document non-obvious usages.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4410
diff
changeset
|
963 /* -1.0 signals make_general_lisp_hash_table to use the default. */ |
| 428 | 964 return NILP (rehash_size) ? -1.0 : XFLOAT_DATA (rehash_size); |
| 965 } | |
| 966 | |
| 967 static int | |
| 2286 | 968 hash_table_rehash_threshold_validate (Lisp_Object UNUSED (keyword), |
| 969 Lisp_Object value, Error_Behavior errb) | |
| 428 | 970 { |
| 971 if (!FLOATP (value)) | |
| 972 { | |
| 563 | 973 maybe_signal_error_1 (Qwrong_type_argument, list2 (Qfloatp, value), |
| 428 | 974 Qhash_table, errb); |
| 975 return 0; | |
| 976 } | |
| 977 | |
| 978 { | |
| 979 double rehash_threshold = XFLOAT_DATA (value); | |
| 980 if (rehash_threshold <= 0.0 || rehash_threshold >= 1.0) | |
| 981 { | |
| 563 | 982 maybe_invalid_argument |
| 428 | 983 ("Hash table rehash threshold must be between 0.0 and 1.0", |
| 984 value, Qhash_table, errb); | |
| 985 return 0; | |
| 986 } | |
| 987 } | |
| 988 | |
| 989 return 1; | |
| 990 } | |
| 991 | |
| 992 static double | |
| 993 decode_hash_table_rehash_threshold (Lisp_Object rehash_threshold) | |
| 994 { | |
|
4585
871eb054b34a
Document non-obvious usages.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4410
diff
changeset
|
995 /* -1.0 signals make_general_lisp_hash_table to use the default. */ |
| 428 | 996 return NILP (rehash_threshold) ? -1.0 : XFLOAT_DATA (rehash_threshold); |
| 997 } | |
| 998 | |
| 999 static int | |
| 2286 | 1000 hash_table_data_validate (Lisp_Object UNUSED (keyword), Lisp_Object value, |
| 1001 Error_Behavior errb) | |
| 428 | 1002 { |
| 1003 int len; | |
| 1004 | |
|
4585
871eb054b34a
Document non-obvious usages.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4410
diff
changeset
|
1005 /* Check for improper lists while getting length. */ |
| 428 | 1006 GET_EXTERNAL_LIST_LENGTH (value, len); |
| 1007 | |
| 1008 if (len & 1) | |
| 1009 { | |
| 563 | 1010 maybe_sferror |
| 428 | 1011 ("Hash table data must have alternating key/value pairs", |
| 1012 value, Qhash_table, errb); | |
| 1013 return 0; | |
| 1014 } | |
|
4585
871eb054b34a
Document non-obvious usages.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4410
diff
changeset
|
1015 |
| 428 | 1016 return 1; |
| 1017 } | |
| 1018 | |
| 1019 /* The actual instantiation of a hash table. This does practically no | |
| 1020 error checking, because it relies on the fact that the paranoid | |
| 1021 functions above have error-checked everything to the last details. | |
| 1022 If this assumption is wrong, we will get a crash immediately (with | |
| 1023 error-checking compiled in), and we'll know if there is a bug in | |
| 1024 the structure mechanism. So there. */ | |
| 1025 static Lisp_Object | |
| 1026 hash_table_instantiate (Lisp_Object plist) | |
| 1027 { | |
| 1028 Lisp_Object hash_table; | |
| 1029 Lisp_Object test = Qnil; | |
| 1030 Lisp_Object size = Qnil; | |
| 1031 Lisp_Object rehash_size = Qnil; | |
| 1032 Lisp_Object rehash_threshold = Qnil; | |
| 1033 Lisp_Object weakness = Qnil; | |
| 1034 Lisp_Object data = Qnil; | |
| 1035 | |
|
4820
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1036 if (KEYWORDP (Fcar (plist))) |
| 428 | 1037 { |
|
4820
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1038 PROPERTY_LIST_LOOP_3 (key, value, plist) |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1039 { |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1040 if (EQ (key, Q_test)) test = value; |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1041 else if (EQ (key, Q_size)) size = value; |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1042 else if (EQ (key, Q_rehash_size)) rehash_size = value; |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1043 else if (EQ (key, Q_rehash_threshold)) rehash_threshold = value; |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1044 else if (EQ (key, Q_weakness)) weakness = value; |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1045 else if (EQ (key, Q_data)) data = value; |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1046 else if (!KEYWORDP (key)) |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1047 signal_error (Qinvalid_read_syntax, |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1048 "can't mix keyword and non-keyword hash table syntax", |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1049 key); |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1050 else ABORT(); |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1051 } |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1052 } |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1053 else |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1054 { |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1055 PROPERTY_LIST_LOOP_3 (key, value, plist) |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1056 { |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1057 if (EQ (key, Qtest)) test = value; |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1058 else if (EQ (key, Qsize)) size = value; |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1059 else if (EQ (key, Qrehash_size)) rehash_size = value; |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1060 else if (EQ (key, Qrehash_threshold)) rehash_threshold = value; |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1061 else if (EQ (key, Qweakness)) weakness = value; |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1062 else if (EQ (key, Qdata)) data = value; |
|
5277
d804e621add0
Simplify the API of PARSE_KEYWORDS for callers.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5232
diff
changeset
|
1063 #ifdef NEED_TO_HANDLE_21_4_CODE |
|
4820
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1064 else if (EQ (key, Qtype))/*obsolete*/ weakness = value; |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1065 #endif |
|
4820
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1066 else if (KEYWORDP (key)) |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1067 signal_error (Qinvalid_read_syntax, |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1068 "can't mix keyword and non-keyword hash table syntax", |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1069 key); |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1070 else ABORT(); |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1071 } |
| 428 | 1072 } |
| 1073 | |
| 1074 /* Create the hash table. */ | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1075 hash_table = make_general_lisp_hash_table |
| 428 | 1076 (decode_hash_table_test (test), |
| 1077 decode_hash_table_size (size), | |
| 1078 decode_hash_table_rehash_size (rehash_size), | |
| 1079 decode_hash_table_rehash_threshold (rehash_threshold), | |
| 1080 decode_hash_table_weakness (weakness)); | |
| 1081 | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1082 /* This can GC with a user-specified test. */ |
| 428 | 1083 { |
| 1084 struct gcpro gcpro1; | |
| 1085 GCPRO1 (hash_table); | |
| 1086 | |
| 1087 /* And fill it with data. */ | |
| 1088 while (!NILP (data)) | |
| 1089 { | |
| 1090 Lisp_Object key, value; | |
| 1091 key = XCAR (data); data = XCDR (data); | |
| 1092 value = XCAR (data); data = XCDR (data); | |
| 1093 Fputhash (key, value, hash_table); | |
| 1094 } | |
| 1095 UNGCPRO; | |
| 1096 } | |
| 1097 | |
| 1098 return hash_table; | |
| 1099 } | |
| 1100 | |
| 1101 static void | |
| 1102 structure_type_create_hash_table_structure_name (Lisp_Object structure_name) | |
| 1103 { | |
| 1104 struct structure_type *st; | |
| 1105 | |
| 1106 st = define_structure_type (structure_name, 0, hash_table_instantiate); | |
|
4820
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1107 |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1108 /* First the keyword syntax: */ |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1109 define_structure_type_keyword (st, Q_test, hash_table_test_validate); |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1110 define_structure_type_keyword (st, Q_size, hash_table_size_validate); |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1111 define_structure_type_keyword (st, Q_rehash_size, hash_table_rehash_size_validate); |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1112 define_structure_type_keyword (st, Q_rehash_threshold, hash_table_rehash_threshold_validate); |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1113 define_structure_type_keyword (st, Q_weakness, hash_table_weakness_validate); |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1114 define_structure_type_keyword (st, Q_data, hash_table_data_validate); |
|
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1115 |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5193
diff
changeset
|
1116 #ifdef NEED_TO_HANDLE_21_4_CODE |
|
4820
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
1117 /* Next the mutually exclusive, older, non-keyword syntax: */ |
| 428 | 1118 define_structure_type_keyword (st, Qtest, hash_table_test_validate); |
| 1119 define_structure_type_keyword (st, Qsize, hash_table_size_validate); | |
| 1120 define_structure_type_keyword (st, Qrehash_size, hash_table_rehash_size_validate); | |
| 1121 define_structure_type_keyword (st, Qrehash_threshold, hash_table_rehash_threshold_validate); | |
| 1122 define_structure_type_keyword (st, Qweakness, hash_table_weakness_validate); | |
| 1123 define_structure_type_keyword (st, Qdata, hash_table_data_validate); | |
| 1124 | |
| 1125 /* obsolete as of 19990901 in xemacs-21.2 */ | |
| 1126 define_structure_type_keyword (st, Qtype, hash_table_weakness_validate); | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1127 #endif |
| 428 | 1128 } |
| 1129 | |
| 1130 /* Create a built-in Lisp structure type named `hash-table'. | |
| 1131 We make #s(hashtable ...) equivalent to #s(hash-table ...), | |
| 1132 for backward compatibility. | |
| 1133 This is called from emacs.c. */ | |
| 1134 void | |
| 1135 structure_type_create_hash_table (void) | |
| 1136 { | |
| 1137 structure_type_create_hash_table_structure_name (Qhash_table); | |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5193
diff
changeset
|
1138 #ifdef NEED_TO_HANDLE_21_4_CODE |
| 428 | 1139 structure_type_create_hash_table_structure_name (Qhashtable); /* compat */ |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5193
diff
changeset
|
1140 #endif |
| 428 | 1141 } |
| 1142 | |
| 1143 | |
| 1144 /************************************************************************/ | |
| 1145 /* Definition of Lisp-visible methods */ | |
| 1146 /************************************************************************/ | |
| 1147 | |
| 1148 DEFUN ("hash-table-p", Fhash_table_p, 1, 1, 0, /* | |
| 1149 Return t if OBJECT is a hash table, else nil. | |
| 1150 */ | |
| 1151 (object)) | |
| 1152 { | |
| 1153 return HASH_TABLEP (object) ? Qt : Qnil; | |
| 1154 } | |
| 1155 | |
| 1156 DEFUN ("make-hash-table", Fmake_hash_table, 0, MANY, 0, /* | |
| 1157 Return a new empty hash table object. | |
| 1158 Use Common Lisp style keywords to specify hash table properties. | |
| 1159 | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1160 Keyword :test can be `eq', `eql' (default), `equal' or `equalp'. |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1161 Comparison between keys is done using this function. If speed is important, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1162 consider using `eq'. When storing strings in the hash table, you will |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1163 likely need to use `equal' or `equalp' (for case-insensitivity). With other |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1164 objects, consider using a test function defined with |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1165 `define-hash-table-test', an emacs extension to this Common Lisp hash table |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1166 API. |
| 428 | 1167 |
| 1168 Keyword :size specifies the number of keys likely to be inserted. | |
| 1169 This number of entries can be inserted without enlarging the hash table. | |
| 1170 | |
| 1171 Keyword :rehash-size must be a float greater than 1.0, and specifies | |
| 1172 the factor by which to increase the size of the hash table when enlarging. | |
| 1173 | |
| 1174 Keyword :rehash-threshold must be a float between 0.0 and 1.0, | |
| 1175 and specifies the load factor of the hash table which triggers enlarging. | |
| 1176 | |
| 442 | 1177 Non-standard keyword :weakness can be `nil' (default), `t', `key-and-value', |
| 1178 `key', `value' or `key-or-value'. `t' is an alias for `key-and-value'. | |
| 428 | 1179 |
| 442 | 1180 A key-and-value-weak hash table, also known as a fully-weak or simply |
| 1181 as a weak hash table, is one whose pointers do not count as GC | |
| 1182 referents: for any key-value pair in the hash table, if the only | |
| 1183 remaining pointer to either the key or the value is in a weak hash | |
| 1184 table, then the pair will be removed from the hash table, and the key | |
| 1185 and value collected. A non-weak hash table (or any other pointer) | |
| 1186 would prevent the object from being collected. | |
| 428 | 1187 |
| 1188 A key-weak hash table is similar to a fully-weak hash table except that | |
| 1189 a key-value pair will be removed only if the key remains unmarked | |
| 1190 outside of weak hash tables. The pair will remain in the hash table if | |
| 1191 the key is pointed to by something other than a weak hash table, even | |
| 1192 if the value is not. | |
| 1193 | |
| 1194 A value-weak hash table is similar to a fully-weak hash table except | |
| 1195 that a key-value pair will be removed only if the value remains | |
| 1196 unmarked outside of weak hash tables. The pair will remain in the | |
| 1197 hash table if the value is pointed to by something other than a weak | |
| 1198 hash table, even if the key is not. | |
| 442 | 1199 |
| 1200 A key-or-value-weak hash table is similar to a fully-weak hash table except | |
| 1201 that a key-value pair will be removed only if the value and the key remain | |
| 1202 unmarked outside of weak hash tables. The pair will remain in the | |
| 1203 hash table if the value or key are pointed to by something other than a weak | |
| 1204 hash table, even if the other is not. | |
|
4693
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4585
diff
changeset
|
1205 |
|
4777
c69aeb86b2a3
Serialise non-default hash table rehash thresholds correctly; use this.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4693
diff
changeset
|
1206 arguments: (&key TEST SIZE REHASH-SIZE REHASH-THRESHOLD WEAKNESS) |
| 428 | 1207 */ |
| 1208 (int nargs, Lisp_Object *args)) | |
| 1209 { | |
|
5277
d804e621add0
Simplify the API of PARSE_KEYWORDS for callers.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5232
diff
changeset
|
1210 #ifndef NEED_TO_HANDLE_21_4_CODE |
|
d804e621add0
Simplify the API of PARSE_KEYWORDS for callers.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5232
diff
changeset
|
1211 PARSE_KEYWORDS (Fmake_hash_table, nargs, args, 5, |
|
5084
6afe991b8135
Add a PARSE_KEYWORDS macro, use it in #'make-hash-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
1212 (test, size, rehash_size, rehash_threshold, weakness), |
|
5277
d804e621add0
Simplify the API of PARSE_KEYWORDS for callers.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5232
diff
changeset
|
1213 NULL); |
|
5084
6afe991b8135
Add a PARSE_KEYWORDS macro, use it in #'make-hash-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
1214 #else |
|
5277
d804e621add0
Simplify the API of PARSE_KEYWORDS for callers.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5232
diff
changeset
|
1215 PARSE_KEYWORDS (Fmake_hash_table, nargs, args, 6, |
|
5084
6afe991b8135
Add a PARSE_KEYWORDS macro, use it in #'make-hash-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
1216 (test, size, rehash_size, rehash_threshold, weakness, |
|
5277
d804e621add0
Simplify the API of PARSE_KEYWORDS for callers.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5232
diff
changeset
|
1217 type), (type = Qunbound, weakness = Qunbound)); |
| 428 | 1218 |
|
5084
6afe991b8135
Add a PARSE_KEYWORDS macro, use it in #'make-hash-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
1219 if (EQ (weakness, Qunbound)) |
|
6afe991b8135
Add a PARSE_KEYWORDS macro, use it in #'make-hash-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
1220 { |
|
6afe991b8135
Add a PARSE_KEYWORDS macro, use it in #'make-hash-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
1221 if (EQ (weakness, Qunbound) && !EQ (type, Qunbound)) |
|
6afe991b8135
Add a PARSE_KEYWORDS macro, use it in #'make-hash-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
1222 { |
|
6afe991b8135
Add a PARSE_KEYWORDS macro, use it in #'make-hash-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
1223 weakness = type; |
|
6afe991b8135
Add a PARSE_KEYWORDS macro, use it in #'make-hash-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
1224 } |
|
6afe991b8135
Add a PARSE_KEYWORDS macro, use it in #'make-hash-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
1225 else |
|
6afe991b8135
Add a PARSE_KEYWORDS macro, use it in #'make-hash-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
1226 { |
|
6afe991b8135
Add a PARSE_KEYWORDS macro, use it in #'make-hash-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
1227 weakness = Qnil; |
|
6afe991b8135
Add a PARSE_KEYWORDS macro, use it in #'make-hash-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
1228 } |
| 428 | 1229 } |
|
5084
6afe991b8135
Add a PARSE_KEYWORDS macro, use it in #'make-hash-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
1230 #endif |
| 428 | 1231 |
| 1232 #define VALIDATE_VAR(var) \ | |
| 1233 if (!NILP (var)) hash_table_##var##_validate (Q##var, var, ERROR_ME); | |
| 1234 | |
| 1235 VALIDATE_VAR (test); | |
| 1236 VALIDATE_VAR (size); | |
| 1237 VALIDATE_VAR (rehash_size); | |
| 1238 VALIDATE_VAR (rehash_threshold); | |
| 1239 VALIDATE_VAR (weakness); | |
| 1240 | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1241 return make_general_lisp_hash_table |
| 428 | 1242 (decode_hash_table_test (test), |
| 1243 decode_hash_table_size (size), | |
| 1244 decode_hash_table_rehash_size (rehash_size), | |
| 1245 decode_hash_table_rehash_threshold (rehash_threshold), | |
| 1246 decode_hash_table_weakness (weakness)); | |
| 1247 } | |
| 1248 | |
| 1249 DEFUN ("copy-hash-table", Fcopy_hash_table, 1, 1, 0, /* | |
| 1250 Return a new hash table containing the same keys and values as HASH-TABLE. | |
| 1251 The keys and values will not themselves be copied. | |
| 1252 */ | |
| 1253 (hash_table)) | |
| 1254 { | |
| 442 | 1255 const Lisp_Hash_Table *ht_old = xhash_table (hash_table); |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
1256 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (hash_table); |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
1257 Lisp_Hash_Table *ht = XHASH_TABLE (obj); |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
1258 copy_lisp_object (obj, hash_table); |
| 428 | 1259 |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
1260 /* We leave room for one never-occupied sentinel htentry at the end. */ |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
1261 ht->hentries = allocate_hash_table_entries (ht_old->size + 1); |
| 1204 | 1262 memcpy (ht->hentries, ht_old->hentries, (ht_old->size + 1) * sizeof (htentry)); |
| 428 | 1263 |
| 1264 if (! EQ (ht->next_weak, Qunbound)) | |
| 1265 { | |
| 1266 ht->next_weak = Vall_weak_hash_tables; | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
1267 Vall_weak_hash_tables = obj; |
| 428 | 1268 } |
| 1269 | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
1270 return obj; |
| 428 | 1271 } |
| 1272 | |
| 1273 static void | |
| 665 | 1274 resize_hash_table (Lisp_Hash_Table *ht, Elemcount new_size) |
| 428 | 1275 { |
| 1204 | 1276 htentry *old_entries, *new_entries, *sentinel, *e; |
| 665 | 1277 Elemcount old_size; |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1278 Hash_Table_Test *http = XHASH_TABLE_TEST (ht->test); |
| 428 | 1279 |
| 1280 old_size = ht->size; | |
| 1281 ht->size = new_size; | |
| 1282 | |
| 1283 old_entries = ht->hentries; | |
| 1284 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
1285 /* We leave room for one never-occupied sentinel htentry at the end. */ |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
1286 ht->hentries = allocate_hash_table_entries (new_size + 1); |
| 428 | 1287 new_entries = ht->hentries; |
| 1288 | |
| 1289 compute_hash_table_derived_values (ht); | |
| 1290 | |
| 440 | 1291 for (e = old_entries, sentinel = e + old_size; e < sentinel; e++) |
| 1204 | 1292 if (!HTENTRY_CLEAR_P (e)) |
| 428 | 1293 { |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1294 htentry *probe = new_entries + HASHCODE (e->key, ht, http); |
| 428 | 1295 LINEAR_PROBING_LOOP (probe, new_entries, new_size) |
| 1296 ; | |
| 1297 *probe = *e; | |
| 1298 } | |
| 1299 | |
| 4117 | 1300 #ifndef NEW_GC |
| 489 | 1301 free_hentries (old_entries, old_size); |
| 4117 | 1302 #endif /* not NEW_GC */ |
| 428 | 1303 } |
| 1304 | |
| 440 | 1305 /* After a hash table has been saved to disk and later restored by the |
| 1306 portable dumper, it contains the same objects, but their addresses | |
| 665 | 1307 and thus their HASHCODEs have changed. */ |
| 428 | 1308 void |
| 440 | 1309 pdump_reorganize_hash_table (Lisp_Object hash_table) |
| 428 | 1310 { |
| 442 | 1311 const Lisp_Hash_Table *ht = xhash_table (hash_table); |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
1312 /* We leave room for one never-occupied sentinel htentry at the end. */ |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
1313 htentry *new_entries = allocate_hash_table_entries (ht->size + 1); |
| 1204 | 1314 htentry *e, *sentinel; |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1315 Hash_Table_Test *http = XHASH_TABLE_TEST (ht->test); |
| 440 | 1316 |
| 1317 for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) | |
| 1204 | 1318 if (!HTENTRY_CLEAR_P (e)) |
| 440 | 1319 { |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1320 htentry *probe = new_entries + HASHCODE (e->key, ht, http); |
| 440 | 1321 LINEAR_PROBING_LOOP (probe, new_entries, ht->size) |
| 1322 ; | |
| 1323 *probe = *e; | |
| 1324 } | |
| 1325 | |
| 1204 | 1326 memcpy (ht->hentries, new_entries, ht->size * sizeof (htentry)); |
| 440 | 1327 |
| 4117 | 1328 #ifndef NEW_GC |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
1329 xfree (new_entries); |
| 3092 | 1330 #endif /* not NEW_GC */ |
| 428 | 1331 } |
| 1332 | |
| 1333 static void | |
| 1334 enlarge_hash_table (Lisp_Hash_Table *ht) | |
| 1335 { | |
| 665 | 1336 Elemcount new_size = |
| 1337 hash_table_size ((Elemcount) ((double) ht->size * ht->rehash_size)); | |
| 428 | 1338 resize_hash_table (ht, new_size); |
| 1339 } | |
| 1340 | |
| 4072 | 1341 htentry * |
| 1204 | 1342 find_htentry (Lisp_Object key, const Lisp_Hash_Table *ht) |
| 428 | 1343 { |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1344 Lisp_Object test = ht->test; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1345 Hash_Table_Test *http = XHASH_TABLE_TEST (test); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1346 |
| 1204 | 1347 htentry *entries = ht->hentries; |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1348 htentry *probe = entries + HASHCODE (key, ht, http); |
| 428 | 1349 |
| 1350 LINEAR_PROBING_LOOP (probe, entries, ht->size) | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1351 if (KEYS_EQUAL_P (probe->key, key, test, http)) |
| 428 | 1352 break; |
| 1353 | |
| 1354 return probe; | |
| 1355 } | |
| 1356 | |
| 2421 | 1357 /* A version of Fputhash() that increments the value by the specified |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1358 amount and dispenses with all error checks. Assumes that tables does |
| 2421 | 1359 comparison using EQ. Used by the profiling routines to avoid |
| 1360 overhead -- profiling overhead was being recorded at up to 15% of the | |
| 1361 total time. */ | |
| 1362 | |
|
5560
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
1363 htentry * |
| 2421 | 1364 inchash_eq (Lisp_Object key, Lisp_Object table, EMACS_INT offset) |
| 1365 { | |
| 1366 Lisp_Hash_Table *ht = XHASH_TABLE (table); | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1367 Hash_Table_Test *http = XHASH_TABLE_TEST (ht->test); |
| 2421 | 1368 htentry *entries = ht->hentries; |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1369 htentry *probe = entries + HASHCODE (key, ht, http); |
| 2421 | 1370 |
| 1371 LINEAR_PROBING_LOOP (probe, entries, ht->size) | |
| 1372 if (EQ (probe->key, key)) | |
| 1373 break; | |
| 1374 | |
| 1375 if (!HTENTRY_CLEAR_P (probe)) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
1376 probe->value = make_fixnum (XFIXNUM (probe->value) + offset); |
| 2421 | 1377 else |
| 1378 { | |
| 1379 probe->key = key; | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
1380 probe->value = make_fixnum (offset); |
| 2421 | 1381 |
| 1382 if (++ht->count >= ht->rehash_count) | |
|
5560
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
1383 { |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
1384 enlarge_hash_table (ht); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
1385 return NULL; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
1386 } |
| 2421 | 1387 } |
|
5560
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
1388 |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
1389 return probe; |
| 2421 | 1390 } |
| 1391 | |
| 428 | 1392 DEFUN ("gethash", Fgethash, 2, 3, 0, /* |
| 1393 Find hash value for KEY in HASH-TABLE. | |
| 1394 If there is no corresponding value, return DEFAULT (which defaults to nil). | |
| 1395 */ | |
| 1396 (key, hash_table, default_)) | |
| 1397 { | |
| 442 | 1398 const Lisp_Hash_Table *ht = xhash_table (hash_table); |
| 1204 | 1399 htentry *e = find_htentry (key, ht); |
| 428 | 1400 |
| 1204 | 1401 return HTENTRY_CLEAR_P (e) ? default_ : e->value; |
| 428 | 1402 } |
| 1403 | |
| 1404 DEFUN ("puthash", Fputhash, 3, 3, 0, /* | |
|
4410
aae1994dfeec
Document return values for #'puthash, #'clrhash.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4398
diff
changeset
|
1405 Hash KEY to VALUE in HASH-TABLE, and return VALUE. |
| 428 | 1406 */ |
| 1407 (key, value, hash_table)) | |
| 1408 { | |
| 1409 Lisp_Hash_Table *ht = xhash_table (hash_table); | |
| 1204 | 1410 htentry *e = find_htentry (key, ht); |
| 428 | 1411 |
| 1204 | 1412 if (!HTENTRY_CLEAR_P (e)) |
| 428 | 1413 return e->value = value; |
| 1414 | |
| 1415 e->key = key; | |
| 1416 e->value = value; | |
| 1417 | |
| 1418 if (++ht->count >= ht->rehash_count) | |
| 1419 enlarge_hash_table (ht); | |
| 1420 | |
| 1421 return value; | |
| 1422 } | |
| 1423 | |
| 1204 | 1424 /* Remove htentry pointed at by PROBE. |
| 428 | 1425 Subsequent entries are removed and reinserted. |
| 1426 We don't use tombstones - too wasteful. */ | |
| 1427 static void | |
| 1204 | 1428 remhash_1 (Lisp_Hash_Table *ht, htentry *entries, htentry *probe) |
| 428 | 1429 { |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1430 Hash_Table_Test *http = XHASH_TABLE_TEST (ht->test); |
| 665 | 1431 Elemcount size = ht->size; |
| 1204 | 1432 CLEAR_HTENTRY (probe); |
| 428 | 1433 probe++; |
| 1434 ht->count--; | |
| 1435 | |
| 1436 LINEAR_PROBING_LOOP (probe, entries, size) | |
| 1437 { | |
| 1438 Lisp_Object key = probe->key; | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1439 htentry *probe2 = entries + HASHCODE (key, ht, http); |
| 428 | 1440 LINEAR_PROBING_LOOP (probe2, entries, size) |
| 1441 if (EQ (probe2->key, key)) | |
| 1204 | 1442 /* htentry at probe doesn't need to move. */ |
| 428 | 1443 goto continue_outer_loop; |
| 1204 | 1444 /* Move htentry from probe to new home at probe2. */ |
| 428 | 1445 *probe2 = *probe; |
| 1204 | 1446 CLEAR_HTENTRY (probe); |
| 428 | 1447 continue_outer_loop: continue; |
| 1448 } | |
| 1449 } | |
| 1450 | |
| 1451 DEFUN ("remhash", Fremhash, 2, 2, 0, /* | |
| 1452 Remove the entry for KEY from HASH-TABLE. | |
| 1453 Do nothing if there is no entry for KEY in HASH-TABLE. | |
| 617 | 1454 Return non-nil if an entry was removed. |
| 428 | 1455 */ |
| 1456 (key, hash_table)) | |
| 1457 { | |
| 1458 Lisp_Hash_Table *ht = xhash_table (hash_table); | |
| 1204 | 1459 htentry *e = find_htentry (key, ht); |
| 428 | 1460 |
| 1204 | 1461 if (HTENTRY_CLEAR_P (e)) |
| 428 | 1462 return Qnil; |
| 1463 | |
| 1464 remhash_1 (ht, ht->hentries, e); | |
| 1465 return Qt; | |
| 1466 } | |
| 1467 | |
| 1468 DEFUN ("clrhash", Fclrhash, 1, 1, 0, /* | |
| 1469 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
|
1470 Return HASH-TABLE. |
| 428 | 1471 */ |
| 1472 (hash_table)) | |
| 1473 { | |
| 1474 Lisp_Hash_Table *ht = xhash_table (hash_table); | |
| 1204 | 1475 htentry *e, *sentinel; |
| 428 | 1476 |
| 1477 for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) | |
| 1204 | 1478 CLEAR_HTENTRY (e); |
| 428 | 1479 ht->count = 0; |
| 1480 | |
| 1481 return hash_table; | |
| 1482 } | |
| 1483 | |
| 1484 /************************************************************************/ | |
| 1485 /* Accessor Functions */ | |
| 1486 /************************************************************************/ | |
| 1487 | |
| 1488 DEFUN ("hash-table-count", Fhash_table_count, 1, 1, 0, /* | |
| 1489 Return the number of entries in HASH-TABLE. | |
| 1490 */ | |
| 1491 (hash_table)) | |
| 1492 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
1493 return make_fixnum (xhash_table (hash_table)->count); |
| 428 | 1494 } |
| 1495 | |
| 1496 DEFUN ("hash-table-test", Fhash_table_test, 1, 1, 0, /* | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1497 Return HASH-TABLE's test. |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1498 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1499 This can be one of `eq', `eql', `equal', `equalp', or some symbol supplied |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1500 as the NAME argument to `define-hash-table-test', which see. |
| 428 | 1501 */ |
| 1502 (hash_table)) | |
| 1503 { | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1504 CHECK_HASH_TABLE (hash_table); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1505 return XHASH_TABLE_TEST (XHASH_TABLE (hash_table)->test)->name; |
| 428 | 1506 } |
| 1507 | |
| 1508 DEFUN ("hash-table-size", Fhash_table_size, 1, 1, 0, /* | |
| 1509 Return the size of HASH-TABLE. | |
| 1510 This is the current number of slots in HASH-TABLE, whether occupied or not. | |
| 1511 */ | |
| 1512 (hash_table)) | |
| 1513 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
1514 return make_fixnum (xhash_table (hash_table)->size); |
| 428 | 1515 } |
| 1516 | |
| 1517 DEFUN ("hash-table-rehash-size", Fhash_table_rehash_size, 1, 1, 0, /* | |
| 1518 Return the current rehash size of HASH-TABLE. | |
| 1519 This is a float greater than 1.0; the factor by which HASH-TABLE | |
| 1520 is enlarged when the rehash threshold is exceeded. | |
| 1521 */ | |
| 1522 (hash_table)) | |
| 1523 { | |
| 1524 return make_float (xhash_table (hash_table)->rehash_size); | |
| 1525 } | |
| 1526 | |
| 1527 DEFUN ("hash-table-rehash-threshold", Fhash_table_rehash_threshold, 1, 1, 0, /* | |
| 1528 Return the current rehash threshold of HASH-TABLE. | |
| 1529 This is a float between 0.0 and 1.0; the maximum `load factor' of HASH-TABLE, | |
| 1530 beyond which the HASH-TABLE is enlarged by rehashing. | |
| 1531 */ | |
| 1532 (hash_table)) | |
| 1533 { | |
| 438 | 1534 return make_float (xhash_table (hash_table)->rehash_threshold); |
| 428 | 1535 } |
| 1536 | |
| 1537 DEFUN ("hash-table-weakness", Fhash_table_weakness, 1, 1, 0, /* | |
| 1538 Return the weakness of HASH-TABLE. | |
| 442 | 1539 This can be one of `nil', `key-and-value', `key-or-value', `key' or `value'. |
| 428 | 1540 */ |
| 1541 (hash_table)) | |
| 1542 { | |
| 1543 switch (xhash_table (hash_table)->weakness) | |
| 1544 { | |
| 442 | 1545 case HASH_TABLE_WEAK: return Qkey_and_value; |
| 1546 case HASH_TABLE_KEY_WEAK: return Qkey; | |
| 1547 case HASH_TABLE_KEY_VALUE_WEAK: return Qkey_or_value; | |
| 1548 case HASH_TABLE_VALUE_WEAK: return Qvalue; | |
| 1549 default: return Qnil; | |
| 428 | 1550 } |
| 1551 } | |
| 1552 | |
| 1553 /* obsolete as of 19990901 in xemacs-21.2 */ | |
| 1554 DEFUN ("hash-table-type", Fhash_table_type, 1, 1, 0, /* | |
| 1555 Return the type of HASH-TABLE. | |
| 1556 This can be one of `non-weak', `weak', `key-weak' or `value-weak'. | |
| 1557 */ | |
| 1558 (hash_table)) | |
| 1559 { | |
| 1560 switch (xhash_table (hash_table)->weakness) | |
| 1561 { | |
| 442 | 1562 case HASH_TABLE_WEAK: return Qweak; |
| 1563 case HASH_TABLE_KEY_WEAK: return Qkey_weak; | |
| 1564 case HASH_TABLE_KEY_VALUE_WEAK: return Qkey_or_value_weak; | |
| 1565 case HASH_TABLE_VALUE_WEAK: return Qvalue_weak; | |
| 1566 default: return Qnon_weak; | |
| 428 | 1567 } |
| 1568 } | |
| 1569 | |
| 1570 /************************************************************************/ | |
| 1571 /* Mapping Functions */ | |
| 1572 /************************************************************************/ | |
| 489 | 1573 |
| 1574 /* We need to be careful when mapping over hash tables because the | |
| 1575 hash table might be modified during the mapping operation: | |
| 1576 - by the mapping function | |
| 1577 - by gc (if the hash table is weak) | |
| 1578 | |
| 1579 So we make a copy of the hentries at the beginning of the mapping | |
| 497 | 1580 operation, and iterate over the copy. Naturally, this is |
| 1581 expensive, but not as expensive as you might think, because no | |
| 1582 actual memory has to be collected by our notoriously inefficient | |
| 1583 GC; we use an unwind-protect instead to free the memory directly. | |
| 1584 | |
| 1585 We could avoid the copying by having the hash table modifiers | |
| 1586 puthash and remhash check for currently active mapping functions. | |
| 1587 Disadvantages: it's hard to get right, and IMO hash mapping | |
| 1588 functions are basically rare, and no extra space in the hash table | |
| 1589 object and no extra cpu in puthash or remhash should be wasted to | |
| 1590 make maphash 3% faster. From a design point of view, the basic | |
| 1591 functions gethash, puthash and remhash should be implementable | |
| 1592 without having to think about maphash. | |
| 1593 | |
| 1594 Note: We don't (yet) have Common Lisp's with-hash-table-iterator. | |
| 1595 If you implement this naively, you cannot have more than one | |
| 1596 concurrently active iterator over the same hash table. The `each' | |
| 1597 function in perl has this limitation. | |
| 1598 | |
| 1599 Note: We GCPRO memory on the heap, not on the stack. There is no | |
| 1600 obvious reason why this is bad, but as of this writing this is the | |
| 1601 only known occurrence of this technique in the code. | |
| 504 | 1602 |
| 1603 -- Martin | |
| 1604 */ | |
| 1605 | |
| 1606 /* Ben disagrees with the "copying hentries" design, and says: | |
| 1607 | |
| 1608 Another solution is the same as I've already proposed -- when | |
| 1609 mapping, mark the table as "change-unsafe", and in this case, use a | |
| 1610 secondary table to maintain changes. this could be basically a | |
| 1611 standard hash table, but with entries only for added or deleted | |
| 1612 entries in the primary table, and a marker like Qunbound to | |
| 1613 indicate a deleted entry. puthash, gethash and remhash need a | |
| 1614 single extra check for this secondary table -- totally | |
| 1615 insignificant speedwise. if you really cared about making | |
| 1616 recursive maphashes completely correct, you'd have to do a bit of | |
| 1617 extra work here -- when maphashing, if the secondary table exists, | |
| 1618 make a copy of it, and use the copy in conjunction with the primary | |
| 1619 table when mapping. the advantages of this are | |
| 1620 | |
| 1621 [a] easy to demonstrate correct, even with weak hashtables. | |
| 1622 | |
| 1623 [b] no extra overhead in the general maphash case -- only when you | |
| 1624 modify the table while maphashing, and even then the overhead is | |
| 1625 very small. | |
| 497 | 1626 */ |
| 1627 | |
| 489 | 1628 static Lisp_Object |
| 1629 maphash_unwind (Lisp_Object unwind_obj) | |
| 1630 { | |
| 1631 void *ptr = (void *) get_opaque_ptr (unwind_obj); | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
1632 xfree (ptr); |
| 489 | 1633 free_opaque_ptr (unwind_obj); |
| 1634 return Qnil; | |
| 1635 } | |
| 1636 | |
| 1637 /* Return a malloced array of alternating key/value pairs from HT. */ | |
| 1638 static Lisp_Object * | |
| 1639 copy_compress_hentries (const Lisp_Hash_Table *ht) | |
| 1640 { | |
| 1641 Lisp_Object * const objs = | |
| 1642 /* If the hash table is empty, ht->count could be 0. */ | |
| 1643 xnew_array (Lisp_Object, 2 * (ht->count > 0 ? ht->count : 1)); | |
| 1204 | 1644 const htentry *e, *sentinel; |
| 489 | 1645 Lisp_Object *pobj; |
| 1646 | |
| 1647 for (e = ht->hentries, sentinel = e + ht->size, pobj = objs; e < sentinel; e++) | |
| 1204 | 1648 if (!HTENTRY_CLEAR_P (e)) |
| 489 | 1649 { |
| 1650 *(pobj++) = e->key; | |
| 1651 *(pobj++) = e->value; | |
| 1652 } | |
| 1653 | |
| 1654 type_checking_assert (pobj == objs + 2 * ht->count); | |
| 1655 | |
| 1656 return objs; | |
| 1657 } | |
| 1658 | |
| 428 | 1659 DEFUN ("maphash", Fmaphash, 2, 2, 0, /* |
| 1660 Map FUNCTION over entries in HASH-TABLE, calling it with two args, | |
| 1661 each key and value in HASH-TABLE. | |
| 1662 | |
| 489 | 1663 FUNCTION must not modify HASH-TABLE, with the one exception that FUNCTION |
| 428 | 1664 may remhash or puthash the entry currently being processed by FUNCTION. |
| 1665 */ | |
| 1666 (function, hash_table)) | |
| 1667 { | |
| 489 | 1668 const Lisp_Hash_Table * const ht = xhash_table (hash_table); |
| 1669 Lisp_Object * const objs = copy_compress_hentries (ht); | |
| 1670 Lisp_Object args[3]; | |
| 1671 const Lisp_Object *pobj, *end; | |
| 1672 int speccount = specpdl_depth (); | |
| 1673 struct gcpro gcpro1; | |
| 1674 | |
| 1675 record_unwind_protect (maphash_unwind, make_opaque_ptr ((void *)objs)); | |
| 1676 GCPRO1 (objs[0]); | |
| 1677 gcpro1.nvars = 2 * ht->count; | |
| 428 | 1678 |
| 489 | 1679 args[0] = function; |
| 1680 | |
| 1681 for (pobj = objs, end = pobj + 2 * ht->count; pobj < end; pobj += 2) | |
| 1682 { | |
| 1683 args[1] = pobj[0]; | |
| 1684 args[2] = pobj[1]; | |
| 1685 Ffuncall (countof (args), args); | |
| 1686 } | |
| 1687 | |
| 771 | 1688 unbind_to (speccount); |
| 489 | 1689 UNGCPRO; |
| 428 | 1690 |
| 1691 return Qnil; | |
| 1692 } | |
| 1693 | |
| 489 | 1694 /* Map *C* function FUNCTION over the elements of a non-weak lisp hash table. |
| 1695 FUNCTION must not modify HASH-TABLE, with the one exception that FUNCTION | |
| 1696 may puthash the entry currently being processed by FUNCTION. | |
| 1697 Mapping terminates if FUNCTION returns something other than 0. */ | |
| 428 | 1698 void |
| 489 | 1699 elisp_maphash_unsafe (maphash_function_t function, |
| 428 | 1700 Lisp_Object hash_table, void *extra_arg) |
| 1701 { | |
| 442 | 1702 const Lisp_Hash_Table *ht = XHASH_TABLE (hash_table); |
| 1204 | 1703 const htentry *e, *sentinel; |
| 428 | 1704 |
| 1705 for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) | |
| 1204 | 1706 if (!HTENTRY_CLEAR_P (e)) |
| 489 | 1707 if (function (e->key, e->value, extra_arg)) |
| 1708 return; | |
| 428 | 1709 } |
| 1710 | |
| 489 | 1711 /* Map *C* function FUNCTION over the elements of a lisp hash table. |
| 1712 It is safe for FUNCTION to modify HASH-TABLE. | |
| 1713 Mapping terminates if FUNCTION returns something other than 0. */ | |
| 1714 void | |
| 1715 elisp_maphash (maphash_function_t function, | |
| 1716 Lisp_Object hash_table, void *extra_arg) | |
| 1717 { | |
| 1718 const Lisp_Hash_Table * const ht = xhash_table (hash_table); | |
| 1719 Lisp_Object * const objs = copy_compress_hentries (ht); | |
| 1720 const Lisp_Object *pobj, *end; | |
| 1721 int speccount = specpdl_depth (); | |
| 1722 struct gcpro gcpro1; | |
| 1723 | |
| 1724 record_unwind_protect (maphash_unwind, make_opaque_ptr ((void *)objs)); | |
| 1725 GCPRO1 (objs[0]); | |
| 1726 gcpro1.nvars = 2 * ht->count; | |
| 1727 | |
| 1728 for (pobj = objs, end = pobj + 2 * ht->count; pobj < end; pobj += 2) | |
| 1729 if (function (pobj[0], pobj[1], extra_arg)) | |
| 1730 break; | |
| 1731 | |
| 771 | 1732 unbind_to (speccount); |
| 489 | 1733 UNGCPRO; |
| 1734 } | |
| 1735 | |
| 1736 /* Remove all elements of a lisp hash table satisfying *C* predicate PREDICATE. | |
| 1737 PREDICATE must not modify HASH-TABLE. */ | |
| 428 | 1738 void |
| 1739 elisp_map_remhash (maphash_function_t predicate, | |
| 1740 Lisp_Object hash_table, void *extra_arg) | |
| 1741 { | |
| 489 | 1742 const Lisp_Hash_Table * const ht = xhash_table (hash_table); |
| 1743 Lisp_Object * const objs = copy_compress_hentries (ht); | |
| 1744 const Lisp_Object *pobj, *end; | |
| 1745 int speccount = specpdl_depth (); | |
| 1746 struct gcpro gcpro1; | |
| 428 | 1747 |
| 489 | 1748 record_unwind_protect (maphash_unwind, make_opaque_ptr ((void *)objs)); |
| 1749 GCPRO1 (objs[0]); | |
| 1750 gcpro1.nvars = 2 * ht->count; | |
| 1751 | |
| 1752 for (pobj = objs, end = pobj + 2 * ht->count; pobj < end; pobj += 2) | |
| 1753 if (predicate (pobj[0], pobj[1], extra_arg)) | |
| 1754 Fremhash (pobj[0], hash_table); | |
| 1755 | |
| 771 | 1756 unbind_to (speccount); |
| 489 | 1757 UNGCPRO; |
| 428 | 1758 } |
| 1759 | |
| 1760 | |
| 1761 /************************************************************************/ | |
| 1762 /* garbage collecting weak hash tables */ | |
| 1763 /************************************************************************/ | |
| 1598 | 1764 #ifdef USE_KKCC |
| 2645 | 1765 #define MARK_OBJ(obj) do { \ |
| 1766 Lisp_Object mo_obj = (obj); \ | |
| 1767 if (!marked_p (mo_obj)) \ | |
| 1768 { \ | |
|
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
1769 kkcc_gc_stack_push_lisp_object_0 (mo_obj); \ |
| 2645 | 1770 did_mark = 1; \ |
| 1771 } \ | |
| 1598 | 1772 } while (0) |
| 1773 | |
| 1774 #else /* NO USE_KKCC */ | |
| 1775 | |
| 442 | 1776 #define MARK_OBJ(obj) do { \ |
| 1777 Lisp_Object mo_obj = (obj); \ | |
| 1778 if (!marked_p (mo_obj)) \ | |
| 1779 { \ | |
| 1780 mark_object (mo_obj); \ | |
| 1781 did_mark = 1; \ | |
| 1782 } \ | |
| 1783 } while (0) | |
| 1598 | 1784 #endif /*NO USE_KKCC */ |
| 442 | 1785 |
| 428 | 1786 |
| 1787 /* Complete the marking for semi-weak hash tables. */ | |
| 1788 int | |
| 1789 finish_marking_weak_hash_tables (void) | |
| 1790 { | |
| 1791 Lisp_Object hash_table; | |
| 1792 int did_mark = 0; | |
| 1793 | |
| 1794 for (hash_table = Vall_weak_hash_tables; | |
| 1795 !NILP (hash_table); | |
| 1796 hash_table = XHASH_TABLE (hash_table)->next_weak) | |
| 1797 { | |
| 442 | 1798 const Lisp_Hash_Table *ht = XHASH_TABLE (hash_table); |
| 1204 | 1799 const htentry *e = ht->hentries; |
| 1800 const htentry *sentinel = e + ht->size; | |
| 428 | 1801 |
| 1802 if (! marked_p (hash_table)) | |
| 1803 /* The hash table is probably garbage. Ignore it. */ | |
| 1804 continue; | |
| 1805 | |
| 1806 /* Now, scan over all the pairs. For all pairs that are | |
| 1807 half-marked, we may need to mark the other half if we're | |
| 1808 keeping this pair. */ | |
| 1809 switch (ht->weakness) | |
| 1810 { | |
| 1811 case HASH_TABLE_KEY_WEAK: | |
| 1812 for (; e < sentinel; e++) | |
| 1204 | 1813 if (!HTENTRY_CLEAR_P (e)) |
| 428 | 1814 if (marked_p (e->key)) |
| 1815 MARK_OBJ (e->value); | |
| 1816 break; | |
| 1817 | |
| 1818 case HASH_TABLE_VALUE_WEAK: | |
| 1819 for (; e < sentinel; e++) | |
| 1204 | 1820 if (!HTENTRY_CLEAR_P (e)) |
| 428 | 1821 if (marked_p (e->value)) |
| 1822 MARK_OBJ (e->key); | |
| 1823 break; | |
| 1824 | |
| 442 | 1825 case HASH_TABLE_KEY_VALUE_WEAK: |
| 1826 for (; e < sentinel; e++) | |
| 1204 | 1827 if (!HTENTRY_CLEAR_P (e)) |
| 442 | 1828 { |
| 1829 if (marked_p (e->value)) | |
| 1830 MARK_OBJ (e->key); | |
| 1831 else if (marked_p (e->key)) | |
| 1832 MARK_OBJ (e->value); | |
| 1833 } | |
| 1834 break; | |
| 1835 | |
| 428 | 1836 case HASH_TABLE_KEY_CAR_WEAK: |
| 1837 for (; e < sentinel; e++) | |
| 1204 | 1838 if (!HTENTRY_CLEAR_P (e)) |
| 428 | 1839 if (!CONSP (e->key) || marked_p (XCAR (e->key))) |
| 1840 { | |
| 1841 MARK_OBJ (e->key); | |
| 1842 MARK_OBJ (e->value); | |
| 1843 } | |
| 1844 break; | |
| 1845 | |
| 450 | 1846 /* We seem to be sprouting new weakness types at an alarming |
| 1847 rate. At least this is not externally visible - and in | |
| 1848 fact all of these KEY_CAR_* types are only used by the | |
| 1849 glyph code. */ | |
| 1850 case HASH_TABLE_KEY_CAR_VALUE_WEAK: | |
| 1851 for (; e < sentinel; e++) | |
| 1204 | 1852 if (!HTENTRY_CLEAR_P (e)) |
| 450 | 1853 { |
| 1854 if (!CONSP (e->key) || marked_p (XCAR (e->key))) | |
| 1855 { | |
| 1856 MARK_OBJ (e->key); | |
| 1857 MARK_OBJ (e->value); | |
| 1858 } | |
| 1859 else if (marked_p (e->value)) | |
| 1860 MARK_OBJ (e->key); | |
| 1861 } | |
| 1862 break; | |
| 1863 | |
| 428 | 1864 case HASH_TABLE_VALUE_CAR_WEAK: |
| 1865 for (; e < sentinel; e++) | |
| 1204 | 1866 if (!HTENTRY_CLEAR_P (e)) |
| 428 | 1867 if (!CONSP (e->value) || marked_p (XCAR (e->value))) |
| 1868 { | |
| 1869 MARK_OBJ (e->key); | |
| 1870 MARK_OBJ (e->value); | |
| 1871 } | |
| 1872 break; | |
| 1873 | |
| 1874 default: | |
| 1875 break; | |
| 1876 } | |
| 1877 } | |
| 1878 | |
| 1879 return did_mark; | |
| 1880 } | |
| 1881 | |
| 1882 void | |
| 1883 prune_weak_hash_tables (void) | |
| 1884 { | |
| 1885 Lisp_Object hash_table, prev = Qnil; | |
| 1886 for (hash_table = Vall_weak_hash_tables; | |
| 1887 !NILP (hash_table); | |
| 1888 hash_table = XHASH_TABLE (hash_table)->next_weak) | |
| 1889 { | |
| 1890 if (! marked_p (hash_table)) | |
| 1891 { | |
| 1892 /* This hash table itself is garbage. Remove it from the list. */ | |
| 1893 if (NILP (prev)) | |
| 1894 Vall_weak_hash_tables = XHASH_TABLE (hash_table)->next_weak; | |
| 1895 else | |
| 1896 XHASH_TABLE (prev)->next_weak = XHASH_TABLE (hash_table)->next_weak; | |
| 1897 } | |
| 1898 else | |
| 1899 { | |
| 1900 /* Now, scan over all the pairs. Remove all of the pairs | |
| 1901 in which the key or value, or both, is unmarked | |
| 1902 (depending on the weakness of the hash table). */ | |
| 1903 Lisp_Hash_Table *ht = XHASH_TABLE (hash_table); | |
| 1204 | 1904 htentry *entries = ht->hentries; |
| 1905 htentry *sentinel = entries + ht->size; | |
| 1906 htentry *e; | |
| 428 | 1907 |
| 1908 for (e = entries; e < sentinel; e++) | |
| 1204 | 1909 if (!HTENTRY_CLEAR_P (e)) |
| 428 | 1910 { |
| 1911 again: | |
| 1912 if (!marked_p (e->key) || !marked_p (e->value)) | |
| 1913 { | |
| 1914 remhash_1 (ht, entries, e); | |
| 1204 | 1915 if (!HTENTRY_CLEAR_P (e)) |
| 428 | 1916 goto again; |
| 1917 } | |
| 1918 } | |
| 1919 | |
| 1920 prev = hash_table; | |
| 1921 } | |
| 1922 } | |
| 1923 } | |
| 1924 | |
| 1925 /* Return a hash value for an array of Lisp_Objects of size SIZE. */ | |
| 1926 | |
| 665 | 1927 Hashcode |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1928 internal_array_hash (Lisp_Object *arr, int size, int depth, Boolint equalp) |
| 428 | 1929 { |
| 1930 int i; | |
| 665 | 1931 Hashcode hash = 0; |
| 442 | 1932 depth++; |
| 428 | 1933 |
| 1934 if (size <= 5) | |
| 1935 { | |
| 1936 for (i = 0; i < size; i++) | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1937 hash = HASH2 (hash, internal_hash (arr[i], depth, equalp)); |
| 428 | 1938 return hash; |
| 1939 } | |
| 1940 | |
| 1941 /* just pick five elements scattered throughout the array. | |
| 1942 A slightly better approach would be to offset by some | |
| 1943 noise factor from the points chosen below. */ | |
| 1944 for (i = 0; i < 5; i++) | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1945 hash = HASH2 (hash, internal_hash (arr[i*size/5], depth, equalp)); |
| 428 | 1946 |
| 1947 return hash; | |
| 1948 } | |
| 1949 | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1950 /* This needs to be algorithmically the same as |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1951 internal_array_hash(). Unfortunately, for strings with non-ASCII content, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1952 it has to be O(2N), I don't see a reasonable alternative to hashing |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1953 sequence relying on their length. It is O(1) for pure ASCII strings, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1954 though. */ |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1955 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1956 static Hashcode |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1957 string_equalp_hash (Lisp_Object string) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1958 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1959 Bytecount len = XSTRING_LENGTH (string), |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1960 ascii_begin = (Bytecount) XSTRING_ASCII_BEGIN (string); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1961 const Ibyte *ptr = XSTRING_DATA (string), *pend = ptr + len; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1962 Charcount clen; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1963 Hashcode hash = 0; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1964 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1965 if (len == ascii_begin) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1966 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1967 clen = len; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1968 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1969 else |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1970 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1971 clen = string_char_length (string); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1972 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1973 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1974 if (clen <= 5) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1975 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1976 while (ptr < pend) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1977 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1978 hash = HASH2 (hash, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1979 LISP_HASH (make_char (CANONCASE (NULL, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1980 itext_ichar (ptr))))); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1981 INC_IBYTEPTR (ptr); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1982 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1983 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1984 else |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1985 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1986 int ii; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1987 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1988 if (clen == len) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1989 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1990 for (ii = 0; ii < 5; ii++) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1991 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1992 hash = HASH2 (hash, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1993 LISP_HASH (make_char |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1994 (CANONCASE (NULL, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1995 ptr[ii * clen / 5])))); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1996 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1997 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1998 else |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
1999 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2000 Charcount this_char = 0, last_char = 0; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2001 for (ii = 0; ii < 5; ii++) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2002 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2003 this_char = ii * clen / 5; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2004 ptr = itext_n_addr (ptr, this_char - last_char); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2005 last_char = this_char; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2006 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2007 hash = HASH2 (hash, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2008 LISP_HASH (make_char |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2009 (CANONCASE (NULL, itext_ichar (ptr))))); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2010 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2011 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2012 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2013 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2014 return HASH2 (clen, hash); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2015 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2016 |
| 428 | 2017 /* Return a hash value for a Lisp_Object. This is for use when hashing |
| 2018 objects with the comparison being `equal' (for `eq', you can just | |
| 2019 use the Lisp_Object itself as the hash value). You need to make a | |
| 2020 tradeoff between the speed of the hash function and how good the | |
| 2021 hashing is. In particular, the hash function needs to be FAST, | |
| 2022 so you can't just traipse down the whole tree hashing everything | |
| 2023 together. Most of the time, objects will differ in the first | |
| 2024 few elements you hash. Thus, we only go to a short depth (5) | |
| 2025 and only hash at most 5 elements out of a vector. Theoretically | |
| 2026 we could still take 5^5 time (a big big number) to compute a | |
| 2027 hash, but practically this won't ever happen. */ | |
| 2028 | |
| 665 | 2029 Hashcode |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2030 internal_hash (Lisp_Object obj, int depth, Boolint equalp) |
| 428 | 2031 { |
| 2032 if (depth > 5) | |
| 2033 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
|
2034 |
|
5193
41ac827cb71b
fix cygwin compile, fix warning and style in elhash.c
Ben Wing <ben@xemacs.org>
parents:
5191
diff
changeset
|
2035 if (CONSP (obj)) |
| 428 | 2036 { |
|
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
|
2037 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
|
2038 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
|
2039 |
|
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
|
2040 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
|
2041 |
|
5193
41ac827cb71b
fix cygwin compile, fix warning and style in elhash.c
Ben Wing <ben@xemacs.org>
parents:
5191
diff
changeset
|
2042 if (!CONSP (XCDR (obj))) |
|
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
|
2043 { |
|
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
|
2044 /* special case for '(a . b) conses */ |
|
5193
41ac827cb71b
fix cygwin compile, fix warning and style in elhash.c
Ben Wing <ben@xemacs.org>
parents:
5191
diff
changeset
|
2045 return HASH2 (internal_hash (XCAR(obj), depth, equalp), |
|
41ac827cb71b
fix cygwin compile, fix warning and style in elhash.c
Ben Wing <ben@xemacs.org>
parents:
5191
diff
changeset
|
2046 internal_hash (XCDR (obj), depth, equalp)); |
|
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
|
2047 } |
|
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
|
2048 |
|
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
|
2049 /* 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
|
2050 same contents in distinct orders differently. */ |
|
5193
41ac827cb71b
fix cygwin compile, fix warning and style in elhash.c
Ben Wing <ben@xemacs.org>
parents:
5191
diff
changeset
|
2051 hash = internal_hash (XCAR (obj), depth, equalp); |
|
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
|
2052 |
|
5193
41ac827cb71b
fix cygwin compile, fix warning and style in elhash.c
Ben Wing <ben@xemacs.org>
parents:
5191
diff
changeset
|
2053 obj = XCDR (obj); |
|
41ac827cb71b
fix cygwin compile, fix warning and style in elhash.c
Ben Wing <ben@xemacs.org>
parents:
5191
diff
changeset
|
2054 for (s = 1; s < 6 && CONSP (obj); obj = XCDR (obj), s++) |
|
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
|
2055 { |
|
5193
41ac827cb71b
fix cygwin compile, fix warning and style in elhash.c
Ben Wing <ben@xemacs.org>
parents:
5191
diff
changeset
|
2056 h = internal_hash (XCAR (obj), depth, equalp); |
|
41ac827cb71b
fix cygwin compile, fix warning and style in elhash.c
Ben Wing <ben@xemacs.org>
parents:
5191
diff
changeset
|
2057 hash = HASH3 (hash, h, s); |
|
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
|
2058 } |
|
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
|
2059 |
|
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
|
2060 return hash; |
| 428 | 2061 } |
| 2062 if (STRINGP (obj)) | |
| 2063 { | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2064 if (equalp) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2065 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2066 return string_equalp_hash (obj); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2067 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2068 |
| 428 | 2069 return hash_string (XSTRING_DATA (obj), XSTRING_LENGTH (obj)); |
| 2070 } | |
| 2071 if (LRECORDP (obj)) | |
| 2072 { | |
| 442 | 2073 const struct lrecord_implementation |
| 428 | 2074 *imp = XRECORD_LHEADER_IMPLEMENTATION (obj); |
| 2075 if (imp->hash) | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2076 return imp->hash (obj, depth, equalp); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2077 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2078 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2079 if (equalp) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2080 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2081 if (CHARP (obj)) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2082 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2083 /* Characters and numbers of the same numeric value hash |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2084 differently, which is fine, they're not equalp. */ |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2085 return LISP_HASH (make_char (CANONCASE (NULL, XCHAR (obj)))); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2086 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2087 |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
2088 if (FIXNUMP (obj)) |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2089 { |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
2090 return FLOAT_HASHCODE_FROM_DOUBLE ((double) (XFIXNUM (obj))); |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2091 } |
| 428 | 2092 } |
| 2093 | |
| 2094 return LISP_HASH (obj); | |
| 2095 } | |
| 2096 | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2097 DEFUN ("eq-hash", Feq_hash, 1, 1, 0, /* |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2098 Return a hash value for OBJECT appropriate for use with `eq.' |
|
5520
05c1ad4f7a7b
Expand the documentation of #'eq-hash, mention the CL PRINT-OBJECT protocol
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
2099 |
|
05c1ad4f7a7b
Expand the documentation of #'eq-hash, mention the CL PRINT-OBJECT protocol
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
2100 If OBJECT is not immediate (it is not a fixnum or character) this hash value |
|
05c1ad4f7a7b
Expand the documentation of #'eq-hash, mention the CL PRINT-OBJECT protocol
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
2101 will be unique among currently-reachable objects, and is appropriate for |
|
05c1ad4f7a7b
Expand the documentation of #'eq-hash, mention the CL PRINT-OBJECT protocol
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
2102 implementing the Common Lisp PRINT-OBJECT protocol. |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2103 */ |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2104 (object)) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2105 { |
|
5193
41ac827cb71b
fix cygwin compile, fix warning and style in elhash.c
Ben Wing <ben@xemacs.org>
parents:
5191
diff
changeset
|
2106 return make_integer ((EMACS_INT) XPNTRVAL (object)); |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2107 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2108 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2109 DEFUN ("eql-hash", Feql_hash, 1, 1, 0, /* |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2110 Return a hash value for OBJECT appropriate for use with `eql.' |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2111 */ |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2112 (object)) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2113 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2114 EMACS_INT hashed = lisp_object_eql_hash (NULL, object); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2115 return make_integer (hashed); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2116 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2117 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2118 DEFUN ("equal-hash", Fequal_hash, 1, 1, 0, /* |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2119 Return a hash value for OBJECT appropriate for use with `equal.' |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2120 \(equal obj1 obj2) implies (= (equal-hash obj1) (equal-hash obj2)). |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2121 */ |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2122 (object)) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2123 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2124 EMACS_INT hashed = internal_hash (object, 0, 0); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2125 return make_integer (hashed); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2126 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2127 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2128 DEFUN ("equalp-hash", Fequalp_hash, 1, 1, 0, /* |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2129 Return a hash value for OBJECT appropriate for use with `equalp.' |
| 428 | 2130 */ |
| 2131 (object)) | |
| 2132 { | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2133 EMACS_INT hashed = internal_hash (object, 0, 1); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2134 return make_integer (hashed); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2135 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2136 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2137 static Lisp_Object |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2138 make_hash_table_test (Lisp_Object name, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2139 hash_table_equal_function_t equal_function, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2140 hash_table_hash_function_t hash_function, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2141 Lisp_Object lisp_equal_function, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2142 Lisp_Object lisp_hash_function) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2143 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2144 Lisp_Object result = ALLOC_NORMAL_LISP_OBJECT (hash_table_test); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2145 Hash_Table_Test *http = XHASH_TABLE_TEST (result); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2146 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2147 http->name = name; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2148 http->equal_function = equal_function; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2149 http->hash_function = hash_function; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2150 http->lisp_equal_function = lisp_equal_function; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2151 http->lisp_hash_function = lisp_hash_function; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2152 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2153 return result; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2154 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2155 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2156 Lisp_Object |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2157 define_hash_table_test (Lisp_Object name, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2158 hash_table_equal_function_t equal_function, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2159 hash_table_hash_function_t hash_function, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2160 Lisp_Object lisp_equal_function, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2161 Lisp_Object lisp_hash_function) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2162 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2163 Lisp_Object result = make_hash_table_test (name, equal_function, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2164 hash_function, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2165 lisp_equal_function, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2166 lisp_hash_function); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2167 XWEAK_LIST_LIST (Vhash_table_test_weak_list) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2168 = Fcons (Fcons (name, result), |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2169 XWEAK_LIST_LIST (Vhash_table_test_weak_list)); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2170 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2171 return result; |
| 428 | 2172 } |
| 2173 | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2174 DEFUN ("define-hash-table-test", Fdefine_hash_table_test, 3, 3, 0, /* |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2175 Define a new hash table test with name NAME, a symbol. |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2176 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2177 In a hash table created with NAME as its test, use EQUAL-FUNCTION to compare |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2178 keys, and HASH-FUNCTION for computing hash codes of keys. |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2179 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2180 EQUAL-FUNCTION must be a function taking two arguments and returning non-nil |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2181 if both arguments are the same. HASH-FUNCTION must be a function taking one |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2182 argument and returning an integer that is the hash code of the argument. |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2183 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2184 Computation should use the whole value range of the underlying machine long |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2185 type. In XEmacs this will necessitate bignums for values above |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2186 `most-positive-fixnum' but below (1+ (* most-positive-fixnum 2)) and |
|
5384
3889ef128488
Fix misspelled words, and some grammar, across the entire source tree.
Jerry James <james@xemacs.org>
parents:
5320
diff
changeset
|
2187 analogous values below `most-negative-fixnum'. Relatively poor hashing |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2188 performance is guaranteed in a build without bignums. |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2189 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2190 This function returns t if successful, and errors if NAME |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2191 cannot be defined as a hash table test. |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2192 */ |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2193 (name, equal_function, hash_function)) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2194 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2195 Lisp_Object min, max, lookup; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2196 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2197 CHECK_SYMBOL (name); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2198 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2199 lookup = Fassq (name, XWEAK_LIST_LIST (Vhash_table_test_weak_list)); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2200 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2201 if (!NILP (lookup)) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2202 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2203 invalid_change ("Cannot redefine existing hash table test", name); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2204 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2205 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2206 min = Ffunction_min_args (equal_function); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2207 max = Ffunction_max_args (equal_function); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2208 |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
2209 if (!((XFIXNUM (min) <= 2) && (NILP (max) || 2 <= XFIXNUM (max)))) |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2210 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2211 signal_wrong_number_of_arguments_error (equal_function, 2); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2212 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2213 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2214 min = Ffunction_min_args (hash_function); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2215 max = Ffunction_max_args (hash_function); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2216 |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
2217 if (!((XFIXNUM (min) <= 1) && (NILP (max) || 1 <= XFIXNUM (max)))) |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2218 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2219 signal_wrong_number_of_arguments_error (hash_function, 1); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2220 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2221 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2222 define_hash_table_test (name, lisp_object_general_equal, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2223 lisp_object_general_hash, equal_function, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2224 hash_function); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2225 return Qt; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2226 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2227 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2228 DEFUN ("valid-hash-table-test-p", Fvalid_hash_table_test_p, 1, 1, 0, /* |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2229 Return t if OBJECT names a hash table test, nil otherwise. |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2230 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2231 A valid hash table test is one of the symbols `eq', `eql', `equal', |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2232 `equalp', or some symbol passed as the NAME argument to |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2233 `define-hash-table-test'. As a special case, `nil' is regarded as |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2234 equivalent to `eql'. |
| 428 | 2235 */ |
| 2236 (object)) | |
| 2237 { | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2238 Lisp_Object lookup; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2239 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2240 if (NILP (object)) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2241 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2242 return Qt; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2243 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2244 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2245 lookup = Fassq (object, XWEAK_LIST_LIST (Vhash_table_test_weak_list)); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2246 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2247 if (!NILP (lookup)) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2248 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2249 return Qt; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2250 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2251 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2252 return Qnil; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2253 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2254 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2255 DEFUN ("hash-table-test-list", Fhash_table_test_list, 0, 0, 0, /* |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2256 Return a list of symbols naming valid hash table tests. |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2257 These can be passed as the value of the TEST keyword to `make-hash-table'. |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2258 This list does not include nil, regarded as equivalent to `eql' by |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2259 `make-hash-table'. |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2260 */ |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2261 ()) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2262 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2263 Lisp_Object result = Qnil; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2264 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2265 LIST_LOOP_2 (test, XWEAK_LIST_LIST (Vhash_table_test_weak_list)) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2266 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2267 if (!UNBOUNDP (XCAR (test))) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2268 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2269 result = Fcons (XCAR (test), result); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2270 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2271 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2272 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2273 return result; |
| 428 | 2274 } |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2275 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2276 DEFUN ("hash-table-test-equal-function", |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2277 Fhash_table_test_equal_function, 1, 1, 0, /* |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2278 Return the comparison function used for hash table test TEST. |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2279 See `define-hash-table-test' and `make-hash-table'. |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2280 */ |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2281 (test)) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2282 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2283 Lisp_Object lookup; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2284 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2285 if (NILP (test)) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2286 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2287 test = Qeql; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2288 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2289 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2290 lookup = Fassq (test, XWEAK_LIST_LIST (Vhash_table_test_weak_list)); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2291 if (NILP (lookup)) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2292 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2293 invalid_argument ("Not a defined hash table test", test); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2294 } |
| 428 | 2295 |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2296 return XHASH_TABLE_TEST (XCDR (lookup))->lisp_equal_function; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2297 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2298 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2299 DEFUN ("hash-table-test-hash-function", |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2300 Fhash_table_test_hash_function, 1, 1, 0, /* |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2301 Return the hash function used for hash table test TEST. |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2302 See `define-hash-table-test' and `make-hash-table'. |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2303 */ |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2304 (test)) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2305 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2306 Lisp_Object lookup; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2307 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2308 if (NILP (test)) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2309 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2310 test = Qeql; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2311 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2312 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2313 lookup = Fassq (test, XWEAK_LIST_LIST (Vhash_table_test_weak_list)); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2314 if (NILP (lookup)) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2315 { |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2316 invalid_argument ("Not a defined hash table test", test); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2317 } |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2318 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2319 return XHASH_TABLE_TEST (XCDR (lookup))->lisp_hash_function; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2320 } |
| 428 | 2321 |
| 2322 /************************************************************************/ | |
| 2323 /* initialization */ | |
| 2324 /************************************************************************/ | |
| 2325 | |
| 2326 void | |
|
5158
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
2327 hash_table_objects_create (void) |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
2328 { |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
2329 #ifdef MEMORY_USAGE_STATS |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
2330 OBJECT_HAS_METHOD (hash_table, memory_usage); |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
2331 #endif |
|
5560
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
2332 OBJECT_HAS_METHOD (hash_table, print_preprocess); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5520
diff
changeset
|
2333 OBJECT_HAS_METHOD (hash_table, nsubst_structures_descend); |
|
5158
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
2334 } |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
2335 |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
2336 void |
| 428 | 2337 syms_of_elhash (void) |
| 2338 { | |
| 2339 DEFSUBR (Fhash_table_p); | |
| 2340 DEFSUBR (Fmake_hash_table); | |
| 2341 DEFSUBR (Fcopy_hash_table); | |
| 2342 DEFSUBR (Fgethash); | |
| 2343 DEFSUBR (Fremhash); | |
| 2344 DEFSUBR (Fputhash); | |
| 2345 DEFSUBR (Fclrhash); | |
| 2346 DEFSUBR (Fmaphash); | |
| 2347 DEFSUBR (Fhash_table_count); | |
| 2348 DEFSUBR (Fhash_table_test); | |
| 2349 DEFSUBR (Fhash_table_size); | |
| 2350 DEFSUBR (Fhash_table_rehash_size); | |
| 2351 DEFSUBR (Fhash_table_rehash_threshold); | |
| 2352 DEFSUBR (Fhash_table_weakness); | |
| 2353 DEFSUBR (Fhash_table_type); /* obsolete */ | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2354 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2355 DEFSUBR (Feq_hash); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2356 DEFSUBR (Feql_hash); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2357 DEFSUBR (Fequal_hash); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2358 Ffset (intern ("sxhash"), intern ("equal-hash")); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2359 DEFSUBR (Fequalp_hash); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2360 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2361 DEFSUBR (Fdefine_hash_table_test); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2362 DEFSUBR (Fvalid_hash_table_test_p); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2363 DEFSUBR (Fhash_table_test_list); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2364 DEFSUBR (Fhash_table_test_equal_function); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2365 DEFSUBR (Fhash_table_test_hash_function); |
| 428 | 2366 |
| 563 | 2367 DEFSYMBOL_MULTIWORD_PREDICATE (Qhash_tablep); |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2368 |
| 563 | 2369 DEFSYMBOL (Qhash_table); |
| 2370 DEFSYMBOL (Qhashtable); | |
|
5084
6afe991b8135
Add a PARSE_KEYWORDS macro, use it in #'make-hash-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
2371 DEFSYMBOL (Qmake_hash_table); |
| 563 | 2372 DEFSYMBOL (Qweakness); |
| 2373 DEFSYMBOL (Qvalue); | |
| 2374 DEFSYMBOL (Qkey_or_value); | |
| 2375 DEFSYMBOL (Qkey_and_value); | |
| 2376 DEFSYMBOL (Qrehash_size); | |
| 2377 DEFSYMBOL (Qrehash_threshold); | |
| 428 | 2378 |
| 563 | 2379 DEFSYMBOL (Qweak); /* obsolete */ |
| 2380 DEFSYMBOL (Qkey_weak); /* obsolete */ | |
| 2381 DEFSYMBOL (Qkey_or_value_weak); /* obsolete */ | |
| 2382 DEFSYMBOL (Qvalue_weak); /* obsolete */ | |
| 2383 DEFSYMBOL (Qnon_weak); /* obsolete */ | |
| 428 | 2384 |
|
4820
e6dec75ded0e
Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4779
diff
changeset
|
2385 DEFKEYWORD (Q_data); |
| 563 | 2386 DEFKEYWORD (Q_size); |
| 2387 DEFKEYWORD (Q_rehash_size); | |
| 2388 DEFKEYWORD (Q_rehash_threshold); | |
| 2389 DEFKEYWORD (Q_weakness); | |
| 428 | 2390 } |
| 2391 | |
| 2392 void | |
|
5158
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
2393 vars_of_elhash (void) |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
2394 { |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2395 Lisp_Object weak_list_list = XWEAK_LIST_LIST (Vhash_table_test_weak_list); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2396 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2397 /* This var was staticpro'd and initialised in |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2398 init_elhash_once_early, but its Vall_weak_lists isn't sane, since |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2399 that was done before vars_of_data() was called. Create a sane |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2400 weak list object now, set its list appropriately, assert that our |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2401 data haven't been garbage collected. */ |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2402 assert (!NILP (Fassq (Qeq, weak_list_list))); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2403 assert (!NILP (Fassq (Qeql, weak_list_list))); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2404 assert (!NILP (Fassq (Qequal, weak_list_list))); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2405 assert (!NILP (Fassq (Qequalp, weak_list_list))); |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
2406 assert (4 == XFIXNUM (Flength (weak_list_list))); |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2407 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2408 Vhash_table_test_weak_list = make_weak_list (WEAK_LIST_KEY_ASSOC); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2409 XWEAK_LIST_LIST (Vhash_table_test_weak_list) = weak_list_list; |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2410 |
|
5158
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
2411 #ifdef MEMORY_USAGE_STATS |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
2412 OBJECT_HAS_PROPERTY |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
2413 (hash_table, memusage_stats_list, list1 (intern ("hash-entries"))); |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
2414 #endif /* MEMORY_USAGE_STATS */ |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
2415 } |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
2416 |
|
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
2417 void |
| 771 | 2418 init_elhash_once_early (void) |
| 428 | 2419 { |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
2420 INIT_LISP_OBJECT (hash_table); |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2421 INIT_LISP_OBJECT (hash_table_test); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2422 |
| 3092 | 2423 #ifdef NEW_GC |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
2424 INIT_LISP_OBJECT (hash_table_entry); |
| 3092 | 2425 #endif /* NEW_GC */ |
| 771 | 2426 |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2427 /* init_elhash_once_early() is called very early, we can't have these |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2428 DEFSYMBOLs in syms_of_elhash(), unfortunately. */ |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2429 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2430 DEFSYMBOL (Qeq); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2431 DEFSYMBOL (Qeql); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2432 DEFSYMBOL (Qequal); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2433 DEFSYMBOL (Qequalp); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2434 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2435 DEFSYMBOL (Qeq_hash); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2436 DEFSYMBOL (Qeql_hash); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2437 DEFSYMBOL (Qequal_hash); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2438 DEFSYMBOL (Qequalp_hash); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2439 |
| 428 | 2440 /* This must NOT be staticpro'd */ |
| 2441 Vall_weak_hash_tables = Qnil; | |
| 452 | 2442 dump_add_weak_object_chain (&Vall_weak_hash_tables); |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2443 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2444 staticpro (&Vhash_table_test_weak_list); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2445 Vhash_table_test_weak_list = make_weak_list (WEAK_LIST_KEY_ASSOC); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2446 |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2447 staticpro (&Vhash_table_test_eq); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2448 Vhash_table_test_eq = define_hash_table_test (Qeq, NULL, NULL, Qeq, Qeq_hash); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2449 staticpro (&Vhash_table_test_eql); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2450 Vhash_table_test_eql |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2451 = define_hash_table_test (Qeql, lisp_object_eql_equal, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2452 lisp_object_eql_hash, Qeql, Qeql_hash); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2453 (void) define_hash_table_test (Qequal, lisp_object_equal_equal, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2454 lisp_object_equal_hash, Qequal, Qequal_hash); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2455 (void) define_hash_table_test (Qequalp, lisp_object_equalp_equal, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2456 lisp_object_equalp_hash, Qequalp, Qequalp_hash); |
| 428 | 2457 } |