l...@gnu.org (Ludovic Courtès) writes:

> For these last two things, we’d need to modify the ‘vector-ref’ and
> ‘vector-set’ instructions so that they do the right thing.  The best
> solution would be to just call scm_c_vector_{ref,set_x} when
> SCM_I_WVECTP, so that the overhead remains low for regular vectors.  Can
> you look into this?

Wingo did this.

>> 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.
>
> Yes, weak vectors are to live in pointerless memory, otherwise the
> disappearing links would not disappear.
>
> The patch looks good to me, modulo a few things:
>
>   - Could you make it 3 (or 4?) different patches, each with a test case
>     showing what is being fixed?
>
>   - If that’s fine with you, you’ll need to assign copyright to the
>     FSF.  We can arrange this off-list.

I have attached a series of three patches with reformatted GNU style
commit logs and the gnu coding style violations fixed.

I talked to wingo, and he suggested that (equal? WEAK-VECTOR VECTOR) =>
#f; I have made this so by unregistering weak vectors as arrays, and
doing additional type checking in scm_eq. I am unsure if this has
ramifications for the rest of the system however.

How do you want to handle copyright assignment?

From 51c78363c827ff7433bf619a4dd0c9afdbd79696 Mon Sep 17 00:00:00 2001
From: Clinton Ebadi <clin...@unknownlamer.org>
Date: Sat, 17 Apr 2010 14:16:30 -0400
Subject: [PATCH 1/3] Forbid comparison of weak and normal vectors

* libguile/vectors.c (scm_i_weak_vector_equal_p): New Function.

