mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 20:00:19 +02:00
Code Activity

Allocate vectors in a contiguous memory area.

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2009-11-02 00:55:17 +01:00
parent 88cbb42189
commit ed7e0765c4
3 changed files with 44 additions and 69 deletions
Download patch file Download diff file Expand all files Collapse all files

79
libguile/vectors.c
View file

@ -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;
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;
}

21
libguile/vectors.h
View file

@ -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);

11
libguile/weaks.h
View file

@ -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)))