From 51c78363c827ff7433bf619a4dd0c9afdbd79696 Mon Sep 17 00:00:00 2001
From: Clinton Ebadi <clinton@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