summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/arrays.c24
-rw-r--r--libguile/bytevectors.c21
-rw-r--r--libguile/uniform.c56
-rw-r--r--libguile/uniform.h4
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);