summaryrefslogtreecommitdiff
path: root/libguile/bytevectors.c
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2009-08-28 19:01:19 +0200
committerLudovic Courtès <ludo@gnu.org>2009-08-28 19:16:46 +0200
commit7af531508c5931261ff8957708642cac67bf86a5 (patch)
treebd36d27d9f7a11d954093d4121ccb9e645f5c59f /libguile/bytevectors.c
parentf86f3b5b113b4cb383c531150b13bef9b2789221 (diff)
parentce3ed0125fcfb9ad09da815f133a2320102d164c (diff)
downloadguile-7af531508c5931261ff8957708642cac67bf86a5.tar.gz
Merge branch 'master' into boehm-demers-weiser-gc
Conflicts: libguile/Makefile.am libguile/bytevectors.c libguile/gc-card.c libguile/gc-mark.c libguile/programs.c libguile/srcprop.c libguile/srfi-14.c libguile/symbols.c libguile/threads.c libguile/unif.c libguile/vm.c
Diffstat (limited to 'libguile/bytevectors.c')
-rw-r--r--libguile/bytevectors.c322
1 files changed, 255 insertions, 67 deletions
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index 5b79a1435..b2e5ec9b0 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -31,7 +31,9 @@
#include "libguile/strings.h"
#include "libguile/validate.h"
#include "libguile/ieee-754.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
+#include "libguile/array-handle.h"
+#include "libguile/uniform.h"
#include "libguile/srfi-4.h"
#include <byteswap.h>
@@ -175,48 +177,99 @@
scm_t_bits scm_tc16_bytevector;
-#define SCM_BYTEVECTOR_SET_LENGTH(_bv, _len) \
+#define SCM_BYTEVECTOR_INLINE_THRESHOLD (2 * sizeof (SCM))
+#define SCM_BYTEVECTOR_INLINEABLE_SIZE_P(_size) \
+ ((_size) <= SCM_BYTEVECTOR_INLINE_THRESHOLD)
+#define SCM_BYTEVECTOR_SET_LENGTH(_bv, _len) \
SCM_SET_SMOB_DATA ((_bv), (scm_t_bits) (_len))
-#define SCM_BYTEVECTOR_SET_CONTENTS(_bv, _buf) \
+#define SCM_BYTEVECTOR_SET_CONTENTS(_bv, _buf) \
SCM_SET_SMOB_DATA_2 ((_bv), (scm_t_bits) (_buf))
+#define SCM_BYTEVECTOR_SET_INLINE(bv) \
+ SCM_SET_SMOB_FLAGS (bv, SCM_SMOB_FLAGS (bv) | SCM_F_BYTEVECTOR_INLINE)
+#define SCM_BYTEVECTOR_SET_ELEMENT_TYPE(bv, hint) \
+ SCM_SET_SMOB_FLAGS (bv, (SCM_SMOB_FLAGS (bv) & 0xFF) | (hint << 8))
+#define SCM_BYTEVECTOR_TYPE_SIZE(var) \
+ (scm_i_array_element_type_sizes[SCM_BYTEVECTOR_ELEMENT_TYPE (var)]/8)
+#define SCM_BYTEVECTOR_TYPED_LENGTH(var) \
+ SCM_BYTEVECTOR_LENGTH (var) / SCM_BYTEVECTOR_TYPE_SIZE (var)
/* The empty bytevector. */
SCM scm_null_bytevector = SCM_UNSPECIFIED;
static inline SCM
-make_bytevector_from_buffer (size_t len, signed char *contents)
+make_bytevector_from_buffer (size_t len, void *contents,
+ scm_t_array_element_type element_type)
{
- /* Assuming LEN > SCM_BYTEVECTOR_INLINE_THRESHOLD. */
- SCM_RETURN_NEWSMOB2 (scm_tc16_bytevector, len, contents);
+ SCM ret;
+ size_t c_len;
+
+ if (SCM_UNLIKELY (element_type > SCM_ARRAY_ELEMENT_TYPE_LAST
+ || scm_i_array_element_type_sizes[element_type] < 8
+ || len >= (SCM_I_SIZE_MAX
+ / (scm_i_array_element_type_sizes[element_type]/8))))
+ /* This would be an internal Guile programming error */
+ abort ();
+
+ c_len = len * (scm_i_array_element_type_sizes[element_type] / 8);
+ if (!SCM_BYTEVECTOR_INLINEABLE_SIZE_P (c_len))
+ SCM_NEWSMOB2 (ret, scm_tc16_bytevector, c_len, contents);
+ else
+ {
+ SCM_NEWSMOB2 (ret, scm_tc16_bytevector, c_len, NULL);
+ SCM_BYTEVECTOR_SET_INLINE (ret);
+ if (contents)
+ {
+ memcpy (SCM_BYTEVECTOR_CONTENTS (ret), contents, c_len);
+ scm_gc_free (contents, c_len, SCM_GC_BYTEVECTOR);
+ }
+ }
+ SCM_BYTEVECTOR_SET_ELEMENT_TYPE (ret, element_type);
+ return ret;
}
static inline SCM
-make_bytevector (size_t len)
+make_bytevector (size_t len, scm_t_array_element_type element_type)
{
- SCM bv;
+ size_t c_len;
- if (SCM_UNLIKELY (len == 0))
- bv = scm_null_bytevector;
+ if (SCM_UNLIKELY (len == 0 && element_type == 0))
+ return scm_null_bytevector;
+ else if (SCM_UNLIKELY (element_type > SCM_ARRAY_ELEMENT_TYPE_LAST
+ || scm_i_array_element_type_sizes[element_type] < 8
+ || len >= (SCM_I_SIZE_MAX
+ / (scm_i_array_element_type_sizes[element_type]/8))))
+ /* This would be an internal Guile programming error */
+ abort ();
+
+ c_len = len * (scm_i_array_element_type_sizes[element_type]/8);
+ if (SCM_BYTEVECTOR_INLINEABLE_SIZE_P (c_len))
+ {
+ SCM ret;
+ SCM_NEWSMOB2 (ret, scm_tc16_bytevector, c_len, NULL);
+ SCM_BYTEVECTOR_SET_INLINE (ret);
+ SCM_BYTEVECTOR_SET_ELEMENT_TYPE (ret, element_type);
+ return ret;
+ }
else
{
- signed char *contents = NULL;
-
- if (!SCM_BYTEVECTOR_INLINEABLE_SIZE_P (len))
- contents = (signed char *)
- scm_gc_malloc_pointerless (len, SCM_GC_BYTEVECTOR);
-
- bv = make_bytevector_from_buffer (len, contents);
+ void *buf = scm_gc_malloc_pointerless (c_len, SCM_GC_BYTEVECTOR);
+ return make_bytevector_from_buffer (len, buf, element_type);
}
-
- return bv;
}
/* Return a new bytevector of size LEN octets. */
SCM
scm_c_make_bytevector (size_t len)
{
- return (make_bytevector (len));
+ return make_bytevector (len, SCM_ARRAY_ELEMENT_TYPE_VU8);
+}
+
+/* Return a new bytevector of size LEN elements. */
+SCM
+scm_i_make_typed_bytevector (size_t len, scm_t_array_element_type element_type)
+{
+ return make_bytevector (len, element_type);
}
/* Return a bytevector of size LEN made up of CONTENTS. The area pointed to
@@ -224,22 +277,14 @@ scm_c_make_bytevector (size_t len)
SCM
scm_c_take_bytevector (signed char *contents, size_t len)
{
- SCM bv;
-
- if (SCM_UNLIKELY (SCM_BYTEVECTOR_INLINEABLE_SIZE_P (len)))
- {
- /* Copy CONTENTS into an "in-line" buffer, then free CONTENTS. */
- signed char *c_bv;
-
- bv = make_bytevector (len);
- c_bv = SCM_BYTEVECTOR_CONTENTS (bv);
- memcpy (c_bv, contents, len);
- scm_gc_free (contents, len, SCM_GC_BYTEVECTOR);
- }
- else
- bv = make_bytevector_from_buffer (len, contents);
+ return make_bytevector_from_buffer (len, contents, SCM_ARRAY_ELEMENT_TYPE_VU8);
+}
- return bv;
+SCM
+scm_c_take_typed_bytevector (signed char *contents, size_t len,
+ scm_t_array_element_type element_type)
+{
+ return make_bytevector_from_buffer (len, contents, element_type);
}
/* Shrink BV to C_NEW_LEN (which is assumed to be smaller than its current
@@ -247,6 +292,10 @@ scm_c_take_bytevector (signed char *contents, size_t len)
SCM
scm_i_shrink_bytevector (SCM bv, size_t c_new_len)
{
+ if (SCM_UNLIKELY (c_new_len % SCM_BYTEVECTOR_TYPE_SIZE (bv)))
+ /* This would be an internal Guile programming error */
+ abort ();
+
if (!SCM_BYTEVECTOR_INLINE_P (bv))
{
size_t c_len;
@@ -260,6 +309,7 @@ scm_i_shrink_bytevector (SCM bv, size_t c_new_len)
if (SCM_BYTEVECTOR_INLINEABLE_SIZE_P (c_new_len))
{
/* Copy to the in-line buffer and free the current buffer. */
+ SCM_BYTEVECTOR_SET_INLINE (bv);
c_new_bv = SCM_BYTEVECTOR_CONTENTS (bv);
memcpy (c_new_bv, c_bv, c_new_len);
scm_gc_free (c_bv, c_len, SCM_GC_BYTEVECTOR);
@@ -272,6 +322,8 @@ scm_i_shrink_bytevector (SCM bv, size_t c_new_len)
SCM_BYTEVECTOR_SET_CONTENTS (bv, c_new_bv);
}
}
+ else
+ SCM_BYTEVECTOR_SET_LENGTH (bv, c_new_len);
return bv;
}
@@ -330,38 +382,30 @@ scm_c_bytevector_set_x (SCM bv, size_t index, scm_t_uint8 value)
}
#undef FUNC_NAME
-/* This procedure is used by `scm_c_generalized_vector_set_x ()'. */
-void
-scm_i_bytevector_generalized_set_x (SCM bv, size_t index, SCM value)
-#define FUNC_NAME "scm_i_bytevector_generalized_set_x"
-{
- scm_c_bytevector_set_x (bv, index, scm_to_uint8 (value));
-}
-#undef FUNC_NAME
+
+
+
static int
-print_bytevector (SCM bv, SCM port, scm_print_state *pstate)
+print_bytevector (SCM bv, SCM port, scm_print_state *pstate SCM_UNUSED)
{
- unsigned c_len, i;
- unsigned char *c_bv;
-
- c_len = SCM_BYTEVECTOR_LENGTH (bv);
- c_bv = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
+ ssize_t ubnd, inc, i;
+ scm_t_array_handle h;
+
+ scm_array_get_handle (bv, &h);
- scm_puts ("#vu8(", port);
- for (i = 0; i < c_len; i++)
+ scm_putc ('#', port);
+ scm_write (scm_array_handle_element_type (&h), port);
+ scm_putc ('(', port);
+ for (i = h.dims[0].lbnd, ubnd = h.dims[0].ubnd, inc = h.dims[0].inc;
+ i <= ubnd; i += inc)
{
if (i > 0)
scm_putc (' ', port);
-
- scm_uintprint (c_bv[i], 10, port);
+ scm_write (scm_array_handle_ref (&h, i), port);
}
-
scm_putc (')', port);
- /* Make GCC think we use it. */
- scm_remember_upto_here ((SCM) pstate);
-
return 1;
}
@@ -430,7 +474,7 @@ SCM_DEFINE (scm_make_bytevector, "make-bytevector", 1, 1, 0,
c_fill = (signed char) value;
}
- bv = make_bytevector (c_len);
+ bv = make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
if (fill != SCM_UNDEFINED)
{
unsigned i;
@@ -556,7 +600,7 @@ SCM_DEFINE (scm_bytevector_copy, "bytevector-copy", 1, 0, 0,
c_len = SCM_BYTEVECTOR_LENGTH (bv);
c_bv = SCM_BYTEVECTOR_CONTENTS (bv);
- copy = make_bytevector (c_len);
+ copy = make_bytevector (c_len, SCM_BYTEVECTOR_ELEMENT_TYPE (bv));
c_copy = SCM_BYTEVECTOR_CONTENTS (copy);
memcpy (c_copy, c_bv, c_len);
@@ -586,7 +630,7 @@ SCM_DEFINE (scm_uniform_array_to_bytevector, "uniform-array->bytevector",
len = h.dims->inc * (h.dims->ubnd - h.dims->lbnd + 1);
sz = scm_array_handle_uniform_element_size (&h);
- ret = make_bytevector (len * sz);
+ ret = make_bytevector (len * sz, SCM_ARRAY_ELEMENT_TYPE_VU8);
memcpy (SCM_BYTEVECTOR_CONTENTS (ret), base, len * sz);
scm_array_handle_release (&h);
@@ -675,7 +719,7 @@ SCM_DEFINE (scm_u8_list_to_bytevector, "u8-list->bytevector", 1, 0, 0,
SCM_VALIDATE_LIST_COPYLEN (1, lst, c_len);
- bv = make_bytevector (c_len);
+ bv = make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
c_bv = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
for (i = 0; i < c_len; lst = SCM_CDR (lst), i++)
@@ -1112,7 +1156,7 @@ SCM_DEFINE (scm_bytevector_to_uint_list, "bytevector->uint-list",
if (SCM_UNLIKELY ((c_size == 0) || (c_size >= (ULONG_MAX >> 3L)))) \
scm_out_of_range (FUNC_NAME, size); \
\
- bv = make_bytevector (c_len * c_size); \
+ bv = make_bytevector (c_len * c_size, SCM_ARRAY_ELEMENT_TYPE_VU8); \
c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv); \
\
for (c_bv_ptr = c_bv; \
@@ -1611,6 +1655,12 @@ double_from_foreign_endianness (const union scm_ieee754_double *source)
_c_type ## _to_foreign_endianness
+/* FIXME: SCM_VALIDATE_REAL rejects integers, etc. grrr */
+#define VALIDATE_REAL(pos, v) \
+ do { \
+ SCM_ASSERT_TYPE (scm_is_true (scm_rational_p (v)), v, pos, FUNC_NAME, "real"); \
+ } while (0)
+
/* Templace getters and setters. */
#define IEEE754_ACCESSOR_PROLOGUE(_type) \
@@ -1647,7 +1697,7 @@ double_from_foreign_endianness (const union scm_ieee754_double *source)
_type c_value; \
\
IEEE754_ACCESSOR_PROLOGUE (_type); \
- SCM_VALIDATE_REAL (3, value); \
+ VALIDATE_REAL (3, value); \
SCM_VALIDATE_SYMBOL (4, endianness); \
c_value = IEEE754_FROM_SCM (_type) (value); \
\
@@ -1667,7 +1717,7 @@ double_from_foreign_endianness (const union scm_ieee754_double *source)
_type c_value; \
\
IEEE754_ACCESSOR_PROLOGUE (_type); \
- SCM_VALIDATE_REAL (3, value); \
+ VALIDATE_REAL (3, value); \
c_value = IEEE754_FROM_SCM (_type) (value); \
\
memcpy (&c_bv[c_index], &c_value, sizeof (c_value)); \
@@ -1883,7 +1933,8 @@ utf_encoding_name (char *name, size_t utf_width, SCM endianness)
scm_dynwind_begin (0); \
scm_dynwind_free (c_utf); \
\
- utf = make_bytevector (c_utf_len); \
+ utf = make_bytevector (c_utf_len, \
+ SCM_ARRAY_ELEMENT_TYPE_VU8); \
memcpy (SCM_BYTEVECTOR_CONTENTS (utf), c_utf, \
c_utf_len); \
\
@@ -1928,7 +1979,8 @@ SCM_DEFINE (scm_string_to_utf8, "string->utf8",
scm_dynwind_begin (0);
scm_dynwind_free (c_utf);
- utf = make_bytevector (UTF_STRLEN (8, c_utf));
+ utf = make_bytevector (UTF_STRLEN (8, c_utf),
+ SCM_ARRAY_ELEMENT_TYPE_VU8);
memcpy (SCM_BYTEVECTOR_CONTENTS (utf), c_utf,
UTF_STRLEN (8, c_utf));
@@ -2059,6 +2111,127 @@ SCM_DEFINE (scm_utf32_to_string, "utf32->string",
+/* Bytevectors as generalized vectors & arrays. */
+
+
+static SCM
+bytevector_ref_c32 (SCM bv, SCM idx)
+{ /* FIXME add some checks */
+ const float *contents = (const float*)SCM_BYTEVECTOR_CONTENTS (bv);
+ size_t i = scm_to_size_t (idx);
+ return scm_c_make_rectangular (contents[i/8], contents[i/8 + 1]);
+}
+
+static SCM
+bytevector_ref_c64 (SCM bv, SCM idx)
+{ /* FIXME add some checks */
+ const double *contents = (const double*)SCM_BYTEVECTOR_CONTENTS (bv);
+ size_t i = scm_to_size_t (idx);
+ return scm_c_make_rectangular (contents[i/16], contents[i/16 + 1]);
+}
+
+typedef SCM (*scm_t_bytevector_ref_fn)(SCM, SCM);
+
+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);
+}
+
+static SCM
+bytevector_set_c32 (SCM bv, SCM idx, SCM val)
+{ /* checks are unnecessary here */
+ float *contents = (float*)SCM_BYTEVECTOR_CONTENTS (bv);
+ size_t i = scm_to_size_t (idx);
+ contents[i/8] = scm_c_real_part (val);
+ contents[i/8 + 1] = scm_c_imag_part (val);
+ return SCM_UNSPECIFIED;
+}
+
+static SCM
+bytevector_set_c64 (SCM bv, SCM idx, SCM val)
+{ /* checks are unnecessary here */
+ double *contents = (double*)SCM_BYTEVECTOR_CONTENTS (bv);
+ size_t i = scm_to_size_t (idx);
+ contents[i/16] = scm_c_real_part (val);
+ contents[i/16 + 1] = scm_c_imag_part (val);
+ return SCM_UNSPECIFIED;
+}
+
+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
@@ -2072,7 +2245,8 @@ scm_bootstrap_bytevectors (void)
scm_set_smob_equalp (scm_tc16_bytevector, bytevector_equal_p);
scm_null_bytevector =
- scm_gc_protect_object (make_bytevector_from_buffer (0, NULL));
+ scm_gc_protect_object
+ (make_bytevector_from_buffer (0, NULL, SCM_ARRAY_ELEMENT_TYPE_VU8));
#ifdef WORDS_BIGENDIAN
scm_i_native_endianness = scm_permanent_object (scm_from_locale_symbol ("big"));
@@ -2083,6 +2257,20 @@ scm_bootstrap_bytevectors (void)
scm_c_register_extension ("libguile", "scm_init_bytevectors",
(scm_t_extension_init_func) scm_init_bytevectors,
NULL);
+
+ {
+ scm_t_array_implementation impl;
+
+ impl.tag = scm_tc16_bytevector;
+ impl.mask = 0xffff;
+ 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);
+ }
}
void