summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/array-handle.c233
-rw-r--r--libguile/array-handle.h40
-rw-r--r--libguile/array-map.c17
-rw-r--r--libguile/arrays.c34
-rw-r--r--libguile/bitvectors.c39
-rw-r--r--libguile/bitvectors.h3
-rw-r--r--libguile/bytevectors.c178
-rw-r--r--libguile/srfi-4.h5
-rw-r--r--libguile/strings.c30
-rw-r--r--libguile/vectors.c34
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)