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

* Fixed parameter checking for make-vector.

Browse source
This commit is contained in:
Dirk Herrmann 2001-02-08 10:48:01 +00:00
parent bf8f092280
commit e382fdbe0f
3 changed files with 39 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

9
libguile/ChangeLog
View file

@ -1,3 +1,12 @@
2001-02-08 Dirk Herrmann <D.Herrmann@tu-bs.de>
* vectors.h (SCM_VECTOR_MAX_LENGTH): New macro.
* vectors.c (scm_make_vector, scm_c_make_vector): Improved the
checking of the size parameter for type correctness and valid
range. Thanks to Rob Browning for reporting the problem. Instead
of deferring interrupts, scm_remember_upto_here_1 is used.
2001-02-05 Keisuke Nishida <kxn30@po.cwru.edu>
* dump.c (scm_store_cell_object, scm_restore_cell_object): Removed.

48
libguile/vectors.c
View file

@ -270,42 +270,52 @@ SCM_DEFINE (scm_make_vector, "make-vector", 1, 1, 0,
"Otherwise the initial contents of each element is unspecified. (r5rs)")
#define FUNC_NAME s_scm_make_vector
{
SCM_VALIDATE_INUM_MIN (1, k, 0);
if (SCM_UNBNDP (fill))
fill = SCM_UNSPECIFIED;
return scm_c_make_vector (SCM_INUM (k), fill);
if (SCM_INUMP (k))
{
SCM_ASSERT_RANGE (1, k, k >= 0);
return scm_c_make_vector (SCM_INUM (k), fill);
}
else if (SCM_BIGP (k))
SCM_OUT_OF_RANGE (1, k);
else
SCM_WRONG_TYPE_ARG (1, k);
}
#undef FUNC_NAME
SCM
scm_c_make_vector (unsigned long int k, SCM fill)
#define FUNC_NAME s_scm_make_vector
{
SCM v;
scm_bits_t *velts;
scm_bits_t *base;
if (k > 0)
{
unsigned long int j;
SCM_ASSERT_RANGE (1, scm_ulong2num (k), k <= SCM_VECTOR_MAX_LENGTH);
base = scm_must_malloc (k * sizeof (scm_bits_t), FUNC_NAME);
for (j = 0; j != k; ++j)
base[j] = SCM_UNPACK (fill);
}
else
base = NULL;
SCM_NEWCELL (v);
velts = (k != 0)
? scm_must_malloc (k * sizeof (scm_bits_t), FUNC_NAME)
: NULL;
SCM_DEFER_INTS;
{
unsigned long int j;
for (j = 0; j != k; ++j)
velts[j] = SCM_UNPACK (fill);
SCM_SET_VECTOR_BASE (v, velts);
SCM_SET_VECTOR_LENGTH (v, k, scm_tc7_vector);
}
SCM_ALLOW_INTS;
SCM_SET_VECTOR_BASE (v, base);
SCM_SET_VECTOR_LENGTH (v, k, scm_tc7_vector);
scm_remember_upto_here_1 (fill);
return v;
}
#undef FUNC_NAME
SCM_DEFINE (scm_vector_to_list, "vector->list", 1, 0, 0,
(SCM v),
"@samp{Vector->list} returns a newly allocated list of the objects contained\n"

1
libguile/vectors.h
View file

@ -54,6 +54,7 @@
#define SCM_VECTORP(x) (SCM_NIMP (x) && (SCM_TYP7S (x) == scm_tc7_vector))
#define SCM_VECTOR_BASE(x) ((scm_bits_t *) SCM_CELL_WORD_1 (x))
#define SCM_SET_VECTOR_BASE(v, b) (SCM_SET_CELL_WORD_1 ((v), (b)))
#define SCM_VECTOR_MAX_LENGTH ((1L << 24) - 1)
#define SCM_VECTOR_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8)
#define SCM_SET_VECTOR_LENGTH(v, l, t) (SCM_SET_CELL_WORD_0 ((v), ((l) << 8) + (t)))