diff options
Diffstat (limited to 'libguile/array-handle.c')
-rw-r--r-- | libguile/array-handle.c | 293 |
1 files changed, 84 insertions, 209 deletions
diff --git a/libguile/array-handle.c b/libguile/array-handle.c index 35fc1fc2f..cd5a46698 100644 --- a/libguile/array-handle.c +++ b/libguile/array-handle.c @@ -27,206 +27,82 @@ #include "libguile/__scm.h" #include "libguile/array-handle.h" -#include "libguile/arrays.h" -#include "libguile/strings.h" -#include "libguile/vectors.h" -#include "libguile/srfi-4.h" -#include "libguile/bitvectors.h" -#include "libguile/bytevectors.h" -static SCM -enclosed_ref (scm_t_array_handle *h, ssize_t pos) -{ - return scm_i_cvref (SCM_I_ARRAY_V (h->array), pos + h->base, 1); -} +SCM scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_LAST + 1]; -static SCM -vector_ref (scm_t_array_handle *h, ssize_t pos) -{ - return ((const SCM *)h->elements)[pos]; -} -static SCM -string_ref (scm_t_array_handle *h, ssize_t pos) -{ - pos += h->base; - if (SCM_I_ARRAYP (h->array)) - return scm_c_string_ref (SCM_I_ARRAY_V (h->array), pos); - else - return scm_c_string_ref (h->array, pos); -} +#define ARRAY_IMPLS_N_STATIC_ALLOC 7 +static scm_t_array_implementation array_impls[ARRAY_IMPLS_N_STATIC_ALLOC]; +static int num_array_impls_registered = 0; -static SCM -bitvector_ref (scm_t_array_handle *h, ssize_t pos) -{ - pos += scm_array_handle_bit_elements_offset (h); - return - scm_from_bool (((scm_t_uint32 *)h->elements)[pos/32] & (1l << (pos % 32))); -} - -static SCM -bytevector_ref (scm_t_array_handle *h, ssize_t pos) -{ - return scm_from_uint8 (((scm_t_uint8 *) h->elements)[pos]); -} - -static SCM -memoize_ref (scm_t_array_handle *h, ssize_t pos) -{ - SCM v = h->array; - - if (SCM_I_ENCLOSED_ARRAYP (v)) - { - h->ref = enclosed_ref; - return enclosed_ref (h, pos); - } - - if (SCM_I_ARRAYP (v)) - v = SCM_I_ARRAY_V (v); - - if (scm_is_vector (v)) - { - h->elements = scm_array_handle_elements (h); - h->ref = vector_ref; - } - else if (scm_is_uniform_vector (v)) - { - h->elements = scm_array_handle_uniform_elements (h); - h->ref = scm_i_uniform_vector_ref_proc (v); - } - else if (scm_is_string (v)) - { - h->ref = string_ref; - } - else if (scm_is_bitvector (v)) - { - h->elements = scm_array_handle_bit_elements (h); - h->ref = bitvector_ref; - } - else if (scm_is_bytevector (v)) - { - h->elements = scm_array_handle_uniform_elements (h); - h->ref = bytevector_ref; - } - else - scm_misc_error (NULL, "unknown array type: ~a", scm_list_1 (h->array)); - - return h->ref (h, pos); -} - -static void -enclosed_set (scm_t_array_handle *h, ssize_t pos, SCM val) -{ - scm_wrong_type_arg_msg (NULL, 0, h->array, "non-enclosed array"); -} - -static void -vector_set (scm_t_array_handle *h, ssize_t pos, SCM val) -{ - ((SCM *)h->writable_elements)[pos] = val; -} - -static void -string_set (scm_t_array_handle *h, ssize_t pos, SCM val) -{ - pos += h->base; - if (SCM_I_ARRAYP (h->array)) - scm_c_string_set_x (SCM_I_ARRAY_V (h->array), pos, val); - else - scm_c_string_set_x (h->array, pos, val); -} -static void -bitvector_set (scm_t_array_handle *h, ssize_t pos, SCM val) +void +scm_i_register_array_implementation (scm_t_array_implementation *impl) { - scm_t_uint32 mask; - pos += scm_array_handle_bit_elements_offset (h); - mask = 1l << (pos % 32); - if (scm_to_bool (val)) - ((scm_t_uint32 *)h->writable_elements)[pos/32] |= mask; + if (num_array_impls_registered >= ARRAY_IMPLS_N_STATIC_ALLOC) + /* need to increase ARRAY_IMPLS_N_STATIC_ALLOC, buster */ + abort (); else - ((scm_t_uint32 *)h->writable_elements)[pos/32] &= ~mask; + array_impls[num_array_impls_registered++] = *impl; } -static void -bytevector_set (scm_t_array_handle *h, ssize_t pos, SCM val) +scm_t_array_implementation* +scm_i_array_implementation_for_obj (SCM obj) { - scm_t_uint8 c_value; - scm_t_uint8 *elements; - - c_value = scm_to_uint8 (val); - elements = (scm_t_uint8 *) h->elements; - elements[pos] = (scm_t_uint8) c_value; -} - -static void -memoize_set (scm_t_array_handle *h, ssize_t pos, SCM val) -{ - SCM v = h->array; - - if (SCM_I_ENCLOSED_ARRAYP (v)) - { - h->set = enclosed_set; - enclosed_set (h, pos, val); - return; - } - - if (SCM_I_ARRAYP (v)) - v = SCM_I_ARRAY_V (v); - - if (scm_is_vector (v)) - { - h->writable_elements = scm_array_handle_writable_elements (h); - h->set = vector_set; - } - else if (scm_is_uniform_vector (v)) - { - h->writable_elements = scm_array_handle_uniform_writable_elements (h); - h->set = scm_i_uniform_vector_set_proc (v); - } - else if (scm_is_string (v)) - { - h->set = string_set; - } - else if (scm_is_bitvector (v)) - { - h->writable_elements = scm_array_handle_bit_writable_elements (h); - h->set = bitvector_set; - } - else if (scm_is_bytevector (v)) - { - h->elements = scm_array_handle_uniform_writable_elements (h); - h->set = bytevector_set; - } - else - scm_misc_error (NULL, "unknown array type: ~a", scm_list_1 (h->array)); - - h->set (h, pos, val); + int i; + for (i = 0; i < num_array_impls_registered; i++) + if (SCM_NIMP (obj) + && (SCM_CELL_TYPE (obj) & array_impls[i].mask) == array_impls[i].tag) + return &array_impls[i]; + return NULL; } void scm_array_get_handle (SCM array, scm_t_array_handle *h) { + scm_t_array_implementation *impl = scm_i_array_implementation_for_obj (array); + if (!impl) + scm_wrong_type_arg_msg (NULL, 0, array, "array"); h->array = array; - h->ref = memoize_ref; - h->set = memoize_set; - - if (SCM_I_ARRAYP (array) || SCM_I_ENCLOSED_ARRAYP (array)) - { - h->dims = SCM_I_ARRAY_DIMS (array); - h->base = SCM_I_ARRAY_BASE (array); - } - else if (scm_is_generalized_vector (array)) + h->impl = impl; + h->base = 0; + h->ndims = 0; + h->dims = NULL; + h->element_type = SCM_ARRAY_ELEMENT_TYPE_SCM; /* have to default to + something... */ + h->elements = NULL; + h->writable_elements = NULL; + h->impl->get_handle (array, h); +} + +ssize_t +scm_array_handle_pos (scm_t_array_handle *h, SCM indices) +{ + scm_t_array_dim *s = scm_array_handle_dims (h); + ssize_t pos = 0, i; + size_t k = scm_array_handle_rank (h); + + while (k > 0 && scm_is_pair (indices)) { - h->dim0.lbnd = 0; - h->dim0.ubnd = scm_c_generalized_vector_length (array) - 1; - h->dim0.inc = 1; - h->dims = &h->dim0; - h->base = 0; + i = scm_to_signed_integer (SCM_CAR (indices), s->lbnd, s->ubnd); + pos += (i - s->lbnd) * s->inc; + k--; + s++; + indices = SCM_CDR (indices); } - else - scm_wrong_type_arg_msg (NULL, 0, array, "array"); + if (k > 0 || !scm_is_null (indices)) + scm_misc_error (NULL, "wrong number of indices, expecting ~a", + scm_list_1 (scm_from_size_t (scm_array_handle_rank (h)))); + return pos; +} + +SCM +scm_array_handle_element_type (scm_t_array_handle *h) +{ + if (h->element_type < 0 || h->element_type > SCM_ARRAY_ELEMENT_TYPE_LAST) + abort (); /* guile programming error */ + return scm_i_array_element_types[h->element_type]; } void @@ -236,47 +112,46 @@ scm_array_handle_release (scm_t_array_handle *h) */ } -size_t -scm_array_handle_rank (scm_t_array_handle *h) -{ - if (SCM_I_ARRAYP (h->array) || SCM_I_ENCLOSED_ARRAYP (h->array)) - return SCM_I_ARRAY_NDIM (h->array); - else - return 1; -} - -scm_t_array_dim * -scm_array_handle_dims (scm_t_array_handle *h) -{ - return h->dims; -} - const SCM * scm_array_handle_elements (scm_t_array_handle *h) { - SCM vec = h->array; - if (SCM_I_ARRAYP (vec)) - vec = SCM_I_ARRAY_V (vec); - if (SCM_I_IS_VECTOR (vec)) - return SCM_I_VECTOR_ELTS (vec) + h->base; - scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array"); + if (h->element_type != SCM_ARRAY_ELEMENT_TYPE_SCM) + scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array"); + return ((const SCM*)h->elements) + h->base; } SCM * scm_array_handle_writable_elements (scm_t_array_handle *h) { - SCM vec = h->array; - if (SCM_I_ARRAYP (vec)) - vec = SCM_I_ARRAY_V (vec); - if (SCM_I_IS_VECTOR (vec)) - return SCM_I_VECTOR_WELTS (vec) + h->base; - scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array"); + if (h->element_type != SCM_ARRAY_ELEMENT_TYPE_SCM) + scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array"); + return ((SCM*)h->elements) + h->base; } - void scm_init_array_handle (void) { +#define DEFINE_ARRAY_TYPE(tag, TAG) \ + scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_##TAG] \ + = (scm_permanent_object (scm_from_locale_symbol (#tag))) + + scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_SCM] = SCM_BOOL_T; + DEFINE_ARRAY_TYPE (a, CHAR); + DEFINE_ARRAY_TYPE (b, BIT); + DEFINE_ARRAY_TYPE (vu8, VU8); + DEFINE_ARRAY_TYPE (u8, U8); + DEFINE_ARRAY_TYPE (s8, S8); + DEFINE_ARRAY_TYPE (u16, U16); + DEFINE_ARRAY_TYPE (s16, S16); + DEFINE_ARRAY_TYPE (u32, U32); + DEFINE_ARRAY_TYPE (s32, S32); + DEFINE_ARRAY_TYPE (u64, U64); + DEFINE_ARRAY_TYPE (s64, S64); + DEFINE_ARRAY_TYPE (f32, F32); + DEFINE_ARRAY_TYPE (f64, F64); + DEFINE_ARRAY_TYPE (c32, C32); + DEFINE_ARRAY_TYPE (c64, C64); + #include "libguile/array-handle.x" } |