mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
bytevectors have "element type" field, e.g. for generalized-vector-ref
Bytevectors have a very close relationship to other forms of uniform vectors. Often you want to view a u64vector as a series of bytes, for writing over a socket; or to process an incoming stream using the convenient and less error-prone s16vector-ref API rather than bytevector-s16-native-ref. The essential needs of the representation of a bytevector and an s64vector are the same, so we take advantage of that and extend the bytevector implementation to have a "native type" field, which defaults to VU8. This commit doesn't actually expose any user-noticeable changes, however. * libguile/bytevectors.h (SCM_BYTEVECTOR_ELEMENT_TYPE): New internal defines. (scm_i_make_typed_bytevector, scm_c_take_typed_bytevector): New internal functions. * libguile/bytevectors.c (SCM_BYTEVECTOR_SET_ELEMENT_TYPE): (SCM_BYTEVECTOR_TYPE_SIZE): (SCM_BYTEVECTOR_TYPED_LENGTH): New internal macros. (make_bytevector, make_bytevector_from_buffer): Take an extra argument, the element type. The length argument is interpreted as being the number of elements, which corresponds to the number of bytes in the default VU8 case. Doing it this way eliminates a class of bugs -- e.g. a u32vector of length 3 bytes doesn't make sense. We do have to check for another class of bugs: overflow. The length stored on the bytevector itself is still the byte length, though. (scm_i_make_typed_bytevector): (scm_c_take_typed_bytevector): New internal functions. (scm_i_shrink_bytevector): Make sure the new size is valid for the bytevector's type. (scm_i_bytevector_generalized_set_x): Remove this function, the array-handle infrastructure takes care of this for us. (print_bytevector): Print the bytevector according to its type. (scm_make_bytevector, scm_bytevector_copy) (scm_uniform_array_to_bytevector) (scm_u8_list_to_bytevector, scm_bytevector_to_uint_list): Adapt to make_bytevector extra arg. (bv_handle_ref, bv_handle_set_x): Adapt to ref and set based on the type of the bytevector, e.g. f64 or u8. (bytevector_get_handle): Set the typed length of the vector, not the byte length. Conflicts: libguile/bytevectors.c
This commit is contained in:
Andy Wingo
parent
f332089ed4
commit
e286c973fc
2 changed files with 185 additions and 47 deletions
|
|
@ -186,47 +186,75 @@ scm_t_bits scm_tc16_bytevector;
|
|||
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)
|
||||
{
|
||||
SCM ret;
|
||||
if (!SCM_BYTEVECTOR_INLINEABLE_SIZE_P (len))
|
||||
SCM_NEWSMOB2 (ret, scm_tc16_bytevector, len, contents);
|
||||
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, len, NULL);
|
||||
SCM_NEWSMOB2 (ret, scm_tc16_bytevector, c_len, NULL);
|
||||
SCM_BYTEVECTOR_SET_INLINE (ret);
|
||||
if (contents)
|
||||
{
|
||||
memcpy (SCM_BYTEVECTOR_CONTENTS (ret), contents, len);
|
||||
scm_gc_free (contents, len, SCM_GC_BYTEVECTOR);
|
||||
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)
|
||||
{
|
||||
if (SCM_UNLIKELY (len == 0))
|
||||
return scm_null_bytevector;
|
||||
size_t c_len;
|
||||
|
||||
if (SCM_BYTEVECTOR_INLINEABLE_SIZE_P (len))
|
||||
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, len, NULL);
|
||||
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
|
||||
{
|
||||
void *buf = scm_gc_malloc (len, SCM_GC_BYTEVECTOR);
|
||||
return make_bytevector_from_buffer (len, buf);
|
||||
void *buf = scm_gc_malloc (c_len, SCM_GC_BYTEVECTOR);
|
||||
return make_bytevector_from_buffer (len, buf, element_type);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -234,7 +262,14 @@ make_bytevector (size_t len)
|
|||
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
|
||||
|
|
@ -242,7 +277,14 @@ scm_c_make_bytevector (size_t len)
|
|||
SCM
|
||||
scm_c_take_bytevector (signed char *contents, size_t len)
|
||||
{
|
||||
return make_bytevector_from_buffer (len, contents);
|
||||
return make_bytevector_from_buffer (len, contents, SCM_ARRAY_ELEMENT_TYPE_VU8);
|
||||
}
|
||||
|
||||
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
|
||||
|
|
@ -250,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;
|
||||
|
|
@ -336,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;
|
||||
ssize_t ubnd, inc, i;
|
||||
scm_t_array_handle h;
|
||||
|
||||
scm_array_get_handle (bv, &h);
|
||||
|
||||
c_len = SCM_BYTEVECTOR_LENGTH (bv);
|
||||
c_bv = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
|
|
@ -455,7 +493,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;
|
||||
|
|
@ -581,7 +619,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);
|
||||
|
||||
|
|
@ -611,7 +649,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);
|
||||
|
|
@ -700,7 +738,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++)
|
||||
|
|
@ -1137,7 +1175,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; \
|
||||
|
|
@ -2067,16 +2105,109 @@ 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)
|
||||
{
|
||||
return SCM_I_MAKINUM (scm_c_bytevector_ref (h->array, 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_c_bytevector_set_x (h->array, index, scm_to_uint8 (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
|
||||
|
|
@ -2086,9 +2217,9 @@ bytevector_get_handle (SCM v, scm_t_array_handle *h)
|
|||
h->ndims = 1;
|
||||
h->dims = &h->dim0;
|
||||
h->dim0.lbnd = 0;
|
||||
h->dim0.ubnd = SCM_BYTEVECTOR_LENGTH (v) - 1;
|
||||
h->dim0.ubnd = SCM_BYTEVECTOR_TYPED_LENGTH (v) - 1;
|
||||
h->dim0.inc = 1;
|
||||
h->element_type = SCM_ARRAY_ELEMENT_TYPE_VU8;
|
||||
h->element_type = SCM_BYTEVECTOR_ELEMENT_TYPE (v);
|
||||
h->elements = h->writable_elements = SCM_BYTEVECTOR_CONTENTS (v);
|
||||
}
|
||||
|
||||
|
|
@ -2107,7 +2238,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"));
|
||||
|
|
|
|||
|
|
@ -121,10 +121,16 @@ SCM_API SCM scm_utf32_to_string (SCM, SCM);
|
|||
#define SCM_F_BYTEVECTOR_INLINE 0x1
|
||||
#define SCM_BYTEVECTOR_INLINE_P(_bv) \
|
||||
(SCM_SMOB_FLAGS (_bv) & SCM_F_BYTEVECTOR_INLINE)
|
||||
#define SCM_BYTEVECTOR_ELEMENT_TYPE(_bv) \
|
||||
(SCM_SMOB_FLAGS (_bv) >> 8)
|
||||
|
||||
/* Hint that is passed to `scm_gc_malloc ()' and friends. */
|
||||
#define SCM_GC_BYTEVECTOR "bytevector"
|
||||
|
||||
SCM_INTERNAL SCM scm_i_make_typed_bytevector (size_t, scm_t_array_element_type);
|
||||
SCM_INTERNAL SCM scm_c_take_typed_bytevector (signed char *, size_t,
|
||||
scm_t_array_element_type);
|
||||
|
||||
SCM_INTERNAL void scm_bootstrap_bytevectors (void);
|
||||
SCM_INTERNAL void scm_init_bytevectors (void);
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue