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
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");
-}
-
\f
/* 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
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;
}
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;
}
#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
#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))
+\f
/* 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);
#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)))
HCoop / bpt / guile.git / commitdiff