--/* Copyright (C) 2009-2014 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_SET_BYTEVECTOR_FLAGS ((bv), \
(hint) \
| (SCM_BYTEVECTOR_CONTIGUOUS_P (bv) << 8UL))
+#define SCM_BYTEVECTOR_SET_PARENT(_bv, _parent) \
+ SCM_SET_CELL_OBJECT_3 ((_bv), (_parent))
+
#define SCM_BYTEVECTOR_TYPE_SIZE(var) \
(scm_i_array_element_type_sizes[SCM_BYTEVECTOR_ELEMENT_TYPE (var)]/8)
#define SCM_BYTEVECTOR_TYPED_LENGTH(var) \
if (SCM_UNLIKELY (element_type > SCM_ARRAY_ELEMENT_TYPE_LAST
|| scm_i_array_element_type_sizes[element_type] < 8
- || len >= (SCM_I_SIZE_MAX
+ || len >= (((size_t) -1)
/ (scm_i_array_element_type_sizes[element_type]/8))))
/* This would be an internal Guile programming error */
abort ();
contents = scm_gc_malloc_pointerless (SCM_BYTEVECTOR_HEADER_BYTES + c_len,
SCM_GC_BYTEVECTOR);
- ret = PTR2SCM (contents);
+ ret = SCM_PACK_POINTER (contents);
contents += SCM_BYTEVECTOR_HEADER_BYTES;
SCM_BYTEVECTOR_SET_LENGTH (ret, c_len);
SCM_BYTEVECTOR_SET_CONTENTS (ret, contents);
SCM_BYTEVECTOR_SET_CONTIGUOUS_P (ret, 1);
SCM_BYTEVECTOR_SET_ELEMENT_TYPE (ret, element_type);
+ SCM_BYTEVECTOR_SET_PARENT (ret, SCM_BOOL_F);
}
return ret;
{
size_t c_len;
- ret = PTR2SCM (scm_gc_malloc (SCM_BYTEVECTOR_HEADER_BYTES,
+ ret = SCM_PACK_POINTER (scm_gc_malloc (SCM_BYTEVECTOR_HEADER_BYTES,
SCM_GC_BYTEVECTOR));
c_len = len * (scm_i_array_element_type_sizes[element_type] / 8);
SCM_BYTEVECTOR_SET_CONTENTS (ret, contents);
SCM_BYTEVECTOR_SET_CONTIGUOUS_P (ret, 0);
SCM_BYTEVECTOR_SET_ELEMENT_TYPE (ret, element_type);
+ SCM_BYTEVECTOR_SET_PARENT (ret, SCM_BOOL_F);
}
return ret;
return make_bytevector (len, element_type);
}
-/* Return a bytevector of size LEN made up of CONTENTS. The area pointed to
- by CONTENTS must have been allocated using `scm_gc_malloc ()'. */
+/* Return a bytevector of size LEN made up of CONTENTS. The area
+ pointed to by CONTENTS must be protected from GC somehow: either
+ because it was allocated using `scm_gc_malloc ()', or because it is
+ part of PARENT. */
SCM
-scm_c_take_gc_bytevector (signed char *contents, size_t len)
+scm_c_take_gc_bytevector (signed char *contents, size_t len, SCM parent)
{
- return make_bytevector_from_buffer (len, contents, SCM_ARRAY_ELEMENT_TYPE_VU8);
+ SCM ret;
+
+ ret = make_bytevector_from_buffer (len, contents, SCM_ARRAY_ELEMENT_TYPE_VU8);
+ SCM_BYTEVECTOR_SET_PARENT (ret, parent);
+
+ return ret;
}
SCM
scm_c_take_typed_bytevector (signed char *contents, size_t len,
- scm_t_array_element_type element_type)
+ scm_t_array_element_type element_type, SCM parent)
{
- return make_bytevector_from_buffer (len, contents, element_type);
+ SCM ret;
+
+ ret = make_bytevector_from_buffer (len, contents, element_type);
+ SCM_BYTEVECTOR_SET_PARENT (ret, parent);
+
+ return ret;
}
/* Shrink BV to C_NEW_LEN (which is assumed to be smaller than its current
scm_array_get_handle (bv, &h);
- scm_putc ('#', port);
+ scm_putc_unlocked ('#', port);
scm_write (scm_array_handle_element_type (&h), port);
- scm_putc ('(', port);
+ scm_putc_unlocked ('(', 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_putc_unlocked (' ', port);
scm_write (scm_array_handle_ref (&h, i), port);
}
- scm_putc (')', port);
+ scm_putc_unlocked (')', port);
return 1;
}
#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;
SCM_VALIDATE_BYTEVECTOR (1, bv);
c_fill = scm_to_int8 (fill);
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);
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 >= (SCM_I_SIZE_MAX >> 3))) \
++ 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);
c_size = scm_to_unsigned_integer (size, 1, (size_t) -1); \
\
c_len = SCM_BYTEVECTOR_LENGTH (bv); \
- if (SCM_UNLIKELY (c_len < c_size)) \
+ 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 \
{ \
#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 >= (SCM_I_SIZE_MAX >> 3))) \
++ 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; \
scm_list_1 (utf), err); \
else \
{ \
- str = scm_from_stringn (c_str, c_strlen, "UTF-8", \
- SCM_FAILED_CONVERSION_ERROR); \
+ str = scm_from_utf8_stringn (c_str, c_strlen); \
free (c_str); \
} \
return (str);
c_utf_len = SCM_BYTEVECTOR_LENGTH (utf);
c_utf = (char *) SCM_BYTEVECTOR_CONTENTS (utf);
- str = scm_from_stringn (c_utf, c_utf_len, "UTF-8",
- SCM_FAILED_CONVERSION_ERROR);
+ str = scm_from_utf8_stringn (c_utf, c_utf_len);
return (str);
}
#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
HCoop / bpt / guile.git / commitdiff