diff options
author | Ludovic Courtès <ludo@gnu.org> | 2011-07-01 19:09:29 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2011-07-01 19:09:29 +0200 |
commit | 4bc95fccad7288004515ce78d50611499cbca2db (patch) | |
tree | 21cbe4bb4050d91aaaa1b4dd9f95f38ccaaa70e4 /libguile/bytevectors.c | |
parent | 1e8f93922922b09c7003a357d86777b2a79e9735 (diff) | |
download | guile-4bc95fccad7288004515ce78d50611499cbca2db.tar.gz |
Add type and range checks to the complex generalized vector accessors.
* libguile/bytevectors.c (COMPLEX_ACCESSOR_PROLOGUE, COMPLEX_NATIVE_REF,
COMPLEX_NATIVE_SET): New macros.
(bytevector_ref_c32, bytevector_ref_c64): Defined in terms of
`COMPLEX_NATIVE_REF'.
(bytevector_set_c32, bytevector_set_c64): Defined in terms of
`COMPLEX_NATIVE_SET'.
(bytevector_ref_fns): Make `static'.
* test-suite/tests/srfi-4.test ("c32 vectors")["generalized-vector-ref",
"generalized-vector-set!", "generalized-vector-ref, out-of-range",
"generalized-vector-set!, out-of-range"]: New tests.
("c64 vectors")["generalized-vector-ref", "generalized-vector-set!",
"generalized-vector-ref, out-of-range",
"generalized-vector-set!, out-of-range"]: New tests.
Diffstat (limited to 'libguile/bytevectors.c')
-rw-r--r-- | libguile/bytevectors.c | 110 |
1 files changed, 64 insertions, 46 deletions
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c index b8af53ad3..7ac1fa34e 100644 --- a/libguile/bytevectors.c +++ b/libguile/bytevectors.c @@ -2092,36 +2092,56 @@ SCM_DEFINE (scm_utf32_to_string, "utf32->string", /* Bytevectors as generalized vectors & arrays. */ +#define COMPLEX_ACCESSOR_PROLOGUE(_type) \ + size_t c_len, c_index; \ + char *c_bv; \ + \ + SCM_VALIDATE_BYTEVECTOR (1, bv); \ + c_index = scm_to_size_t (index); \ + \ + c_len = SCM_BYTEVECTOR_LENGTH (bv); \ + c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv); \ + \ + if (SCM_UNLIKELY (c_index + 2 * sizeof (_type) - 1 >= c_len)) \ + scm_out_of_range (FUNC_NAME, index); -static SCM -bytevector_ref_c32 (SCM bv, SCM idx) -{ /* FIXME add some checks */ - float real, imag; - const char *contents = (char *) SCM_BYTEVECTOR_CONTENTS (bv); - size_t i = scm_to_size_t (idx); - - memcpy (&real, &contents[i], sizeof (float)); - memcpy (&imag, &contents[i + sizeof (float)], sizeof (float)); +/* Template for native access to complex numbers of type TYPE. */ +#define COMPLEX_NATIVE_REF(_type) \ + SCM result; \ + \ + COMPLEX_ACCESSOR_PROLOGUE (_type); \ + \ + { \ + _type real, imag; \ + \ + memcpy (&real, &c_bv[c_index], sizeof (_type)); \ + memcpy (&imag, &c_bv[c_index + sizeof (_type)], sizeof (_type)); \ + \ + result = scm_c_make_rectangular (real, imag); \ + } \ + \ + return result; - return scm_c_make_rectangular (real, imag); +static SCM +bytevector_ref_c32 (SCM bv, SCM index) +#define FUNC_NAME "bytevector_ref_c32" +{ + COMPLEX_NATIVE_REF (float); } +#undef FUNC_NAME static SCM -bytevector_ref_c64 (SCM bv, SCM idx) -{ /* FIXME add some checks */ - double real, imag; - const char *contents = (char *) SCM_BYTEVECTOR_CONTENTS (bv); - size_t i = scm_to_size_t (idx); - - memcpy (&real, &contents[i], sizeof (double)); - memcpy (&imag, &contents[i + sizeof (double)], sizeof (double)); - - return scm_c_make_rectangular (real, imag); +bytevector_ref_c64 (SCM bv, SCM index) +#define FUNC_NAME "bytevector_ref_c64" +{ + COMPLEX_NATIVE_REF (double); } +#undef FUNC_NAME typedef SCM (*scm_t_bytevector_ref_fn)(SCM, SCM); -const scm_t_bytevector_ref_fn bytevector_ref_fns[SCM_ARRAY_ELEMENT_TYPE_LAST + 1] = +static const scm_t_bytevector_ref_fn +bytevector_ref_fns[SCM_ARRAY_ELEMENT_TYPE_LAST + 1] = { NULL, /* SCM */ NULL, /* CHAR */ @@ -2153,38 +2173,36 @@ bv_handle_ref (scm_t_array_handle *h, size_t index) return ref_fn (h->array, byte_index); } -/* FIXME add checks!!! */ +/* Template for native modification of complex numbers of type TYPE. */ +#define COMPLEX_NATIVE_SET(_type) \ + COMPLEX_ACCESSOR_PROLOGUE (_type); \ + \ + { \ + _type real, imag; \ + real = scm_c_real_part (value); \ + imag = scm_c_imag_part (value); \ + \ + memcpy (&c_bv[c_index], &real, sizeof (_type)); \ + memcpy (&c_bv[c_index + sizeof (_type)], &imag, sizeof (_type)); \ + } \ + \ + return SCM_UNSPECIFIED; + static SCM -bytevector_set_c32 (SCM bv, SCM idx, SCM val) +bytevector_set_c32 (SCM bv, SCM index, SCM value) +#define FUNC_NAME "bytevector_set_c32" { - float imag, real; - char *contents = (char *) SCM_BYTEVECTOR_CONTENTS (bv); - size_t i = scm_to_size_t (idx); - - real = scm_c_real_part (val); - imag = scm_c_imag_part (val); - - memcpy (&contents[i], &real, sizeof (float)); - memcpy (&contents[i + sizeof (float)], &imag, sizeof (float)); - - return SCM_UNSPECIFIED; + COMPLEX_NATIVE_SET (float); } +#undef FUNC_NAME static SCM -bytevector_set_c64 (SCM bv, SCM idx, SCM val) +bytevector_set_c64 (SCM bv, SCM index, SCM value) +#define FUNC_NAME "bytevector_set_c64" { - double imag, real; - char *contents = (char *) SCM_BYTEVECTOR_CONTENTS (bv); - size_t i = scm_to_size_t (idx); - - real = scm_c_real_part (val); - imag = scm_c_imag_part (val); - - memcpy (&contents[i], &real, sizeof (double)); - memcpy (&contents[i + sizeof (double)], &imag, sizeof (double)); - - return SCM_UNSPECIFIED; + COMPLEX_NATIVE_SET (double); } +#undef FUNC_NAME typedef SCM (*scm_t_bytevector_set_fn)(SCM, SCM, SCM); |