X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Felhash.c;h=b034860f0bac2df5b2e84747730674ffd9a4ba76;hb=c1b778278af87064688c8ef8477f58bcbdbfae16;hp=36b51de0c33bdfa85067934b9f8fc7d57c20f8a5;hpb=d8bd7eee3147c839d3c74d1823c139cd54867a75;p=chise%2Fxemacs-chise.git- diff --git a/src/elhash.c b/src/elhash.c index 36b51de..b034860 100644 --- a/src/elhash.c +++ b/src/elhash.c @@ -71,9 +71,9 @@ struct Lisp_Hash_Table #define HASH_TABLE_MIN_SIZE 10 #define HASH_CODE(key, ht) \ -((((ht)->hash_function ? (ht)->hash_function (key) : LISP_HASH (key)) \ - * (ht)->golden_ratio) \ - % (ht)->size) + ((((ht)->hash_function ? (ht)->hash_function (key) : LISP_HASH (key)) \ + * (ht)->golden_ratio) \ + % (ht)->size) #define KEYS_EQUAL_P(key1, key2, testfun) \ (EQ (key1, key2) || ((testfun) && (testfun) (key1, key2))) @@ -434,36 +434,54 @@ compute_hash_table_derived_values (Lisp_Hash_Table *ht) } Lisp_Object -make_general_lisp_hash_table (enum hash_table_test test, - size_t size, - double rehash_size, - double rehash_threshold, - enum hash_table_weakness weakness) +make_standard_lisp_hash_table (enum hash_table_test test, + size_t size, + double rehash_size, + double rehash_threshold, + enum hash_table_weakness weakness) { - Lisp_Object hash_table; - Lisp_Hash_Table *ht = alloc_lcrecord_type (Lisp_Hash_Table, &lrecord_hash_table); + hash_table_hash_function_t hash_function = 0; + hash_table_test_function_t test_function = 0; switch (test) { case HASH_TABLE_EQ: - ht->test_function = 0; - ht->hash_function = 0; + test_function = 0; + hash_function = 0; break; case HASH_TABLE_EQL: - ht->test_function = lisp_object_eql_equal; - ht->hash_function = lisp_object_eql_hash; + test_function = lisp_object_eql_equal; + hash_function = lisp_object_eql_hash; break; case HASH_TABLE_EQUAL: - ht->test_function = lisp_object_equal_equal; - ht->hash_function = lisp_object_equal_hash; + test_function = lisp_object_equal_equal; + hash_function = lisp_object_equal_hash; break; default: abort (); } + return make_general_lisp_hash_table (hash_function, test_function, + size, rehash_size, rehash_threshold, + weakness); +} + +Lisp_Object +make_general_lisp_hash_table (hash_table_hash_function_t hash_function, + hash_table_test_function_t test_function, + size_t size, + double rehash_size, + double rehash_threshold, + enum hash_table_weakness weakness) +{ + Lisp_Object hash_table; + Lisp_Hash_Table *ht = alloc_lcrecord_type (Lisp_Hash_Table, &lrecord_hash_table); + + ht->test_function = test_function; + ht->hash_function = hash_function; ht->weakness = weakness; ht->rehash_size = @@ -482,13 +500,7 @@ make_general_lisp_hash_table (enum hash_table_test test, compute_hash_table_derived_values (ht); /* We leave room for one never-occupied sentinel hentry at the end. */ - ht->hentries = xnew_array (hentry, ht->size + 1); - - { - hentry *e, *sentinel; - for (e = ht->hentries, sentinel = e + ht->size; e <= sentinel; e++) - CLEAR_HENTRY (e); - } + ht->hentries = xnew_array_and_zero (hentry, ht->size + 1); XSETHASH_TABLE (hash_table, ht); @@ -505,7 +517,7 @@ make_lisp_hash_table (size_t size, enum hash_table_weakness weakness, enum hash_table_test test) { - return make_general_lisp_hash_table (test, size, -1.0, -1.0, weakness); + return make_standard_lisp_hash_table (test, size, -1.0, -1.0, weakness); } /* Pretty reading of hash tables. @@ -722,7 +734,7 @@ hash_table_instantiate (Lisp_Object plist) } /* Create the hash table. */ - hash_table = make_general_lisp_hash_table + hash_table = make_standard_lisp_hash_table (decode_hash_table_test (test), decode_hash_table_size (size), decode_hash_table_rehash_size (rehash_size), @@ -872,7 +884,7 @@ if (!NILP (var)) hash_table_##var##_validate (Q##var, var, ERROR_ME); VALIDATE_VAR (rehash_threshold); VALIDATE_VAR (weakness); - return make_general_lisp_hash_table + return make_standard_lisp_hash_table (decode_hash_table_test (test), decode_hash_table_size (size), decode_hash_table_rehash_size (rehash_size), @@ -1189,6 +1201,19 @@ may remhash or puthash the entry currently being processed by FUNCTION. return Qnil; } +/* #### If the Lisp function being called does a puthash and this + #### causes the hash table to be resized, the results will be quite + #### random and we will likely crash. To fix this, either set a + #### flag in the hash table while we're mapping and signal an error + #### when new entries are added, or fix things to make this + #### operation work properly, like this: Store two hash tables in + #### each hash table object -- the second one is written to when + #### you do a puthash inside of a mapping operation, and the + #### various operations need to check both hash tables for entries. + #### As soon as the last maphash over a particular hash table + #### object terminates, the entries in the second table are added + #### to the first (using an unwind-protect). --ben */ + /* Map *C* function FUNCTION over the elements of a lisp hash table. */ void elisp_maphash (maphash_function_t function, @@ -1305,6 +1330,24 @@ finish_marking_weak_hash_tables (void) } break; + /* We seem to be sprouting new weakness types at an alarming + rate. At least this is not externally visible - and in + fact all of these KEY_CAR_* types are only used by the + glyph code. */ + case HASH_TABLE_KEY_CAR_VALUE_WEAK: + for (; e < sentinel; e++) + if (!HENTRY_CLEAR_P (e)) + { + if (!CONSP (e->key) || marked_p (XCAR (e->key))) + { + MARK_OBJ (e->key); + MARK_OBJ (e->value); + } + else if (marked_p (e->value)) + MARK_OBJ (e->key); + } + break; + case HASH_TABLE_VALUE_CAR_WEAK: for (; e < sentinel; e++) if (!HENTRY_CLEAR_P (e)) @@ -1432,7 +1475,7 @@ internal_hash (Lisp_Object obj, int depth) DEFUN ("sxhash", Fsxhash, 1, 1, 0, /* Return a hash value for OBJECT. -(equal obj1 obj2) implies (= (sxhash obj1) (sxhash obj2)). +\(equal obj1 obj2) implies (= (sxhash obj1) (sxhash obj2)). */ (object)) { @@ -1511,5 +1554,5 @@ vars_of_elhash (void) { /* This must NOT be staticpro'd */ Vall_weak_hash_tables = Qnil; - pdump_wire_list (&Vall_weak_hash_tables); + dump_add_weak_object_chain (&Vall_weak_hash_tables); }