-/* Copyright (C) 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 2009-2015 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
#ifdef HAVE_LIMITS_H
# include <limits.h>
-#else
-/* Assuming 32-bit longs. */
-# define ULONG_MAX 4294967295UL
#endif
#include <string.h>
SCM_BYTEVECTOR_SET_LENGTH (bv, c_new_len);
if (SCM_BYTEVECTOR_CONTIGUOUS_P (bv))
- new_bv = PTR2SCM (scm_gc_realloc (SCM2PTR (bv),
- c_len + SCM_BYTEVECTOR_HEADER_BYTES,
- c_new_len + SCM_BYTEVECTOR_HEADER_BYTES,
- SCM_GC_BYTEVECTOR));
+ {
+ signed char *c_bv;
+
+ c_bv = scm_gc_realloc (SCM2PTR (bv),
+ c_len + SCM_BYTEVECTOR_HEADER_BYTES,
+ c_new_len + SCM_BYTEVECTOR_HEADER_BYTES,
+ SCM_GC_BYTEVECTOR);
+ new_bv = PTR2SCM (c_bv);
+ SCM_BYTEVECTOR_SET_CONTENTS (new_bv, c_bv + SCM_BYTEVECTOR_HEADER_BYTES);
+ }
else
{
signed char *c_bv;
#define FUNC_NAME s_scm_make_bytevector
{
SCM bv;
- unsigned c_len;
- signed char c_fill = '\0';
+ size_t c_len;
+ scm_t_uint8 c_fill = 0;
- SCM_VALIDATE_UINT_COPY (1, len, c_len);
+ SCM_VALIDATE_SIZE_COPY (1, len, c_len);
if (!scm_is_eq (fill, SCM_UNDEFINED))
{
int value;
value = scm_to_int (fill);
if (SCM_UNLIKELY ((value < -128) || (value > 255)))
scm_out_of_range (FUNC_NAME, fill);
- c_fill = (signed char) value;
+ c_fill = (scm_t_uint8) value;
}
bv = make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
if (!scm_is_eq (fill, SCM_UNDEFINED))
{
- unsigned i;
- signed char *contents;
+ size_t i;
+ scm_t_uint8 *contents;
- contents = SCM_BYTEVECTOR_CONTENTS (bv);
+ contents = (scm_t_uint8 *) SCM_BYTEVECTOR_CONTENTS (bv);
for (i = 0; i < c_len; i++)
contents[i] = c_fill;
}
#define FUNC_NAME s_scm_bytevector_eq_p
{
SCM result = SCM_BOOL_F;
- unsigned c_len1, c_len2;
+ size_t c_len1, c_len2;
SCM_VALIDATE_BYTEVECTOR (1, bv1);
SCM_VALIDATE_BYTEVECTOR (2, bv2);
"Fill bytevector @var{bv} with @var{fill}, a byte.")
#define FUNC_NAME s_scm_bytevector_fill_x
{
- unsigned c_len, i;
- signed char *c_bv, c_fill;
+ size_t c_len, i;
+ scm_t_uint8 *c_bv, c_fill;
+ int value;
SCM_VALIDATE_BYTEVECTOR (1, bv);
- c_fill = scm_to_int8 (fill);
+
+ value = scm_to_int (fill);
+ if (SCM_UNLIKELY ((value < -128) || (value > 255)))
+ scm_out_of_range (FUNC_NAME, fill);
+ c_fill = (scm_t_uint8) value;
c_len = SCM_BYTEVECTOR_LENGTH (bv);
- c_bv = SCM_BYTEVECTOR_CONTENTS (bv);
+ c_bv = (scm_t_uint8 *) SCM_BYTEVECTOR_CONTENTS (bv);
for (i = 0; i < c_len; i++)
c_bv[i] = c_fill;
"@var{target_start}.")
#define FUNC_NAME s_scm_bytevector_copy_x
{
- unsigned c_len, c_source_len, c_target_len;
- unsigned c_source_start, c_target_start;
+ size_t c_len, c_source_len, c_target_len;
+ size_t c_source_start, c_target_start;
signed char *c_source, *c_target;
SCM_VALIDATE_BYTEVECTOR (1, source);
SCM_VALIDATE_BYTEVECTOR (3, target);
- c_len = scm_to_uint (len);
- c_source_start = scm_to_uint (source_start);
- c_target_start = scm_to_uint (target_start);
+ c_len = scm_to_size_t (len);
+ c_source_start = scm_to_size_t (source_start);
+ c_target_start = scm_to_size_t (target_start);
c_source = SCM_BYTEVECTOR_CONTENTS (source);
c_target = SCM_BYTEVECTOR_CONTENTS (target);
#define FUNC_NAME s_scm_bytevector_copy
{
SCM copy;
- unsigned c_len;
+ size_t c_len;
signed char *c_bv, *c_copy;
SCM_VALIDATE_BYTEVECTOR (1, bv);
c_len = SCM_BYTEVECTOR_LENGTH (bv);
c_bv = SCM_BYTEVECTOR_CONTENTS (bv);
- copy = make_bytevector (c_len, SCM_BYTEVECTOR_ELEMENT_TYPE (bv));
+ copy = make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
c_copy = SCM_BYTEVECTOR_CONTENTS (copy);
memcpy (c_copy, c_bv, c_len);
if (sz >= 8 && ((sz % 8) == 0))
byte_len = len * (sz / 8);
else if (sz < 8)
- /* byte_len = ceil (len * sz / 8) */
- byte_len = (len * sz + 7) / 8;
+ /* Elements of sub-byte size (bitvectors) are addressed in 32-bit
+ units. */
+ byte_len = ((len * sz + 31) / 32) * 4;
else
/* an internal guile error, really */
SCM_MISC_ERROR ("uniform elements larger than 8 bits must fill whole bytes", SCM_EOL);
#define FUNC_NAME s_scm_bytevector_to_u8_list
{
SCM lst, pair;
- unsigned c_len, i;
- unsigned char *c_bv;
+ size_t c_len, i;
+ scm_t_uint8 *c_bv;
SCM_VALIDATE_BYTEVECTOR (1, bv);
c_len = SCM_BYTEVECTOR_LENGTH (bv);
- c_bv = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
+ c_bv = (scm_t_uint8 *) SCM_BYTEVECTOR_CONTENTS (bv);
- lst = scm_make_list (scm_from_uint (c_len), SCM_UNSPECIFIED);
+ lst = scm_make_list (scm_from_size_t (c_len), SCM_UNSPECIFIED);
for (i = 0, pair = lst;
i < c_len;
i++, pair = SCM_CDR (pair))
#define FUNC_NAME s_scm_u8_list_to_bytevector
{
SCM bv, item;
- long c_len, i;
- unsigned char *c_bv;
+ size_t c_len, i;
+ scm_t_uint8 *c_bv;
SCM_VALIDATE_LIST_COPYLEN (1, lst, c_len);
bv = make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
- c_bv = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
+ c_bv = (scm_t_uint8 *) SCM_BYTEVECTOR_CONTENTS (bv);
for (i = 0; i < c_len; lst = SCM_CDR (lst), i++)
{
c_item = SCM_I_INUM (item);
if (SCM_LIKELY ((c_item >= 0) && (c_item < 256)))
- c_bv[i] = (unsigned char) c_item;
+ c_bv[i] = (scm_t_uint8) c_item;
else
goto type_error;
}
}
#define GENERIC_INTEGER_ACCESSOR_PROLOGUE(_sign) \
- unsigned long c_len, c_index, c_size; \
+ size_t c_len, c_index, c_size; \
char *c_bv; \
\
SCM_VALIDATE_BYTEVECTOR (1, bv); \
- c_index = scm_to_ulong (index); \
- c_size = scm_to_ulong (size); \
+ c_index = scm_to_size_t (index); \
+ c_size = scm_to_size_t (size); \
\
c_len = SCM_BYTEVECTOR_LENGTH (bv); \
c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv); \
\
/* C_SIZE must have its 3 higher bits set to zero so that \
- multiplying it by 8 yields a number that fits in an \
- unsigned long. */ \
- if (SCM_UNLIKELY ((c_size == 0) || (c_size >= (ULONG_MAX >> 3L)))) \
+ multiplying it by 8 yields a number that fits in a \
+ size_t. */ \
+ if (SCM_UNLIKELY (c_size == 0 || c_size >= (SIZE_MAX >> 3))) \
scm_out_of_range (FUNC_NAME, size); \
if (SCM_UNLIKELY (c_index + c_size > c_len)) \
scm_out_of_range (FUNC_NAME, index);
\
SCM_VALIDATE_BYTEVECTOR (1, bv); \
SCM_VALIDATE_SYMBOL (2, endianness); \
- c_size = scm_to_uint (size); \
+ c_size = scm_to_unsigned_integer (size, 1, (size_t) -1); \
\
c_len = SCM_BYTEVECTOR_LENGTH (bv); \
- if (SCM_UNLIKELY (c_len == 0)) \
+ if (SCM_UNLIKELY (c_len % c_size != 0)) \
+ scm_wrong_type_arg_msg \
+ (FUNC_NAME, 0, size, \
+ "an exact positive integer that divides the bytevector length"); \
+ else if (SCM_UNLIKELY (c_len == 0)) \
lst = SCM_EOL; \
- else if (SCM_UNLIKELY (c_len < c_size)) \
- scm_out_of_range (FUNC_NAME, size); \
else \
{ \
const char *c_bv; \
\
c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv); \
\
- lst = scm_make_list (scm_from_uint (c_len / c_size), \
+ lst = scm_make_list (scm_from_size_t (c_len / c_size), \
SCM_UNSPECIFIED); \
for (i = 0, pair = lst; \
i <= c_len - c_size; \
#define INTEGER_LIST_TO_BYTEVECTOR(_sign) \
SCM bv; \
- long c_len; \
+ size_t c_len; \
size_t c_size; \
char *c_bv, *c_bv_ptr; \
\
SCM_VALIDATE_LIST_COPYLEN (1, lst, c_len); \
SCM_VALIDATE_SYMBOL (2, endianness); \
- c_size = scm_to_uint (size); \
+ c_size = scm_to_size_t (size); \
\
- if (SCM_UNLIKELY ((c_size == 0) || (c_size >= (ULONG_MAX >> 3L)))) \
+ if (SCM_UNLIKELY (c_size == 0 || c_size >= (SIZE_MAX >> 3))) \
scm_out_of_range (FUNC_NAME, size); \
\
- bv = make_bytevector (c_len * c_size, SCM_ARRAY_ELEMENT_TYPE_VU8); \
+ 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; \
#undef FUNC_NAME
\f
-/* 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);
-}
-
-\f
/* Initialization. */
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