ecl_extend_hashtable() now does not destructively modify a package hash table. Instead, it returns a new object. This affects ecl_sethash() and all package functions that modify the package tables.

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 ***

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);
 		}
+        }
 }
 
 

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);

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);

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 */