diff options
-rw-r--r-- | libguile/arrays.c | 24 | ||||
-rw-r--r-- | libguile/bytevectors.c | 21 | ||||
-rw-r--r-- | libguile/uniform.c | 56 | ||||
-rw-r--r-- | libguile/uniform.h | 4 |
4 files changed, 59 insertions, 46 deletions
diff --git a/libguile/arrays.c b/libguile/arrays.c index 2be9ec3f0..62ce83e3b 100644 --- a/libguile/arrays.c +++ b/libguile/arrays.c @@ -211,7 +211,7 @@ scm_from_contiguous_typed_array (SCM type, SCM bounds, const void *bytes, scm_t_array_dim *s; SCM ra; scm_t_array_handle h; - void *base; + void *elts; size_t sz; ra = scm_i_shap2ra (bounds); @@ -230,16 +230,24 @@ scm_from_contiguous_typed_array (SCM type, SCM bounds, const void *bytes, scm_array_get_handle (ra, &h); - base = scm_array_handle_uniform_writable_elements (&h); - sz = scm_array_handle_uniform_element_size (&h); + elts = h.writable_elements; + sz = scm_array_handle_uniform_element_bit_size (&h); scm_array_handle_release (&h); - if (byte_len % sz) - SCM_MISC_ERROR ("byte length not a multiple of the unit size", SCM_EOL); - if (byte_len / sz != rlen) - SCM_MISC_ERROR ("byte length and dimensions do not match", SCM_EOL); + if (sz >= 8 && ((sz % 8) == 0)) + { + if (byte_len % (sz / 8)) + SCM_MISC_ERROR ("byte length not a multiple of the unit size", SCM_EOL); + if (byte_len / (sz / 8) != rlen) + SCM_MISC_ERROR ("byte length and dimensions do not match", SCM_EOL); + } + else + { + if (rlen * (sz / 8) + rlen * (sz % 8) / 8 != byte_len) + SCM_MISC_ERROR ("byte length and dimensions do not match", SCM_EOL); + } - memcpy (base, bytes, byte_len); + memcpy (elts, bytes, byte_len); if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra)) if (s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc)) diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c index 4246f0111..a3233eab1 100644 --- a/libguile/bytevectors.c +++ b/libguile/bytevectors.c @@ -22,6 +22,7 @@ #endif #include <alloca.h> +#include <assert.h> #include <gmp.h> @@ -587,23 +588,29 @@ SCM_DEFINE (scm_uniform_array_to_bytevector, "uniform-array->bytevector", #define FUNC_NAME s_scm_uniform_array_to_bytevector { SCM contents, ret; - size_t len; + size_t len, sz, byte_len; scm_t_array_handle h; - const void *base; - size_t sz; + const void *elts; contents = scm_array_contents (array, SCM_BOOL_T); if (scm_is_false (contents)) scm_wrong_type_arg_msg (FUNC_NAME, 0, array, "uniform contiguous array"); scm_array_get_handle (contents, &h); + assert (h.base == 0); - base = scm_array_handle_uniform_elements (&h); + elts = h.elements; len = h.dims->inc * (h.dims->ubnd - h.dims->lbnd + 1); - sz = scm_array_handle_uniform_element_size (&h); + sz = scm_array_handle_uniform_element_bit_size (&h); + if (sz >= 8 && ((sz % 8) == 0)) + byte_len = len * (sz / 8); + else + /* uf. tricky, and i'm not sure i'm avoiding overflow. */ + byte_len = len * (sz / 8) + + (((len * (sz % 8)) - 1) / 8) + 1; - ret = make_bytevector (len * sz, SCM_ARRAY_ELEMENT_TYPE_VU8); - memcpy (SCM_BYTEVECTOR_CONTENTS (ret), base, len * sz); + ret = make_bytevector (byte_len, SCM_ARRAY_ELEMENT_TYPE_VU8); + memcpy (SCM_BYTEVECTOR_CONTENTS (ret), elts, byte_len); scm_array_handle_release (&h); diff --git a/libguile/uniform.c b/libguile/uniform.c index 28125da8b..6bab85675 100644 --- a/libguile/uniform.c +++ b/libguile/uniform.c @@ -44,13 +44,24 @@ const size_t scm_i_array_element_type_sizes[SCM_ARRAY_ELEMENT_TYPE_LAST + 1] = { 64, 128 }; -/* FIXME: return bit size instead of byte size? */ size_t scm_array_handle_uniform_element_size (scm_t_array_handle *h) { size_t ret = scm_i_array_element_type_sizes[h->element_type]; if (ret && ret % 8 == 0) return ret / 8; + else if (ret) + scm_wrong_type_arg_msg (NULL, 0, h->array, "byte-aligned uniform array"); + else + scm_wrong_type_arg_msg (NULL, 0, h->array, "uniform array"); +} + +size_t +scm_array_handle_uniform_element_bit_size (scm_t_array_handle *h) +{ + size_t ret = scm_i_array_element_type_sizes[h->element_type]; + if (ret) + return ret; else scm_wrong_type_arg_msg (NULL, 0, h->array, "uniform array"); } @@ -110,14 +121,15 @@ SCM_DEFINE (scm_uniform_vector_p, "uniform-vector?", 1, 0, 0, SCM_DEFINE (scm_uniform_vector_element_type, "uniform-vector-element-type", 1, 0, 0, (SCM v), - "Return the number of elements in the uniform vector, @var{v}.") + "Return the type of the elements in the uniform vector, @var{v}.") #define FUNC_NAME s_scm_uniform_vector_element_type { scm_t_array_handle h; - size_t len; - ssize_t inc; SCM ret; - scm_uniform_vector_elements (v, &h, &len, &inc); + + if (!scm_is_uniform_vector (v)) + scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, v, "uniform vector"); + scm_array_get_handle (v, &h); ret = scm_array_handle_element_type (&h); scm_array_handle_release (&h); return ret; @@ -144,15 +156,9 @@ SCM_DEFINE (scm_uniform_vector_element_size, "uniform-vector-element-size", 1, 0 SCM scm_c_uniform_vector_ref (SCM v, size_t idx) { - SCM ret; - scm_t_array_handle h; - size_t len; - ssize_t inc; - - scm_uniform_vector_elements (v, &h, &len, &inc); - ret = scm_array_handle_ref (&h, idx*inc); - scm_array_handle_release (&h); - return ret; + if (!scm_is_uniform_vector (v)) + scm_wrong_type_arg_msg (NULL, 0, v, "uniform vector"); + return scm_c_generalized_vector_ref (v, idx); } SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0, @@ -168,13 +174,9 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0, void scm_c_uniform_vector_set_x (SCM v, size_t idx, SCM val) { - scm_t_array_handle h; - size_t len; - ssize_t inc; - - scm_uniform_vector_elements (v, &h, &len, &inc); - scm_array_handle_set (&h, idx*inc, val); - scm_array_handle_release (&h); + if (!scm_is_uniform_vector (v)) + scm_wrong_type_arg_msg (NULL, 0, v, "uniform vector"); + scm_c_generalized_vector_set_x (v, idx, val); } SCM_DEFINE (scm_uniform_vector_set_x, "uniform-vector-set!", 3, 0, 0, @@ -193,15 +195,9 @@ SCM_DEFINE (scm_uniform_vector_to_list, "uniform-vector->list", 1, 0, 0, "Convert the uniform numeric vector @var{uvec} to a list.") #define FUNC_NAME s_scm_uniform_vector_to_list { - SCM ret; - scm_t_array_handle h; - size_t len; - ssize_t inc; - - scm_uniform_vector_elements (uvec, &h, &len, &inc); - ret = scm_generalized_vector_to_list (uvec); - scm_array_handle_release (&h); - return ret; + if (!scm_is_uniform_vector (uvec)) + scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, uvec, "uniform vector"); + return scm_generalized_vector_to_list (uvec); } #undef FUNC_NAME diff --git a/libguile/uniform.h b/libguile/uniform.h index b1f396594..f0d5915f6 100644 --- a/libguile/uniform.h +++ b/libguile/uniform.h @@ -36,8 +36,10 @@ SCM_INTERNAL const size_t scm_i_array_element_type_sizes[]; #define SCM_ARRAY_ELEMENT_TYPE_IS_UNBOXED(t) \ (scm_i_array_element_type_sizes[(t)] != 0) -/* returns type size in bits */ +/* type size in bytes */ SCM_API size_t scm_array_handle_uniform_element_size (scm_t_array_handle *h); +/* type size in bits */ +SCM_API size_t scm_array_handle_uniform_element_bit_size (scm_t_array_handle *h); SCM_API const void *scm_array_handle_uniform_elements (scm_t_array_handle *h); SCM_API void *scm_array_handle_uniform_writable_elements (scm_t_array_handle *h); |