diff options
author | Andy Wingo <wingo@pobox.com> | 2011-01-05 20:15:11 -0800 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-01-07 09:18:36 -0800 |
commit | e0c83bf5009480ea3e872465b669d26f6d6871ef (patch) | |
tree | ac3f7eb0329b50c6c60a5630e4dcf69a1afc1584 /libguile/symbols.c | |
parent | 622415380cb4b24d1d12641781f705f99b9e720e (diff) | |
download | guile-e0c83bf5009480ea3e872465b669d26f6d6871ef.tar.gz |
fix symbol garbage collection
* libguile/symbols.c (lookup_interned_symbol, intern_symbol): Refactor
to use hashtab.[ch] interfaces.
Diffstat (limited to 'libguile/symbols.c')
-rw-r--r-- | libguile/symbols.c | 192 |
1 files changed, 86 insertions, 106 deletions
diff --git a/libguile/symbols.c b/libguile/symbols.c index 9a59b6a8e..769e397ab 100644 --- a/libguile/symbols.c +++ b/libguile/symbols.c @@ -68,128 +68,108 @@ SCM_DEFINE (scm_sys_symbols, "%symbols", 0, 0, 0, /* {Symbols} */ -/* In order to optimize reading speed, this function breaks part of - * the hashtable abstraction. The optimizations are: - * - * 1. The argument string can be compared directly to symbol objects - * without first creating an SCM string object. (This would have - * been necessary if we had used the hashtable API in hashtab.h.) - * - * 2. We can use the raw hash value stored in scm_i_symbol_hash (sym) - * to speed up lookup. - * - * Both optimizations might be possible without breaking the - * abstraction if the API in hashtab.c is improved. - */ - unsigned long scm_i_hash_symbol (SCM obj, unsigned long n, void *closure) { return scm_i_symbol_hash (obj) % n; } +struct string_lookup_data +{ + unsigned long string_hash; +}; + +static unsigned long +string_lookup_hash_fn (SCM obj, unsigned long max, void *closure) +{ + struct string_lookup_data *data = closure; + + if (scm_is_symbol (obj)) + return scm_i_symbol_hash (obj) % max; + else + return data->string_hash % max; +} + +static SCM +string_lookup_assoc_fn (SCM obj, SCM alist, void *closure) +{ + struct string_lookup_data *data = closure; + + for (; !scm_is_null (alist); alist = SCM_CDR (alist)) + { + SCM sym = SCM_CAAR (alist); + + if (scm_i_symbol_hash (sym) == data->string_hash + && scm_is_true (scm_string_equal_p (scm_symbol_to_string (sym), obj))) + return SCM_CAR (alist); + } + + return SCM_BOOL_F; +} + static SCM lookup_interned_symbol (SCM name, unsigned long raw_hash) { - /* Try to find the symbol in the symbols table */ - SCM result = SCM_BOOL_F; - SCM bucket, elt, previous_elt; - size_t len; - unsigned long hash = raw_hash % SCM_HASHTABLE_N_BUCKETS (symbols); + struct string_lookup_data data; + SCM handle; + + data.string_hash = raw_hash; + + /* Strictly speaking, we should take a lock here. But instead we rely + on the fact that if this fails, we do take the lock on the + intern_symbol path; and since nothing deletes from the hash table, + we should be OK. Though, weak pair deletion is somewhat + worrying... */ + handle = scm_hash_fn_get_handle (symbols, name, + string_lookup_hash_fn, + string_lookup_assoc_fn, + &data); + + if (scm_is_true (handle)) + return SCM_CAR (handle); + else + return SCM_BOOL_F; +} - len = scm_i_string_length (name); - bucket = SCM_HASHTABLE_BUCKET (symbols, hash); +static unsigned long +symbol_lookup_hash_fn (SCM obj, unsigned long max, void *closure) +{ + return scm_i_symbol_hash (obj) % max; +} - for (elt = bucket, previous_elt = SCM_BOOL_F; - !scm_is_null (elt); - previous_elt = elt, elt = SCM_CDR (elt)) +static SCM +symbol_lookup_assoc_fn (SCM obj, SCM alist, void *closure) +{ + for (; !scm_is_null (alist); alist = SCM_CDR (alist)) { - SCM pair, sym; - - pair = SCM_CAR (elt); - if (!scm_is_pair (pair)) - abort (); - - if (SCM_WEAK_PAIR_CAR_DELETED_P (pair)) - { - /* PAIR is a weak pair whose key got nullified: remove it from - BUCKET. */ - /* FIXME: Since this is done lazily, i.e., only when a new symbol - is to be inserted in a bucket containing deleted symbols, the - number of items in the hash table may remain erroneous for some - time, thus precluding proper rehashing. */ - if (previous_elt != SCM_BOOL_F) - SCM_SETCDR (previous_elt, SCM_CDR (elt)); - else - bucket = SCM_CDR (elt); - - SCM_HASHTABLE_DECREMENT (symbols); - continue; - } - - sym = SCM_CAR (pair); - - if (scm_i_symbol_hash (sym) == raw_hash - && scm_i_symbol_length (sym) == len) - { - size_t i = len; - - /* Slightly faster path for comparing narrow to narrow. */ - if (scm_i_is_narrow_string (name) && scm_i_is_narrow_symbol (sym)) - { - const char *chrs = scm_i_symbol_chars (sym); - const char *str = scm_i_string_chars (name); - - while (i != 0) - { - --i; - if (str[i] != chrs[i]) - goto next_symbol; - } - } - else - { - /* Somewhat slower path for comparing narrow to wide or - wide to wide. */ - while (i != 0) - { - --i; - if (scm_i_string_ref (name, i) != scm_i_symbol_ref (sym, i)) - goto next_symbol; - } - } - - /* We found it. */ - result = sym; - break; - } - next_symbol: - ; - } + SCM sym = SCM_CAAR (alist); - if (SCM_HASHTABLE_N_ITEMS (symbols) < SCM_HASHTABLE_LOWER (symbols)) - /* We removed many symbols in this pass so trigger a rehashing. */ - scm_i_rehash (symbols, scm_i_hash_symbol, 0, "lookup_interned_symbol"); + if (scm_i_symbol_hash (sym) == scm_i_symbol_hash (obj) + && scm_is_true (scm_string_equal_p (scm_symbol_to_string (sym), + scm_symbol_to_string (obj)))) + return SCM_CAR (alist); + } - return result; + return SCM_BOOL_F; } -/* Intern SYMBOL, an uninterned symbol. */ -static void +static scm_i_pthread_mutex_t intern_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER; + +/* Intern SYMBOL, an uninterned symbol. Might return a different + symbol, if another one was interned at the same time. */ +static SCM intern_symbol (SCM symbol) { - SCM slot, cell; - unsigned long hash; + SCM handle; - hash = scm_i_symbol_hash (symbol) % SCM_HASHTABLE_N_BUCKETS (symbols); - slot = SCM_HASHTABLE_BUCKET (symbols, hash); - cell = scm_cons (symbol, SCM_UNDEFINED); + scm_i_pthread_mutex_lock (&intern_lock); + handle = scm_hash_fn_create_handle_x (symbols, symbol, SCM_UNDEFINED, + symbol_lookup_hash_fn, + symbol_lookup_assoc_fn, + NULL); + scm_i_pthread_mutex_unlock (&intern_lock); - SCM_SET_HASHTABLE_BUCKET (symbols, hash, scm_cons (cell, slot)); - SCM_HASHTABLE_INCREMENT (symbols); - - if (SCM_HASHTABLE_N_ITEMS (symbols) > SCM_HASHTABLE_UPPER (symbols)) - scm_i_rehash (symbols, scm_i_hash_symbol, 0, "intern_symbol"); + return SCM_CAR (handle); } static SCM @@ -199,15 +179,15 @@ scm_i_str2symbol (SCM str) size_t raw_hash = scm_i_string_hash (str); symbol = lookup_interned_symbol (str, raw_hash); - if (scm_is_false (symbol)) + if (scm_is_true (symbol)) + return symbol; + else { /* The symbol was not found, create it. */ symbol = scm_i_make_symbol (str, 0, raw_hash, scm_cons (SCM_BOOL_F, SCM_EOL)); - intern_symbol (symbol); + return intern_symbol (symbol); } - - return symbol; } |