* libguile/eq.c (scm_equal_p): Dispatch scm_tc7_wvect to
  `scm_i_weak_vector_equal_p', and forbid comparison of normal and weak
  vectors.
---
 libguile/eq.c      |   11 +++++++++--
 libguile/vectors.c |   15 ++++++++++++++-
 libguile/vectors.h |    1 +
 3 files changed, 24 insertions(+), 3 deletions(-)

diff --git a/libguile/eq.c b/libguile/eq.c
index 923fa77..7debae7 100644
--- a/libguile/eq.c
+++ b/libguile/eq.c
@@ -342,9 +342,16 @@ scm_equal_p (SCM x, SCM y)
 	case scm_tc16_fraction:
           return scm_i_fraction_equalp (x, y);
         }
-    case scm_tc7_vector:
     case scm_tc7_wvect:
-      return scm_i_vector_equal_p (x, y);
+      if (SCM_LIKELY (SCM_TYP7 (y) == scm_tc7_wvect))
+	return scm_i_weak_vector_equal_p (x, y);
+      else
+	return SCM_BOOL_F;
+    case scm_tc7_vector:
+      if (SCM_LIKELY (SCM_TYP7 (y) == scm_tc7_vector))
+	return scm_i_vector_equal_p (x, y);
+      else
+	return SCM_BOOL_F;
     }
   /* Check equality between structs of equal type (see cell-type test above). */
   if (SCM_STRUCTP (x))
diff --git a/libguile/vectors.c b/libguile/vectors.c
index 321b499..e60e2c3 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -509,6 +509,19 @@ scm_i_vector_equal_p (SCM x, SCM y)
   return SCM_BOOL_T;
 }
 
+SCM
+scm_i_weak_vector_equal_p (SCM x, SCM y)
+{
+  /* This is slower, but necessary to catch NULLified weak references and
+     correctly hold the collector lock when accessing each element. */
+  long i;
+  for (i = SCM_I_VECTOR_LENGTH (x) - 1; i >= 0; i--)
+    if (scm_is_false (scm_equal_p (scm_c_vector_ref (x, i),
+				   scm_c_vector_ref (y, i))))
+      return SCM_BOOL_F;
+  return SCM_BOOL_T;
+}
+
 
 SCM_DEFINE (scm_vector_move_left_x, "vector-move-left!", 5, 0, 0, 
             (SCM vec1, SCM start1, SCM end1, SCM vec2, SCM start2),
@@ -622,7 +635,7 @@ vector_get_handle (SCM v, scm_t_array_handle *h)
 
 /* the & ~2 allows catching scm_tc7_wvect as well. needs changing if you change
    tags.h. */
-SCM_ARRAY_IMPLEMENTATION (scm_tc7_vector, 0x7f & ~2,
+SCM_ARRAY_IMPLEMENTATION (scm_tc7_vector, 0x7f,
                           vector_handle_ref, vector_handle_set,
                           vector_get_handle)
 SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_SCM, scm_make_vector)
diff --git a/libguile/vectors.h b/libguile/vectors.h
index 3746e90..f426d0c 100644
--- a/libguile/vectors.h
+++ b/libguile/vectors.h
@@ -74,6 +74,7 @@ SCM_API SCM *scm_vector_writable_elements (SCM vec,
 #define SCM_I_VECTOR_LENGTH(x) (((size_t) SCM_CELL_WORD_0 (x)) >> 8)
 
 SCM_INTERNAL SCM  scm_i_vector_equal_p (SCM x, SCM y);
+SCM_INTERNAL SCM  scm_i_weak_vector_equal_p (SCM x, SCM y);
 
 /* Weak vectors share implementation details with ordinary vectors,
    but no one else should.  */
-- 
1.6.5.7

From cecef73d94a59f5932e28e938145700019203801 Mon Sep 17 00:00:00 2001
From: Clinton Ebadi <clin...@unknownlamer.org>
Date: Sat, 17 Apr 2010 14:21:43 -0400
Subject: [PATCH 2/3] Register disappearing links when initializing weak vectors

* libguile/vectors.c (scm_c_vector_set_x): Unregister old weak
  link when assigning to a weak vector.
  (scm_i_make_weak_vector): Register elements as disappearing links
  to fill value.
  (scm_i_make_weak_vector_from_list): Register elements as
  disappearing links.
---
 libguile/vectors.c |   12 +++++++++---
 1 files changed, 9 insertions(+), 3 deletions(-)

diff --git a/libguile/vectors.c b/libguile/vectors.c
index e60e2c3..cca57cd 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -274,10 +274,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);
 	}
     }
@@ -292,10 +293,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);
 	    }
 	}
@@ -420,7 +422,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;
 }
@@ -442,6 +447,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

From af6252f00326542cfa052ec9c2a99477cd1b1d7e Mon Sep 17 00:00:00 2001
From: Clinton Ebadi <clin...@unknownlamer.org>
Date: Sat, 17 Apr 2010 14:23:16 -0400
Subject: [PATCH 3/3] Reference weak vectors with the allocator lock held

* libguile/vectors.c (do_weak_vector_ref): New function.
  (scm_c_vector_ref): Call `do_weak_vector_ref' with the allocator
  lock held when referencing weak vectors.
---
 libguile/vectors.c |   54 ++++++++++++++++++++++++++++++++++++++-------------
 1 files changed, 40 insertions(+), 14 deletions(-)

diff --git a/libguile/vectors.c b/libguile/vectors.c
index cca57cd..5788ec1 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -202,22 +202,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)
     {
@@ -225,18 +249,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 GC_call_with_alloc_lock (do_weak_vector_ref, &args);
+	    }
 
-	  return elt;
+	  return (SCM_I_VECTOR_ELTS (vv))[k];
 	}
       scm_wrong_type_arg_msg (NULL, 0, v, "non-uniform vector");
     }
-- 
1.6.5.7




-- 
Corinne: this is why we should have designated bath buddies
Corinne: to get places you cant reach because youre slippery and in
         case you get a lil tooo slippery and crack your head open
         someone can call the coast guard and save you

Attachment: pgpDDYbq0P6Ol.pgp
Description: PGP signature

Reply via email to