diff --git a/libguile/vectors.c b/libguile/vectors.c
index 272a3d2dd..afc74b7da 100644
--- a/libguile/vectors.c
+++ b/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;
-
-      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");
-      for (j = 0; j != c_size; ++j)
-	base[j] = fill;
-    }
+    /* 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;
 
-  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);
-
-  return v;
+  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;
+
+  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;
+
+  MAKE_WEAK_VECTOR (wv, type, c_size, base);
+
+  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"
diff --git a/libguile/vectors.h b/libguile/vectors.h
index b1def0689..db43a86d0 100644
--- a/libguile/vectors.h
+++ b/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);
 
diff --git a/libguile/weaks.c b/libguile/weaks.c
index 6f22f629a..4a0f3bcd7 100644
--- a/libguile/weaks.c
+++ b/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