Change Guile license to LGPLv3+
[bpt/guile.git] / libguile / hashtab.c
index 311827c..e3a6c43 100644 (file)
@@ -1,22 +1,28 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
 \f
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <stdio.h>
 
 #include "libguile/_scm.h"
 #include "libguile/alist.h"
 
 scm_t_bits scm_tc16_hashtable;
 
-#define HASHTABLE_SIZE_N 25
-
 static unsigned long hashtable_size[] = {
   31, 61, 113, 223, 443, 883, 1759, 3517, 7027, 14051, 28099, 56197, 112363,
-  224717, 449419, 898823, 1797641, 3595271, 7190537, 14381041, 28762081,
-  57524111, 115048217, 230096423, 460192829 /* larger values can't be
-                                              represented as INUMs */
+  224717, 449419, 898823, 1797641, 3595271, 7190537, 14381041
+#if 0
+  /* vectors are currently restricted to 2^24-1 = 16777215 elements. */
+  28762081, 57524111, 115048217, 230096423, 460192829
+  /* larger values can't be represented as INUMs */
+#endif
 };
 
-/* Turn an empty vector hash table into an opaque resizable one. */
+#define HASHTABLE_SIZE_N (sizeof(hashtable_size)/sizeof(unsigned long))
 
 static char *s_hashtable = "hashtable";
 
 SCM weak_hashtables = SCM_EOL;
 
 static SCM
