diff options
author | Andy Wingo <wingo@pobox.com> | 2014-02-09 12:31:59 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2014-02-09 12:48:21 +0100 |
commit | cf64dca65c4ee4d845a73e7d7c15ab7583aff15b (patch) | |
tree | 690ecc2fd6357077f0e736df9bf4637bce6b0aa6 /libguile/array-handle.c | |
parent | 8269f0be18c046d94f01f83dcff80794e97e6c27 (diff) | |
download | guile-cf64dca65c4ee4d845a73e7d7c15ab7583aff15b.tar.gz |
Remove array impl. registry; instead, hard-code array handle creation
* libguile/array-handle.h (scm_t_vector_ref, scm_t_vector_set): Rename
from scm_t_array_ref, scm_t_array_set. These were named
scm_i_t_array_ref and scm_i_t_array_set in 1.8 and 2.0. Change to
take the vector directly, instead of the array handle. In this way,
generic array handles are layered on top of specific implementations
of backing stores.
Remove scm_t_array_implementation, introduced in 2.0 but never
documented. It was a failed attempt to layer the array implementation
that actually introduced too many layers, as it prevented the "vref"
and "vset" members of scm_t_array_handle (called "ref" and "set" in
1.8, not present in 2.0) from specializing on array backing stores.
(scm_i_register_array_implementation) (scm_i_array_implementation_for_obj):
Remove these internal interfaces.
(scm_t_array_handle): Adapt to scm_t_vector_ref / scm_t_vector_set
change.
(scm_array_handle_ref, scm_array_handle_set): Adapt to change in
vref/vset prototype.
* libguile/array-handle.c (scm_array_get_handle): Inline all the
necessary initializations here for all specific array types.
* libguile/array-map.c (rafill, racp, ramap, rafe, array_index_map_1):
* libguile/arrays.c: Remove array implementation code.
* libguile/bitvectors.h:
* libguile/bitvectors.c: Remove array implementation code.
(scm_i_bitvector_bits): New internal interface.
* libguile/bytevectors.c: Remove array implementation code.
* libguile/srfi-4.h: Remove declarations for internal procedures that
don't exist (!).
* libguile/strings.c: Remove array implementation code.
* libguile/vectors.c: Remove array implementation code.
Diffstat (limited to 'libguile/array-handle.c')
-rw-r--r-- | libguile/array-handle.c | 233 |
1 files changed, 203 insertions, 30 deletions
diff --git a/libguile/array-handle.c b/libguile/array-handle.c index daa1fcbc7..84e9f88a1 100644 --- a/libguile/array-handle.c +++ b/libguile/array-handle.c @@ -33,50 +33,223 @@ SCM scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_LAST + 1]; -#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; +/* Bytevectors as generalized vectors & arrays. */ +#define DEFINE_BYTEVECTOR_ACCESSORS(type, tag, infix) \ + static SCM \ + bytevector_##tag##_ref (SCM bv, size_t pos) \ + { \ + SCM idx = scm_from_size_t (pos * sizeof (type)); \ + return scm_bytevector_##infix##_ref (bv, idx); \ + } \ + static void \ + bytevector_##tag##_set (SCM bv, size_t pos, SCM val) \ + { \ + SCM idx = scm_from_size_t (pos * sizeof (type)); \ + scm_bytevector_##infix##_set_x (bv, idx, val); \ + } -void -scm_i_register_array_implementation (scm_t_array_implementation *impl) +DEFINE_BYTEVECTOR_ACCESSORS (uint8_t, u8, u8); +DEFINE_BYTEVECTOR_ACCESSORS (int8_t, s8, s8); +DEFINE_BYTEVECTOR_ACCESSORS (uint16_t, u16, u16_native); +DEFINE_BYTEVECTOR_ACCESSORS (int16_t, s16, s16_native); +DEFINE_BYTEVECTOR_ACCESSORS (uint32_t, u32, u32_native); +DEFINE_BYTEVECTOR_ACCESSORS (int32_t, s32, s32_native); +DEFINE_BYTEVECTOR_ACCESSORS (uint64_t, u64, u64_native); +DEFINE_BYTEVECTOR_ACCESSORS (int64_t, s64, s64_native); +DEFINE_BYTEVECTOR_ACCESSORS (float, f32, ieee_single_native); +DEFINE_BYTEVECTOR_ACCESSORS (double, f64, ieee_double_native); + +/* Since these functions are only called by Guile's C code, we can abort + instead of throwing if there is an error. */ +static SCM +bytevector_c32_ref (SCM bv, size_t pos) +{ + char *c_bv; + float real, imag; + + if (!SCM_BYTEVECTOR_P (bv)) + abort (); + c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv); + pos *= 2 * sizeof (float); + if (pos + 2 * sizeof (float) - 1 >= SCM_BYTEVECTOR_LENGTH (bv)) + abort (); + + memcpy (&real, &c_bv[pos], sizeof (float)); + memcpy (&imag, &c_bv[pos + sizeof (float)], sizeof (float)); + return scm_c_make_rectangular (real, imag); +} + +static SCM +bytevector_c64_ref (SCM bv, size_t pos) +{ + char *c_bv; + double real, imag; + + if (!SCM_BYTEVECTOR_P (bv)) + abort (); + c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv); + pos *= 2 * sizeof (double); + if (pos + 2 * sizeof (double) - 1 >= SCM_BYTEVECTOR_LENGTH (bv)) + abort (); + + memcpy (&real, &c_bv[pos], sizeof (double)); + memcpy (&imag, &c_bv[pos + sizeof (double)], sizeof (double)); + return scm_c_make_rectangular (real, imag); +} + +static void +bytevector_c32_set (SCM bv, size_t pos, SCM val) +{ + char *c_bv; + float real, imag; + + if (!SCM_BYTEVECTOR_P (bv)) + abort (); + c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv); + pos *= 2 * sizeof (float); + if (pos + 2 * sizeof (float) - 1 >= SCM_BYTEVECTOR_LENGTH (bv)) + abort (); + + real = scm_c_real_part (val); + imag = scm_c_imag_part (val); + memcpy (&c_bv[pos], &real, sizeof (float)); + memcpy (&c_bv[pos + sizeof (float)], &imag, sizeof (float)); +} + +static void +bytevector_c64_set (SCM bv, size_t pos, SCM val) { - if (num_array_impls_registered >= ARRAY_IMPLS_N_STATIC_ALLOC) - /* need to increase ARRAY_IMPLS_N_STATIC_ALLOC, buster */ + char *c_bv; + double real, imag; + + if (!SCM_BYTEVECTOR_P (bv)) + abort (); + c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv); + pos *= 2 * sizeof (double); + if (pos + 2 * sizeof (double) - 1 >= SCM_BYTEVECTOR_LENGTH (bv)) abort (); - else - array_impls[num_array_impls_registered++] = *impl; + + real = scm_c_real_part (val); + imag = scm_c_imag_part (val); + memcpy (&c_bv[pos], &real, sizeof (double)); + memcpy (&c_bv[pos + sizeof (double)], &imag, sizeof (double)); } -scm_t_array_implementation* -scm_i_array_implementation_for_obj (SCM obj) +static void +initialize_vector_handle (scm_t_array_handle *h, size_t len, + scm_t_array_element_type element_type, + scm_t_vector_ref vref, scm_t_vector_set vset, + void *writable_elements) { - 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; + h->base = 0; + h->ndims = 1; + h->dims = &h->dim0; + h->dim0.lbnd = 0; + h->dim0.ubnd = (ssize_t) (len - 1U); + h->dim0.inc = 1; + h->element_type = element_type; + h->elements = h->writable_elements = writable_elements; + h->vector = h->array; + h->vref = vref; + h->vset = vset; } 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) + if (!SCM_HEAP_OBJECT_P (array)) scm_wrong_type_arg_msg (NULL, 0, array, "array"); + h->array = array; - 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->vref = impl->vref; - h->vset = impl->vset; - h->vector = SCM_I_ARRAYP (array) ? SCM_I_ARRAY_V (array) : array; - impl->get_handle (array, h); + + switch (SCM_TYP7 (array)) + { + case scm_tc7_string: + initialize_vector_handle (h, scm_c_string_length (array), + SCM_ARRAY_ELEMENT_TYPE_CHAR, + scm_c_string_ref, scm_c_string_set_x, + NULL); + break; + case scm_tc7_vector: + initialize_vector_handle (h, scm_c_vector_length (array), + SCM_ARRAY_ELEMENT_TYPE_SCM, + scm_c_vector_ref, scm_c_vector_set_x, + SCM_I_VECTOR_WELTS (array)); + break; + case scm_tc7_bitvector: + initialize_vector_handle (h, scm_c_bitvector_length (array), + SCM_ARRAY_ELEMENT_TYPE_BIT, + scm_c_bitvector_ref, scm_c_bitvector_set_x, + scm_i_bitvector_bits (array)); + break; + case scm_tc7_bytevector: + { + size_t byte_length, length, element_byte_size; + scm_t_array_element_type element_type; + scm_t_vector_ref vref; + scm_t_vector_set vset; + + byte_length = scm_c_bytevector_length (array); + element_type = SCM_BYTEVECTOR_ELEMENT_TYPE (array); + element_byte_size = scm_i_array_element_type_sizes[element_type] / 8; + length = byte_length / element_byte_size; + + switch (element_type) + { +#define ACCESSOR_CASE(tag, TAG) \ + case SCM_ARRAY_ELEMENT_TYPE_##TAG: \ + vref = bytevector_##tag##_ref; \ + vset = bytevector_##tag##_set; \ + break + + case SCM_ARRAY_ELEMENT_TYPE_VU8: + ACCESSOR_CASE(u8, U8); + ACCESSOR_CASE(s8, S8); + ACCESSOR_CASE(u16, U16); + ACCESSOR_CASE(s16, S16); + ACCESSOR_CASE(u32, U32); + ACCESSOR_CASE(s32, S32); + ACCESSOR_CASE(u64, U64); + ACCESSOR_CASE(s64, S64); + ACCESSOR_CASE(f32, F32); + ACCESSOR_CASE(f64, F64); + ACCESSOR_CASE(c32, C32); + ACCESSOR_CASE(c64, C64); + + case SCM_ARRAY_ELEMENT_TYPE_SCM: + case SCM_ARRAY_ELEMENT_TYPE_BIT: + case SCM_ARRAY_ELEMENT_TYPE_CHAR: + default: + abort (); + +#undef ACCESSOR_CASE + } + + initialize_vector_handle (h, length, element_type, vref, vset, + SCM_BYTEVECTOR_CONTENTS (array)); + } + break; + case scm_tc7_array: + h->base = SCM_I_ARRAY_BASE (array); + h->ndims = SCM_I_ARRAY_NDIM (array); + h->dims = SCM_I_ARRAY_DIMS (array); + { + scm_t_array_handle vh; + + scm_array_get_handle (SCM_I_ARRAY_V (array), &vh); + h->element_type = vh.element_type; + h->elements = vh.elements; + h->writable_elements = vh.writable_elements; + h->vector = vh.vector; + h->vref = vh.vref; + h->vset = vh.vset; + scm_array_handle_release (&vh); + } + break; + default: + scm_wrong_type_arg_msg (NULL, 0, array, "array"); + } } ssize_t |