Allocate vectors in a contiguous memory area.

* libguile/vectors.c (scm_c_make_vector): Allocate the whole vector and
  header with `scm_gc_malloc ()'.
  (scm_vector_copy): Use `scm_c_make_vector ()'.
  (scm_i_vector_free, MAKE_WEAK_VECTOR): Remove.
  (allocate_weak_vector): Rename to...
  (make_weak_vector): ... this.  Change to return the whole weak vector,
  allocated with `scm_gc_malloc_pointerless ()'.
  (scm_i_make_weak_vector, scm_i_make_weak_vector_from_list): Use
  `make_weak_vector ()'.

* libguile/vectors.h (SCM_I_VECTOR_HEADER_SIZE): New macro.
  (SCM_I_VECTOR_ELTS): Write in terms of `SCM_I_VECTOR_WELTS ()'.
  (SCM_I_VECTOR_WELTS): Update to the new representation.
  (SCM_I_WVECT_EXTRA, SCM_I_SET_WVECT_EXTRA): Likewise.
  (SCM_I_WVECT_GC_CHAIN, SCM_I_SET_WVECT_GC_CHAIN): Remove.

* libguile/weaks.h (SCM_I_WVECT_DELTA, SCM_I_SET_WVECT_DELTA): Remove.

3 files changed, 44 insertions, 69 deletions

diff --git a/libguile/vectors.c b/libguile/vectors.c
index b1b5890f4..405ebb163 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -339,26 +339,28 @@ SCM
 scm_c_make_vector (size_t k, SCM fill)
 #define FUNC_NAME s_scm_make_vector
 {
-  SCM v;
-  SCM *base;
+  SCM *vector;
 
-  if (k > 0) 
+  vector = (SCM *)
+    scm_gc_malloc ((k + SCM_I_VECTOR_HEADER_SIZE) * sizeof (SCM),
+		   "vector");
+
+  if (k > 0)
     {
+      SCM *base;
       unsigned long int j;
 
       SCM_ASSERT_RANGE (1, scm_from_ulong (k), k <= VECTOR_MAX_LENGTH);
 
-      base = scm_gc_malloc (k * sizeof (SCM), "vector");
+      base = vector + SCM_I_VECTOR_HEADER_SIZE;
       for (j = 0; j != k; ++j)
 	base[j] = fill;
     }
-  else
-    base = NULL;
 
-  v = scm_immutable_cell ((k << 8) | scm_tc7_vector, (scm_t_bits) base);
-  scm_remember_upto_here_1 (fill);
+  ((scm_t_bits *) vector)[0] = (k << 8) | scm_tc7_vector;
+  ((scm_t_bits *) vector)[1] = 0;
 
-  return v;
+  return PTR2SCM (vector);
 }
 #undef FUNC_NAME
 
@@ -371,54 +373,39 @@ SCM_DEFINE (scm_vector_copy, "vector-copy", 1, 0, 0,
   size_t i, len;
   ssize_t inc;
   const SCM *src;
-  SCM *dst;
+  SCM result, *dst;
 
   src = scm_vector_elements (vec, &handle, &len, &inc);
-  dst = scm_gc_malloc (len * sizeof (SCM), "vector");
+
+  result = scm_c_make_vector (len, SCM_UNDEFINED);
+  dst = SCM_I_VECTOR_WELTS (result);
   for (i = 0; i < len; i++, src += inc)
     dst[i] = *src;
+
   scm_array_handle_release (&handle);
 
-  return scm_cell ((len << 8) | scm_tc7_vector, (scm_t_bits) dst);
+  return result;
 }
 #undef FUNC_NAME
 
-void
-scm_i_vector_free (SCM vec)
-{
-  scm_gc_free (SCM_I_VECTOR_WELTS (vec),
-	       SCM_I_VECTOR_LENGTH (vec) * sizeof(SCM),
-	       "vector");
-}
-
 
 /* Weak vectors.  */
 
-
-/* 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)
+static SCM
+make_weak_vector (scm_t_bits type, size_t c_size)
 {
-  SCM *base;
+  SCM *vector;
+  size_t total_size;
 
-  if (c_size > 0)
-    /* 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;
+  total_size = (c_size + SCM_I_VECTOR_HEADER_SIZE) * sizeof (SCM);
+  vector = (SCM *) scm_gc_malloc_pointerless (total_size, "weak vector");
 
-  return base;
+  ((scm_t_bits *) vector)[0] = (c_size << 8) | scm_tc7_wvect;
+  ((scm_t_bits *) vector)[1] = type;
+
+  return PTR2SCM (vector);
 }
 
 /* Return a new weak vector.  The allocated vector will be of the given weak
@@ -434,13 +421,12 @@ scm_i_make_weak_vector (scm_t_bits type, SCM size, SCM fill)
     fill = SCM_UNSPECIFIED;
 
   c_size = scm_to_unsigned_integer (size, 0, VECTOR_MAX_LENGTH);
-  base = allocate_weak_vector (type, c_size);
+  wv = make_weak_vector (type, c_size);
+  base = SCM_I_WVECT_GC_WVELTS (wv);
 
   for (j = 0; j != c_size; ++j)
     base[j] = fill;
 
-  MAKE_WEAK_VECTOR (wv, type, c_size, base);
-
   return wv;
 }
 
@@ -449,22 +435,21 @@ scm_i_make_weak_vector (scm_t_bits type, SCM size, SCM fill)
 SCM
 scm_i_make_weak_vector_from_list (scm_t_bits type, SCM lst)
 {
-  SCM wv, *base, *elt;
+  SCM wv, *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;
+  wv = make_weak_vector(type, (size_t) c_size);
+
+  for (elt = SCM_I_WVECT_GC_WVELTS (wv);
        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;
 }
 
diff --git a/libguile/vectors.h b/libguile/vectors.h
index 0e2cb6e8f..a74c8a980 100644
--- a/libguile/vectors.h
+++ b/libguile/vectors.h
@@ -3,7 +3,7 @@
 #ifndef SCM_VECTORS_H
 #define SCM_VECTORS_H
 
-/* Copyright (C) 1995,1996,1998,2000,2001,2002,2004,2005, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,2000,2001,2002,2004,2005, 2006, 2008, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -61,29 +61,30 @@ SCM_API SCM *scm_vector_writable_elements (SCM vec,
 #define SCM_SIMPLE_VECTOR_REF(x,idx)     ((SCM_I_VECTOR_ELTS(x))[idx])
 #define SCM_SIMPLE_VECTOR_SET(x,idx,val) ((SCM_I_VECTOR_WELTS(x))[idx]=(val))
 
+
 /* Internals */
 
+/* Vectors have a 2-word header: 1 for the type tag, and 1 for the weak
+   vector extra data (see below.)  */
+#define SCM_I_VECTOR_HEADER_SIZE  2U
+
 #define SCM_I_IS_VECTOR(x)     (!SCM_IMP(x) && (SCM_TYP7S(x)==scm_tc7_vector))
-#define SCM_I_VECTOR_ELTS(x)   ((const SCM *) SCM_CELL_WORD_1 (x))
-#define SCM_I_VECTOR_WELTS(x)  ((SCM *) SCM_CELL_WORD_1 (x))
+#define SCM_I_VECTOR_ELTS(x)   ((const SCM *) SCM_I_VECTOR_WELTS (x))
+#define SCM_I_VECTOR_WELTS(x)  (SCM_CELL_OBJECT_LOC (x, SCM_I_VECTOR_HEADER_SIZE))
 #define SCM_I_VECTOR_LENGTH(x) (((size_t) SCM_CELL_WORD_0 (x)) >> 8)
 
-SCM_INTERNAL void scm_i_vector_free (SCM vec);
 SCM_INTERNAL SCM  scm_i_vector_equal_p (SCM x, SCM y);
 
 /* Weak vectors share implementation details with ordinary vectors,
-   but no one else should.
- */
+   but no one else should.  */
 
 #define SCM_I_WVECTP(x)                 (!SCM_IMP (x) && \
                                          SCM_TYP7 (x) == scm_tc7_wvect)
 #define SCM_I_WVECT_LENGTH              SCM_I_VECTOR_LENGTH
 #define SCM_I_WVECT_VELTS               SCM_I_VECTOR_ELTS
 #define SCM_I_WVECT_GC_WVELTS           SCM_I_VECTOR_WELTS
-#define SCM_I_WVECT_EXTRA(x)            (SCM_CELL_WORD_2 (x))
-#define SCM_I_SET_WVECT_EXTRA(x, t)     (SCM_SET_CELL_WORD_2 ((x),(t)))
-#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)))
+#define SCM_I_WVECT_EXTRA(x)            (SCM_CELL_WORD_1 (x))
+#define SCM_I_SET_WVECT_EXTRA(x, t)     (SCM_SET_CELL_WORD_1 ((x),(t)))
 
 SCM_INTERNAL SCM scm_i_make_weak_vector (scm_t_bits type, SCM size, SCM fill);
 SCM_INTERNAL SCM scm_i_make_weak_vector_from_list (scm_t_bits type, SCM lst);
diff --git a/libguile/weaks.h b/libguile/weaks.h
index eecc6184e..5cb8bc388 100644
--- a/libguile/weaks.h
+++ b/libguile/weaks.h
@@ -33,17 +33,6 @@
 #define SCM_WVECT_WEAK_KEY_P(x) (SCM_I_WVECT_EXTRA(x) & SCM_WVECTF_WEAK_KEY)
 #define SCM_WVECT_WEAK_VALUE_P(x) (SCM_I_WVECT_EXTRA(x) & SCM_WVECTF_WEAK_VALUE)
 
-/* The DELTA field is used by the abstract hash tables.  During GC,
-   this field will be set to the number of items that have been
-   dropped.  The abstract hash table will then use it to update its
-   item count.  DELTA is unsigned.
-*/
-
-#define SCM_I_WVECT_DELTA(x)       (SCM_I_WVECT_EXTRA(x) >> 3)
-#define SCM_I_SET_WVECT_DELTA(x,n) (SCM_I_SET_WVECT_EXTRA \
-				    ((x), ((SCM_I_WVECT_EXTRA (x) & 7)	\
-					   | ((n) << 3))))
-
 #define SCM_I_WVECT_TYPE(x)       (SCM_I_WVECT_EXTRA(x) & 7)
 #define SCM_I_SET_WVECT_TYPE(x,t) (SCM_I_SET_WVECT_EXTRA		\
 				   ((x), (SCM_I_WVECT_EXTRA (x) & ~7) | (t)))