Mercurial > hg > xemacs-beta

comparison src/elhash.c @ 173:8eaf7971accc r20-3b13

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b13
author cvs
date Mon, 13 Aug 2007 09:49:09 +0200
parents 25f70ba0133c
children 3d6bfa290dbd
comparison
equal deleted inserted replaced
172:a38aed19690b 173:8eaf7971accc
65 the table->harray itself at the same time; it's hard to mark 65 the table->harray itself at the same time; it's hard to mark
66 that here without also marking its contents. */ 66 that here without also marking its contents. */
67 return Qnil; 67 return Qnil;
68 } 68 }
69 ((markobj) (table->zero_entry)); 69 ((markobj) (table->zero_entry));
70 return (table->harray); 70 return table->harray;
71 } 71 }
72 72
73 static void 73 static void
74 print_hashtable (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) 74 print_hashtable (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
75 { 75 {
84 table->type == HASHTABLE_VALUE_WEAK ? "value-weak " : 84 table->type == HASHTABLE_VALUE_WEAK ? "value-weak " :
85 table->type == HASHTABLE_KEY_CAR_WEAK ? "key-car-weak " : 85 table->type == HASHTABLE_KEY_CAR_WEAK ? "key-car-weak " :
86 table->type == HASHTABLE_VALUE_CAR_WEAK ? "value-car-weak " : 86 table->type == HASHTABLE_VALUE_CAR_WEAK ? "value-car-weak " :
87 ""), 87 ""),
88 table->fullness, 88 table->fullness,
89 (vector_length (XVECTOR (table->harray)) / LISP_OBJECTS_PER_HENTRY), 89 XVECTOR_LENGTH (table->harray) / LISP_OBJECTS_PER_HENTRY,
90 table->header.uid); 90 table->header.uid);
91 write_c_string (buf, printcharfun); 91 write_c_string (buf, printcharfun);
92 } 92 }
93 93
94 static void 94 static void
95 ht_copy_to_c (struct hashtable_struct *ht, 95 ht_copy_to_c (struct hashtable_struct *ht,
96 c_hashtable c_table) 96 c_hashtable c_table)
97 { 97 {
98 int len; 98 int len = XVECTOR_LENGTH (ht->harray);
99 99
100 c_table->harray = (void *) vector_data (XVECTOR (ht->harray)); 100 c_table->harray = (void *) XVECTOR_DATA (ht->harray);
101 c_table->zero_set = (!GC_UNBOUNDP (ht->zero_entry)); 101 c_table->zero_set = (!GC_UNBOUNDP (ht->zero_entry));
102 c_table->zero_entry = LISP_TO_VOID (ht->zero_entry); 102 c_table->zero_entry = LISP_TO_VOID (ht->zero_entry);
103 len = vector_length (XVECTOR (ht->harray));
104 if (len < 0) 103 if (len < 0)
105 { 104 {
106 /* #### if alloc.c mark_object() changes, this must change too. */ 105 /* #### if alloc.c mark_object() changes, this must change too. */
107 /* barf gag retch. When a vector is marked, its len is 106 /* barf gag retch. When a vector is marked, its len is
108 made less than 0. In the prune_weak_hashtables() stage, 107 made less than 0. In the prune_weak_hashtables() stage,
109 we are called on vectors that are like this, and we must 108 we are called on vectors that are like this, and we must
110 be able to deal. */ 109 be able to deal. */
111 assert (gc_in_progress); 110 assert (gc_in_progress);
112 len = -1 - len; 111 len = -1 - len;
113 } 112 }
114 c_table->size = len/LISP_OBJECTS_PER_HENTRY; 113 c_table->size = len/LISP_OBJECTS_PER_HENTRY;
115 c_table->fullness = ht->fullness; 114 c_table->fullness = ht->fullness;
116 c_table->hash_function = ht->hash_function; 115 c_table->hash_function = ht->hash_function;
117 c_table->test_function = ht->test_function; 116 c_table->test_function = ht->test_function;
118 XSETHASHTABLE (c_table->elisp_table, ht); 117 XSETHASHTABLE (c_table->elisp_table, ht);
119 } 118 }
120 119
124 { 123 {
125 struct Lisp_Vector dummy; 124 struct Lisp_Vector dummy;
126 /* C is truly hateful */ 125 /* C is truly hateful */
127 void *vec_addr 126 void *vec_addr
128 = ((char *) c_table->harray 127 = ((char *) c_table->harray
129 - ((char *) &(dummy.contents) - (char *) &dummy)); 128 - ((char *) &(dummy.contents[0]) - (char *) &dummy));
130 129
131 XSETVECTOR (ht->harray, vec_addr); 130 XSETVECTOR (ht->harray, vec_addr);
132 if (c_table->zero_set) 131 if (c_table->zero_set)
133 VOID_TO_LISP (ht->zero_entry, c_table->zero_entry); 132 VOID_TO_LISP (ht->zero_entry, c_table->zero_entry);
134 else 133 else
140 static struct hashtable_struct * 139 static struct hashtable_struct *
141 allocate_hashtable (void) 140 allocate_hashtable (void)
142 { 141 {
143 struct hashtable_struct *table 142 struct hashtable_struct *table
144 = alloc_lcrecord (sizeof (struct hashtable_struct), lrecord_hashtable); 143 = alloc_lcrecord (sizeof (struct hashtable_struct), lrecord_hashtable);
145 table->harray = Qnil; 144 table->harray = Qnil;
146 table->zero_entry = Qunbound; 145 table->zero_entry = Qunbound;
147 table->fullness = 0; 146 table->fullness = 0;
148 table->hash_function = 0; 147 table->hash_function = 0;
149 table->test_function = 0; 148 table->test_function = 0;
150 return (table); 149 return table;
151 } 150 }
152 151
153 char * 152 void *
154 elisp_hvector_malloc (unsigned int bytes, Lisp_Object table) 153 elisp_hvector_malloc (unsigned int bytes, Lisp_Object table)
155 { 154 {
156 Lisp_Object new_vector; 155 Lisp_Object new_vector;
157 struct hashtable_struct *ht; 156 struct hashtable_struct *ht;
158 157
159 ht = XHASHTABLE (table); 158 ht = XHASHTABLE (table);
160 assert (bytes > vector_length (XVECTOR (ht->harray)) * sizeof (Lisp_Object)); 159 assert (bytes > XVECTOR_LENGTH (ht->harray) * sizeof (Lisp_Object));
161 new_vector = make_vector ((bytes / sizeof (Lisp_Object)), Qzero); 160 new_vector = make_vector ((bytes / sizeof (Lisp_Object)), Qzero);
162 return ((char *) (vector_data (XVECTOR (new_vector)))); 161 return (void *) XVECTOR_DATA (new_vector);
163 } 162 }
164 163
165 void 164 void
166 elisp_hvector_free (void *ptr, Lisp_Object table) 165 elisp_hvector_free (void *ptr, Lisp_Object table)
167 { 166 {
168 struct hashtable_struct *ht = XHASHTABLE (table); 167 struct hashtable_struct *ht = XHASHTABLE (table);
169 #if defined (USE_ASSERTIONS) || defined (DEBUG_XEMACS) 168 #if defined (USE_ASSERTIONS) || defined (DEBUG_XEMACS)
170 Lisp_Object current_vector = ht->harray; 169 Lisp_Object current_vector = ht->harray;
171 #endif 170 #endif
172 171
173 assert (((void *) vector_data (XVECTOR (current_vector))) == ptr); 172 assert (((void *) XVECTOR_DATA (current_vector)) == ptr);
174 ht->harray = Qnil; /* Let GC do its job */ 173 ht->harray = Qnil; /* Let GC do its job */
175 return;
176 } 174 }
177 175
178 176
179 DEFUN ("hashtablep", Fhashtablep, 1, 1, 0, /* 177 DEFUN ("hashtablep", Fhashtablep, 1, 1, 0, /*
180 Return t if OBJ is a hashtable, else nil. 178 Return t if OBJ is a hashtable, else nil.
181 */ 179 */
182 (obj)) 180 (obj))
183 { 181 {
184 return ((HASHTABLEP (obj)) ? Qt : Qnil); 182 return HASHTABLEP (obj) ? Qt : Qnil;
185 } 183 }
186 184
187 185
188 186
189 187
289 Vall_weak_hashtables = result; 287 Vall_weak_hashtables = result;
290 } 288 }
291 else 289 else
292 table->next_weak = Qunbound; 290 table->next_weak = Qunbound;
293 291
294 return (result); 292 return result;
295 } 293 }
296 294
297 static enum hashtable_test_fun 295 static enum hashtable_test_fun
298 decode_hashtable_test_fun (Lisp_Object sym) 296 decode_hashtable_test_fun (Lisp_Object sym)
299 { 297 {
364 { 362 {
365 new_ht->next_weak = Vall_weak_hashtables; 363 new_ht->next_weak = Vall_weak_hashtables;
366 Vall_weak_hashtables = result; 364 Vall_weak_hashtables = result;
367 } 365 }
368 366
369 return (result); 367 return result;
370 } 368 }
371 369
372 370
373 DEFUN ("gethash", Fgethash, 2, 3, 0, /* 371 DEFUN ("gethash", Fgethash, 2, 3, 0, /*
374 Find hash value for KEY in TABLE. 372 Find hash value for KEY in TABLE.
375 If there is no corresponding value, return DEFAULT (defaults to nil). 373 If there is no corresponding value, return DEFAULT (defaults to nil).
376 */ 374 */
377 (key, table, defalt)) 375 (key, table, default_))
378 { 376 {
379 CONST void *vval; 377 CONST void *vval;
380 struct _C_hashtable htbl; 378 struct _C_hashtable htbl;
381 if (!gc_in_progress) 379 if (!gc_in_progress)
382 CHECK_HASHTABLE (table); 380 CHECK_HASHTABLE (table);
386 Lisp_Object val; 384 Lisp_Object val;
387 CVOID_TO_LISP (val, vval); 385 CVOID_TO_LISP (val, vval);
388 return val; 386 return val;
389 } 387 }
390 else 388 else
391 return defalt; 389 return default_;
392 } 390 }
393 391
394 392
395 DEFUN ("remhash", Fremhash, 2, 2, 0, /* 393 DEFUN ("remhash", Fremhash, 2, 2, 0, /*
396 Remove hash value for KEY in TABLE. 394 Remove hash value for KEY in TABLE.
428 GCPRO3 (key, val, table); 426 GCPRO3 (key, val, table);
429 puthash (vkey, LISP_TO_VOID (val), &htbl); 427 puthash (vkey, LISP_TO_VOID (val), &htbl);
430 ht_copy_from_c (&htbl, XHASHTABLE (table)); 428 ht_copy_from_c (&htbl, XHASHTABLE (table));
431 UNGCPRO; 429 UNGCPRO;
432 } 430 }
433 return (val); 431 return val;
434 } 432 }
435 433
436 DEFUN ("clrhash", Fclrhash, 1, 1, 0, /* 434 DEFUN ("clrhash", Fclrhash, 1, 1, 0, /*
437 Flush TABLE. 435 Flush TABLE.
438 */ 436 */
452 (table)) 450 (table))
453 { 451 {
454 struct _C_hashtable htbl; 452 struct _C_hashtable htbl;
455 CHECK_HASHTABLE (table); 453 CHECK_HASHTABLE (table);
456 ht_copy_to_c (XHASHTABLE (table), &htbl); 454 ht_copy_to_c (XHASHTABLE (table), &htbl);
457 return (make_int (htbl.fullness)); 455 return make_int (htbl.fullness);
458 } 456 }
459 457
460 458
461 static void 459 static void
462 verify_function (Lisp_Object function, CONST char *description) 460 verify_function (Lisp_Object function, CONST char *description)
757 that is going to stay ought to have been marked already 755 that is going to stay ought to have been marked already
758 by the finish_marking stage). */ 756 by the finish_marking stage). */
759 CVOID_TO_LISP (keytem, key); 757 CVOID_TO_LISP (keytem, key);
760 CVOID_TO_LISP (valuetem, contents); 758 CVOID_TO_LISP (valuetem, contents);
761 759
762 return (! ((*fmh->obj_marked_p) (keytem) && 760 return ! ((*fmh->obj_marked_p) (keytem) &&
763 (*fmh->obj_marked_p) (valuetem))); 761 (*fmh->obj_marked_p) (valuetem));
764 } 762 }
765 763
766 void 764 void
767 prune_weak_hashtables (int (*obj_marked_p) (Lisp_Object)) 765 prune_weak_hashtables (int (*obj_marked_p) (Lisp_Object))
768 { 766 {
854 else if (LRECORDP (obj)) 852 else if (LRECORDP (obj))
855 { 853 {
856 CONST struct lrecord_implementation 854 CONST struct lrecord_implementation
857 *imp = XRECORD_LHEADER (obj)->implementation; 855 *imp = XRECORD_LHEADER (obj)->implementation;
858 if (imp->hash) 856 if (imp->hash)
859 return ((imp->hash) (obj, depth)); 857 return (imp->hash) (obj, depth);
860 } 858 }
861 859
862 return LISP_HASH (obj); 860 return LISP_HASH (obj);
863 } 861 }
864 862