reimplement hashtab.c's weak hash tables in terms of weak-table.c

* libguile/hashtab.c:
* libguile/hashtab.h: Reimplement the weak hash table implementation in
  terms of weak tables.  All is well except for the horrific hack for
  hashx tables.

* libguile/weak-table.h:
* libguile/weak-table.c (scm_make_weak_key_hash_table)
  (scm_make_weak_value_hash_table, scm_make_doubly_weak_hash_table)
  (scm_weak_key_hash_table_p, scm_weak_value_hash_table_p)
  (scm_doubly_weak_hash_table_p): Move these definitions here.

4 files changed, 235 insertions, 597 deletions

diff --git a/libguile/hashtab.c b/libguile/hashtab.c
index c4f2b5eb0..1f1f69ca5 100644
--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@@ -53,9 +53,6 @@
  * The implementation stores the upper and lower number of items which
  * trigger a resize in the hashtable object.
  *
- * Weak hash tables use weak pairs in the bucket lists rather than
- * normal pairs.
- *
  * Possible hash table sizes (primes) are stored in the array
  * hashtable_size.
  */
@@ -75,201 +72,8 @@ static unsigned long hashtable_size[] = {
 
 static char *s_hashtable = "hashtable";
 
-
-
-/* Helper functions and macros to deal with weak pairs.
-
-   Weak pairs need to be accessed very carefully since their components can
-   be nullified by the GC when the object they refer to becomes unreachable.
-   Hence the macros and functions below that detect such weak pairs within
-   buckets and remove them.  */
-
-
-/* Remove nullified weak pairs from ALIST such that the result contains only
-   valid pairs.  Set REMOVED_ITEMS to the number of pairs that have been
-   deleted.  */
 static SCM
-scm_fixup_weak_alist (SCM alist, size_t *removed_items)
-{
-  SCM result;
-  SCM prev = SCM_EOL;
-
-  *removed_items = 0;
-  for (result = alist;
-       scm_is_pair (alist);
-       alist = SCM_CDR (alist))
-    {
-      SCM pair = SCM_CAR (alist);
-
-      if (SCM_WEAK_PAIR_DELETED_P (pair))
-	{
-	  /* Remove from ALIST weak pair PAIR whose car/cdr has been
-	     nullified by the GC.  */
-	  if (scm_is_null (prev))
-	    result = SCM_CDR (alist);
-	  else
-	    SCM_SETCDR (prev, SCM_CDR (alist));
-
-	  (*removed_items)++;
-
-	  /* Leave PREV unchanged.  */
-	}
-      else
-	prev = alist;
-    }
-
-  return result;
-}
-
-static void
-vacuum_weak_hash_table (SCM table)
-{
-  SCM buckets = SCM_HASHTABLE_VECTOR (table);
-  unsigned long k = SCM_SIMPLE_VECTOR_LENGTH (buckets);
-  size_t len = SCM_HASHTABLE_N_ITEMS (table);
-
-  while (k--)
-    {
-      size_t removed;
-      SCM alist = SCM_SIMPLE_VECTOR_REF (buckets, k);
-      alist = scm_fixup_weak_alist (alist, &removed);
-      assert (removed <= len);
-      len -= removed;
-      SCM_SIMPLE_VECTOR_SET (buckets, k, alist);
-    }
-
-  SCM_SET_HASHTABLE_N_ITEMS (table, len);
-}
-
-
-/* Packed arguments for `do_weak_bucket_fixup'.  */
-struct t_fixup_args
-{
-  SCM bucket;
-  SCM *bucket_copy;
-  size_t removed_items;
-};
-
-static void *
-do_weak_bucket_fixup (void *data)
-{
-  struct t_fixup_args *args;
-  SCM pair, *copy;
-
-  args = (struct t_fixup_args *) data;
-
-  args->bucket = scm_fixup_weak_alist (args->bucket, &args->removed_items);
-
-  for (pair = args->bucket, copy = args->bucket_copy;
-       scm_is_pair (pair);
-       pair = SCM_CDR (pair), copy += 2)
-    {
-      /* At this point, all weak pairs have been removed.  */
-      assert (!SCM_WEAK_PAIR_DELETED_P (SCM_CAR (pair)));
-
-      /* Copy the key and value.  */
-      copy[0] = SCM_CAAR (pair);
-      copy[1] = SCM_CDAR (pair);
-    }
-
-  return args;
-}
-
-/* Lookup OBJECT in weak hash table TABLE using ASSOC.  OBJECT is searched
-   for in the alist that is the BUCKET_INDEXth element of BUCKETS.
-   Optionally update TABLE and rehash it.  */
-static SCM
-weak_bucket_assoc (SCM table, SCM buckets, size_t bucket_index,
-		   scm_t_hash_fn hash_fn,
-		   scm_t_assoc_fn assoc, SCM object, void *closure)
-{
-  SCM result;
-  SCM bucket, *strong_refs;
-  struct t_fixup_args args;
-
-  bucket = SCM_SIMPLE_VECTOR_REF (buckets, bucket_index);
-
-  /* Prepare STRONG_REFS as an array large enough to hold all the keys
-     and values in BUCKET.  */
-  strong_refs = alloca (scm_ilength (bucket) * 2 * sizeof (SCM));
-
-  args.bucket = bucket;
-  args.bucket_copy = strong_refs;
-
-  /* Fixup BUCKET.  Do that with the allocation lock held to avoid
-     seeing disappearing links pointing to objects that have already
-     been reclaimed (this happens when the disappearing links that point
-     to it haven't yet been cleared.)
-
-     The `do_weak_bucket_fixup' call populates STRONG_REFS with a copy
-     of BUCKET's entries after it's been fixed up.  Thus, all the
-     entries kept in BUCKET are still reachable when ASSOC sees
-     them.  */
-  GC_call_with_alloc_lock (do_weak_bucket_fixup, &args);
-
-  bucket = args.bucket;
-  SCM_SIMPLE_VECTOR_SET (buckets, bucket_index, bucket);
-
-  result = assoc (object, bucket, closure);
-
-  /* If we got a result, it should not have NULL fields.  */
-  if (scm_is_pair (result) && SCM_WEAK_PAIR_DELETED_P (result))
-    abort ();
-
-  scm_remember_upto_here_1 (strong_refs);
-
-  if (args.removed_items > 0)
-    {
-      /* Update TABLE's item count and optionally trigger a rehash.  */
-      size_t remaining;
-
-      assert (SCM_HASHTABLE_N_ITEMS (table) >= args.removed_items);
-
-      remaining = SCM_HASHTABLE_N_ITEMS (table) - args.removed_items;
-      SCM_SET_HASHTABLE_N_ITEMS (table, remaining);
-
-      if (remaining < SCM_HASHTABLE_LOWER (table))
-	scm_i_rehash (table, hash_fn, closure, "weak_bucket_assoc");
-    }
-
-  return result;
-}
-
-
-/* Packed arguments for `weak_bucket_assoc_by_hash'.  */
-struct assoc_by_hash_data
-{
-  SCM alist;
-  SCM ret;
-  scm_t_hash_predicate_fn predicate;
-  void *closure;
-};
-
-/* See scm_hash_fn_get_handle_by_hash below.  */
-static void*
-weak_bucket_assoc_by_hash (void *args)
-{
-  struct assoc_by_hash_data *data = args;
-  SCM alist = data->alist;
-
-  for (; scm_is_pair (alist); alist = SCM_CDR (alist))
-    {
-      SCM pair = SCM_CAR (alist);
-      
-      if (!SCM_WEAK_PAIR_DELETED_P (pair)
-          && data->predicate (SCM_CAR (pair), data->closure))
-        {
-          data->ret = pair;
-          break;
-        }
-    }
-  return args;
-}
-        
-
-
-static SCM
-make_hash_table (int flags, unsigned long k, const char *func_name) 
+make_hash_table (unsigned long k, const char *func_name) 
 {
   SCM vector;
   scm_t_hashtable *t;
@@ -278,9 +82,6 @@ make_hash_table (int flags, unsigned long k, const char *func_name)
     ++i;
   n = hashtable_size[i];
 
-  /* In both cases, i.e., regardless of whether we are creating a weak hash
-     table, we return a non-weak vector.  This is because the vector itself
-     is not weak in the case of a weak hash table: the alist pairs are.  */
   vector = scm_c_make_vector (n, SCM_EOL);
 
   t = scm_gc_malloc_pointerless (sizeof (*t), s_hashtable);
@@ -288,8 +89,6 @@ make_hash_table (int flags, unsigned long k, const char *func_name)
   t->n_items = 0;
   t->lower = 0;
   t->upper = 9 * n / 10;
-  t->flags = flags;
-  t->hash_fn = NULL;
 
   /* FIXME: we just need two words of storage, not three */
   return scm_double_cell (scm_tc7_hashtable, SCM_UNPACK (vector),
@@ -322,13 +121,6 @@ scm_i_rehash (SCM table,
       if (i >= HASHTABLE_SIZE_N)
 	/* don't rehash */
 	return;
-
-      /* 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;
   
@@ -342,13 +134,6 @@ scm_i_rehash (SCM table,
 
   new_buckets = scm_c_make_vector (new_size, SCM_EOL);
 
-  /* 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);
 
@@ -368,10 +153,6 @@ scm_i_rehash (SCM table,
 	  handle = SCM_CAR (cell);
 	  ls = SCM_CDR (ls);
 
-	  if (SCM_WEAK_PAIR_DELETED_P (handle))
-	    /* HANDLE is a nullified weak pair: skip it.  */
-	    continue;
-
 	  h = hash_fn (SCM_CAR (handle), new_size, closure);
 	  if (h >= new_size)
 	    scm_out_of_range (func_name, scm_from_ulong (h));
@@ -386,14 +167,7 @@ scm_i_rehash (SCM table,
 void
 scm_i_hashtable_print (SCM exp, SCM port, scm_print_state *pstate)
 {
-  scm_puts ("#<", port);
-  if (SCM_HASHTABLE_WEAK_KEY_P (exp))
-    scm_puts ("weak-key-", port);
-  else if (SCM_HASHTABLE_WEAK_VALUE_P (exp))
-    scm_puts ("weak-value-", port);
-  else if (SCM_HASHTABLE_DOUBLY_WEAK_P (exp))
-    scm_puts ("doubly-weak-", port);
-  scm_puts ("hash-table ", port);
+  scm_puts ("#<hash-table ", port);
   scm_uintprint (SCM_HASHTABLE_N_ITEMS (exp), 10, port);
   scm_putc ('/', port);
   scm_uintprint (SCM_SIMPLE_VECTOR_LENGTH (SCM_HASHTABLE_VECTOR (exp)),
@@ -405,7 +179,7 @@ scm_i_hashtable_print (SCM exp, SCM port, scm_print_state *pstate)
 SCM
 scm_c_make_hash_table (unsigned long k)
 {
-  return make_hash_table (0, k, "scm_c_make_hash_table");
+  return make_hash_table (k, "scm_c_make_hash_table");
 }
 
 SCM_DEFINE (scm_make_hash_table, "make-hash-table", 0, 1, 0,
@@ -413,171 +187,18 @@ SCM_DEFINE (scm_make_hash_table, "make-hash-table", 0, 1, 0,
 	    "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))
-    return make_hash_table (0, 0, FUNC_NAME);
-  else
-    return make_hash_table (0, scm_to_ulong (n), FUNC_NAME);
-}
-#undef FUNC_NAME
-
-/* The before-gc C hook only runs if GC_set_start_callback is available,
-   so if not, fall back on a finalizer-based implementation.  */
-static int
-weak_gc_callback (void **weak)
-{
-  void *val = weak[0];
-  void (*callback) (SCM) = weak[1];
-  
-  if (!val)
-    return 0;
-  
-  callback (PTR2SCM (val));
-
-  return 1;
-}
-
-#ifdef HAVE_GC_SET_START_CALLBACK
-static void*
-weak_gc_hook (void *hook_data, void *fn_data, void *data)
-{
-  if (!weak_gc_callback (fn_data))
-    scm_c_hook_remove (&scm_before_gc_c_hook, weak_gc_hook, fn_data);
-
-  return NULL;
-}
-#else
-static void
-weak_gc_finalizer (void *ptr, void *data)
-{
-  if (weak_gc_callback (ptr))
-    GC_REGISTER_FINALIZER_NO_ORDER (ptr, weak_gc_finalizer, data, NULL, NULL);
-}
-#endif
-
-static void
-scm_c_register_weak_gc_callback (SCM obj, void (*callback) (SCM))
-{
-  void **weak = GC_MALLOC_ATOMIC (sizeof (void*) * 2);
-
-  weak[0] = SCM2PTR (obj);
-  weak[1] = (void*)callback;
-  GC_GENERAL_REGISTER_DISAPPEARING_LINK (weak, SCM2PTR (obj));
-
-#ifdef HAVE_GC_SET_START_CALLBACK
-  scm_c_hook_add (&scm_before_gc_c_hook, weak_gc_hook, weak, 0);
-#else
-  GC_REGISTER_FINALIZER_NO_ORDER (weak, weak_gc_finalizer, NULL, NULL, NULL);
-#endif
-}
-
-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.\n"
-	    "\n"
-	    "You can modify weak hash tables in exactly the same way you\n"
-	    "would modify regular hash tables. (@pxref{Hash Tables})")
-#define FUNC_NAME s_scm_make_weak_key_hash_table
-{
-  SCM ret;
-
-  if (SCM_UNBNDP (n))
-    ret = make_hash_table (SCM_HASHTABLEF_WEAK_CAR, 0, FUNC_NAME);
-  else
-    ret = make_hash_table (SCM_HASHTABLEF_WEAK_CAR,
-                           scm_to_ulong (n), FUNC_NAME);
-
-  scm_c_register_weak_gc_callback (ret, vacuum_weak_hash_table);
-
-  return ret;
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_make_weak_value_hash_table, "make-weak-value-hash-table", 0, 1, 0, 
-            (SCM n),
-	    "Return a hash table with weak values with @var{size} buckets.\n"
-	    "(@pxref{Hash Tables})")
-#define FUNC_NAME s_scm_make_weak_value_hash_table
-{
-  SCM ret;
-
-  if (SCM_UNBNDP (n))
-    ret = make_hash_table (SCM_HASHTABLEF_WEAK_CDR, 0, FUNC_NAME);
-  else
-    ret = make_hash_table (SCM_HASHTABLEF_WEAK_CDR,
-                           scm_to_ulong (n), FUNC_NAME);
-
-  scm_c_register_weak_gc_callback (ret, vacuum_weak_hash_table);
-
-  return ret;
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_make_doubly_weak_hash_table, "make-doubly-weak-hash-table", 1, 0, 0, 
-            (SCM n),
-	    "Return a hash table with weak keys and values with @var{size}\n"
-	    "buckets.  (@pxref{Hash Tables})")
-#define FUNC_NAME s_scm_make_doubly_weak_hash_table
-{
-  SCM ret;
-
-  if (SCM_UNBNDP (n))
-    ret = make_hash_table (SCM_HASHTABLEF_WEAK_CAR | SCM_HASHTABLEF_WEAK_CDR,
-                           0, FUNC_NAME);
-  else
-    ret = make_hash_table (SCM_HASHTABLEF_WEAK_CAR | SCM_HASHTABLEF_WEAK_CDR,
-                           scm_to_ulong (n), FUNC_NAME);
-
-  scm_c_register_weak_gc_callback (ret, vacuum_weak_hash_table);
-
-  return ret;
+  return make_hash_table (SCM_UNBNDP (n) ? 0 : scm_to_ulong (n), FUNC_NAME);
 }
 #undef FUNC_NAME
 
+#define SCM_WEAK_TABLE_P(x) (scm_is_true (scm_weak_table_p (x)))
 
 SCM_DEFINE (scm_hash_table_p, "hash-table?", 1, 0, 0, 
             (SCM obj),
 	    "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));
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_weak_key_hash_table_p, "weak-key-hash-table?", 1, 0, 0, 
-           (SCM obj),
-	    "@deffnx {Scheme Procedure} weak-value-hash-table? obj\n"
-	    "@deffnx {Scheme Procedure} doubly-weak-hash-table? obj\n"
-	    "Return @code{#t} if @var{obj} is the specified weak hash\n"
-	    "table. Note that a doubly weak hash table is neither a weak key\n"
-	    "nor a weak value hash table.")
-#define FUNC_NAME s_scm_weak_key_hash_table_p
-{
-  return scm_from_bool (SCM_HASHTABLE_P (obj) && SCM_HASHTABLE_WEAK_KEY_P (obj));
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_weak_value_hash_table_p, "weak-value-hash-table?", 1, 0, 0, 
-            (SCM obj),
-	    "Return @code{#t} if @var{obj} is a weak value hash table.")
-#define FUNC_NAME s_scm_weak_value_hash_table_p
-{
-  return scm_from_bool (SCM_HASHTABLE_P (obj) && SCM_HASHTABLE_WEAK_VALUE_P (obj));
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_doubly_weak_hash_table_p, "doubly-weak-hash-table?", 1, 0, 0, 
-            (SCM obj),
-	    "Return @code{#t} if @var{obj} is a doubly weak hash table.")
-#define FUNC_NAME s_scm_doubly_weak_hash_table_p
-{
-  return scm_from_bool (SCM_HASHTABLE_P (obj) && SCM_HASHTABLE_DOUBLY_WEAK_P (obj));
+  return scm_from_bool (SCM_HASHTABLE_P (obj) || SCM_WEAK_TABLE_P (obj));
 }
 #undef FUNC_NAME
 
@@ -602,69 +223,7 @@ scm_hash_fn_get_handle (SCM table, SCM obj,
   if (k >= SCM_SIMPLE_VECTOR_LENGTH (buckets))
     scm_out_of_range (FUNC_NAME, scm_from_ulong (k));
 
-  if (SCM_HASHTABLE_WEAK_P (table))
-    h = weak_bucket_assoc (table, buckets, k, hash_fn,
-			   assoc_fn, obj, closure);
-  else
-    h = assoc_fn (obj, SCM_SIMPLE_VECTOR_REF (buckets, k), closure);
-
-  return h;
-}
-#undef FUNC_NAME
-
-
-/* This procedure implements three optimizations, with respect to the
-   raw get_handle():
-
-   1. For weak tables, it's assumed that calling the predicate in the
-      allocation lock is safe. In practice this means that the predicate
-      cannot call arbitrary scheme functions. 
-
-   2. We don't check for overflow / underflow and rehash.
-
-   3. We don't actually have to allocate a key -- instead we get the
-      hash value directly. This is useful for, for example, looking up
-      strings in the symbol table.
- */
-SCM
-scm_hash_fn_get_handle_by_hash (SCM table, unsigned long raw_hash,
-                                scm_t_hash_predicate_fn predicate_fn,
-                                void *closure)
-#define FUNC_NAME "scm_hash_fn_ref_by_hash"
-{
-  unsigned long k;
-  SCM buckets, alist, h = SCM_BOOL_F;
-
-  SCM_VALIDATE_HASHTABLE (SCM_ARG1, table);
-  buckets = SCM_HASHTABLE_VECTOR (table);
-
-  if (SCM_SIMPLE_VECTOR_LENGTH (buckets) == 0)
-    return SCM_BOOL_F;
-
-  k = raw_hash % SCM_SIMPLE_VECTOR_LENGTH (buckets);
-  alist = SCM_SIMPLE_VECTOR_REF (buckets, k);
-
-  if (SCM_HASHTABLE_WEAK_P (table))
-    {
-      struct assoc_by_hash_data args;
-
-      args.alist = alist;
-      args.ret = SCM_BOOL_F;
-      args.predicate = predicate_fn;
-      args.closure = closure;
-      GC_call_with_alloc_lock (weak_bucket_assoc_by_hash, &args);
-      h = args.ret;
-    }
-  else
-    for (; scm_is_pair (alist); alist = SCM_CDR (alist))
-      {
-        SCM pair = SCM_CAR (alist);
-        if (predicate_fn (SCM_CAR (pair), closure))
-          {
-            h = pair;
-            break;
-          }
-      }
+  h = assoc_fn (obj, SCM_SIMPLE_VECTOR_REF (buckets, k), closure);
 
   return h;
 }
@@ -690,11 +249,7 @@ scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init,
   if (k >= SCM_SIMPLE_VECTOR_LENGTH (buckets))
     scm_out_of_range ("hash_fn_create_handle_x", scm_from_ulong (k));
 
-  if (SCM_HASHTABLE_WEAK_P (table))
-    it = weak_bucket_assoc (table, buckets, k, hash_fn,
-			    assoc_fn, obj, closure);
-  else
-    it = assoc_fn (obj, SCM_SIMPLE_VECTOR_REF (buckets, k), closure);
+  it = assoc_fn (obj, SCM_SIMPLE_VECTOR_REF (buckets, k), closure);
 
   if (scm_is_pair (it))
     return it;
@@ -702,29 +257,9 @@ scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init,
     scm_wrong_type_arg_msg (NULL, 0, it, "a pair");
   else
     {
-      /* 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 handle, new_bucket;
 
-      if (SCM_HASHTABLE_WEAK_P (table))
-	{
-	  /* FIXME: We don't support weak alist vectors.  */
-	  /* Use a weak cell.  */
-	  if (SCM_HASHTABLE_DOUBLY_WEAK_P (table))
-	    handle = scm_doubly_weak_pair (obj, init);
-	  else if (SCM_HASHTABLE_WEAK_KEY_P (table))
-	    handle = scm_weak_car_pair (obj, init);
-	  else
-	    handle = scm_weak_cdr_pair (obj, init);
-	}
-      else
-	/* Use a regular, non-weak cell.  */
-	handle = scm_cons (obj, init);
-
+      handle = scm_cons (obj, init);
       new_bucket = scm_cons (handle, SCM_EOL);
 
       if (!scm_is_eq (SCM_HASHTABLE_VECTOR (table), buckets))
@@ -760,36 +295,6 @@ scm_hash_fn_ref (SCM table, SCM obj, SCM dflt,
     return dflt;
 }
 
-struct weak_cdr_data
-{
-  SCM pair;
-  SCM cdr;
-};
-
-static void*
-get_weak_cdr (void *data)
-{
-  struct weak_cdr_data *d = data;
-
-  if (SCM_WEAK_PAIR_CDR_DELETED_P (d->pair))
-    d->cdr = SCM_BOOL_F;
-  else
-    d->cdr = SCM_CDR (d->pair);
-
-  return NULL;
-}
-
-static SCM
-weak_pair_cdr (SCM x)
-{
-  struct weak_cdr_data data;
-
-  data.pair = x;
-  GC_call_with_alloc_lock (get_weak_cdr, &data);
-
-  return data.cdr;
-}
-
 SCM
 scm_hash_fn_set_x (SCM table, SCM obj, SCM val,
 		   scm_t_hash_fn hash_fn, scm_t_assoc_fn assoc_fn,
@@ -801,24 +306,7 @@ scm_hash_fn_set_x (SCM table, SCM obj, SCM val,
                                       hash_fn, assoc_fn, closure);
 
   if (!scm_is_eq (SCM_CDR (pair), val))
-    {
-      if (SCM_UNLIKELY (SCM_HASHTABLE_WEAK_VALUE_P (table)))
-        {
-          /* If the former value was on the heap, we need to unregister
-             the weak link.  */
-          SCM prev = weak_pair_cdr (pair);
-          
-          SCM_SETCDR (pair, val);
-
-          if (SCM_NIMP (prev) && !SCM_NIMP (val))
-            GC_unregister_disappearing_link ((GC_PTR) SCM_CDRLOC (pair));
-          else
-            SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) SCM_CDRLOC (pair),
-                                              (GC_PTR) SCM2PTR (val));
-        }
-      else
-        SCM_SETCDR (pair, val);
-    }
+    SCM_SETCDR (pair, val);
   
   return val;
 }
@@ -845,11 +333,7 @@ scm_hash_fn_remove_x (SCM table, SCM obj,
   if (k >= SCM_SIMPLE_VECTOR_LENGTH (buckets))
     scm_out_of_range (FUNC_NAME, scm_from_ulong (k));
 
-  if (SCM_HASHTABLE_WEAK_P (table))
-    h = weak_bucket_assoc (table, buckets, k, hash_fn,
-			   assoc_fn, obj, closure);
-  else
-    h = assoc_fn (obj, SCM_SIMPLE_VECTOR_REF (buckets, k), closure);
+  h = assoc_fn (obj, SCM_SIMPLE_VECTOR_REF (buckets, k), closure);
 
   if (scm_is_true (h))
     {
@@ -868,6 +352,9 @@ SCM_DEFINE (scm_hash_clear_x, "hash-clear!", 1, 0, 0,
 	    "Remove all items from @var{table} (without triggering a resize).")
 #define FUNC_NAME s_scm_hash_clear_x
 {
+  if (SCM_WEAK_TABLE_P (table))
+    return scm_weak_table_clear_x (table);
+
   SCM_VALIDATE_HASHTABLE (SCM_ARG1, table);
 
   scm_vector_fill_x (SCM_HASHTABLE_VECTOR (table), SCM_EOL);
@@ -887,9 +374,6 @@ SCM_DEFINE (scm_hashq_get_handle, "hashq-get-handle", 2, 0, 0,
 	    "Uses @code{eq?} for equality testing.")
 #define FUNC_NAME s_scm_hashq_get_handle
 {
-  if (SCM_UNLIKELY (SCM_HASHTABLE_P (table) && SCM_HASHTABLE_WEAK_P (table)))
-    SCM_MISC_ERROR ("Handle access not permitted on weak table", SCM_EOL);
-
   return scm_hash_fn_get_handle (table, key,
 				 (scm_t_hash_fn) scm_ihashq,
 				 (scm_t_assoc_fn) scm_sloppy_assq,
@@ -905,9 +389,6 @@ SCM_DEFINE (scm_hashq_create_handle_x, "hashq-create-handle!", 3, 0, 0,
 	    "associates @var{key} with @var{init}.")
 #define FUNC_NAME s_scm_hashq_create_handle_x
 {
-  if (SCM_UNLIKELY (SCM_HASHTABLE_P (table) && SCM_HASHTABLE_WEAK_P (table)))
-    SCM_MISC_ERROR ("Handle access not permitted on weak table", SCM_EOL);
-
   return scm_hash_fn_create_handle_x (table, key, init,
 				      (scm_t_hash_fn) scm_ihashq,
 				      (scm_t_assoc_fn) scm_sloppy_assq,
@@ -926,6 +407,10 @@ SCM_DEFINE (scm_hashq_ref, "hashq-ref", 2, 1, 0,
 {
   if (SCM_UNBNDP (dflt))
     dflt = SCM_BOOL_F;
+
+  if (SCM_WEAK_TABLE_P (table))
+    return scm_weak_table_refq (table, key, dflt);
+
   return scm_hash_fn_ref (table, key, dflt,
 			  (scm_t_hash_fn) scm_ihashq,
 			  (scm_t_assoc_fn) scm_sloppy_assq,
@@ -941,6 +426,9 @@ SCM_DEFINE (scm_hashq_set_x, "hashq-set!", 3, 0, 0,
 	    "store @var{value} there. Uses @code{eq?} for equality testing.")
 #define FUNC_NAME s_scm_hashq_set_x
 {
+  if (SCM_WEAK_TABLE_P (table))
+    return scm_weak_table_putq_x (table, key, val);
+
   return scm_hash_fn_set_x (table, key, val,
 			    (scm_t_hash_fn) scm_ihashq,
 			    (scm_t_assoc_fn) scm_sloppy_assq,
@@ -956,6 +444,9 @@ 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
 {
+  if (SCM_WEAK_TABLE_P (table))
+    return scm_weak_table_remq_x (table, key);
+
   return scm_hash_fn_remove_x (table, key,
 			       (scm_t_hash_fn) scm_ihashq,
 			       (scm_t_assoc_fn) scm_sloppy_assq,
@@ -974,9 +465,6 @@ SCM_DEFINE (scm_hashv_get_handle, "hashv-get-handle", 2, 0, 0,
 	    "Uses @code{eqv?} for equality testing.")
 #define FUNC_NAME s_scm_hashv_get_handle
 {
-  if (SCM_UNLIKELY (SCM_HASHTABLE_P (table) && SCM_HASHTABLE_WEAK_P (table)))
-    SCM_MISC_ERROR ("Handle access not permitted on weak table", SCM_EOL);
-
   return scm_hash_fn_get_handle (table, key,
 				 (scm_t_hash_fn) scm_ihashv,
 				 (scm_t_assoc_fn) scm_sloppy_assv,
@@ -992,9 +480,6 @@ SCM_DEFINE (scm_hashv_create_handle_x, "hashv-create-handle!", 3, 0, 0,
 	    "associates @var{key} with @var{init}.")
 #define FUNC_NAME s_scm_hashv_create_handle_x
 {
-  if (SCM_UNLIKELY (SCM_HASHTABLE_P (table) && SCM_HASHTABLE_WEAK_P (table)))
-    SCM_MISC_ERROR ("Handle access not permitted on weak table", SCM_EOL);
-
   return scm_hash_fn_create_handle_x (table, key, init,
 				      (scm_t_hash_fn) scm_ihashv,
 				      (scm_t_assoc_fn) scm_sloppy_assv,
@@ -1003,6 +488,12 @@ SCM_DEFINE (scm_hashv_create_handle_x, "hashv-create-handle!", 3, 0, 0,
 #undef FUNC_NAME
 
 
+static int
+assv_predicate (SCM k, SCM v, void *closure)
+{
+  return scm_is_true (scm_eqv_p (k, PTR2SCM (closure)));
+}
+
 SCM_DEFINE (scm_hashv_ref, "hashv-ref", 2, 1, 0,
             (SCM table, SCM key, SCM dflt),
 	    "Look up @var{key} in the hash table @var{table}, and return the\n"
@@ -1013,6 +504,11 @@ SCM_DEFINE (scm_hashv_ref, "hashv-ref", 2, 1, 0,
 {
   if (SCM_UNBNDP (dflt))
     dflt = SCM_BOOL_F;
+
+  if (SCM_WEAK_TABLE_P (table))
+    return scm_c_weak_table_ref (table, scm_ihashv (key, -1),
+                                 assv_predicate, SCM_PACK (key), dflt);
+
   return scm_hash_fn_ref (table, key, dflt,
 			  (scm_t_hash_fn) scm_ihashv,
 			  (scm_t_assoc_fn) scm_sloppy_assv,
@@ -1028,6 +524,14 @@ SCM_DEFINE (scm_hashv_set_x, "hashv-set!", 3, 0, 0,
 	    "store @var{value} there. Uses @code{eqv?} for equality testing.")
 #define FUNC_NAME s_scm_hashv_set_x
 {
+  if (SCM_WEAK_TABLE_P (table))
+    {
+      scm_c_weak_table_put_x (table, scm_ihashv (key, -1),
+                              assv_predicate, SCM_PACK (key),
+                              key, val);
+      return SCM_UNSPECIFIED;
+    }
+
   return scm_hash_fn_set_x (table, key, val,
 			    (scm_t_hash_fn) scm_ihashv,
 			    (scm_t_assoc_fn) scm_sloppy_assv,
@@ -1042,6 +546,13 @@ 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
 {
+  if (SCM_WEAK_TABLE_P (table))
+    {
+      scm_c_weak_table_remove_x (table, scm_ihashv (key, -1),
+                                 assv_predicate, SCM_PACK (key));
+      return SCM_UNSPECIFIED;
+    }
+
   return scm_hash_fn_remove_x (table, key,
 			       (scm_t_hash_fn) scm_ihashv,
 			       (scm_t_assoc_fn) scm_sloppy_assv,
@@ -1059,9 +570,6 @@ SCM_DEFINE (scm_hash_get_handle, "hash-get-handle", 2, 0, 0,
 	    "Uses @code{equal?} for equality testing.")
 #define FUNC_NAME s_scm_hash_get_handle
 {
-  if (SCM_UNLIKELY (SCM_HASHTABLE_P (table) && SCM_HASHTABLE_WEAK_P (table)))
-    SCM_MISC_ERROR ("Handle access not permitted on weak table", SCM_EOL);
-
   return scm_hash_fn_get_handle (table, key,
 				 (scm_t_hash_fn) scm_ihash,
 				 (scm_t_assoc_fn) scm_sloppy_assoc,
@@ -1077,9 +585,6 @@ SCM_DEFINE (scm_hash_create_handle_x, "hash-create-handle!", 3, 0, 0,
 	    "associates @var{key} with @var{init}.")
 #define FUNC_NAME s_scm_hash_create_handle_x
 {
-  if (SCM_UNLIKELY (SCM_HASHTABLE_P (table) && SCM_HASHTABLE_WEAK_P (table)))
-    SCM_MISC_ERROR ("Handle access not permitted on weak table", SCM_EOL);
-
   return scm_hash_fn_create_handle_x (table, key, init,
 				      (scm_t_hash_fn) scm_ihash,
 				      (scm_t_assoc_fn) scm_sloppy_assoc,
@@ -1088,6 +593,12 @@ SCM_DEFINE (scm_hash_create_handle_x, "hash-create-handle!", 3, 0, 0,
 #undef FUNC_NAME
 
 
+static int
+assoc_predicate (SCM k, SCM v, void *closure)
+{
+  return scm_is_true (scm_equal_p (k, PTR2SCM (closure)));
+}
+
 SCM_DEFINE (scm_hash_ref, "hash-ref", 2, 1, 0,
             (SCM table, SCM key, SCM dflt),
 	    "Look up @var{key} in the hash table @var{table}, and return the\n"
@@ -1098,6 +609,11 @@ SCM_DEFINE (scm_hash_ref, "hash-ref", 2, 1, 0,
 {
   if (SCM_UNBNDP (dflt))
     dflt = SCM_BOOL_F;
+
+  if (SCM_WEAK_TABLE_P (table))
+    return scm_c_weak_table_ref (table, scm_ihash (key, -1),
+                                 assoc_predicate, SCM_PACK (key), dflt);
+
   return scm_hash_fn_ref (table, key, dflt,
 			  (scm_t_hash_fn) scm_ihash,
 			  (scm_t_assoc_fn) scm_sloppy_assoc,
@@ -1114,6 +630,14 @@ SCM_DEFINE (scm_hash_set_x, "hash-set!", 3, 0, 0,
 	    "testing.")
 #define FUNC_NAME s_scm_hash_set_x
 {
+  if (SCM_WEAK_TABLE_P (table))
+    {
+      scm_c_weak_table_put_x (table, scm_ihash (key, -1),
+                              assoc_predicate, SCM_PACK (key),
+                              key, val);
+      return SCM_UNSPECIFIED;
+    }
+
   return scm_hash_fn_set_x (table, key, val,
 			    (scm_t_hash_fn) scm_ihash,
 			    (scm_t_assoc_fn) scm_sloppy_assoc,
@@ -1129,6 +653,13 @@ 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
 {
+  if (SCM_WEAK_TABLE_P (table))
+    {
+      scm_c_weak_table_remove_x (table, scm_ihash (key, -1),
+                                 assoc_predicate, SCM_PACK (key));
+      return SCM_UNSPECIFIED;
+    }
+
   return scm_hash_fn_remove_x (table, key,
 			       (scm_t_hash_fn) scm_ihash,
 			       (scm_t_assoc_fn) scm_sloppy_assoc,
@@ -1143,10 +674,9 @@ typedef struct scm_t_ihashx_closure
 {
   SCM hash;
   SCM assoc;
+  SCM key;
 } scm_t_ihashx_closure;
 
-
-
 static unsigned long
 scm_ihashx (SCM obj, unsigned long n, void *arg)
 {
@@ -1156,8 +686,6 @@ scm_ihashx (SCM obj, unsigned long n, void *arg)
   return scm_to_ulong (answer);
 }
 
-
-
 static SCM
 scm_sloppy_assx (SCM obj, SCM alist, void *arg)
 {
@@ -1165,6 +693,20 @@ scm_sloppy_assx (SCM obj, SCM alist, void *arg)
   return scm_call_2 (closure->assoc, obj, alist);
 }
 
+static int
+assx_predicate (SCM k, SCM v, void *closure)
+{
+  scm_t_ihashx_closure *c = (scm_t_ihashx_closure *) closure;
+
+  /* FIXME: The hashx interface is crazy.  Hash tables have nothing to
+     do with alists in principle.  Instead of getting an assoc proc,
+     hashx functions should use an equality predicate.  Perhaps we can
+     change this before 2.2, but until then, add a terrible, terrible
+     hack.  */
+
+  return scm_is_true (scm_call_2 (c->assoc, c->key, scm_acons (k, v, SCM_EOL)));
+}
+
 
 SCM_DEFINE (scm_hashx_get_handle, "hashx-get-handle", 4, 0, 0, 
             (SCM hash, SCM assoc, SCM table, SCM key),
@@ -1179,9 +721,7 @@ SCM_DEFINE (scm_hashx_get_handle, "hashx-get-handle", 4, 0, 0,
   scm_t_ihashx_closure closure;
   closure.hash = hash;
   closure.assoc = assoc;
-
-  if (SCM_UNLIKELY (SCM_HASHTABLE_P (table) && SCM_HASHTABLE_WEAK_P (table)))
-    SCM_MISC_ERROR ("Handle access not permitted on weak table", SCM_EOL);
+  closure.key = key;
 
   return scm_hash_fn_get_handle (table, key, scm_ihashx, scm_sloppy_assx,
 				 (void *) &closure);
@@ -1202,9 +742,7 @@ SCM_DEFINE (scm_hashx_create_handle_x, "hashx-create-handle!", 5, 0, 0,
   scm_t_ihashx_closure closure;
   closure.hash = hash;
   closure.assoc = assoc;
-
-  if (SCM_UNLIKELY (SCM_HASHTABLE_P (table) && SCM_HASHTABLE_WEAK_P (table)))
-    SCM_MISC_ERROR ("Handle access not permitted on weak table", SCM_EOL);
+  closure.key = key;
 
   return scm_hash_fn_create_handle_x (table, key, init, scm_ihashx,
 				      scm_sloppy_assx, (void *)&closure);
@@ -1231,6 +769,15 @@ SCM_DEFINE (scm_hashx_ref, "hashx-ref", 4, 1, 0,
     dflt = SCM_BOOL_F;
   closure.hash = hash;
   closure.assoc = assoc;
+  closure.key = key;
+
+  if (SCM_WEAK_TABLE_P (table))
+    {
+      unsigned long h = scm_to_ulong (scm_call_2 (hash, key,
+                                                  scm_from_ulong (-1)));
+      return scm_c_weak_table_ref (table, h, assx_predicate, &closure, dflt);
+    }
+
   return scm_hash_fn_ref (table, key, dflt, scm_ihashx, scm_sloppy_assx,
 			  (void *)&closure);
 }
@@ -1255,6 +802,16 @@ SCM_DEFINE (scm_hashx_set_x, "hashx-set!", 5, 0, 0,
   scm_t_ihashx_closure closure;
   closure.hash = hash;
   closure.assoc = assoc;
+  closure.key = key;
+
+  if (SCM_WEAK_TABLE_P (table))
+    {
+      unsigned long h = scm_to_ulong (scm_call_2 (hash, key,
+                                                  scm_from_ulong (-1)));
+      scm_c_weak_table_put_x (table, h, assx_predicate, &closure, key, val);
+      return SCM_UNSPECIFIED;
+    }
+
   return scm_hash_fn_set_x (table, key, val, scm_ihashx, scm_sloppy_assx,
 			    (void *)&closure);
 }
@@ -1276,6 +833,16 @@ SCM_DEFINE (scm_hashx_remove_x, "hashx-remove!", 4, 0, 0,
   scm_t_ihashx_closure closure;
   closure.hash = hash;
   closure.assoc = assoc;
+  closure.key = obj;
+
+  if (SCM_WEAK_TABLE_P (table))
+    {
+      unsigned long h = scm_to_ulong (scm_call_2 (hash, obj,
+                                                  scm_from_ulong (-1)));
+      scm_c_weak_table_remove_x (table, h, assx_predicate, &closure);
+      return SCM_UNSPECIFIED;
+    }
+
   return scm_hash_fn_remove_x (table, obj, scm_ihashx, scm_sloppy_assx,
                                (void *) &closure);
 }
@@ -1296,6 +863,10 @@ SCM_DEFINE (scm_hash_fold, "hash-fold", 3, 0, 0,
 #define FUNC_NAME s_scm_hash_fold
 {
   SCM_VALIDATE_PROC (1, proc);
+
+  if (SCM_WEAK_TABLE_P (table))
+    return scm_weak_table_fold (proc, init, table);
+
   SCM_VALIDATE_HASHTABLE (3, table);
   return scm_internal_hash_fold ((scm_t_hash_fold_fn) scm_call_3,
 				 (void *) SCM_UNPACK (proc), init, table);
@@ -1317,6 +888,10 @@ SCM_DEFINE (scm_hash_for_each, "hash-for-each", 2, 0, 0,
 #define FUNC_NAME s_scm_hash_for_each
 {
   SCM_VALIDATE_PROC (1, proc);
+
+  if (SCM_WEAK_TABLE_P (table))
+    return scm_weak_table_for_each (proc, table);
+
   SCM_VALIDATE_HASHTABLE (2, table);
   
   scm_internal_hash_for_each_handle (for_each_proc,
@@ -1335,9 +910,6 @@ SCM_DEFINE (scm_hash_for_each_handle, "hash-for-each-handle", 2, 0, 0,
   SCM_ASSERT (scm_is_true (scm_procedure_p (proc)), proc, 1, FUNC_NAME);
   SCM_VALIDATE_HASHTABLE (2, table);
   
-  if (SCM_UNLIKELY (SCM_HASHTABLE_WEAK_P (table)))
-    SCM_MISC_ERROR ("Handle access not permitted on weak table", SCM_EOL);
-
   scm_internal_hash_for_each_handle ((scm_t_hash_handle_fn) scm_call_1,
 				     (void *) SCM_UNPACK (proc),
 				     table);
@@ -1360,6 +932,10 @@ SCM_DEFINE (scm_hash_map_to_list, "hash-map->list", 2, 0, 0,
 #define FUNC_NAME s_scm_hash_map_to_list
 {
   SCM_VALIDATE_PROC (1, proc);
+
+  if (SCM_WEAK_TABLE_P (table))
+    return scm_weak_table_map_to_list (proc, table);
+
   SCM_VALIDATE_HASHTABLE (2, table);
   return scm_internal_hash_fold (map_proc,
 				 (void *) SCM_UNPACK (proc),
@@ -1378,6 +954,9 @@ scm_internal_hash_fold (scm_t_hash_fold_fn fn, void *closure,
   long i, n;
   SCM buckets, result = init;
   
+  if (SCM_WEAK_TABLE_P (table))
+    return scm_c_weak_table_fold (fn, closure, init, table);
+
   SCM_VALIDATE_HASHTABLE (0, table);
   buckets = SCM_HASHTABLE_VECTOR (table);
   
@@ -1390,14 +969,7 @@ scm_internal_hash_fold (scm_t_hash_fold_fn fn, void *closure,
 	   ls = SCM_CDR (ls))
 	{
 	  handle = SCM_CAR (ls);
-
-	  if (SCM_HASHTABLE_WEAK_P (table) && SCM_WEAK_PAIR_DELETED_P (handle))
-            /* Don't try to unlink this weak pair, as we're not within
-               the allocation lock.  Instead rely on
-               vacuum_weak_hash_table to do its job.  */
-            continue;
-          else
-            result = fn (closure, SCM_CAR (handle), SCM_CDR (handle), result);
+          result = fn (closure, SCM_CAR (handle), SCM_CDR (handle), result);
 	}
     }
 
diff --git a/libguile/hashtab.h b/libguile/hashtab.h
index 314994630..fdd746c98 100644
--- a/libguile/hashtab.h
+++ b/libguile/hashtab.h
@@ -3,7 +3,7 @@
 #ifndef SCM_HASHTAB_H
 #define SCM_HASHTAB_H
 
-/* Copyright (C) 1995,1996,1999,2000,2001, 2003, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1999,2000,2001, 2003, 2004, 2006, 2008, 2009, 2011 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
@@ -25,29 +25,14 @@
 
 #include "libguile/__scm.h"
 
-#include "weaks.h"
-
 
 
-#define SCM_HASHTABLEF_WEAK_CAR SCM_WVECTF_WEAK_KEY
-#define SCM_HASHTABLEF_WEAK_CDR SCM_WVECTF_WEAK_VALUE
-
 #define SCM_HASHTABLE_P(x) (!SCM_IMP (x) && SCM_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_FLAGS(x)	   (SCM_HASHTABLE (x)->flags)
-#define SCM_HASHTABLE_WEAK_KEY_P(x) \
-  (SCM_HASHTABLE_FLAGS (x) & SCM_HASHTABLEF_WEAK_CAR)
-#define SCM_HASHTABLE_WEAK_VALUE_P(x) \
-  (SCM_HASHTABLE_FLAGS (x) & SCM_HASHTABLEF_WEAK_CDR)
-#define SCM_HASHTABLE_DOUBLY_WEAK_P(x)				\
-  ((SCM_HASHTABLE_FLAGS (x)					\
-    & (SCM_HASHTABLEF_WEAK_CAR | SCM_HASHTABLEF_WEAK_CDR))	\
-   == (SCM_HASHTABLEF_WEAK_CAR | SCM_HASHTABLEF_WEAK_CDR))
-#define SCM_HASHTABLE_WEAK_P(x)	   SCM_HASHTABLE_FLAGS (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)++)
@@ -70,10 +55,6 @@ typedef unsigned long (*scm_t_hash_fn) (SCM obj, unsigned long max,
    some equality predicate.  */
 typedef SCM (*scm_t_assoc_fn) (SCM obj, SCM alist, void *closure);
 
-/* Function that returns true if the given object is the one we are
-   looking for, for scm_hash_fn_ref_by_hash.  */
-typedef int (*scm_t_hash_predicate_fn) (SCM obj, void *closure);
-
 /* Function to fold over the entries of a hash table.  */
 typedef SCM (*scm_t_hash_fold_fn) (void *closure, SCM key, SCM value,
 				   SCM result);
@@ -83,7 +64,6 @@ 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 {
-  int flags;			/* properties of table */
   unsigned long n_items;	/* number of items in table */
   unsigned long lower;		/* when to shrink */
   unsigned long upper;		/* when to grow */
@@ -97,14 +77,8 @@ typedef struct scm_t_hashtable {
 SCM_API SCM scm_vector_to_hash_table (SCM vector);
 SCM_API SCM scm_c_make_hash_table (unsigned long k);
 SCM_API SCM scm_make_hash_table (SCM n);
-SCM_API SCM scm_make_weak_key_hash_table (SCM k);
-SCM_API SCM scm_make_weak_value_hash_table (SCM k);
-SCM_API SCM scm_make_doubly_weak_hash_table (SCM k);
 
 SCM_API SCM scm_hash_table_p (SCM h);
-SCM_API SCM scm_weak_key_hash_table_p (SCM h);
-SCM_API SCM scm_weak_value_hash_table_p (SCM h);
-SCM_API SCM scm_doubly_weak_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);
@@ -114,10 +88,6 @@ SCM_API SCM scm_hash_fn_get_handle (SCM table, SCM obj,
 				    scm_t_hash_fn hash_fn,
 				    scm_t_assoc_fn assoc_fn,
 				    void *closure);
-SCM_INTERNAL
-SCM scm_hash_fn_get_handle_by_hash (SCM table, unsigned long raw_hash,
-                                    scm_t_hash_predicate_fn predicate_fn,
-                                    void *closure);
 SCM_API SCM scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init,
 					 scm_t_hash_fn hash_fn,
 					 scm_t_assoc_fn assoc_fn,
diff --git a/libguile/weak-table.c b/libguile/weak-table.c
index fb4776322..160eca2cf 100644
--- a/libguile/weak-table.c
+++ b/libguile/weak-table.c
@@ -1024,6 +1024,90 @@ scm_weak_table_map_to_list (SCM proc, SCM table)
 #undef FUNC_NAME
 
 
+
+
+/* Legacy interface.  */
+
+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.\n"
+	    "\n"
+	    "You can modify weak hash tables in exactly the same way you\n"
+	    "would modify regular hash tables. (@pxref{Hash Tables})")
+#define FUNC_NAME s_scm_make_weak_key_hash_table
+{
+  return scm_c_make_weak_table (SCM_UNBNDP (n) ? 0 : scm_to_ulong (n),
+                                SCM_WEAK_TABLE_KIND_KEY);
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_make_weak_value_hash_table, "make-weak-value-hash-table", 0, 1, 0, 
+            (SCM n),
+	    "Return a hash table with weak values with @var{size} buckets.\n"
+	    "(@pxref{Hash Tables})")
+#define FUNC_NAME s_scm_make_weak_value_hash_table
+{
+  return scm_c_make_weak_table (SCM_UNBNDP (n) ? 0 : scm_to_ulong (n),
+                                SCM_WEAK_TABLE_KIND_VALUE);
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_make_doubly_weak_hash_table, "make-doubly-weak-hash-table", 1, 0, 0, 
+            (SCM n),
+	    "Return a hash table with weak keys and values with @var{size}\n"
+	    "buckets.  (@pxref{Hash Tables})")
+#define FUNC_NAME s_scm_make_doubly_weak_hash_table
+{
+  return scm_c_make_weak_table (SCM_UNBNDP (n) ? 0 : scm_to_ulong (n),
+                                SCM_WEAK_TABLE_KIND_BOTH);
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_weak_key_hash_table_p, "weak-key-hash-table?", 1, 0, 0, 
+           (SCM obj),
+	    "@deffnx {Scheme Procedure} weak-value-hash-table? obj\n"
+	    "@deffnx {Scheme Procedure} doubly-weak-hash-table? obj\n"
+	    "Return @code{#t} if @var{obj} is the specified weak hash\n"
+	    "table. Note that a doubly weak hash table is neither a weak key\n"
+	    "nor a weak value hash table.")
+#define FUNC_NAME s_scm_weak_key_hash_table_p
+{
+  return scm_from_bool (SCM_WEAK_TABLE_P (obj) &&
+                        SCM_WEAK_TABLE (obj)->kind == SCM_WEAK_TABLE_KIND_KEY);
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_weak_value_hash_table_p, "weak-value-hash-table?", 1, 0, 0, 
+            (SCM obj),
+	    "Return @code{#t} if @var{obj} is a weak value hash table.")
+#define FUNC_NAME s_scm_weak_value_hash_table_p
+{
+  return scm_from_bool (SCM_WEAK_TABLE_P (obj) &&
+                        SCM_WEAK_TABLE (obj)->kind == SCM_WEAK_TABLE_KIND_VALUE);
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_doubly_weak_hash_table_p, "doubly-weak-hash-table?", 1, 0, 0, 
+            (SCM obj),
+	    "Return @code{#t} if @var{obj} is a doubly weak hash table.")
+#define FUNC_NAME s_scm_doubly_weak_hash_table_p
+{
+  return scm_from_bool (SCM_WEAK_TABLE_P (obj) &&
+                        SCM_WEAK_TABLE (obj)->kind == SCM_WEAK_TABLE_KIND_BOTH);
+}
+#undef FUNC_NAME
+
+
+
+
+
 void
 scm_weak_table_prehistory (void)
 {
diff --git a/libguile/weak-table.h b/libguile/weak-table.h
index 10cfc99ca..cb2831c3a 100644
--- a/libguile/weak-table.h
+++ b/libguile/weak-table.h
@@ -69,6 +69,18 @@ SCM_INTERNAL SCM scm_weak_table_fold (SCM proc, SCM init, SCM table);
 SCM_INTERNAL SCM scm_weak_table_for_each (SCM proc, SCM table);
 SCM_INTERNAL SCM scm_weak_table_map_to_list (SCM proc, SCM table);
 
+
+
+/* Legacy interface.  */
+SCM_API SCM scm_make_weak_key_hash_table (SCM k);
+SCM_API SCM scm_make_weak_value_hash_table (SCM k);
+SCM_API SCM scm_make_doubly_weak_hash_table (SCM k);
+SCM_API SCM scm_weak_key_hash_table_p (SCM h);
+SCM_API SCM scm_weak_value_hash_table_p (SCM h);
+SCM_API SCM scm_doubly_weak_hash_table_p (SCM h);
+
+
+
 SCM_INTERNAL void scm_i_weak_table_print (SCM exp, SCM port, scm_print_state *pstate);
 SCM_INTERNAL void scm_weak_table_prehistory (void);
 SCM_INTERNAL void scm_init_weak_table (void);