-make_hash_table (int flags, unsigned long k, const char *func_name) {
+make_hash_table (int flags, unsigned long k, const char *func_name) 
+{
   SCM table, vector;
   scm_t_hashtable *t;
   int i = 0, n = k ? k : 31;
@@ -86,13 +94,7 @@ make_hash_table (int flags, unsigned long k, const char *func_name) {
     ++i;
   n = hashtable_size[i];
   if (flags)
-    /* The SCM_WVECTF_NOSCAN flag informs the weak vector code not to
-       perform the final scan for broken references.  Instead we do
-       that ourselves in scan_weak_hashtables. */
-    vector = scm_i_allocate_weak_vector (flags | SCM_WVECTF_NOSCAN,
-                                        scm_from_int (n),
-                                        SCM_EOL,
-                                        func_name);
+    vector = scm_i_allocate_weak_vector (flags, scm_from_int (n), SCM_EOL);
   else
     vector = scm_c_make_vector (n, SCM_EOL);
   t = scm_gc_malloc (sizeof (*t), s_hashtable);
@@ -101,6 +103,7 @@ make_hash_table (int flags, unsigned long k, const char *func_name) {
   t->lower = 0;
   t->upper = 9 * n / 10;
   t->flags = flags;
+  t->hash_fn = NULL;
   if (flags)
     {
       SCM_NEWSMOB3 (table, scm_tc16_hashtable, vector, t, weak_hashtables);
@@ -111,7 +114,6 @@ make_hash_table (int flags, unsigned long k, const char *func_name) {
   return table;
 }
 
-
 void
 scm_i_rehash (SCM table,
              unsigned long (*hash_fn)(),
@@ -138,9 +140,13 @@ scm_i_rehash (SCM table,
       if (i >= HASHTABLE_SIZE_N)
        /* don't rehash */
        return;
-      /* store for use in rehash_after_gc */
-      SCM_HASHTABLE (table)->hash_fn = hash_fn;
-      SCM_HASHTABLE (table)->closure = closure;
+
+      /* Remember HASH_FN for rehash_after_gc, but only when CLOSURE
+        is not needed since CLOSURE can not be guaranteed to be valid
+        after this function returns.
+      */
+      if (closure == NULL)
+       SCM_HASHTABLE (table)->hash_fn = hash_fn;
     }
   SCM_HASHTABLE (table)->size_index = i;
   
@@ -153,38 +159,50 @@ scm_i_rehash (SCM table,
   buckets = SCM_HASHTABLE_VECTOR (table);
   
   if (SCM_HASHTABLE_WEAK_P (table))
-    new_buckets = scm_i_allocate_weak_vector (SCM_HASHTABLE_FLAGS (table)
-                                             | SCM_WVECTF_NOSCAN,
+    new_buckets = scm_i_allocate_weak_vector (SCM_HASHTABLE_FLAGS (table),
                                              scm_from_ulong (new_size),
-                                             SCM_EOL,
-                                             func_name);
+                                             SCM_EOL);
   else
     new_buckets = scm_c_make_vector (new_size, SCM_EOL);
 
-  old_size = SCM_VECTOR_LENGTH (buckets);
+  /* When this is a weak hashtable, running the GC might change it.
+     We need to cope with this while rehashing its elements.  We do
+     this by first installing the new, empty bucket vector.  Then we
+     remove the elements from the old bucket vector and insert them
+     into the new one.
+  */
+
+  SCM_SET_HASHTABLE_VECTOR (table, new_buckets);
+  SCM_SET_HASHTABLE_N_ITEMS (table, 0);
+
+  old_size = SCM_SIMPLE_VECTOR_LENGTH (buckets);
   for (i = 0; i < old_size; ++i)
     {
-      SCM ls = SCM_VELTS (buckets)[i], handle;
-      while (!SCM_NULLP (ls))
+      SCM ls, cell, handle;
+
+      ls = SCM_SIMPLE_VECTOR_REF (buckets, i);
+      SCM_SIMPLE_VECTOR_SET (buckets, i, SCM_EOL);
+
+      while (scm_is_pair (ls))
        {
          unsigned long h;
-         handle = SCM_CAR (ls);
+         cell = ls;
+         handle = SCM_CAR (cell);
+         ls = SCM_CDR (ls);
          h = hash_fn (SCM_CAR (handle), new_size, closure);
          if (h >= new_size)
-           scm_out_of_range (func_name, scm_ulong2num (h));
-         SCM_VECTOR_SET (new_buckets, h,
-                         scm_cons (handle, SCM_VELTS (new_buckets)[h]));
-         ls = SCM_CDR (ls);
+           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);
        }
     }
-  SCM_SET_HASHTABLE_VECTOR (table, new_buckets);
 }
 
 
 static int
 hashtable_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
 {
-  scm_t_hashtable *t = SCM_HASHTABLE (exp);
   scm_puts ("#<", port);
   if (SCM_HASHTABLE_WEAK_KEY_P (exp))
     scm_puts ("weak-key-", port);
@@ -193,57 +211,35 @@ hashtable_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
   else if (SCM_HASHTABLE_DOUBLY_WEAK_P (exp))
     scm_puts ("doubly-weak-", port);
   scm_puts ("hash-table ", port);
-  scm_intprint ((unsigned long) t->n_items, 10, port);
+  scm_uintprint (SCM_HASHTABLE_N_ITEMS (exp), 10, port);
   scm_putc ('/', port);
-  scm_intprint ((unsigned long) SCM_VECTOR_LENGTH (SCM_HASHTABLE_VECTOR (exp)),
-               10, port);
+  scm_uintprint (SCM_SIMPLE_VECTOR_LENGTH (SCM_HASHTABLE_VECTOR (exp)),
+                10, port);
   scm_puts (">", port);
   return 1;
 }
 
-#define UNMARKED_CELL_P(x) (SCM_NIMP(x) && !SCM_GC_MARK_P (x))
-
 /* keep track of hash tables that need to shrink after scan */
 static SCM to_rehash = SCM_EOL;
 
-/* scan hash tables for broken references, remove them, and update
-   hash tables item count */
-static void *
-scan_weak_hashtables (void *dummy1 SCM_UNUSED,
-                     void *dummy2 SCM_UNUSED,
-                     void *dummy3 SCM_UNUSED)
+/* scan hash tables and update hash tables item count */
+void
+scm_i_scan_weak_hashtables ()
 {
   SCM *next = &weak_hashtables;
   SCM h = *next;
-  while (!SCM_NULLP (h))
+  while (!scm_is_null (h))
     {
       if (!SCM_GC_MARK_P (h))
        *next = h = SCM_HASHTABLE_NEXT (h);
       else
        {
-         SCM alist;
-         int i, n = SCM_HASHTABLE_N_BUCKETS (h);
-         int weak_car = SCM_HASHTABLE_FLAGS (h) & SCM_HASHTABLEF_WEAK_CAR;
-         int weak_cdr = SCM_HASHTABLE_FLAGS (h) & SCM_HASHTABLEF_WEAK_CDR;
-         int check_size_p = 0;
-         for (i = 0; i < n; ++i)
-           {
-             SCM *next_spine = (SCM *) &SCM_HASHTABLE_BUCKETS (h)[i];
-             for (alist = *next_spine;
-                  !SCM_NULLP (alist);
-                  alist = SCM_CDR (alist))
-               if ((weak_car && UNMARKED_CELL_P (SCM_CAAR (alist)))
-                   || (weak_cdr && UNMARKED_CELL_P (SCM_CDAR (alist))))
-                 {
-                   *next_spine = SCM_CDR (alist);
-                   SCM_HASHTABLE_DECREMENT (h);
-                   check_size_p = 1;
-                 }
-               else
-                 next_spine = SCM_CDRLOC (alist);
-           }
-         if (check_size_p
-             && SCM_HASHTABLE_N_ITEMS (h) < SCM_HASHTABLE_LOWER (h))
+         SCM vec = SCM_HASHTABLE_VECTOR (h);
+         size_t delta = SCM_I_WVECT_DELTA (vec);
+         SCM_I_SET_WVECT_DELTA (vec, 0);
+         SCM_SET_HASHTABLE_N_ITEMS (h, SCM_HASHTABLE_N_ITEMS (h) - delta);
+
+         if (SCM_HASHTABLE_N_ITEMS (h) < SCM_HASHTABLE_LOWER (h))
            {
              SCM tmp = SCM_HASHTABLE_NEXT (h);
              /* temporarily move table from weak_hashtables to to_rehash */
@@ -258,7 +254,6 @@ scan_weak_hashtables (void *dummy1 SCM_UNUSED,
            }
        }
     }
-  return 0;
 }
 
 static void *
@@ -266,7 +261,7 @@ rehash_after_gc (void *dummy1 SCM_UNUSED,
                 void *dummy2 SCM_UNUSED,
                 void *dummy3 SCM_UNUSED)
 {
-  if (!SCM_NULLP (to_rehash))
+  if (!scm_is_null (to_rehash))
     {
       SCM first = to_rehash, last, h;
       /* important to clear to_rehash here so that we don't get stuck
@@ -275,14 +270,14 @@ rehash_after_gc (void *dummy1 SCM_UNUSED,
       h = first;
       do
        {
-         scm_i_rehash (h,
-                       /* use same hash_fn and closure as last time */
-                       SCM_HASHTABLE (h)->hash_fn,
-                       SCM_HASHTABLE (h)->closure,
-                       "rehash_after_gc");
+         /* Rehash only when we have a hash_fn.
+          */
+         if (SCM_HASHTABLE (h)->hash_fn)
+           scm_i_rehash (h, SCM_HASHTABLE (h)->hash_fn, NULL,
+                         "rehash_after_gc");
          last = h;
          h = SCM_HASHTABLE_NEXT (h);
-       } while (!SCM_NULLP (h));
+       } while (!scm_is_null (h));
       /* move tables back to weak_hashtables */
       SCM_SET_HASHTABLE_NEXT (last, weak_hashtables);
       weak_hashtables = first;
@@ -306,7 +301,7 @@ scm_c_make_hash_table (unsigned long k)
 
 SCM_DEFINE (scm_make_hash_table, "make-hash-table", 0, 1, 0,
            (SCM n),
-           "Make a hash table with optional minimum number of buckets @var{n}\n")
+           "Make a new abstract hash table object with minimum number of buckets @var{n}\n")
 #define FUNC_NAME s_scm_make_hash_table
 {
   if (SCM_UNBNDP (n))
@@ -320,9 +315,7 @@ SCM_DEFINE (scm_make_weak_key_hash_table, "make-weak-key-hash-table", 0, 1, 0,
            (SCM n),
            "@deffnx {Scheme Procedure} make-weak-value-hash-table size\n"
            "@deffnx {Scheme Procedure} make-doubly-weak-hash-table size\n"
-           "Return a weak hash table with @var{size} buckets. As with any\n"
-           "hash table, choosing a good size for the table requires some\n"
-           "caution.\n"
+           "Return a weak hash table with @var{size} buckets.\n"
            "\n"
            "You can modify weak hash tables in exactly the same way you\n"
            "would modify regular hash tables. (@pxref{Hash Tables})")
@@ -376,7 +369,7 @@ SCM_DEFINE (scm_make_doubly_weak_hash_table, "make-doubly-weak-hash-table", 1, 0
 
 SCM_DEFINE (scm_hash_table_p, "hash-table?", 1, 0, 0, 
             (SCM obj),
-           "Return @code{#t} if @var{obj} is a hash table.")
+           "Return @code{#t} if @var{obj} is an abstract hash table object.")
 #define FUNC_NAME s_scm_hash_table_p
 {
   return scm_from_bool (SCM_HASHTABLE_P (obj));
@@ -429,12 +422,12 @@ scm_hash_fn_get_handle (SCM table, SCM obj, unsigned long (*hash_fn)(), SCM (*as
     table = SCM_HASHTABLE_VECTOR (table);
   else
     SCM_VALIDATE_VECTOR (1, table);
-  if (SCM_VECTOR_LENGTH (table) == 0)
+  if (SCM_SIMPLE_VECTOR_LENGTH (table) == 0)
     return SCM_BOOL_F;
-  k = hash_fn (obj, SCM_VECTOR_LENGTH (table), closure);
-  if (k >= SCM_VECTOR_LENGTH (table))
-    scm_out_of_range ("hash_fn_get_handle", scm_ulong2num (k));
-  h = assoc_fn (obj, SCM_VELTS (table)[k], closure);
+  k = hash_fn (obj, SCM_SIMPLE_VECTOR_LENGTH (table), closure);
+  if (k >= SCM_SIMPLE_VECTOR_LENGTH (table))
+    scm_out_of_range ("hash_fn_get_handle", scm_from_ulong (k));
+  h = assoc_fn (obj, SCM_SIMPLE_VECTOR_REF (table, k), closure);
   return h;
 }
 #undef FUNC_NAME
@@ -452,28 +445,50 @@ scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, unsigned long (*hash_
     buckets = SCM_HASHTABLE_VECTOR (table);
   else
     {
-      SCM_ASSERT (SCM_VECTORP (table),
+      SCM_ASSERT (scm_is_simple_vector (table),
                  table, SCM_ARG1, "hash_fn_create_handle_x");
       buckets = table;
     }
-  if (SCM_VECTOR_LENGTH (buckets) == 0)
+  if (SCM_SIMPLE_VECTOR_LENGTH (buckets) == 0)
     SCM_MISC_ERROR ("void hashtable", SCM_EOL);
 
-  k = hash_fn (obj, SCM_VECTOR_LENGTH (buckets), closure);
-  if (k >= SCM_VECTOR_LENGTH (buckets))
-    scm_out_of_range ("hash_fn_create_handle_x", scm_ulong2num (k));
-  it = assoc_fn (obj, SCM_VELTS (buckets)[k], closure);
-  if (scm_is_true (it))
+  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));
+  it = assoc_fn (obj, SCM_SIMPLE_VECTOR_REF (buckets, k), closure);
+  if (scm_is_pair (it))
     return it;
+  else if (scm_is_true (it))
+    scm_wrong_type_arg_msg (NULL, 0, it, "a pair");
   else
     {
-      SCM old_bucket = SCM_VELTS (buckets)[k];
-      SCM new_bucket = scm_acons (obj, init, old_bucket);
-      SCM_VECTOR_SET (buckets, k, new_bucket);
-      if (table != buckets)
+      /* When this is a weak hashtable, running the GC can change it.
+        Thus, we must allocate the new cells first and can only then
+        access BUCKETS.  Also, we need to fetch the bucket vector
+        again since the hashtable might have been rehashed.  This
+        necessitates a new hash value as well.
+      */
+      SCM new_bucket = scm_acons (obj, init, SCM_EOL);
+      if (!scm_is_eq (table, buckets)
+         && !scm_is_eq (SCM_HASHTABLE_VECTOR (table), buckets))
        {
+         buckets = SCM_HASHTABLE_VECTOR (table);
+         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);
+      if (!scm_is_eq (table, buckets))
+       {
+         /* Update element count and maybe rehash the table.  The
+            table might have too few entries here since weak hash
+            tables used with the hashx_* functions can not be
+            rehashed after GC.
+         */
          SCM_HASHTABLE_INCREMENT (table);
-         if (SCM_HASHTABLE_N_ITEMS (table) > SCM_HASHTABLE_UPPER (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);
        }
       return SCM_CAR (new_bucket);
@@ -487,7 +502,7 @@ scm_hash_fn_ref (SCM table, SCM obj, SCM dflt, unsigned long (*hash_fn)(),
                  SCM (*assoc_fn)(), void * closure)
 {
   SCM it = scm_hash_fn_get_handle (table, obj, hash_fn, assoc_fn, closure);
-  if (SCM_CONSP (it))
+  if (scm_is_pair (it))
     return SCM_CDR (it);
   else
     return dflt;
@@ -508,12 +523,11 @@ scm_hash_fn_set_x (SCM table, SCM obj, SCM val, unsigned long (*hash_fn)(),
 }
 
 
-
-
-
 SCM 
-scm_hash_fn_remove_x (SCM table, SCM obj, unsigned long (*hash_fn)(), SCM (*assoc_fn)(),
-                      SCM (*delete_fn)(), void * closure)
+scm_hash_fn_remove_x (SCM table, SCM obj,
+                     unsigned long (*hash_fn)(),
+                     SCM (*assoc_fn)(),
+                      void *closure)
 {
   unsigned long k;
   SCM buckets, h;
@@ -522,20 +536,22 @@ scm_hash_fn_remove_x (SCM table, SCM obj, unsigned long (*hash_fn)(), SCM (*asso
     buckets = SCM_HASHTABLE_VECTOR (table);
   else
     {
-      SCM_ASSERT (SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_remove_x");
+      SCM_ASSERT (scm_is_simple_vector (table), table,
+                 SCM_ARG1, "hash_fn_remove_x");
       buckets = table;
     }
-  if (SCM_VECTOR_LENGTH (table) == 0)
+  if (SCM_SIMPLE_VECTOR_LENGTH (table) == 0)
     return SCM_EOL;
 
-  k = hash_fn (obj, SCM_VECTOR_LENGTH (buckets), closure);
-  if (k >= SCM_VECTOR_LENGTH (buckets))
-    scm_out_of_range ("hash_fn_remove_x", scm_ulong2num (k));
-  h = assoc_fn (obj, SCM_VELTS (buckets)[k], closure);
+  k = hash_fn (obj, SCM_SIMPLE_VECTOR_LENGTH (buckets), closure);
+  if (k >= SCM_SIMPLE_VECTOR_LENGTH (buckets))
+    scm_out_of_range ("hash_fn_remove_x", scm_from_ulong (k));
+  h = assoc_fn (obj, SCM_SIMPLE_VECTOR_REF (buckets, k), closure);
   if (scm_is_true (h))
     {
-      SCM_VECTOR_SET (buckets, k, delete_fn (h, SCM_VELTS (buckets)[k]));
-      if (table != buckets)
+      SCM_SIMPLE_VECTOR_SET 
+       (buckets, k, scm_delq_x (h, SCM_SIMPLE_VECTOR_REF (buckets, k)));
+      if (!scm_is_eq (table, buckets))
        {
          SCM_HASHTABLE_DECREMENT (table);
          if (SCM_HASHTABLE_N_ITEMS (table) < SCM_HASHTABLE_LOWER (table))
@@ -547,12 +563,16 @@ scm_hash_fn_remove_x (SCM table, SCM obj, unsigned long (*hash_fn)(), SCM (*asso
 
 SCM_DEFINE (scm_hash_clear_x, "hash-clear!", 1, 0, 0,
            (SCM table),
-           "Remove all items from TABLE (without triggering a resize).")
+           "Remove all items from @var{table} (without triggering a resize).")
 #define FUNC_NAME s_scm_hash_clear_x
 {
-  SCM_VALIDATE_HASHTABLE (1, table);
-  scm_vector_fill_x (SCM_HASHTABLE_VECTOR (table), SCM_EOL);
-  SCM_SET_HASHTABLE_N_ITEMS (table, 0);
+  if (SCM_HASHTABLE_P (table))
+    {
+      scm_vector_fill_x (SCM_HASHTABLE_VECTOR (table), SCM_EOL);
+      SCM_SET_HASHTABLE_N_ITEMS (table, 0);
+    }
+  else
+    scm_vector_fill_x (table, SCM_EOL);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -618,8 +638,7 @@ SCM_DEFINE (scm_hashq_remove_x, "hashq-remove!", 2, 0, 0,
            "@var{table}.  Uses @code{eq?} for equality tests.")
 #define FUNC_NAME s_scm_hashq_remove_x
 {
-  return scm_hash_fn_remove_x (table, key, scm_ihashq, scm_sloppy_assq,
-                              scm_delq_x, 0);
+  return scm_hash_fn_remove_x (table, key, scm_ihashq, scm_sloppy_assq, 0);
 }
 #undef FUNC_NAME
 
@@ -685,8 +704,7 @@ SCM_DEFINE (scm_hashv_remove_x, "hashv-remove!", 2, 0, 0,
            "@var{table}.  Uses @code{eqv?} for equality tests.")
 #define FUNC_NAME s_scm_hashv_remove_x
 {
-  return scm_hash_fn_remove_x (table, key, scm_ihashv, scm_sloppy_assv,
-                              scm_delv_x, 0);
+  return scm_hash_fn_remove_x (table, key, scm_ihashv, scm_sloppy_assv, 0);
 }
 #undef FUNC_NAME
 
@@ -752,8 +770,7 @@ SCM_DEFINE (scm_hash_remove_x, "hash-remove!", 2, 0, 0,
            "@var{table}.  Uses @code{equal?} for equality tests.")
 #define FUNC_NAME s_scm_hash_remove_x
 {
-  return scm_hash_fn_remove_x (table, key, scm_ihash, scm_sloppy_assoc,
-                              scm_delete_x, 0);
+  return scm_hash_fn_remove_x (table, key, scm_ihash, scm_sloppy_assoc, 0);
 }
 #undef FUNC_NAME
 
@@ -764,7 +781,6 @@ typedef struct scm_t_ihashx_closure
 {
   SCM hash;
   SCM assoc;
-  SCM delete;
 } scm_t_ihashx_closure;
 
 
@@ -772,9 +788,7 @@ typedef struct scm_t_ihashx_closure
 static unsigned long
 scm_ihashx (SCM obj, unsigned long n, scm_t_ihashx_closure *closure)
 {
-  SCM answer = scm_call_2 (closure->hash,
-                          obj,
-                          scm_ulong2num ((unsigned long) n));
+  SCM answer = scm_call_2 (closure->hash, obj, scm_from_ulong (n));
   return scm_to_ulong (answer);
 }
 
@@ -787,16 +801,6 @@ scm_sloppy_assx (SCM obj, SCM alist, scm_t_ihashx_closure *closure)
 }
 
 
-
-
-static SCM
-scm_delx_x (SCM obj, SCM alist, scm_t_ihashx_closure *closure)
-{
-  return scm_call_2 (closure->delete, obj, alist);
-}
-
-
-
 SCM_DEFINE (scm_hashx_get_handle, "hashx-get-handle", 4, 0, 0, 
             (SCM hash, SCM assoc, SCM table, SCM key),
            "This behaves the same way as the corresponding\n"
@@ -883,17 +887,26 @@ SCM_DEFINE (scm_hashx_set_x, "hashx-set!", 5, 0, 0,
 }
 #undef FUNC_NAME
 
-
-
-SCM
-scm_hashx_remove_x (SCM hash, SCM assoc, SCM delete, SCM table, SCM obj)
+SCM_DEFINE (scm_hashx_remove_x, "hashx-remove!", 4, 0, 0,
+           (SCM hash, SCM assoc, SCM table, SCM obj),
+           "This behaves the same way as the corresponding @code{remove!}\n"
+           "function, but uses @var{hash} as a hash function and\n"
+           "@var{assoc} to compare keys.  @code{hash} must be a function\n"
+           "that takes two arguments, a key to be hashed and a table size.\n"
+           "@code{assoc} must be an associator function, like @code{assoc},\n"
+           "@code{assq} or @code{assv}.\n"
+           "\n"
+           " By way of illustration, @code{hashq-remove! table key} is\n"
+           "equivalent to @code{hashx-remove!  hashq assq #f table key}.")
+#define FUNC_NAME s_scm_hashx_remove_x
 {
   scm_t_ihashx_closure closure;
   closure.hash = hash;
   closure.assoc = assoc;
-  closure.delete = delete;
-  return scm_hash_fn_remove_x (table, obj, scm_ihashx, scm_sloppy_assx, scm_delx_x, 0);
+  return scm_hash_fn_remove_x (table, obj, scm_ihashx, scm_sloppy_assx,
+                               (void *) &closure);
 }
+#undef FUNC_NAME
 
 /* Hash table iterators */
 
@@ -910,16 +923,16 @@ scm_internal_hash_fold (SCM (*fn) (), void *closure, SCM init, SCM table)
   else
     buckets = table;
   
-  n = SCM_VECTOR_LENGTH (buckets);
+  n = SCM_SIMPLE_VECTOR_LENGTH (buckets);
   for (i = 0; i < n; ++i)
     {
-      SCM ls = SCM_VELTS (buckets)[i], handle;
-      while (!SCM_NULLP (ls))
+      SCM ls = SCM_SIMPLE_VECTOR_REF (buckets, i), handle;
+      while (!scm_is_null (ls))
        {
-         if (!SCM_CONSP (ls))
+         if (!scm_is_pair (ls))
            scm_wrong_type_arg (s_scm_hash_fold, SCM_ARG3, buckets);
          handle = SCM_CAR (ls);
-         if (!SCM_CONSP (handle))
+         if (!scm_is_pair (handle))
            scm_wrong_type_arg (s_scm_hash_fold, SCM_ARG3, buckets);
          result = fn (closure, SCM_CAR (handle), SCM_CDR (handle), result);
          ls = SCM_CDR (ls);
@@ -948,16 +961,16 @@ scm_internal_hash_for_each_handle (SCM (*fn) (), void *closure, SCM table)
   else
     buckets = table;
   
-  n = SCM_VECTOR_LENGTH (buckets);
+  n = SCM_SIMPLE_VECTOR_LENGTH (buckets);
   for (i = 0; i < n; ++i)
     {
-      SCM ls = SCM_VELTS (buckets)[i], handle;
-      while (!SCM_NULLP (ls))
+      SCM ls = SCM_SIMPLE_VECTOR_REF (buckets, i), handle;
+      while (!scm_is_null (ls))
        {
-         if (!SCM_CONSP (ls))
+         if (!scm_is_pair (ls))
            scm_wrong_type_arg (s_scm_hash_for_each, SCM_ARG3, buckets);
          handle = SCM_CAR (ls);
-         if (!SCM_CONSP (handle))
+         if (!scm_is_pair (handle))
            scm_wrong_type_arg (s_scm_hash_for_each, SCM_ARG3, buckets);
          fn (closure, handle);
          ls = SCM_CDR (ls);
@@ -1061,7 +1074,6 @@ scm_hashtab_prehistory ()
   scm_set_smob_mark (scm_tc16_hashtable, scm_markcdr);
   scm_set_smob_print (scm_tc16_hashtable, hashtable_print);
   scm_set_smob_free (scm_tc16_hashtable, hashtable_free);
-  scm_c_hook_add (&scm_after_sweep_c_hook, scan_weak_hashtables, 0, 0);
   scm_c_hook_add (&scm_after_gc_c_hook, rehash_after_gc, 0, 0);
 }