Weak Vectors Patch

[Clinton Ebadi <clinton@unknownlamer.org>]

[-- Attachment #1: Type: text/plain, Size: 647 bytes --]


Attached is a patch that should improve weak vectors and prevent
`vector-ref' from segfaulting on them after a GC.

The root of the problem was that weak vectors were being allocated as
containing no pointers *and* disappearing links were not being
registered for initial elements. If you, however, created an empty weak
vector and then `vector-set!' the elements things were fine.

I'm not sure that weak vectors should have their allocated memory marked
as containing no pointers, but it seems to work so I left that alone in
case there was some magic going on that I didn't quite grok.

CC any replies to me; I'm not subscribed to bug-guile.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Fix-weak-vectors.patch --]
[-- Type: text/x-diff, Size: 4810 bytes --]

From a20475f1f9643093ea96118a71826623ecf15220 Mon Sep 17 00:00:00 2001
From: Clinton Ebadi <clinton@unknownlamer.org>
Date: Thu, 1 Apr 2010 13:11:10 -0400
Subject: [PATCH] Fix weak vectors
 * libguile/vectors.c (scm_i_make_weak_vector,
   scm_i_make_weak_vector_from_list): Register elements as disappearing links.
 * libguile/vectors.c (do_weak_vector_ref): New function to access an
   element of a weak vector while the allocator lock is held.
 * libguile/vectors.c (scm_c_vector_ref): Use `do_weak_vector_ref' when
   accessing weak vectors.
 * libguile/vectors.c (scm_c_vector_set_x): Deregister link before
   registering disappearing link to new object. Might not be needed.
 * libguile/vectors.c (scm_c_vector_ref, scm_c_vector_set_x): Only
   check for NULLified pointers in weak vectors and not in weak hash
   vectors (the elements of a WHVEC are not weak).

---
 libguile/vectors.c |   66 ++++++++++++++++++++++++++++++++++++++-------------
 1 files changed, 49 insertions(+), 17 deletions(-)

diff --git a/libguile/vectors.c b/libguile/vectors.c
index 6ac5acb..f72c927 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -203,22 +203,46 @@ scm_vector_ref (SCM v, SCM k)
 }
 #undef FUNC_NAME
 
+struct t_weak_vector_ref_args
+{
+  SCM vector;
+  size_t k;
+};
+
+/* Accessing weak pointers *must* be done with the allocator lock held */
+static void* 
+do_weak_vector_ref (void* data)
+{
+  struct t_weak_vector_ref_args *args = (struct t_weak_vector_ref_args *) data;
+  register SCM elt = (SCM_I_VECTOR_ELTS(args->vector))[args->k];
+
+  if (elt == SCM_PACK (NULL))
+    /* ELT was a weak pointer and got nullified by the GC.  */
+    return SCM_BOOL_F;  
+
+  return elt;
+}
+
 SCM
 scm_c_vector_ref (SCM v, size_t k)
 {
   if (SCM_I_IS_VECTOR (v))
     {
-      register SCM elt;
-
       if (k >= SCM_I_VECTOR_LENGTH (v))
 	scm_out_of_range (NULL, scm_from_size_t (k));
-      elt = (SCM_I_VECTOR_ELTS(v))[k];
 
-      if ((elt == SCM_PACK (NULL)) && SCM_I_WVECTP (v))
-	/* ELT was a weak pointer and got nullified by the GC.  */
-	return SCM_BOOL_F;
+      if (SCM_I_WVECTP (v) && !SCM_IS_WHVEC (v))
+	{
+	  struct t_weak_vector_ref_args args;
+	  args.vector = v;
+	  args.k = k;
 
-      return elt;
+	  return GC_call_with_alloc_lock (do_weak_vector_ref, &args);
+	}
+      else
+	{
+	  return (SCM_I_VECTOR_ELTS(v))[k];
+	}
     }
   else if (SCM_I_ARRAYP (v) && SCM_I_ARRAY_NDIM (v) == 1)
     {
@@ -226,18 +250,20 @@ scm_c_vector_ref (SCM v, size_t k)
       SCM vv = SCM_I_ARRAY_V (v);
       if (SCM_I_IS_VECTOR (vv))
 	{
-	  register SCM elt;
-
 	  if (k >= dim->ubnd - dim->lbnd + 1)
 	    scm_out_of_range (NULL, scm_from_size_t (k));
 	  k = SCM_I_ARRAY_BASE (v) + k*dim->inc;
-	  elt = (SCM_I_VECTOR_ELTS (vv))[k];
 
-	  if ((elt == SCM_PACK (NULL)) && (SCM_I_WVECTP (vv)))
-	    /* ELT was a weak pointer and got nullified by the GC.  */
-	    return SCM_BOOL_F;
+	  if (SCM_I_WVECTP (vv) && !SCM_IS_WHVEC (vv))
+	    {
+	      struct t_weak_vector_ref_args args;
+	      args.vector = vv;
+	      args.k = k;
 
-	  return elt;
+	      return GC_call_with_alloc_lock (do_weak_vector_ref, &args);
+	    }
+
+	  return (SCM_I_VECTOR_ELTS (vv))[k];
 	}
       scm_wrong_type_arg_msg (NULL, 0, v, "non-uniform vector");
     }
@@ -275,10 +301,11 @@ scm_c_vector_set_x (SCM v, size_t k, SCM obj)
       if (k >= SCM_I_VECTOR_LENGTH (v))
 	scm_out_of_range (NULL, scm_from_size_t (k)); 
       (SCM_I_VECTOR_WELTS(v))[k] = obj;
-      if (SCM_I_WVECTP (v))
+      if (SCM_I_WVECTP (v) && !SCM_IS_WHVEC (v))
 	{
 	  /* Make it a weak pointer.  */
 	  GC_PTR link = (GC_PTR) & ((SCM_I_VECTOR_WELTS (v))[k]);
+	  GC_unregister_disappearing_link (link);
 	  SCM_I_REGISTER_DISAPPEARING_LINK (link, obj);
 	}
     }
@@ -293,10 +320,11 @@ scm_c_vector_set_x (SCM v, size_t k, SCM obj)
 	  k = SCM_I_ARRAY_BASE (v) + k*dim->inc;
 	  (SCM_I_VECTOR_WELTS (vv))[k] = obj;
 
-	  if (SCM_I_WVECTP (vv))
+	  if (SCM_I_WVECTP (vv) && !SCM_IS_WHVEC (vv))
 	    {
 	      /* Make it a weak pointer.  */
 	      GC_PTR link = (GC_PTR) & ((SCM_I_VECTOR_WELTS (vv))[k]);
+	      GC_unregister_disappearing_link (link);
 	      SCM_I_REGISTER_DISAPPEARING_LINK (link, obj);
 	    }
 	}
@@ -421,7 +449,10 @@ scm_i_make_weak_vector (scm_t_bits type, SCM size, SCM fill)
   base = SCM_I_WVECT_GC_WVELTS (wv);
 
   for (j = 0; j != c_size; ++j)
-    base[j] = fill;
+    {
+      base[j] = fill;
+      SCM_I_REGISTER_DISAPPEARING_LINK((GC_PTR) base + j, (GC_PTR) SCM_UNPACK(fill));
+    }
 
   return wv;
 }
@@ -443,6 +474,7 @@ scm_i_make_weak_vector_from_list (scm_t_bits type, SCM lst)
        scm_is_pair (lst);
        lst = SCM_CDR (lst), elt++)
     {
+      SCM_I_REGISTER_DISAPPEARING_LINK((GC_PTR) elt, (GC_PTR) SCM_UNPACK(SCM_CAR(lst)));
       *elt = SCM_CAR (lst);
     }
 
-- 
1.6.5.7


[-- Attachment #3: Type: text/plain, Size: 33 bytes --]


-- 
Mike: I WAS NOT MICROWAVED.