Convert hash tables away from scm_cell

* libguile/hashtab.h (SCM_HASHTABLE_VECTOR):
(SCM_SET_HASHTABLE_VECTOR):
(SCM_HASHTABLE):
(SCM_HASHTABLE_N_ITEMS):
(SCM_SET_HASHTABLE_N_ITEMS):
(SCM_HASHTABLE_INCREMENT):
(SCM_HASHTABLE_DECREMENT):
(SCM_HASHTABLE_UPPER):
(SCM_HASHTABLE_LOWER):
(SCM_HASHTABLE_N_BUCKETS):
(SCM_HASHTABLE_BUCKET):
(SCM_SET_HASHTABLE_BUCKET): Remove these internal definitions from the
public interface.
(scm_t_hashtable): Add a tag, and add buckets.
(scm_is_hashtable):
(scm_to_hashtable):
(scm_from_hashtable): New helpers.
* libguile/modules.c (scm_module_reverse_lookup): Adapt to hash table
API change.
* libguile/hashtab.c: Rework to access hash table data through the typed
"struct scm_t_hashtable".

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_tagged (SCM_I_CURRENT_THREAD, sizeof (*t));
-
+  t->tag = scm_tc7_hashtable;
-  t = scm_allocate_pointerless (SCM_I_CURRENT_THREAD, sizeof (*t));
+  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_from_hashtable (t);
-  return scm_double_cell (scm_tc7_hashtable, SCM_UNPACK (vector),
-                          (scm_t_bits)t, 0);
 }
 
-void
+static void
-scm_i_rehash (SCM table,
+rehash (struct scm_t_hashtable *table, scm_t_hash_fn hash_fn,
-	      scm_t_hash_fn hash_fn,
+        void *closure, const char* func_name)
-	      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
+      while (i > table->min_size_index
-	     && SCM_HASHTABLE_N_ITEMS (table) < hashtable_size[i] / 4);
+	     && 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];
+  size_t new_size = hashtable_size[i];
-  if (i <= SCM_HASHTABLE (table)->min_size_index)
+  if (i <= table->min_size_index)
-    SCM_HASHTABLE (table)->lower = 0;
+    table->lower = 0;
   else
-    SCM_HASHTABLE (table)->lower = new_size / 4;
+    table->lower = new_size / 4;
-  SCM_HASHTABLE (table)->upper = 9 * new_size / 10;
+  table->upper = 9 * new_size / 10;
-  buckets = SCM_HASHTABLE_VECTOR (table);
 
-  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);
+  table->buckets = new_buckets;
-  SCM_SET_HASHTABLE_N_ITEMS (table, 0);
+  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;
+      SCM ls = SCM_SIMPLE_VECTOR_REF (buckets, i);
-
-      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;
+	  SCM cell = ls;
-	  handle = SCM_CAR (cell);
+	  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 ("#<hash-table ", port);
   scm_uintprint (SCM_UNPACK (exp), 16, port);
   scm_putc (' ', port);
-  scm_uintprint (SCM_HASHTABLE_N_ITEMS (exp), 10, port);
+  scm_uintprint (hashtable_n_items (ht), 10, port);
   scm_putc ('/', port);
-  scm_uintprint (SCM_SIMPLE_VECTOR_LENGTH (SCM_HASHTABLE_VECTOR (exp)),
+  scm_uintprint (hashtable_bucket_count (ht), 10, port);
-		 10, port);
   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)
+      if (hashtable_n_items (ht) < hashtable_lower (ht)
-          || SCM_HASHTABLE_N_ITEMS (table) > SCM_HASHTABLE_UPPER (table))
+          || hashtable_n_items (ht) > hashtable_upper (ht))
-        scm_i_rehash (table, hash_fn, closure, FUNC_NAME);
+        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);
+      hashtable_decrement (ht);
-      if (SCM_HASHTABLE_N_ITEMS (table) < SCM_HASHTABLE_LOWER (table))
+      if (hashtable_n_items (ht) < hashtable_lower (ht))
-        scm_i_rehash (table, hash_fn, closure, FUNC_NAME);
+        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_vector_fill_x (hashtable_buckets (ht), SCM_EOL);
-  SCM_SET_HASHTABLE_N_ITEMS (table, 0);
+  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)

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,

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;
+      for (SCM ls = SCM_SIMPLE_VECTOR_REF (buckets, i);
-      while (!scm_is_null (ls))
+           !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);
 	}
     }