diff --git a/src/CHANGELOG b/src/CHANGELOG index c312ff409..424f7ab1d 100644 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -106,6 +106,12 @@ ECL 9.9.1: enters the debugger, allowing either to continue or to interrupt specific processes. +* Packages: + + - The package hash tables are not destructively extended, but rather a new + hash table is created when we need more room. ecl_sethash() now returns + the pointer to the possibly reallocated hashtable. + ;;; Local Variables: *** ;;; mode:text *** ;;; fill-column:79 *** diff --git a/src/c/hash.d b/src/c/hash.d index f464a874a..81a243cbc 100644 --- a/src/c/hash.d +++ b/src/c/hash.d @@ -339,7 +339,7 @@ add_new_to_hash(cl_object key, cl_object hashtable, cl_object value) corrupted_hash(hashtable); } -void +cl_object ecl_sethash(cl_object key, cl_object hashtable, cl_object value) { cl_index i; @@ -355,17 +355,18 @@ ecl_sethash(cl_object key, cl_object hashtable, cl_object value) i = hashtable->hash.entries + 1; if (i >= hashtable->hash.size || i >= (hashtable->hash.size * hashtable->hash.factor)) { - ecl_extend_hashtable(hashtable); + hashtable = ecl_extend_hashtable(hashtable); } add_new_to_hash(key, hashtable, value); OUTPUT: HASH_TABLE_UNLOCK(hashtable); + return hashtable; } -void +cl_object ecl_extend_hashtable(cl_object hashtable) { - cl_object old, key; + cl_object old, new, key; cl_index old_size, new_size, i; cl_object new_size_obj; @@ -385,23 +386,31 @@ ecl_extend_hashtable(cl_object hashtable) } else { new_size = fix(new_size_obj); } - old = ecl_alloc_object(t_hashtable); - old->hash = hashtable->hash; - hashtable->hash.data = NULL; /* for GC sake */ - hashtable->hash.entries = 0; - hashtable->hash.size = new_size; - hashtable->hash.data = (struct ecl_hashtable_entry *) + if (hashtable->hash.test == htt_pack) { + new = ecl_alloc_object(t_hashtable); + new->hash = hashtable->hash; + old = hashtable; + } else { + old = ecl_alloc_object(t_hashtable); + old->hash = hashtable->hash; + new = hashtable; + } + new->hash.data = NULL; /* for GC sake */ + new->hash.entries = 0; + new->hash.size = new_size; + new->hash.data = (struct ecl_hashtable_entry *) ecl_alloc(new_size * sizeof(struct ecl_hashtable_entry)); for (i = 0; i < new_size; i++) { - hashtable->hash.data[i].key = OBJNULL; - hashtable->hash.data[i].value = OBJNULL; + new->hash.data[i].key = OBJNULL; + new->hash.data[i].value = OBJNULL; } - for (i = 0; i < old_size; i++) + for (i = 0; i < old_size; i++) { if ((key = old->hash.data[i].key) != OBJNULL) { - if (hashtable->hash.test == htt_pack) + if (new->hash.test == htt_pack) key = SYMBOL_NAME(old->hash.data[i].value); - add_new_to_hash(key, hashtable, old->hash.data[i].value); + add_new_to_hash(key, new, old->hash.data[i].value); } + } } diff --git a/src/c/package.d b/src/c/package.d index 6eb387622..0fdfcbba9 100644 --- a/src/c/package.d +++ b/src/c/package.d @@ -367,9 +367,9 @@ ecl_intern(cl_object name, cl_object p, int *intern_flag) if (p == cl_core.keyword_package) { ecl_symbol_type_set(s, ecl_symbol_type(s) | stp_constant); ECL_SET(s, s); - ecl_sethash(name, p->pack.external, s); + p->pack.external = ecl_sethash(name, p->pack.external, s); } else { - ecl_sethash(name, p->pack.internal, s); + p->pack.internal = ecl_sethash(name, p->pack.internal, s); } OUTPUT: PACKAGE_UNLOCK(p); @@ -520,7 +520,7 @@ cl_export2(cl_object s, cl_object p) } end_loop_for_on; if (hash != OBJNULL) ecl_remhash(name, hash); - ecl_sethash(name, p->pack.external, s); + p->pack.external = ecl_sethash(name, p->pack.external, s); OUTPUT: PACKAGE_UNLOCK(p); } @@ -609,7 +609,7 @@ cl_unexport2(cl_object s, cl_object p) (void)0; } else { ecl_remhash(name, p->pack.external); - ecl_sethash(name, p->pack.internal, s); + p->pack.internal = ecl_sethash(name, p->pack.internal, s); } PACKAGE_UNLOCK(p); } @@ -638,7 +638,7 @@ cl_import2(cl_object s, cl_object p) if (intern_flag == INTERNAL || intern_flag == EXTERNAL) goto OUTPUT; } - ecl_sethash(name, p->pack.internal, s); + p->pack.internal = ecl_sethash(name, p->pack.internal, s); symbol_add_package(s, p); OUTPUT: PACKAGE_UNLOCK(p); @@ -673,7 +673,7 @@ ecl_shadowing_import(cl_object s, cl_object p) symbol_remove_package(x, p); } p->pack.shadowings = CONS(s, p->pack.shadowings); - ecl_sethash(name, p->pack.internal, s); + p->pack.internal = ecl_sethash(name, p->pack.internal, s); OUTPUT: PACKAGE_UNLOCK(p); } @@ -694,7 +694,7 @@ ecl_shadow(cl_object s, cl_object p) x = ecl_find_symbol_nolock(s, p, &intern_flag); if (intern_flag != INTERNAL && intern_flag != EXTERNAL) { x = cl_make_symbol(s); - ecl_sethash(s, p->pack.internal, x); + p->pack.internal = ecl_sethash(s, p->pack.internal, x); x->symbol.hpack = p; } p->pack.shadowings = CONS(x, p->pack.shadowings); diff --git a/src/h/external.h b/src/h/external.h index ad96dd4ce..1d2e2af69 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -731,7 +731,7 @@ extern ECL_API cl_object si_hash_eql _ARGS((cl_narg narg, ...)); extern ECL_API cl_object si_hash_equal _ARGS((cl_narg narg, ...)); extern ECL_API cl_object si_hash_equalp _ARGS((cl_narg narg, ...)); -extern ECL_API void ecl_sethash(cl_object key, cl_object hashtable, cl_object value); +extern ECL_API cl_object ecl_sethash(cl_object key, cl_object hashtable, cl_object value); extern ECL_API cl_object ecl_gethash(cl_object key, cl_object hash); extern ECL_API cl_object ecl_gethash_safe(cl_object key, cl_object hash, cl_object def); extern ECL_API bool ecl_remhash(cl_object key, cl_object hash); diff --git a/src/h/internal.h b/src/h/internal.h index 6e745b207..21974c87b 100644 --- a/src/h/internal.h +++ b/src/h/internal.h @@ -239,7 +239,7 @@ extern cl_object si_formatter_aux _ARGS((cl_narg narg, cl_object strm, cl_object #endif /* hash.d */ -extern void ecl_extend_hashtable(cl_object hashtable); +extern cl_object ecl_extend_hashtable(cl_object hashtable); /* gfun.d, kernel.lsp */