Fixed `list->weak-vector'.

* libguile/vectors.c (scm_i_allocate_weak_vector): Removed.
  (MAKE_WEAK_VECTOR): New macro.
  (allocate_weak_vector): New.
  (scm_i_make_weak_vector): New.
  (scm_i_make_weak_vector_from_list): New.

* libguile/vectors.h: Updated.

* libguile/weaks.c (scm_make_weak_vector): Use `scm_i_make_weak_vector ()'.
  (scm_weak_vector): Use `scm_i_make_weak_vector_from_list ()'.

git-archimport-id: lcourtes@laas.fr--2005-libre/guile-core--boehm-gc--1.9--patch-13

libguile/vectors.c

@@ -384,45 +384,85 @@ scm_i_vector_free (SCM vec)
 	       "vector");
 }
 
-/* Allocate memory for a weak vector on behalf of the caller.  The allocated
- * vector will be of the given weak vector subtype.  It will contain size
- * elements which are initialized with the 'fill' object, or, if 'fill' is
- * undefined, with an unspecified object.
- */
-SCM
-scm_i_allocate_weak_vector (scm_t_bits type, SCM size, SCM fill)
-{
-  size_t c_size;
-  SCM *base;
-  SCM v;
+
+/* Weak vectors.  */
 
-  c_size = scm_to_unsigned_integer (size, 0, VECTOR_MAX_LENGTH);
+
+/* Initialize RET as a weak vector of type TYPE of SIZE elements pointed to
+   by BASE.  */
+#define MAKE_WEAK_VECTOR(_ret, _type, _size, _base)		\
+  (_ret) = scm_double_cell ((_size << 8) | scm_tc7_wvect,	\
+			    (scm_t_bits) (_base),		\
+			    (_type),				\
+			    SCM_UNPACK (SCM_EOL));
+
+
+/* Allocate memory for the elements of a weak vector on behalf of the
+   caller.  */
+static SCM *
+allocate_weak_vector (scm_t_bits type, size_t c_size)
+{
+  SCM *base;
 
   if (c_size > 0)
-    {
-      size_t j;
+    /* The base itself should not be scanned for pointers otherwise those
+       pointers will always be reachable.  */
+    base = scm_gc_malloc_pointerless (c_size * sizeof (SCM), "weak vector");
+  else
+    base = NULL;
+
+  return base;
+}
+
+/* Return a new weak vector.  The allocated vector will be of the given weak
+   vector subtype.  It will contain SIZE elements which are initialized with
+   the FILL object, or, if FILL is undefined, with an unspecified object.  */
+SCM
+scm_i_make_weak_vector (scm_t_bits type, SCM size, SCM fill)
+{
+  SCM wv, *base;
+  size_t c_size, j;
 
   if (SCM_UNBNDP (fill))
     fill = SCM_UNSPECIFIED;
 
-      /* The base itself should not be scanned for pointers otherwise those
-	 pointers will always be reachable.  */
-      base = scm_gc_malloc_pointerless (c_size * sizeof (SCM), "weak vector");
+  c_size = scm_to_unsigned_integer (size, 0, VECTOR_MAX_LENGTH);
+  base = allocate_weak_vector (type, c_size);
+
   for (j = 0; j != c_size; ++j)
     base[j] = fill;
-    }
-  else
-    base = NULL;
 
-  v = scm_double_cell ((c_size << 8) | scm_tc7_wvect,
-		       (scm_t_bits) base,
-		       type,
-		       SCM_UNPACK (SCM_EOL));
-  scm_remember_upto_here_1 (fill);
+  MAKE_WEAK_VECTOR (wv, type, c_size, base);
 
-  return v;
+  return wv;
 }
 
+/* Return a new weak vector with type TYPE and whose content are taken from
+   list LST.  */
+SCM
+scm_i_make_weak_vector_from_list (scm_t_bits type, SCM lst)
+{
+  SCM wv, *base, *elt;
+  long c_size;
+
+  c_size = scm_ilength (lst);
+  SCM_ASSERT (c_size >= 0, lst, SCM_ARG2, "scm_i_make_weak_vector_from_list");
+
+  base = allocate_weak_vector (type, (size_t)c_size);
+  for (elt = base;
+       scm_is_pair (lst);
+       lst = SCM_CDR (lst), elt++)
+    {
+      *elt = SCM_CAR (lst);
+    }
+
+  MAKE_WEAK_VECTOR (wv, type, (size_t)c_size, base);
+
+  return wv;
+}
+
+
+
 SCM_DEFINE (scm_vector_to_list, "vector->list", 1, 0, 0, 
 	    (SCM v),
 	    "Return a newly allocated list composed of the elements of @var{v}.\n"

libguile/vectors.h

@@ -99,7 +99,8 @@ SCM_API SCM  scm_i_vector_equal_p (SCM x, SCM y);
 #define SCM_I_WVECT_GC_CHAIN(x)         (SCM_CELL_OBJECT_3 (x))
 #define SCM_I_SET_WVECT_GC_CHAIN(x, o)  (SCM_SET_CELL_OBJECT_3 ((x), (o)))
 
-SCM_API SCM scm_i_allocate_weak_vector (scm_t_bits type, SCM size, SCM fill);
+SCM_API SCM scm_i_make_weak_vector (scm_t_bits type, SCM size, SCM fill);
+SCM_API SCM scm_i_make_weak_vector_from_list (scm_t_bits type, SCM lst);
 
 SCM_API void scm_init_vectors (void);
 

libguile/weaks.c

@@ -76,7 +76,7 @@ SCM_DEFINE (scm_make_weak_vector, "make-weak-vector", 1, 1, 0,
 	    "empty list.")
 #define FUNC_NAME s_scm_make_weak_vector
 {
-  return scm_i_allocate_weak_vector (0, size, fill);
+  return scm_i_make_weak_vector (0, size, fill);
 }
 #undef FUNC_NAME
 
@@ -92,26 +92,7 @@ SCM_DEFINE (scm_weak_vector, "weak-vector", 0, 0, 1,
 	    "the same way @code{list->vector} would.")
 #define FUNC_NAME s_scm_weak_vector
 {
-  scm_t_array_handle handle;
-  SCM res, *data;
-  long i;
-
-  i = scm_ilength (l);
-  SCM_ASSERT (i >= 0, l, SCM_ARG1, FUNC_NAME);
-
-  res = scm_make_weak_vector (scm_from_int (i), SCM_UNSPECIFIED);
-  data = scm_vector_writable_elements (res, &handle, NULL, NULL);
-
-  while (scm_is_pair (l) && i > 0)
-    {
-      *data++ = SCM_CAR (l);
-      l = SCM_CDR (l);
-      i--;
-    }
-
-  scm_array_handle_release (&handle);
-
-  return res;
+  return scm_i_make_weak_vector_from_list (0, l);
 }
 #undef FUNC_NAME