diff options
author | Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> | 2001-02-08 10:48:01 +0000 |
---|---|---|
committer | Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> | 2001-02-08 10:48:01 +0000 |
commit | e382fdbe0f4c540dd70e6e77ccbf9368d7cea2e4 (patch) | |
tree | ea0328573eec9bea13c1c5268c758b373b5d8e8a | |
parent | bf8f0922803b0885853ab0a4cebdd6f90d1a4daa (diff) | |
download | guile-e382fdbe0f4c540dd70e6e77ccbf9368d7cea2e4.tar.gz |
* Fixed parameter checking for make-vector.
-rw-r--r-- | libguile/ChangeLog | 9 | ||||
-rw-r--r-- | libguile/vectors.c | 44 | ||||
-rw-r--r-- | libguile/vectors.h | 1 |
3 files changed, 37 insertions, 17 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 9265dc481..14033e6b5 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -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. diff --git a/libguile/vectors.c b/libguile/vectors.c index 292252ebd..7e36ebafc 100644 --- a/libguile/vectors.c +++ b/libguile/vectors.c @@ -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_NEWCELL (v); + scm_bits_t *base; - velts = (k != 0) - ? scm_must_malloc (k * sizeof (scm_bits_t), FUNC_NAME) - : NULL; + if (k > 0) + { + unsigned long int j; - SCM_DEFER_INTS; - { - unsigned long int j; + SCM_ASSERT_RANGE (1, scm_ulong2num (k), k <= SCM_VECTOR_MAX_LENGTH); - for (j = 0; j != k; ++j) - velts[j] = SCM_UNPACK (fill); + 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_SET_VECTOR_BASE (v, velts); - SCM_SET_VECTOR_LENGTH (v, k, scm_tc7_vector); - } - SCM_ALLOW_INTS; + SCM_NEWCELL (v); + 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" diff --git a/libguile/vectors.h b/libguile/vectors.h index f8449a714..d479d1b80 100644 --- a/libguile/vectors.h +++ b/libguile/vectors.h @@ -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))) |