From b590aceb96a8a483b0938e5b2fbe7c94fe9e7a1e Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 27 Dec 2004 02:10:14 +0000 Subject: [PATCH] (scm_uniform_vector_elements, scm_u8vector_elements, etc): Made return value "const". (scm_uniform_vector_writable_elements, scm_u8vector_writable_elements, etc): New. (scm_uniform_vector_release, scm_uniform_vector_release_elements): Renamed former to latter. Added explicit call to scm_remember_upto_here_1. (scm_frame_uniform_vector_release, scm_frame_uniform_vector_release_elements): Renamed former to latter. (scm_uniform_vector_release_writable_elements, scm_frame_uniform_vector_release_writable_elements): New. Takes crown of longest identifier yet. Changed all uses as required by the changes above. --- libguile/convert.i.c | 8 ++++---- libguile/gh_data.c | 2 +- libguile/random.c | 12 +++++------ libguile/srfi-4.c | 49 ++++++++++++++++++++++++++++++++++++-------- libguile/srfi-4.h | 45 ++++++++++++++++++++++++++-------------- libguile/srfi-4.i.c | 9 +++++++- 6 files changed, 90 insertions(+), 35 deletions(-) diff --git a/libguile/convert.i.c b/libguile/convert.i.c index 7a28213dd..ec3c55406 100644 --- a/libguile/convert.i.c +++ b/libguile/convert.i.c @@ -67,7 +67,7 @@ CTYPE * SCM2CTYPES (SCM obj, CTYPE *data) { size_t len, i; - UVEC_CTYPE *uvec_elements; + const UVEC_CTYPE *uvec_elements; obj = F(scm_any_to_,UVEC_TAG,vector) (obj); len = scm_c_uniform_vector_length (obj); @@ -78,7 +78,7 @@ SCM2CTYPES (SCM obj, CTYPE *data) for (i = 0; i < len; i++) data[i] = uvec_elements[i]; - scm_uniform_vector_release (obj); + scm_uniform_vector_release_elements (obj); return data; } @@ -108,12 +108,12 @@ CTYPES2UVECT (const CTYPE *data, long n) UVEC_CTYPE *uvec_elements; uvec = F(scm_make_,UVEC_TAG,vector) (scm_from_long (n), SCM_UNDEFINED); - uvec_elements = F(scm_,UVEC_TAG,vector_elements) (uvec); + uvec_elements = F(scm_,UVEC_TAG,vector_writable_elements) (uvec); for (i = 0; i < n; i++) uvec_elements[i] = data[i]; - scm_uniform_vector_release (uvec); + scm_uniform_vector_release_writable_elements (uvec); return uvec; } diff --git a/libguile/gh_data.c b/libguile/gh_data.c index ca70b173b..357ec7d5b 100644 --- a/libguile/gh_data.c +++ b/libguile/gh_data.c @@ -284,7 +284,7 @@ scm2whatever (SCM obj, void *m, size_t size) if (m == NULL) return NULL; memcpy (m, scm_uniform_vector_elements (obj), n * size); - scm_uniform_vector_release (obj); + scm_uniform_vector_release_elements (obj); return m; } diff --git a/libguile/random.c b/libguile/random.c index 6c1e75d05..42a28097e 100644 --- a/libguile/random.c +++ b/libguile/random.c @@ -439,11 +439,11 @@ vector_scale_x (SCM v, double c) else { /* must be a f64vector. */ - double *elts = scm_f64vector_elements (v); + double *elts = scm_f64vector_writable_elements (v); n = scm_c_uniform_vector_length (v); while (n-- > 0) elts[n] *= c; - scm_uniform_vector_release (v); + scm_uniform_vector_release_writable_elements (v); } } @@ -464,14 +464,14 @@ vector_sum_squares (SCM v) else { /* must be a f64vector. */ - double *elts = scm_f64vector_elements (v); + const double *elts = scm_f64vector_elements (v); n = scm_c_uniform_vector_length (v); while (n-- > 0) { x = elts[n]; sum += x * x; } - scm_uniform_vector_release (v); + scm_uniform_vector_release_elements (v); } return sum; } @@ -545,11 +545,11 @@ SCM_DEFINE (scm_random_normal_vector_x, "random:normal-vector!", 1, 1, 0, else { /* must be a f64vector. */ - double *elts = scm_f64vector_elements (v); + double *elts = scm_f64vector_writable_elements (v); n = scm_c_uniform_vector_length (v); while (n-- > 0) elts[n] = scm_c_normal01 (SCM_RSTATE (state)); - scm_uniform_vector_release (v); + scm_uniform_vector_release_writable_elements (v); } return SCM_UNSPECIFIED; } diff --git a/libguile/srfi-4.c b/libguile/srfi-4.c index f58940a60..f3a75c78c 100644 --- a/libguile/srfi-4.c +++ b/libguile/srfi-4.c @@ -596,7 +596,7 @@ SCM_DEFINE (scm_uniform_vector_to_list, "uniform-vector->list", 1, 0, 0, } #undef FUNC_NAME -void * +const void * scm_uniform_vector_elements (SCM uvec) { if (scm_is_uniform_vector (uvec)) @@ -606,7 +606,7 @@ scm_uniform_vector_elements (SCM uvec) } void -scm_uniform_vector_release (SCM uvec) +scm_uniform_vector_release_elements (SCM uvec) { /* Nothing to do right now, but this function might come in handy when uniform vectors need to be locked when giving away a pointer @@ -615,15 +615,48 @@ scm_uniform_vector_release (SCM uvec) Also, a call to scm_uniform_vector_release acts like scm_remember_upto_here, which is needed in any case. */ + + scm_remember_upto_here_1 (uvec); } void -scm_frame_uniform_vector_release (SCM uvec) +scm_frame_uniform_vector_release_elements (SCM uvec) { - scm_frame_unwind_handler_with_scm (scm_uniform_vector_release, uvec, + scm_frame_unwind_handler_with_scm (scm_uniform_vector_release_elements, uvec, SCM_F_WIND_EXPLICITLY); } +void * +scm_uniform_vector_writable_elements (SCM uvec) +{ + if (scm_is_uniform_vector (uvec)) + return SCM_UVEC_BASE (uvec); + else + scm_wrong_type_arg_msg (NULL, 0, uvec, "uniform vector"); +} + +void +scm_uniform_vector_release_writable_elements (SCM uvec) +{ + /* Nothing to do right now, but this function might come in handy + when uniform vectors need to be locked when giving away a pointer + to their elements. + + Also, a call to scm_uniform_vector_release acts like + scm_remember_upto_here, which is needed in any case. + */ + + scm_remember_upto_here_1 (uvec); +} + +void +scm_frame_uniform_vector_release_writable_elements (SCM uvec) +{ + scm_frame_unwind_handler_with_scm + (scm_uniform_vector_release_writable_elements, uvec, + SCM_F_WIND_EXPLICITLY); +} + size_t scm_uniform_vector_element_size (SCM uvec) { @@ -690,8 +723,8 @@ SCM_DEFINE (scm_uniform_vector_read_x, "uniform-vector-read!", 1, 3, 0, vlen = scm_c_uniform_vector_length (uvec); sz = scm_uniform_vector_element_size (uvec); - base = scm_uniform_vector_elements (uvec); - scm_frame_uniform_vector_release (uvec); + base = scm_uniform_vector_writable_elements (uvec); + scm_frame_uniform_vector_release_writable_elements (uvec); cstart = 0; cend = vlen; @@ -782,7 +815,7 @@ SCM_DEFINE (scm_uniform_vector_write, "uniform-vector-write", 1, 3, 0, size_t vlen, sz, ans; size_t cstart, cend; size_t amount, off; - void *base; + const void *base; port_or_fd = SCM_COERCE_OUTPORT (port_or_fd); @@ -798,7 +831,7 @@ SCM_DEFINE (scm_uniform_vector_write, "uniform-vector-write", 1, 3, 0, vlen = scm_c_generalized_vector_length (uvec); sz = scm_uniform_vector_element_size (uvec); base = scm_uniform_vector_elements (uvec); - scm_frame_uniform_vector_release (uvec); + scm_frame_uniform_vector_release_elements (uvec); cstart = 0; cend = vlen; diff --git a/libguile/srfi-4.h b/libguile/srfi-4.h index de426a00d..503e12292 100644 --- a/libguile/srfi-4.h +++ b/libguile/srfi-4.h @@ -41,10 +41,13 @@ SCM_API size_t scm_c_uniform_vector_size (SCM v); SCM_API SCM scm_c_uniform_vector_ref (SCM v, size_t idx); SCM_API void scm_c_uniform_vector_set_x (SCM v, size_t idx, SCM val); -SCM_API void *scm_uniform_vector_elements (SCM uvec); SCM_API size_t scm_uniform_vector_element_size (SCM uvec); -SCM_API void scm_uniform_vector_release (SCM uvec); -SCM_API void scm_frame_uniform_vector_release (SCM uvec); +SCM_API const void *scm_uniform_vector_elements (SCM uvec); +SCM_API void scm_uniform_vector_release_elements (SCM uvec); +SCM_API void scm_frame_uniform_vector_release_elements (SCM uvec); +SCM_API void *scm_uniform_vector_writable_elements (SCM uvec); +SCM_API void scm_uniform_vector_release_writable_elements (SCM uvec); +SCM_API void scm_frame_uniform_vector_release_writable_elements (SCM uvec); /* Specific procedures. */ @@ -59,7 +62,8 @@ SCM_API SCM scm_u8vector_set_x (SCM uvec, SCM index, SCM value); SCM_API SCM scm_u8vector_to_list (SCM uvec); SCM_API SCM scm_list_to_u8vector (SCM l); SCM_API SCM scm_any_to_u8vector (SCM obj); -SCM_API scm_t_uint8 *scm_u8vector_elements (SCM uvec); +SCM_API const scm_t_uint8 *scm_u8vector_elements (SCM uvec); +SCM_API scm_t_uint8 *scm_u8vector_writable_elements (SCM uvec); SCM_API SCM scm_s8vector_p (SCM obj); SCM_API SCM scm_make_s8vector (SCM n, SCM fill); @@ -71,7 +75,8 @@ SCM_API SCM scm_s8vector_set_x (SCM uvec, SCM index, SCM value); SCM_API SCM scm_s8vector_to_list (SCM uvec); SCM_API SCM scm_list_to_s8vector (SCM l); SCM_API SCM scm_any_to_s8vector (SCM obj); -SCM_API scm_t_int8 *scm_s8vector_elements (SCM uvec); +SCM_API const scm_t_int8 *scm_s8vector_elements (SCM uvec); +SCM_API scm_t_int8 *scm_s8vector_writable_elements (SCM uvec); SCM_API SCM scm_u16vector_p (SCM obj); SCM_API SCM scm_make_u16vector (SCM n, SCM fill); @@ -83,7 +88,8 @@ SCM_API SCM scm_u16vector_set_x (SCM uvec, SCM index, SCM value); SCM_API SCM scm_u16vector_to_list (SCM uvec); SCM_API SCM scm_list_to_u16vector (SCM l); SCM_API SCM scm_any_to_u16vector (SCM obj); -SCM_API scm_t_uint16 *scm_u16vector_elements (SCM uvec); +SCM_API const scm_t_uint16 *scm_u16vector_elements (SCM uvec); +SCM_API scm_t_uint16 *scm_u16vector_writable_elements (SCM uvec); SCM_API SCM scm_s16vector_p (SCM obj); SCM_API SCM scm_make_s16vector (SCM n, SCM fill); @@ -95,7 +101,8 @@ SCM_API SCM scm_s16vector_set_x (SCM uvec, SCM index, SCM value); SCM_API SCM scm_s16vector_to_list (SCM uvec); SCM_API SCM scm_list_to_s16vector (SCM l); SCM_API SCM scm_any_to_s16vector (SCM obj); -SCM_API scm_t_int16 *scm_s16vector_elements (SCM uvec); +SCM_API const scm_t_int16 *scm_s16vector_elements (SCM uvec); +SCM_API scm_t_int16 *scm_s16vector_writable_elements (SCM uvec); SCM_API SCM scm_u32vector_p (SCM obj); SCM_API SCM scm_make_u32vector (SCM n, SCM fill); @@ -107,7 +114,8 @@ SCM_API SCM scm_u32vector_set_x (SCM uvec, SCM index, SCM value); SCM_API SCM scm_u32vector_to_list (SCM uvec); SCM_API SCM scm_list_to_u32vector (SCM l); SCM_API SCM scm_any_to_u32vector (SCM obj); -SCM_API scm_t_uint32 *scm_u32vector_elements (SCM uvec); +SCM_API const scm_t_uint32 *scm_u32vector_elements (SCM uvec); +SCM_API scm_t_uint32 *scm_u32vector_writable_elements (SCM uvec); SCM_API SCM scm_s32vector_p (SCM obj); SCM_API SCM scm_make_s32vector (SCM n, SCM fill); @@ -119,7 +127,8 @@ SCM_API SCM scm_s32vector_set_x (SCM uvec, SCM index, SCM value); SCM_API SCM scm_s32vector_to_list (SCM uvec); SCM_API SCM scm_list_to_s32vector (SCM l); SCM_API SCM scm_any_to_s32vector (SCM obj); -SCM_API scm_t_int32 *scm_s32vector_elements (SCM uvec); +SCM_API const scm_t_int32 *scm_s32vector_elements (SCM uvec); +SCM_API scm_t_int32 *scm_s32vector_writable_elements (SCM uvec); SCM_API SCM scm_u64vector_p (SCM obj); SCM_API SCM scm_make_u64vector (SCM n, SCM fill); @@ -131,7 +140,8 @@ SCM_API SCM scm_u64vector_set_x (SCM uvec, SCM index, SCM value); SCM_API SCM scm_u64vector_to_list (SCM uvec); SCM_API SCM scm_list_to_u64vector (SCM l); SCM_API SCM scm_any_to_u64vector (SCM obj); -SCM_API scm_t_uint64 *scm_u64vector_elements (SCM uvec); +SCM_API const scm_t_uint64 *scm_u64vector_elements (SCM uvec); +SCM_API scm_t_uint64 *scm_u64vector_writable_elements (SCM uvec); SCM_API SCM scm_s64vector_p (SCM obj); SCM_API SCM scm_make_s64vector (SCM n, SCM fill); @@ -143,7 +153,8 @@ SCM_API SCM scm_s64vector_set_x (SCM uvec, SCM index, SCM value); SCM_API SCM scm_s64vector_to_list (SCM uvec); SCM_API SCM scm_list_to_s64vector (SCM l); SCM_API SCM scm_any_to_s64vector (SCM obj); -SCM_API scm_t_int64 *scm_s64vector_elements (SCM uvec); +SCM_API const scm_t_int64 *scm_s64vector_elements (SCM uvec); +SCM_API scm_t_int64 *scm_s64vector_writable_elements (SCM uvec); SCM_API SCM scm_f32vector_p (SCM obj); SCM_API SCM scm_make_f32vector (SCM n, SCM fill); @@ -155,7 +166,8 @@ SCM_API SCM scm_f32vector_set_x (SCM uvec, SCM index, SCM value); SCM_API SCM scm_f32vector_to_list (SCM uvec); SCM_API SCM scm_list_to_f32vector (SCM l); SCM_API SCM scm_any_to_f32vector (SCM obj); -SCM_API float *scm_f32vector_elements (SCM uvec); +SCM_API const float *scm_f32vector_elements (SCM uvec); +SCM_API float *scm_f32vector_writable_elements (SCM uvec); SCM_API SCM scm_f64vector_p (SCM obj); SCM_API SCM scm_make_f64vector (SCM n, SCM fill); @@ -167,7 +179,8 @@ SCM_API SCM scm_f64vector_set_x (SCM uvec, SCM index, SCM value); SCM_API SCM scm_f64vector_to_list (SCM uvec); SCM_API SCM scm_list_to_f64vector (SCM l); SCM_API SCM scm_any_to_f64vector (SCM obj); -SCM_API double *scm_f64vector_elements (SCM uvec); +SCM_API const double *scm_f64vector_elements (SCM uvec); +SCM_API double *scm_f64vector_writable_elements (SCM uvec); SCM_API SCM scm_c32vector_p (SCM obj); SCM_API SCM scm_make_c32vector (SCM n, SCM fill); @@ -179,7 +192,8 @@ SCM_API SCM scm_c32vector_set_x (SCM uvec, SCM index, SCM value); SCM_API SCM scm_c32vector_to_list (SCM uvec); SCM_API SCM scm_list_to_c32vector (SCM l); SCM_API SCM scm_any_to_c32vector (SCM obj); -SCM_API float *scm_c32vector_elements (SCM uvec); +SCM_API const float *scm_c32vector_elements (SCM uvec); +SCM_API float *scm_c32vector_writable_elements (SCM uvec); SCM_API SCM scm_c64vector_p (SCM obj); SCM_API SCM scm_make_c64vector (SCM n, SCM fill); @@ -191,7 +205,8 @@ SCM_API SCM scm_c64vector_set_x (SCM uvec, SCM index, SCM value); SCM_API SCM scm_c64vector_to_list (SCM uvec); SCM_API SCM scm_list_to_c64vector (SCM l); SCM_API SCM scm_any_to_c64vector (SCM obj); -SCM_API double *scm_c64vector_elements (SCM uvec); +SCM_API const double *scm_c64vector_elements (SCM uvec); +SCM_API double *scm_c64vector_writable_elements (SCM uvec); SCM_API SCM scm_i_generalized_vector_creator (SCM uvec); SCM_API const char *scm_i_uniform_vector_tag (SCM uvec); diff --git a/libguile/srfi-4.i.c b/libguile/srfi-4.i.c index 755589f38..21c0895ee 100644 --- a/libguile/srfi-4.i.c +++ b/libguile/srfi-4.i.c @@ -138,8 +138,15 @@ SCM_DEFINE (F(scm_any_to_,TAG,vector), "any->"S(TAG)"vector", 1, 0, 0, } #undef FUNC_NAME -CTYPE * +const CTYPE * F(scm_,TAG,vector_elements) (SCM obj) +{ + uvec_assert (TYPE, obj); + return (const CTYPE *)SCM_UVEC_BASE (obj); +} + +CTYPE * +F(scm_,TAG,vector_writable_elements) (SCM obj) { uvec_assert (TYPE, obj); return (CTYPE *)SCM_UVEC_BASE (obj);