From 1d0df896c97b3f876700206a4b5e2d8d452cece4 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 27 Dec 2004 02:01:21 +0000 Subject: [PATCH] (scm_c_vector_set_x): Make return type void. (scm_is_vector, scm_vector_p, scm_vector_length, scm_c_vector_length, scm_vector_ref, scm_c_vector_ref, scm_vector_set_x, scm_c_vector_set_x, scm_vector_to_list, scm_vector_move_left_x, scm_vector_move_right_x, scm_vector_fill_x): handle one-dimensional arrays. (scm_vector_elements, scm_vector_release_elements, scm_vector_frame_release_elements, scm_vector_writable_elements, scm_vector_release_writable_elements, scm_vector_frame_release_writable_elements): New. (scm_list_to_vector, scm_vector_to_list, scm_vector_fill, scm_vector_move_left_x, scm_vector_move_right_x): Use them. --- libguile/vectors.c | 99 +++++++++++++++++++++++++++++++++++----------- libguile/vectors.h | 11 +++++- 2 files changed, 87 insertions(+), 23 deletions(-) diff --git a/libguile/vectors.c b/libguile/vectors.c index f5f8d4d11..852749af1 100644 --- a/libguile/vectors.c +++ b/libguile/vectors.c @@ -31,6 +31,7 @@ #include "libguile/srfi-4.h" #include "libguile/strings.h" #include "libguile/srfi-13.h" +#include "libguile/dynwind.h" @@ -41,6 +42,52 @@ scm_is_vector (SCM obj) || (SCM_ARRAYP (obj) && SCM_ARRAY_NDIM (obj) == 1)); } +SCM * +scm_vector_writable_elements (SCM vec) +{ + if (SCM_VECTORP (vec)) + return SCM_WRITABLE_VELTS (vec); + else + scm_wrong_type_arg_msg (NULL, 0, vec, "simple vector"); +} + +const SCM * +scm_vector_elements (SCM vec) +{ + if (SCM_VECTORP (vec)) + return SCM_VELTS (vec); + else + scm_wrong_type_arg_msg (NULL, 0, vec, "simple vector"); +} + +void +scm_vector_release_writable_elements (SCM vec) +{ + scm_remember_upto_here_1 (vec); +} + +void +scm_vector_release_elements (SCM vec) +{ + scm_remember_upto_here_1 (vec); +} + +void +scm_frame_vector_release_writable_elements (SCM vec) +{ + scm_frame_unwind_handler_with_scm + (scm_vector_release_writable_elements, vec, + SCM_F_WIND_EXPLICITLY); +} + +void +scm_frame_vector_release_elements (SCM vec) +{ + scm_frame_unwind_handler_with_scm + (scm_vector_release_elements, vec, + SCM_F_WIND_EXPLICITLY); +} + SCM_DEFINE (scm_vector_p, "vector?", 1, 0, 0, (SCM obj), "Return @code{#t} if @var{obj} is a vector, otherwise return\n" @@ -98,22 +145,20 @@ SCM_DEFINE (scm_vector, "vector", 0, 0, 1, { SCM res; SCM *data; - long i; + long i, len; - /* Dirk:FIXME:: In case of multiple threads, the list might get corrupted - while the vector is being created. */ - SCM_VALIDATE_LIST_COPYLEN (1, l, i); - res = scm_c_make_vector (i, SCM_UNSPECIFIED); + SCM_VALIDATE_LIST_COPYLEN (1, l, len); + res = scm_c_make_vector (len, SCM_UNSPECIFIED); - /* - this code doesn't alloc. -- accessing RES is safe. - */ - data = SCM_WRITABLE_VELTS (res); - while (!SCM_NULL_OR_NIL_P (l)) + data = scm_vector_writable_elements (res); + i = 0; + while (!SCM_NULL_OR_NIL_P (l) && i < len) { - *data++ = SCM_CAR (l); + data[i] = SCM_CAR (l); l = SCM_CDR (l); + i++; } + scm_vector_release_writable_elements (res); return res; } @@ -273,10 +318,11 @@ SCM_DEFINE (scm_vector_to_list, "vector->list", 1, 0, 0, { SCM res = SCM_EOL; long i; - SCM const *data; - data = SCM_VELTS(v); + const SCM *data; + data = scm_vector_elements (v); for(i = SCM_VECTOR_LENGTH(v)-1; i >= 0; i--) - res = scm_cons(data[i], res); + res = scm_cons (data[i], res); + scm_vector_release_elements (v); return res; } else if (SCM_ARRAYP (v) && SCM_ARRAY_NDIM (v) == 1) @@ -295,9 +341,10 @@ SCM_DEFINE (scm_vector_fill_x, "vector-fill!", 2, 0, 0, { if (SCM_VECTORP (v)) { - register long i; - for (i = SCM_VECTOR_LENGTH (v) - 1; i >= 0; i--) - SCM_VECTOR_SET (v, i, fill); + size_t i, len; + SCM *elts = scm_vector_writable_elements (v); + for (i = 0, len = SCM_VECTOR_LENGTH (v); i < len; i++) + elts[i] = fill; return SCM_UNSPECIFIED; } else if (SCM_ARRAYP (v) && SCM_ARRAY_NDIM (v) == 1) @@ -309,10 +356,10 @@ SCM_DEFINE (scm_vector_fill_x, "vector-fill!", 2, 0, 0, SCM -scm_vector_equal_p(SCM x, SCM y) +scm_vector_equal_p (SCM x, SCM y) { long i; - for(i = SCM_VECTOR_LENGTH (x) - 1; i >= 0; i--) + for (i = SCM_VECTOR_LENGTH (x) - 1; i >= 0; i--) if (scm_is_false (scm_equal_p (SCM_VELTS (x)[i], SCM_VELTS (y)[i]))) return SCM_BOOL_F; return SCM_BOOL_T; @@ -339,12 +386,16 @@ SCM_DEFINE (scm_vector_move_left_x, "vector-move-left!", 5, 0, 0, e = scm_to_unsigned_integer (end1, i, len1); j = scm_to_unsigned_integer (start2, 0, len2 - (i-e)); - /* Optimize common case of two regular vectors. + /* Optimize common case of two simple vectors. */ if (SCM_VECTORP (vec1) && SCM_VECTORP (vec2)) { + const SCM *elts1 = scm_vector_elements (vec1); + SCM *elts2 = scm_vector_writable_elements (vec2); for (; i < e; i++, j++) - SCM_VECTOR_SET (vec2, j, SCM_VECTOR_REF (vec1, i)); + elts2[j] = elts1[i]; + scm_vector_release_elements (vec1); + scm_vector_release_writable_elements (vec2); } else { @@ -381,11 +432,15 @@ SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 5, 0, 0, j += e - i; if (SCM_VECTORP (vec1) && SCM_VECTORP (vec2)) { + const SCM *elts1 = scm_vector_elements (vec1); + SCM *elts2 = scm_vector_writable_elements (vec2); while (i < e) { e--, j--; - SCM_VECTOR_SET (vec2, j, SCM_VECTOR_REF (vec1, e)); + elts2[j] = elts1[e]; } + scm_vector_release_elements (vec1); + scm_vector_release_writable_elements (vec2); } else { diff --git a/libguile/vectors.h b/libguile/vectors.h index de231250e..cf19ea624 100644 --- a/libguile/vectors.h +++ b/libguile/vectors.h @@ -66,7 +66,6 @@ SCM_API SCM scm_vector_set_x (SCM v, SCM k, SCM obj); SCM_API SCM scm_make_vector (SCM k, SCM fill); SCM_API SCM scm_vector_to_list (SCM v); SCM_API SCM scm_vector_fill_x (SCM v, SCM fill_x); -SCM_API SCM scm_vector_equal_p (SCM x, SCM y); SCM_API SCM scm_vector_move_left_x (SCM vec1, SCM start1, SCM end1, SCM vec2, SCM start2); SCM_API SCM scm_vector_move_right_x (SCM vec1, SCM start1, SCM end1, @@ -77,6 +76,12 @@ SCM_API SCM scm_c_make_vector (size_t len, SCM fill); SCM_API size_t scm_c_vector_length (SCM vec); SCM_API SCM scm_c_vector_ref (SCM vec, size_t k); SCM_API void scm_c_vector_set_x (SCM vec, size_t k, SCM obj); +SCM_API const SCM *scm_vector_elements (SCM vec); +SCM_API void scm_vector_release_elements (SCM vec); +SCM_API void scm_frame_vector_release_elements (SCM vec); +SCM_API SCM *scm_vector_writable_elements (SCM vec); +SCM_API void scm_vector_release_writable_elements (SCM vec); +SCM_API void scm_frame_vector_release_writable_elements (SCM vec); /* Generalized vectors */ @@ -91,6 +96,10 @@ SCM_API size_t scm_c_generalized_vector_length (SCM v); SCM_API SCM scm_c_generalized_vector_ref (SCM v, size_t idx); SCM_API void scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val); +/* Deprecated */ + +SCM_API SCM scm_vector_equal_p (SCM x, SCM y); + SCM_API void scm_init_vectors (void); #endif /* SCM_VECTORS_H */ -- 2.20.1