Mercurial > hg > xemacs-beta

comparison src/elhash.c @ 251:677f6a0ee643 r20-5b24

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-5b24
author cvs
date Mon, 13 Aug 2007 10:19:59 +0200
parents f220cc83d72e
children c5d627a313b1
comparison
equal deleted inserted replaced
250:f385a461c9aa 251:677f6a0ee643
49 static Lisp_Object Vall_weak_hashtables; 49 static Lisp_Object Vall_weak_hashtables;
50 50
51 static Lisp_Object mark_hashtable (Lisp_Object, void (*) (Lisp_Object)); 51 static Lisp_Object mark_hashtable (Lisp_Object, void (*) (Lisp_Object));
52 static void print_hashtable (Lisp_Object, Lisp_Object, int); 52 static void print_hashtable (Lisp_Object, Lisp_Object, int);
53 static int hashtable_equal (Lisp_Object t1, Lisp_Object t2, int depth); 53 static int hashtable_equal (Lisp_Object t1, Lisp_Object t2, int depth);
54 static unsigned long hashtable_hash (Lisp_Object obj, int depth);
55 DEFINE_LRECORD_IMPLEMENTATION ("hashtable", hashtable, 54 DEFINE_LRECORD_IMPLEMENTATION ("hashtable", hashtable,
56 mark_hashtable, print_hashtable, 0, 55 mark_hashtable, print_hashtable, 0,
57 hashtable_equal, hashtable_hash, 56 /* #### Implement hashtable_hash()! */
57 hashtable_equal, 0,
58 struct hashtable); 58 struct hashtable);
59 59
60 static Lisp_Object 60 static Lisp_Object
61 mark_hashtable (Lisp_Object obj, void (*markobj) (Lisp_Object)) 61 mark_hashtable (Lisp_Object obj, void (*markobj) (Lisp_Object))
62 { 62 {
91 int equal; 91 int equal;
92 Lisp_Object other_table; 92 Lisp_Object other_table;
93 }; 93 };
94 94
95 static int 95 static int
96 hashtable_equal_mapper (void *key, void *contents, void *arg) 96 hashtable_equal_mapper (CONST void *key, void *contents, void *arg)
97 { 97 {
98 struct hashtable_equal_closure *closure = 98 struct hashtable_equal_closure *closure =
99 (struct hashtable_equal_closure *)arg; 99 (struct hashtable_equal_closure *)arg;
100 Lisp_Object keytem, valuetem; 100 Lisp_Object keytem, valuetem;
101 Lisp_Object value_in_other; 101 Lisp_Object value_in_other;
121 struct hashtable *table1 = XHASHTABLE (t1); 121 struct hashtable *table1 = XHASHTABLE (t1);
122 struct hashtable *table2 = XHASHTABLE (t2); 122 struct hashtable *table2 = XHASHTABLE (t2);
123 123
124 /* The objects are `equal' if they are of the same type, so return 0 124 /* The objects are `equal' if they are of the same type, so return 0
125 if types or test functions are not the same. Obviously, the 125 if types or test functions are not the same. Obviously, the
126 number of elements must be equal, too. */ 126 number of elements must be equal, too. #### table->fullness is
127 broken, so we cannot use it. */
127 if ((table1->test_function != table2->test_function) 128 if ((table1->test_function != table2->test_function)
128 || (table1->type != table2->type) 129 || (table1->type != table2->type)
129 || (table1->fullness != table2->fullness)) 130 /*|| (table1->fullness != table2->fullness))*/
131 )
130 return 0; 132 return 0;
131 133
132 closure.depth = depth + 1; 134 closure.depth = depth + 1;
133 closure.equal = 1; 135 closure.equal = 1;
134 closure.other_table = t2; 136 closure.other_table = t2;
135 elisp_maphash (hashtable_equal_mapper, t1, &closure); 137 elisp_maphash (hashtable_equal_mapper, t1, &closure);
136 return closure.equal; 138 return closure.equal;
137 }
138
139 /* Hashtable hash function. This hashes 5 key-value pairs. For EQ
140 hashtables, keys are used as the hash value themselves, whereas
141 values are hashed with internal_hash(). For EQUAL hashtables, both
142 keys and values are hashed properly. EQL tables are handled as
143 necessary. All of this should make the hash function compatible
144 with hashtable_equal(). The elements hashed are the first five
145 mapped over by maphash(). */
146
147 struct hashtable_hash_closure
148 {
149 struct hashtable *table;
150 int depth;
151 unsigned long hash;
152 int count;
153 };
154
155 /* Needed for tests. */
156 static int lisp_object_eql_equal (CONST void *x1, CONST void *x2);
157 static int lisp_object_equal_equal (CONST void *x1, CONST void *x2);
158
159 static int
160 hashtable_hash_mapper (void *key, void *contents, void *arg)
161 {
162 struct hashtable_hash_closure *closure =
163 (struct hashtable_hash_closure *)arg;
164 Lisp_Object valuetem, keytem;
165 unsigned long keyhash;
166
167 CVOID_TO_LISP (keytem, key);
168 CVOID_TO_LISP (valuetem, contents);
169
170 if (!closure->table->test_function)
171 /* For eq, use key itself as hash. */
172 keyhash = LISP_HASH (keytem);
173 else if (closure->table->test_function == lisp_object_eql_equal)
174 /* The same as eq, unless the key is float. */
175 keyhash = (FLOATP (keytem)
176 ? internal_hash (keytem, closure->depth) : LISP_HASH (keytem));
177 else
178 /* equal: hash the key properly. */
179 keyhash = internal_hash (keytem, closure->depth);
180
181 closure->hash = HASH3 (closure->hash, keyhash,
182 internal_hash (valuetem, closure->depth));
183 return (++closure->count > 5) ? 1 : 0;
184 }
185
186 static unsigned long
187 hashtable_hash (Lisp_Object obj, int depth)
188 {
189 struct hashtable_hash_closure closure;
190
191 closure.table = XHASHTABLE (obj);
192 closure.depth = depth + 1;
193 closure.hash = 0;
194 closure.count = 0;
195
196 elisp_maphash (hashtable_hash_mapper, obj, &closure);
197 return closure.hash;
198 } 139 }
199 140
200 /* Printing hashtables. 141 /* Printing hashtables.
201 142
202 This is non-trivial, because we use a readable structure-style 143 This is non-trivial, because we use a readable structure-style
225 the beginning. */ 166 the beginning. */
226 Lisp_Object printcharfun; 167 Lisp_Object printcharfun;
227 }; 168 };
228 169
229 static int 170 static int
230 print_hashtable_data_mapper (void *key, void *contents, void *arg) 171 print_hashtable_data_mapper (CONST void *key, void *contents, void *arg)
231 { 172 {
232 Lisp_Object keytem, valuetem; 173 Lisp_Object keytem, valuetem;
233 struct print_hashtable_data_closure *closure = 174 struct print_hashtable_data_closure *closure =
234 (struct print_hashtable_data_closure *)arg; 175 (struct print_hashtable_data_closure *)arg;
235 176
261 write_c_string (" data (", printcharfun); 202 write_c_string (" data (", printcharfun);
262 elisp_maphash (print_hashtable_data_mapper, hashtable, &closure); 203 elisp_maphash (print_hashtable_data_mapper, hashtable, &closure);
263 write_c_string ((!print_readably && closure.count > 4) ? " ...)" : ")", 204 write_c_string ((!print_readably && closure.count > 4) ? " ...)" : ")",
264 printcharfun); 205 printcharfun);
265 } 206 }
207
208 /* Needed for tests. */
209 static int lisp_object_eql_equal (CONST void *x1, CONST void *x2);
210 static int lisp_object_equal_equal (CONST void *x1, CONST void *x2);
266 211
267 static void 212 static void
268 print_hashtable (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) 213 print_hashtable (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
269 { 214 {
270 struct hashtable *table = XHASHTABLE (obj); 215 struct hashtable *table = XHASHTABLE (obj);