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 | |
parent | 8269f0be18c046d94f01f83dcff80794e97e6c27 (diff) |
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.
-rw-r--r-- | libguile/array-handle.c | 233 | ||||
-rw-r--r-- | libguile/array-handle.h | 40 | ||||
-rw-r--r-- | libguile/array-map.c | 17 | ||||
-rw-r--r-- | libguile/arrays.c | 34 | ||||
-rw-r--r-- | libguile/bitvectors.c | 39 | ||||
-rw-r--r-- | libguile/bitvectors.h | 3 | ||||
-rw-r--r-- | libguile/bytevectors.c | 178 | ||||
-rw-r--r-- | libguile/srfi-4.h | 5 | ||||
-rw-r--r-- | libguile/strings.c | 30 | ||||
-rw-r--r-- | libguile/vectors.c | 34 |
10 files changed, 233 insertions, 380 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 diff --git a/libguile/array-handle.h b/libguile/array-handle.h index abe617ff5..a623b4e2e 100644 --- a/libguile/array-handle.h +++ b/libguile/array-handle.h @@ -30,35 +30,8 @@ -struct scm_t_array_handle; - -typedef SCM (*scm_t_array_ref) (struct scm_t_array_handle *, size_t); -typedef void (*scm_t_array_set) (struct scm_t_array_handle *, size_t, SCM); - -typedef struct -{ - scm_t_bits tag; - scm_t_bits mask; - scm_t_array_ref vref; - scm_t_array_set vset; - void (*get_handle)(SCM, struct scm_t_array_handle*); -} scm_t_array_implementation; - -#define SCM_ARRAY_IMPLEMENTATION(tag_,mask_,vref_,vset_,handle_) \ - SCM_SNARF_INIT ({ \ - scm_t_array_implementation impl; \ - impl.tag = tag_; impl.mask = mask_; \ - impl.vref = vref_; impl.vset = vset_; \ - impl.get_handle = handle_; \ - scm_i_register_array_implementation (&impl); \ - }) - - -SCM_INTERNAL void scm_i_register_array_implementation (scm_t_array_implementation *impl); -SCM_INTERNAL scm_t_array_implementation* scm_i_array_implementation_for_obj (SCM obj); - - - +typedef SCM (*scm_t_vector_ref) (SCM, size_t); +typedef void (*scm_t_vector_set) (SCM, size_t, SCM); typedef struct scm_t_array_dim { @@ -93,6 +66,7 @@ SCM_INTERNAL SCM scm_i_array_element_types[]; typedef struct scm_t_array_handle { SCM array; + /* `Base' is an offset into elements or writable_elements, corresponding to the first element in the array. It would be nicer just to adjust the elements/writable_elements pointer, but we can't because that element might @@ -109,8 +83,8 @@ typedef struct scm_t_array_handle { /* The backing store for the array, and its accessors. */ SCM vector; - scm_t_array_ref vref; - scm_t_array_set vset; + scm_t_vector_ref vref; + scm_t_vector_set vset; } scm_t_array_handle; #define scm_array_handle_rank(h) ((h)->ndims) @@ -139,7 +113,7 @@ scm_array_handle_ref (scm_t_array_handle *h, ssize_t p) /* catch overflow */ scm_out_of_range (NULL, scm_from_ssize_t (p)); /* perhaps should catch overflow here too */ - return h->vref (h, h->base + p); + return h->vref (h->vector, h->base + p); } SCM_INLINE_IMPLEMENTATION void @@ -149,7 +123,7 @@ scm_array_handle_set (scm_t_array_handle *h, ssize_t p, SCM v) /* catch overflow */ scm_out_of_range (NULL, scm_from_ssize_t (p)); /* perhaps should catch overflow here too */ - h->vset (h, h->base + p, v); + h->vset (h->vector, h->base + p, v); } #endif diff --git a/libguile/array-map.c b/libguile/array-map.c index f3d6e2d42..bef539dae 100644 --- a/libguile/array-map.c +++ b/libguile/array-map.c @@ -309,7 +309,7 @@ rafill (SCM dst, SCM fill) inc = SCM_I_ARRAY_DIMS (dst)->inc; for (; n-- > 0; i += inc) - h.vset (&h, i, fill); + h.vset (h.vector, i, fill); scm_array_handle_release (&h); return 1; @@ -345,7 +345,7 @@ racp (SCM src, SCM dst) inc_d = SCM_I_ARRAY_DIMS (dst)->inc; for (; n-- > 0; i_s += inc_s, i_d += inc_d) - h_d.vset (&h_d, i_d, h_s.vref (&h_s, i_s)); + h_d.vset (h_d.vector, i_d, h_s.vref (h_s.vector, i_s)); scm_array_handle_release (&h_d); scm_array_handle_release (&h_s); @@ -647,7 +647,7 @@ ramap (SCM ra0, SCM proc, SCM ras) i0end = i0 + n*inc0; if (scm_is_null (ras)) for (; i0 < i0end; i0 += inc0) - h0.vset (&h0, i0, scm_call_0 (proc)); + h0.vset (h0.vector, i0, scm_call_0 (proc)); else { SCM ra1 = SCM_CAR (ras); @@ -660,7 +660,7 @@ ramap (SCM ra0, SCM proc, SCM ras) ras = SCM_CDR (ras); if (scm_is_null (ras)) for (; i0 < i0end; i0 += inc0, i1 += inc1) - h0.vset (&h0, i0, scm_call_1 (proc, h1.vref (&h1, i1))); + h0.vset (h0.vector, i0, scm_call_1 (proc, h1.vref (h1.vector, i1))); else { ras = scm_vector (ras); @@ -670,7 +670,8 @@ ramap (SCM ra0, SCM proc, SCM ras) unsigned long k; for (k = scm_c_vector_length (ras); k--;) args = scm_cons (AREF (scm_c_vector_ref (ras, k), i), args); - h0.vset (&h0, i0, scm_apply_1 (proc, h1.vref (&h1, i1), args)); + h0.vset (h0.vector, i0, + scm_apply_1 (proc, h1.vref (h1.vector, i1), args)); } } scm_array_handle_release (&h1); @@ -720,7 +721,7 @@ rafe (SCM ra0, SCM proc, SCM ras) i0end = i0 + n*inc0; if (scm_is_null (ras)) for (; i0 < i0end; i0 += inc0) - scm_call_1 (proc, h0.vref (&h0, i0)); + scm_call_1 (proc, h0.vref (h0.vector, i0)); else { ras = scm_vector (ras); @@ -730,7 +731,7 @@ rafe (SCM ra0, SCM proc, SCM ras) unsigned long k; for (k = scm_c_vector_length (ras); k--;) args = scm_cons (AREF (scm_c_vector_ref (ras, k), i), args); - scm_apply_1 (proc, h0.vref (&h0, i0), args); + scm_apply_1 (proc, h0.vref (h0.vector, i0), args); } } scm_array_handle_release (&h0); @@ -759,7 +760,7 @@ array_index_map_1 (SCM ra, SCM proc) scm_array_get_handle (ra, &h); inc = h.dims[0].inc; for (i = h.dims[0].lbnd, p = h.base; i <= h.dims[0].ubnd; ++i, p += inc) - h.vset (&h, p, scm_call_1 (proc, scm_from_ulong (i))); + h.vset (h.vector, p, scm_call_1 (proc, scm_from_ulong (i))); scm_array_handle_release (&h); } diff --git a/libguile/arrays.c b/libguile/arrays.c index a771739ad..84d0f71fb 100644 --- a/libguile/arrays.c +++ b/libguile/arrays.c @@ -819,40 +819,6 @@ scm_i_print_array (SCM array, SCM port, scm_print_state *pstate) return scm_i_print_array_dimension (&h, 0, 0, port, pstate); } -static SCM -array_handle_ref (scm_t_array_handle *hh, size_t pos) -{ - return scm_c_array_ref_1 (SCM_I_ARRAY_V (hh->array), pos); -} - -static void -array_handle_set (scm_t_array_handle *hh, size_t pos, SCM val) -{ - scm_c_array_set_1_x (SCM_I_ARRAY_V (hh->array), val, pos); -} - -/* FIXME: should be handle for vect? maybe not, because of dims */ -static void -array_get_handle (SCM array, scm_t_array_handle *h) -{ - scm_t_array_handle vh; - scm_array_get_handle (SCM_I_ARRAY_V (array), &vh); - assert (vh.dims[0].inc == 1 && vh.dims[0].lbnd == 0 && vh.base == 0); - h->element_type = vh.element_type; - h->elements = vh.elements; - h->writable_elements = vh.writable_elements; - scm_array_handle_release (&vh); - - h->dims = SCM_I_ARRAY_DIMS (array); - h->ndims = SCM_I_ARRAY_NDIM (array); - h->base = SCM_I_ARRAY_BASE (array); -} - -SCM_ARRAY_IMPLEMENTATION (scm_tc7_array, - 0x7f, - array_handle_ref, array_handle_set, - array_get_handle) - void scm_init_arrays () { diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c index 2eef1dc56..1611119ab 100644 --- a/libguile/bitvectors.c +++ b/libguile/bitvectors.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -42,6 +42,13 @@ #define BITVECTOR_LENGTH(obj) ((size_t)SCM_CELL_WORD_1(obj)) #define BITVECTOR_BITS(obj) ((scm_t_uint32 *)SCM_CELL_WORD_2(obj)) +scm_t_uint32 *scm_i_bitvector_bits (SCM vec) +{ + if (!IS_BITVECTOR (vec)) + abort (); + return BITVECTOR_BITS (vec); +} + int scm_i_print_bitvector (SCM vec, SCM port, scm_print_state *pstate) { @@ -852,36 +859,6 @@ scm_istr2bve (SCM str) return res; } -/* FIXME: h->array should be h->vector */ -static SCM -bitvector_handle_ref (scm_t_array_handle *h, size_t pos) -{ - return scm_c_bitvector_ref (h->array, pos); -} - -static void -bitvector_handle_set (scm_t_array_handle *h, size_t pos, SCM val) -{ - scm_c_bitvector_set_x (h->array, pos, val); -} - -static void -bitvector_get_handle (SCM bv, scm_t_array_handle *h) -{ - h->array = bv; - h->ndims = 1; - h->dims = &h->dim0; - h->dim0.lbnd = 0; - h->dim0.ubnd = BITVECTOR_LENGTH (bv) - 1; - h->dim0.inc = 1; - h->element_type = SCM_ARRAY_ELEMENT_TYPE_BIT; - h->elements = h->writable_elements = BITVECTOR_BITS (bv); -} - -SCM_ARRAY_IMPLEMENTATION (scm_tc7_bitvector, - 0x7f, - bitvector_handle_ref, bitvector_handle_set, - bitvector_get_handle) SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_BIT, scm_make_bitvector) void diff --git a/libguile/bitvectors.h b/libguile/bitvectors.h index 6b25327a8..6b2cb1e5c 100644 --- a/libguile/bitvectors.h +++ b/libguile/bitvectors.h @@ -3,7 +3,7 @@ #ifndef SCM_BITVECTORS_H #define SCM_BITVECTORS_H -/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009, 2014 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -70,6 +70,7 @@ SCM_API scm_t_uint32 *scm_bitvector_writable_elements (SCM vec, size_t *lenp, ssize_t *incp); +SCM_INTERNAL scm_t_uint32 *scm_i_bitvector_bits (SCM vec); SCM_INTERNAL int scm_i_print_bitvector (SCM vec, SCM port, scm_print_state *pstate); SCM_INTERNAL SCM scm_i_bitvector_equal_p (SCM vec1, SCM vec2); SCM_INTERNAL void scm_init_bitvectors (void); diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c index 064c427ed..c7908d75c 100644 --- a/libguile/bytevectors.c +++ b/libguile/bytevectors.c @@ -2081,168 +2081,6 @@ SCM_DEFINE (scm_utf32_to_string, "utf32->string", #undef FUNC_NAME -/* 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); - -/* 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; - -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 index) -#define FUNC_NAME "bytevector_ref_c64" -{ - COMPLEX_NATIVE_REF (double); -} -#undef FUNC_NAME - -typedef SCM (*scm_t_bytevector_ref_fn)(SCM, SCM); - -static const scm_t_bytevector_ref_fn -bytevector_ref_fns[SCM_ARRAY_ELEMENT_TYPE_LAST + 1] = -{ - NULL, /* SCM */ - NULL, /* CHAR */ - NULL, /* BIT */ - scm_bytevector_u8_ref, /* VU8 */ - scm_bytevector_u8_ref, /* U8 */ - scm_bytevector_s8_ref, - scm_bytevector_u16_native_ref, - scm_bytevector_s16_native_ref, - scm_bytevector_u32_native_ref, - scm_bytevector_s32_native_ref, - scm_bytevector_u64_native_ref, - scm_bytevector_s64_native_ref, - scm_bytevector_ieee_single_native_ref, - scm_bytevector_ieee_double_native_ref, - bytevector_ref_c32, - bytevector_ref_c64 -}; - -static SCM -bv_handle_ref (scm_t_array_handle *h, size_t index) -{ - SCM byte_index; - scm_t_bytevector_ref_fn ref_fn; - - ref_fn = bytevector_ref_fns[h->element_type]; - byte_index = - scm_from_size_t (index * scm_array_handle_uniform_element_size (h)); - return ref_fn (h->array, byte_index); -} - -/* 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 index, SCM value) -#define FUNC_NAME "bytevector_set_c32" -{ - COMPLEX_NATIVE_SET (float); -} -#undef FUNC_NAME - -static SCM -bytevector_set_c64 (SCM bv, SCM index, SCM value) -#define FUNC_NAME "bytevector_set_c64" -{ - COMPLEX_NATIVE_SET (double); -} -#undef FUNC_NAME - -typedef SCM (*scm_t_bytevector_set_fn)(SCM, SCM, SCM); - -const scm_t_bytevector_set_fn bytevector_set_fns[SCM_ARRAY_ELEMENT_TYPE_LAST + 1] = -{ - NULL, /* SCM */ - NULL, /* CHAR */ - NULL, /* BIT */ - scm_bytevector_u8_set_x, /* VU8 */ - scm_bytevector_u8_set_x, /* U8 */ - scm_bytevector_s8_set_x, - scm_bytevector_u16_native_set_x, - scm_bytevector_s16_native_set_x, - scm_bytevector_u32_native_set_x, - scm_bytevector_s32_native_set_x, - scm_bytevector_u64_native_set_x, - scm_bytevector_s64_native_set_x, - scm_bytevector_ieee_single_native_set_x, - scm_bytevector_ieee_double_native_set_x, - bytevector_set_c32, - bytevector_set_c64 -}; - -static void -bv_handle_set_x (scm_t_array_handle *h, size_t index, SCM val) -{ - SCM byte_index; - scm_t_bytevector_set_fn set_fn; - - set_fn = bytevector_set_fns[h->element_type]; - byte_index = - scm_from_size_t (index * scm_array_handle_uniform_element_size (h)); - set_fn (h->array, byte_index, val); -} - -static void -bytevector_get_handle (SCM v, scm_t_array_handle *h) -{ - h->array = v; - h->ndims = 1; - h->dims = &h->dim0; - h->dim0.lbnd = 0; - h->dim0.ubnd = SCM_BYTEVECTOR_TYPED_LENGTH (v) - 1; - h->dim0.inc = 1; - h->element_type = SCM_BYTEVECTOR_ELEMENT_TYPE (v); - h->elements = h->writable_elements = SCM_BYTEVECTOR_CONTENTS (v); -} - - /* Initialization. */ void @@ -2264,19 +2102,9 @@ scm_bootstrap_bytevectors (void) (scm_t_extension_init_func) scm_init_bytevectors, NULL); - { - scm_t_array_implementation impl; - - impl.tag = scm_tc7_bytevector; - impl.mask = 0x7f; - impl.vref = bv_handle_ref; - impl.vset = bv_handle_set_x; - impl.get_handle = bytevector_get_handle; - scm_i_register_array_implementation (&impl); - scm_i_register_vector_constructor - (scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_VU8], - scm_make_bytevector); - } + scm_i_register_vector_constructor + (scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_VU8], + scm_make_bytevector); } void diff --git a/libguile/srfi-4.h b/libguile/srfi-4.h index a710a94fa..f56c3f35b 100644 --- a/libguile/srfi-4.h +++ b/libguile/srfi-4.h @@ -274,11 +274,6 @@ SCM_API double *scm_c64vector_writable_elements (SCM uvec, size_t *lenp, ssize_t *incp); -SCM_INTERNAL SCM scm_i_generalized_vector_type (SCM vec); -SCM_INTERNAL const char *scm_i_uniform_vector_tag (SCM uvec); -SCM_INTERNAL scm_t_array_ref scm_i_uniform_vector_ref_proc (SCM uvec); -SCM_INTERNAL scm_t_array_set scm_i_uniform_vector_set_proc (SCM uvec); - SCM_INTERNAL void scm_init_srfi_4 (void); #endif /* SCM_SRFI_4_H */ diff --git a/libguile/strings.c b/libguile/strings.c index e8eb91cbd..90dc83a66 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1998,2000,2001, 2004, 2006, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,2000,2001, 2004, 2006, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -2465,34 +2465,6 @@ scm_i_get_substring_spec (size_t len, *cend = scm_to_unsigned_integer (end, *cstart, len); } -static SCM -string_handle_ref (scm_t_array_handle *h, size_t index) -{ - return scm_c_string_ref (h->array, index); -} - -static void -string_handle_set (scm_t_array_handle *h, size_t index, SCM val) -{ - scm_c_string_set_x (h->array, index, val); -} - -static void -string_get_handle (SCM v, scm_t_array_handle *h) -{ - h->array = v; - h->ndims = 1; - h->dims = &h->dim0; - h->dim0.lbnd = 0; - h->dim0.ubnd = scm_c_string_length (v) - 1; - h->dim0.inc = 1; - h->element_type = SCM_ARRAY_ELEMENT_TYPE_CHAR; - h->elements = h->writable_elements = NULL; -} - -SCM_ARRAY_IMPLEMENTATION (scm_tc7_string, 0x7f, - string_handle_ref, string_handle_set, - string_get_handle) SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_CHAR, scm_make_string) void diff --git a/libguile/vectors.c b/libguile/vectors.c index bb42e00ba..5dab5454a 100644 --- a/libguile/vectors.c +++ b/libguile/vectors.c @@ -432,40 +432,6 @@ SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 5, 0, 0, #undef FUNC_NAME -static SCM -vector_handle_ref (scm_t_array_handle *h, size_t idx) -{ - if (idx > h->dims[0].ubnd) - scm_out_of_range ("vector-handle-ref", scm_from_size_t (idx)); - return ((SCM*)h->elements)[idx]; -} - -static void -vector_handle_set (scm_t_array_handle *h, size_t idx, SCM val) -{ - if (idx > h->dims[0].ubnd) - scm_out_of_range ("vector-handle-set!", scm_from_size_t (idx)); - ((SCM*)h->writable_elements)[idx] = val; -} - -static void -vector_get_handle (SCM v, scm_t_array_handle *h) -{ - h->array = v; - h->ndims = 1; - h->dims = &h->dim0; - h->dim0.lbnd = 0; - h->dim0.ubnd = SCM_I_VECTOR_LENGTH (v) - 1; - h->dim0.inc = 1; - h->element_type = SCM_ARRAY_ELEMENT_TYPE_SCM; - h->elements = h->writable_elements = SCM_I_VECTOR_WELTS (v); -} - -/* the & ~2 allows catching scm_tc7_wvect as well. needs changing if you change - tags.h. */ -SCM_ARRAY_IMPLEMENTATION (scm_tc7_vector, 0x7f & ~2, - vector_handle_ref, vector_handle_set, - vector_get_handle) SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_SCM, scm_make_vector) |