diff --git a/libguile/hashtab.c b/libguile/hashtab.c index f97aa0e4c..e11c54de9 100644 --- a/libguile/hashtab.c +++ b/libguile/hashtab.c @@ -464,7 +464,67 @@ scm_doubly_weak_hash_table_p (SCM x) -/* A hash table is a cell containing a vector of association lists. +static inline SCM +hashtable_buckets (struct scm_t_hashtable *ht) +{ + return ht->buckets; +} + +static inline void +hashtable_set_buckets (struct scm_t_hashtable *ht, SCM v) +{ + ht->buckets = v; +} + +static inline size_t +hashtable_n_items (struct scm_t_hashtable *ht) +{ + return ht->n_items; +} + +static inline void +hashtable_increment (struct scm_t_hashtable *ht) +{ + ht->n_items++; +} + +static inline void +hashtable_decrement (struct scm_t_hashtable *ht) +{ + ht->n_items--; +} + +static inline size_t +hashtable_upper (struct scm_t_hashtable *ht) +{ + return ht->upper; +} + +static inline size_t +hashtable_lower (struct scm_t_hashtable *ht) +{ + return ht->lower; +} + +static inline size_t +hashtable_bucket_count (struct scm_t_hashtable *ht) +{ + return SCM_SIMPLE_VECTOR_LENGTH (hashtable_buckets (ht)); +} + +static inline SCM +hashtable_bucket (struct scm_t_hashtable *ht, size_t idx) +{ + return SCM_SIMPLE_VECTOR_REF (hashtable_buckets (ht), idx); +} + +static inline void +hashtable_set_bucket (struct scm_t_hashtable *ht, size_t idx, SCM bucket) +{ + SCM_SIMPLE_VECTOR_SET (hashtable_buckets (ht), idx, bucket); +} + +/* A hash table contains a vector of association lists. * * Growing or shrinking, with following rehashing, is triggered when * the load factor @@ -496,82 +556,72 @@ static unsigned long hashtable_size[] = { static SCM make_hash_table (unsigned long k, const char *func_name) { - SCM vector; scm_t_hashtable *t; int i = 0, n = k ? k : 31; while (i + 1 < HASHTABLE_SIZE_N && n > hashtable_size[i]) ++i; n = hashtable_size[i]; - vector = scm_c_make_vector (n, SCM_EOL); - - t = scm_allocate_pointerless (SCM_I_CURRENT_THREAD, sizeof (*t)); + t = scm_allocate_tagged (SCM_I_CURRENT_THREAD, sizeof (*t)); + t->tag = scm_tc7_hashtable; + t->buckets = scm_c_make_vector (n, SCM_EOL); t->min_size_index = t->size_index = i; t->n_items = 0; t->lower = 0; t->upper = 9 * n / 10; - /* FIXME: we just need two words of storage, not three */ - return scm_double_cell (scm_tc7_hashtable, SCM_UNPACK (vector), - (scm_t_bits)t, 0); + return scm_from_hashtable (t); } -void -scm_i_rehash (SCM table, - scm_t_hash_fn hash_fn, - void *closure, - const char* func_name) +static void +rehash (struct scm_t_hashtable *table, scm_t_hash_fn hash_fn, + void *closure, const char* func_name) { - SCM buckets, new_buckets; int i; - unsigned long old_size; - unsigned long new_size; - if (SCM_HASHTABLE_N_ITEMS (table) < SCM_HASHTABLE_LOWER (table)) + if (hashtable_n_items (table) < hashtable_lower (table)) { /* rehashing is not triggered when i <= min_size */ - i = SCM_HASHTABLE (table)->size_index; + i = table->size_index; do --i; - while (i > SCM_HASHTABLE (table)->min_size_index - && SCM_HASHTABLE_N_ITEMS (table) < hashtable_size[i] / 4); + while (i > table->min_size_index + && hashtable_n_items (table) < hashtable_size[i] / 4); } else { - i = SCM_HASHTABLE (table)->size_index + 1; + i = table->size_index + 1; if (i >= HASHTABLE_SIZE_N) /* don't rehash */ return; } - SCM_HASHTABLE (table)->size_index = i; + table->size_index = i; - new_size = hashtable_size[i]; - if (i <= SCM_HASHTABLE (table)->min_size_index) - SCM_HASHTABLE (table)->lower = 0; + size_t new_size = hashtable_size[i]; + if (i <= table->min_size_index) + table->lower = 0; else - SCM_HASHTABLE (table)->lower = new_size / 4; - SCM_HASHTABLE (table)->upper = 9 * new_size / 10; - buckets = SCM_HASHTABLE_VECTOR (table); + table->lower = new_size / 4; + table->upper = 9 * new_size / 10; - new_buckets = scm_c_make_vector (new_size, SCM_EOL); + SCM buckets = hashtable_buckets (table); + SCM new_buckets = scm_c_make_vector (new_size, SCM_EOL); - SCM_SET_HASHTABLE_VECTOR (table, new_buckets); - SCM_SET_HASHTABLE_N_ITEMS (table, 0); + table->buckets = new_buckets; + table->n_items = 0; - old_size = SCM_SIMPLE_VECTOR_LENGTH (buckets); + size_t old_size = SCM_SIMPLE_VECTOR_LENGTH (buckets); for (i = 0; i < old_size; ++i) { - SCM ls, cell, handle; - - ls = SCM_SIMPLE_VECTOR_REF (buckets, i); + SCM ls = SCM_SIMPLE_VECTOR_REF (buckets, i); SCM_SIMPLE_VECTOR_SET (buckets, i, SCM_EOL); while (scm_is_pair (ls)) { unsigned long h; - cell = ls; - handle = SCM_CAR (cell); + SCM cell = ls; + SCM handle = SCM_CAR (cell); ls = SCM_CDR (ls); h = hash_fn (SCM_CAR (handle), new_size, closure); @@ -579,7 +629,7 @@ scm_i_rehash (SCM table, scm_out_of_range (func_name, scm_from_ulong (h)); SCM_SETCDR (cell, SCM_SIMPLE_VECTOR_REF (new_buckets, h)); SCM_SIMPLE_VECTOR_SET (new_buckets, h, cell); - SCM_HASHTABLE_INCREMENT (table); + hashtable_increment (table); } } } @@ -588,13 +638,14 @@ scm_i_rehash (SCM table, void scm_i_hashtable_print (SCM exp, SCM port, scm_print_state *pstate) { + struct scm_t_hashtable *ht = scm_to_hashtable (exp); + scm_puts ("#", port); } @@ -643,7 +694,8 @@ scm_hash_fn_get_handle (SCM table, SCM obj, SCM buckets, h; SCM_VALIDATE_HASHTABLE (SCM_ARG1, table); - buckets = SCM_HASHTABLE_VECTOR (table); + struct scm_t_hashtable *ht = scm_to_hashtable (table); + buckets = hashtable_buckets (ht); if (SCM_SIMPLE_VECTOR_LENGTH (buckets) == 0) return SCM_BOOL_F; @@ -668,7 +720,8 @@ scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, SCM buckets, it; SCM_VALIDATE_HASHTABLE (SCM_ARG1, table); - buckets = SCM_HASHTABLE_VECTOR (table); + struct scm_t_hashtable *ht = scm_to_hashtable (table); + buckets = hashtable_buckets (ht); if (SCM_SIMPLE_VECTOR_LENGTH (buckets) == 0) SCM_MISC_ERROR ("void hashtable", SCM_EOL); @@ -690,21 +743,21 @@ scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, handle = scm_cons (obj, init); new_bucket = scm_cons (handle, SCM_EOL); - if (!scm_is_eq (SCM_HASHTABLE_VECTOR (table), buckets)) + if (!scm_is_eq (hashtable_buckets (ht), buckets)) { - buckets = SCM_HASHTABLE_VECTOR (table); + buckets = hashtable_buckets (ht); k = hash_fn (obj, SCM_SIMPLE_VECTOR_LENGTH (buckets), closure); if (k >= SCM_SIMPLE_VECTOR_LENGTH (buckets)) scm_out_of_range ("hash_fn_create_handle_x", scm_from_ulong (k)); } SCM_SETCDR (new_bucket, SCM_SIMPLE_VECTOR_REF (buckets, k)); SCM_SIMPLE_VECTOR_SET (buckets, k, new_bucket); - SCM_HASHTABLE_INCREMENT (table); + hashtable_increment (ht); /* Maybe rehash the table. */ - if (SCM_HASHTABLE_N_ITEMS (table) < SCM_HASHTABLE_LOWER (table) - || SCM_HASHTABLE_N_ITEMS (table) > SCM_HASHTABLE_UPPER (table)) - scm_i_rehash (table, hash_fn, closure, FUNC_NAME); + if (hashtable_n_items (ht) < hashtable_lower (ht) + || hashtable_n_items (ht) > hashtable_upper (ht)) + rehash (ht, hash_fn, closure, FUNC_NAME); return SCM_CAR (new_bucket); } } @@ -752,7 +805,8 @@ scm_hash_fn_remove_x (SCM table, SCM obj, SCM_VALIDATE_HASHTABLE (SCM_ARG1, table); - buckets = SCM_HASHTABLE_VECTOR (table); + struct scm_t_hashtable *ht = scm_to_hashtable (table); + buckets = hashtable_buckets (ht); if (SCM_SIMPLE_VECTOR_LENGTH (buckets) == 0) return SCM_EOL; @@ -767,9 +821,9 @@ scm_hash_fn_remove_x (SCM table, SCM obj, { SCM_SIMPLE_VECTOR_SET (buckets, k, scm_delq_x (h, SCM_SIMPLE_VECTOR_REF (buckets, k))); - SCM_HASHTABLE_DECREMENT (table); - if (SCM_HASHTABLE_N_ITEMS (table) < SCM_HASHTABLE_LOWER (table)) - scm_i_rehash (table, hash_fn, closure, FUNC_NAME); + hashtable_decrement (ht); + if (hashtable_n_items (ht) < hashtable_lower (ht)) + rehash (ht, hash_fn, closure, FUNC_NAME); } return h; } @@ -793,9 +847,10 @@ SCM_DEFINE (scm_hash_clear_x, "hash-clear!", 1, 0, 0, #endif SCM_VALIDATE_HASHTABLE (SCM_ARG1, table); + struct scm_t_hashtable *ht = scm_to_hashtable (table); - scm_vector_fill_x (SCM_HASHTABLE_VECTOR (table), SCM_EOL); - SCM_SET_HASHTABLE_N_ITEMS (table, 0); + scm_vector_fill_x (hashtable_buckets (ht), SCM_EOL); + ht->n_items = 0; return SCM_UNSPECIFIED; } @@ -964,7 +1019,7 @@ SCM_DEFINE (scm_hashv_ref, "hashv-ref", 2, 1, 0, dflt = SCM_BOOL_F; #if (SCM_ENABLE_DEPRECATED == 1) - if (!SCM_HASHTABLE_P (table)) + if (!scm_is_hashtable (table)) { if (is_weak_key_hash_table (table)) return weak_key_hash_table_ref (table, key, dflt); @@ -991,7 +1046,7 @@ SCM_DEFINE (scm_hashv_set_x, "hashv-set!", 3, 0, 0, #define FUNC_NAME s_scm_hashv_set_x { #if (SCM_ENABLE_DEPRECATED == 1) - if (!SCM_HASHTABLE_P (table)) + if (!scm_is_hashtable (table)) { if (is_weak_key_hash_table (table)) return weak_key_hash_table_set_x (table, key, val); @@ -1017,7 +1072,7 @@ SCM_DEFINE (scm_hashv_remove_x, "hashv-remove!", 2, 0, 0, #define FUNC_NAME s_scm_hashv_remove_x { #if (SCM_ENABLE_DEPRECATED == 1) - if (!SCM_HASHTABLE_P (table)) + if (!scm_is_hashtable (table)) { if (is_weak_key_hash_table (table)) return weak_key_hash_table_remove_x (table, key); @@ -1080,7 +1135,7 @@ SCM_DEFINE (scm_hash_ref, "hash-ref", 2, 1, 0, dflt = SCM_BOOL_F; #if (SCM_ENABLE_DEPRECATED == 1) - if (!SCM_HASHTABLE_P (table)) + if (!scm_is_hashtable (table)) { if (is_weak_key_hash_table (table)) return weak_key_hash_table_ref (table, key, dflt); @@ -1108,7 +1163,7 @@ SCM_DEFINE (scm_hash_set_x, "hash-set!", 3, 0, 0, #define FUNC_NAME s_scm_hash_set_x { #if (SCM_ENABLE_DEPRECATED == 1) - if (!SCM_HASHTABLE_P (table)) + if (!scm_is_hashtable (table)) { if (is_weak_key_hash_table (table)) return weak_key_hash_table_set_x (table, key, val); @@ -1135,7 +1190,7 @@ SCM_DEFINE (scm_hash_remove_x, "hash-remove!", 2, 0, 0, #define FUNC_NAME s_scm_hash_remove_x { #if (SCM_ENABLE_DEPRECATED == 1) - if (!SCM_HASHTABLE_P (table)) + if (!scm_is_hashtable (table)) { if (is_weak_key_hash_table (table)) return weak_key_hash_table_remove_x (table, key); @@ -1243,7 +1298,7 @@ SCM_DEFINE (scm_hashx_ref, "hashx-ref", 4, 1, 0, closure.key = key; #if (SCM_ENABLE_DEPRECATED == 1) - if (!SCM_HASHTABLE_P (table)) + if (!scm_is_hashtable (table)) { if (is_weak_key_hash_table (table)) return weak_key_hash_table_ref (table, key, dflt); @@ -1281,7 +1336,7 @@ SCM_DEFINE (scm_hashx_set_x, "hashx-set!", 5, 0, 0, closure.key = key; #if (SCM_ENABLE_DEPRECATED == 1) - if (!SCM_HASHTABLE_P (table)) + if (!scm_is_hashtable (table)) { if (is_weak_key_hash_table (table)) return weak_key_hash_table_set_x (table, key, val); @@ -1316,7 +1371,7 @@ SCM_DEFINE (scm_hashx_remove_x, "hashx-remove!", 4, 0, 0, closure.key = obj; #if (SCM_ENABLE_DEPRECATED == 1) - if (!SCM_HASHTABLE_P (table)) + if (!scm_is_hashtable (table)) { if (is_weak_key_hash_table (table)) return weak_key_hash_table_remove_x (table, obj); @@ -1349,7 +1404,7 @@ SCM_DEFINE (scm_hash_fold, "hash-fold", 3, 0, 0, SCM_VALIDATE_PROC (1, proc); #if (SCM_ENABLE_DEPRECATED == 1) - if (!SCM_HASHTABLE_P (table)) + if (!scm_is_hashtable (table)) { if (is_weak_key_hash_table (table)) return weak_key_hash_table_fold (proc, init, table); @@ -1383,7 +1438,7 @@ SCM_DEFINE (scm_hash_for_each, "hash-for-each", 2, 0, 0, SCM_VALIDATE_PROC (1, proc); #if (SCM_ENABLE_DEPRECATED == 1) - if (!SCM_HASHTABLE_P (table)) + if (!scm_is_hashtable (table)) { if (is_weak_key_hash_table (table)) return weak_key_hash_table_for_each (proc, table); @@ -1493,7 +1548,8 @@ scm_internal_hash_fold (scm_t_hash_fold_fn fn, void *closure, SCM buckets, result = init; SCM_VALIDATE_HASHTABLE (0, table); - buckets = SCM_HASHTABLE_VECTOR (table); + struct scm_t_hashtable *ht = scm_to_hashtable (table); + buckets = hashtable_buckets (ht); n = SCM_SIMPLE_VECTOR_LENGTH (buckets); for (i = 0; i < n; ++i) @@ -1527,7 +1583,8 @@ scm_internal_hash_for_each_handle (scm_t_hash_handle_fn fn, void *closure, SCM buckets; SCM_VALIDATE_HASHTABLE (0, table); - buckets = SCM_HASHTABLE_VECTOR (table); + struct scm_t_hashtable *ht = scm_to_hashtable (table); + buckets = hashtable_buckets (ht); n = SCM_SIMPLE_VECTOR_LENGTH (buckets); for (i = 0; i < n; ++i) diff --git a/libguile/hashtab.h b/libguile/hashtab.h index 8c9e45e25..abb3d49a3 100644 --- a/libguile/hashtab.h +++ b/libguile/hashtab.h @@ -26,26 +26,6 @@ -#define SCM_HASHTABLE_P(x) (SCM_HAS_TYP7 (x, scm_tc7_hashtable)) -#define SCM_VALIDATE_HASHTABLE(pos, arg) \ - SCM_MAKE_VALIDATE_MSG (pos, arg, HASHTABLE_P, "hash-table") -#define SCM_HASHTABLE_VECTOR(h) SCM_CELL_OBJECT_1 (h) -#define SCM_SET_HASHTABLE_VECTOR(x, v) SCM_SET_CELL_OBJECT_1 ((x), (v)) -#define SCM_HASHTABLE(x) ((scm_t_hashtable *) SCM_CELL_WORD_2 (x)) -#define SCM_HASHTABLE_N_ITEMS(x) (SCM_HASHTABLE (x)->n_items) -#define SCM_SET_HASHTABLE_N_ITEMS(x, n) (SCM_HASHTABLE (x)->n_items = n) -#define SCM_HASHTABLE_INCREMENT(x) (SCM_HASHTABLE_N_ITEMS(x)++) -#define SCM_HASHTABLE_DECREMENT(x) (SCM_HASHTABLE_N_ITEMS(x)--) -#define SCM_HASHTABLE_UPPER(x) (SCM_HASHTABLE (x)->upper) -#define SCM_HASHTABLE_LOWER(x) (SCM_HASHTABLE (x)->lower) - -#define SCM_HASHTABLE_N_BUCKETS(h) \ - SCM_SIMPLE_VECTOR_LENGTH (SCM_HASHTABLE_VECTOR (h)) -#define SCM_HASHTABLE_BUCKET(h, i) \ - SCM_SIMPLE_VECTOR_REF (SCM_HASHTABLE_VECTOR (h), i) -#define SCM_SET_HASHTABLE_BUCKET(h, i, x) \ - SCM_SIMPLE_VECTOR_SET (SCM_HASHTABLE_VECTOR (h), i, x) - /* Function that computes a hash of OBJ modulo MAX. */ typedef unsigned long (*scm_t_hash_fn) (SCM obj, unsigned long max, void *closure); @@ -63,6 +43,8 @@ typedef SCM (*scm_t_hash_fold_fn) (void *closure, SCM key, SCM value, typedef SCM (*scm_t_hash_handle_fn) (void *closure, SCM handle); typedef struct scm_t_hashtable { + scm_t_bits tag; + SCM buckets; unsigned long n_items; /* number of items in table */ unsigned long lower; /* when to shrink */ unsigned long upper; /* when to grow */ @@ -71,6 +53,30 @@ typedef struct scm_t_hashtable { scm_t_hash_fn hash_fn; /* for rehashing after a GC. */ } scm_t_hashtable; +static inline int +scm_is_hashtable (SCM x) +{ + return SCM_HAS_TYP7 (x, scm_tc7_hashtable); +} + +static inline struct scm_t_hashtable* +scm_to_hashtable (SCM x) +{ + if (!scm_is_hashtable (x)) + abort (); + return (struct scm_t_hashtable *) SCM_UNPACK_POINTER (x); +} + +static inline SCM +scm_from_hashtable (struct scm_t_hashtable *x) +{ + return SCM_PACK_POINTER (x); +} + +#define SCM_HASHTABLE_P(x) scm_is_hashtable (x) +#define SCM_VALIDATE_HASHTABLE(pos, arg) \ + SCM_MAKE_VALIDATE_MSG (pos, arg, HASHTABLE_P, "hash-table") + SCM_API SCM scm_vector_to_hash_table (SCM vector); @@ -79,10 +85,6 @@ SCM_API SCM scm_make_hash_table (SCM n); SCM_API SCM scm_hash_table_p (SCM h); -SCM_INTERNAL void scm_i_rehash (SCM table, scm_t_hash_fn hash_fn, - void *closure, const char *func_name); - - SCM_API SCM scm_hash_fn_get_handle (SCM table, SCM obj, scm_t_hash_fn hash_fn, scm_t_assoc_fn assoc_fn, diff --git a/libguile/modules.c b/libguile/modules.c index 8872e1e20..f9c827b67 100644 --- a/libguile/modules.c +++ b/libguile/modules.c @@ -845,18 +845,18 @@ SCM_DEFINE (scm_module_reverse_lookup, "module-reverse-lookup", 2, 0, 0, /* XXX - We do not use scm_hash_fold here to avoid searching the whole obarray. We should have a scm_hash_find procedure. */ - n = SCM_HASHTABLE_N_BUCKETS (obarray); + struct scm_t_hashtable *ht = scm_to_hashtable (obarray); + SCM buckets = ht->buckets; + n = SCM_SIMPLE_VECTOR_LENGTH (buckets); for (i = 0; i < n; ++i) { - SCM ls = SCM_HASHTABLE_BUCKET (obarray, i), handle; - while (!scm_is_null (ls)) + for (SCM ls = SCM_SIMPLE_VECTOR_REF (buckets, i); + !scm_is_null (ls); + ls = SCM_CDR (ls)) { - handle = SCM_CAR (ls); - + SCM handle = SCM_CAR (ls); if (scm_is_eq (SCM_CDR (handle), variable)) return SCM_CAR (handle); - - ls = SCM_CDR (ls); } }