mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 03:30:27 +02:00
Remove the distinction between inline/outline storage for bytevectors.
* libguile/bytevectors.c (SCM_BYTEVECTOR_INLINE_THRESHOLD, SCM_BYTEVECTOR_INLINEABLE_SIZE_P, SCM_BYTEVECTOR_SET_CONTENTS, SCM_BYTEVECTOR_SET_INLINE): Remove. (SCM_BYTEVECTOR_HEADER_BYTES): New macro. (SCM_BYTEVECTOR_SET_ELEMENT_TYPE): Adjust to new flag layout. (make_bytevector): Remove content inlining machinery; use `scm_gc_malloc_pointerless ()' in all cases; special-case zero-sized vu8 buffers. (make_bytevector_from_buffer): Simplified. (scm_c_shrink_bytevector): New, formerly `scm_i_shrink_bytevector ()'. Remove buffer inlining machinery. (scm_bootstrap_bytevectors): Use `make_bytevector ()' for SCM_NULL_BYTEVECTOR. * libguile/bytevectors.h (SCM_BYTEVECTOR_HEADER_SIZE): New macro. (SCM_BYTEVECTOR_CONTENTS): Adjust to new layout. (SCM_SET_BYTEVECTOR_FLAGS): Properly cast F. (SCM_F_BYTEVECTOR_INLINE, SCM_BYTEVECTOR_INLINE_P): Remove. (SCM_BYTEVECTOR_ELEMENT_TYPE): Adjust. (scm_c_shrink_bytevector): Remove macro, make a C function declaration.
This commit is contained in:
Ludovic Courtès
parent
807e5a6641
commit
0665b3ffcb
2 changed files with 68 additions and 103 deletions
|
|
@ -175,27 +175,14 @@
|
|||
|
||||
/* Bytevector type. */
|
||||
|
||||
/* The threshold (in octets) under which bytevectors are stored "in-line",
|
||||
i.e., without allocating memory beside the double cell itself.
|
||||
This optimization is necessary since small bytevectors are expected to be
|
||||
common. */
|
||||
#define SCM_BYTEVECTOR_INLINE_THRESHOLD (2 * sizeof (SCM))
|
||||
#define SCM_BYTEVECTOR_HEADER_BYTES \
|
||||
(SCM_BYTEVECTOR_HEADER_SIZE * sizeof (SCM))
|
||||
|
||||
#define SCM_BYTEVECTOR_INLINEABLE_SIZE_P(_size) \
|
||||
((_size) <= SCM_BYTEVECTOR_INLINE_THRESHOLD)
|
||||
#define SCM_BYTEVECTOR_SET_LENGTH(_bv, _len) \
|
||||
SCM_SET_CELL_WORD_1 ((_bv), (scm_t_bits) (_len))
|
||||
#define SCM_BYTEVECTOR_SET_CONTENTS(_bv, _buf) \
|
||||
SCM_SET_CELL_WORD_2 ((_bv), (scm_t_bits) (_buf))
|
||||
#define SCM_BYTEVECTOR_SET_INLINE(bv) \
|
||||
SCM_SET_BYTEVECTOR_FLAGS (bv, \
|
||||
SCM_BYTEVECTOR_FLAGS (bv) \
|
||||
| SCM_F_BYTEVECTOR_INLINE)
|
||||
|
||||
#define SCM_BYTEVECTOR_SET_ELEMENT_TYPE(bv, hint) \
|
||||
SCM_SET_BYTEVECTOR_FLAGS (bv, \
|
||||
(SCM_BYTEVECTOR_FLAGS (bv) & SCM_F_BYTEVECTOR_INLINE) \
|
||||
| ((hint) << 1UL))
|
||||
#define SCM_BYTEVECTOR_SET_ELEMENT_TYPE(bv, hint) \
|
||||
SCM_SET_BYTEVECTOR_FLAGS ((bv), (hint))
|
||||
#define SCM_BYTEVECTOR_TYPE_SIZE(var) \
|
||||
(scm_i_array_element_type_sizes[SCM_BYTEVECTOR_ELEMENT_TYPE (var)]/8)
|
||||
#define SCM_BYTEVECTOR_TYPED_LENGTH(var) \
|
||||
|
|
@ -206,67 +193,65 @@ SCM scm_null_bytevector = SCM_UNSPECIFIED;
|
|||
|
||||
|
||||
static inline SCM
|
||||
make_bytevector_from_buffer (size_t len, void *contents,
|
||||
scm_t_array_element_type element_type)
|
||||
make_bytevector (size_t len, scm_t_array_element_type element_type)
|
||||
{
|
||||
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))
|
||||
ret = scm_double_cell (scm_tc7_bytevector, (scm_t_bits) c_len,
|
||||
(scm_t_bits) contents, 0);
|
||||
|
||||
if (SCM_UNLIKELY (len == 0 && element_type == SCM_ARRAY_ELEMENT_TYPE_VU8
|
||||
&& SCM_BYTEVECTOR_P (scm_null_bytevector)))
|
||||
ret = scm_null_bytevector;
|
||||
else
|
||||
{
|
||||
ret = scm_double_cell (scm_tc7_bytevector, (scm_t_bits) c_len, 0, 0);
|
||||
SCM_BYTEVECTOR_SET_INLINE (ret);
|
||||
if (contents)
|
||||
{
|
||||
memcpy (SCM_BYTEVECTOR_CONTENTS (ret), contents, c_len);
|
||||
scm_gc_free (contents, c_len, SCM_GC_BYTEVECTOR);
|
||||
}
|
||||
c_len = len * (scm_i_array_element_type_sizes[element_type] / 8);
|
||||
|
||||
ret = PTR2SCM (scm_gc_malloc_pointerless (SCM_BYTEVECTOR_HEADER_BYTES + c_len,
|
||||
SCM_GC_BYTEVECTOR));
|
||||
|
||||
SCM_SET_CELL_TYPE (ret, scm_tc7_bytevector);
|
||||
SCM_BYTEVECTOR_SET_LENGTH (ret, c_len);
|
||||
SCM_BYTEVECTOR_SET_ELEMENT_TYPE (ret, element_type);
|
||||
}
|
||||
SCM_BYTEVECTOR_SET_ELEMENT_TYPE (ret, element_type);
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* Return a bytevector of LEN elements of type ELEMENT_TYPE, with element
|
||||
values taken from CONTENTS. */
|
||||
static inline SCM
|
||||
make_bytevector (size_t len, scm_t_array_element_type element_type)
|
||||
make_bytevector_from_buffer (size_t len, void *contents,
|
||||
scm_t_array_element_type element_type)
|
||||
{
|
||||
size_t c_len;
|
||||
SCM ret;
|
||||
|
||||
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 ();
|
||||
/* We actually never reuse storage from CONTENTS. Hans Boehm says in
|
||||
<gc/gc.h> that realloc(3) "shouldn't have been invented" and he may well
|
||||
be right. */
|
||||
ret = make_bytevector (len, element_type);
|
||||
|
||||
c_len = len * (scm_i_array_element_type_sizes[element_type]/8);
|
||||
if (SCM_BYTEVECTOR_INLINEABLE_SIZE_P (c_len))
|
||||
if (len > 0)
|
||||
{
|
||||
SCM ret;
|
||||
ret = scm_double_cell (scm_tc7_bytevector, (scm_t_bits) c_len, 0, 0);
|
||||
SCM_BYTEVECTOR_SET_INLINE (ret);
|
||||
SCM_BYTEVECTOR_SET_ELEMENT_TYPE (ret, element_type);
|
||||
return ret;
|
||||
}
|
||||
else
|
||||
{
|
||||
void *buf = scm_gc_malloc_pointerless (c_len, SCM_GC_BYTEVECTOR);
|
||||
return make_bytevector_from_buffer (len, buf, element_type);
|
||||
size_t c_len;
|
||||
|
||||
c_len = len * (scm_i_array_element_type_sizes[element_type] / 8);
|
||||
memcpy (SCM_BYTEVECTOR_CONTENTS (ret),
|
||||
contents,
|
||||
c_len);
|
||||
|
||||
scm_gc_free (contents, c_len, SCM_GC_BYTEVECTOR);
|
||||
}
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
|
||||
/* Return a new bytevector of size LEN octets. */
|
||||
SCM
|
||||
scm_c_make_bytevector (size_t len)
|
||||
|
|
@ -297,44 +282,30 @@ scm_c_take_typed_bytevector (signed char *contents, size_t len,
|
|||
}
|
||||
|
||||
/* Shrink BV to C_NEW_LEN (which is assumed to be smaller than its current
|
||||
size) and return BV. */
|
||||
size) and return the new bytevector (possibly different from BV). */
|
||||
SCM
|
||||
scm_i_shrink_bytevector (SCM bv, size_t c_new_len)
|
||||
scm_c_shrink_bytevector (SCM bv, size_t c_new_len)
|
||||
{
|
||||
SCM new_bv;
|
||||
size_t c_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;
|
||||
signed char *c_bv, *c_new_bv;
|
||||
c_len = SCM_BYTEVECTOR_LENGTH (bv);
|
||||
if (SCM_UNLIKELY (c_new_len > c_len))
|
||||
abort ();
|
||||
|
||||
c_len = SCM_BYTEVECTOR_LENGTH (bv);
|
||||
c_bv = SCM_BYTEVECTOR_CONTENTS (bv);
|
||||
SCM_BYTEVECTOR_SET_LENGTH (bv, c_new_len);
|
||||
|
||||
SCM_BYTEVECTOR_SET_LENGTH (bv, c_new_len);
|
||||
/* Resize the existing buffer. */
|
||||
new_bv = PTR2SCM (scm_gc_realloc (SCM2PTR (bv),
|
||||
c_len + SCM_BYTEVECTOR_HEADER_BYTES,
|
||||
c_new_len + SCM_BYTEVECTOR_HEADER_BYTES,
|
||||
SCM_GC_BYTEVECTOR));
|
||||
|
||||
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);
|
||||
}
|
||||
else
|
||||
{
|
||||
/* Resize the existing buffer. */
|
||||
c_new_bv = scm_gc_realloc (c_bv, c_len, c_new_len,
|
||||
SCM_GC_BYTEVECTOR);
|
||||
SCM_BYTEVECTOR_SET_CONTENTS (bv, c_new_bv);
|
||||
}
|
||||
}
|
||||
else
|
||||
SCM_BYTEVECTOR_SET_LENGTH (bv, c_new_len);
|
||||
|
||||
return bv;
|
||||
return new_bv;
|
||||
}
|
||||
|
||||
int
|
||||
|
|
@ -2242,8 +2213,7 @@ scm_bootstrap_bytevectors (void)
|
|||
want to access bytevectors even though `(rnrs bytevector)' hasn't been
|
||||
loaded. */
|
||||
scm_null_bytevector =
|
||||
scm_gc_protect_object
|
||||
(make_bytevector_from_buffer (0, NULL, SCM_ARRAY_ELEMENT_TYPE_VU8));
|
||||
scm_gc_protect_object (make_bytevector (0, SCM_ARRAY_ELEMENT_TYPE_VU8));
|
||||
|
||||
#ifdef WORDS_BIGENDIAN
|
||||
scm_i_native_endianness = scm_permanent_object (scm_from_locale_symbol ("big"));
|
||||
|
|
|
|||
|
|
@ -26,12 +26,15 @@
|
|||
|
||||
/* R6RS bytevectors. */
|
||||
|
||||
/* The size in words of the bytevector header (type tag, flags, and
|
||||
length). */
|
||||
#define SCM_BYTEVECTOR_HEADER_SIZE 2U
|
||||
|
||||
#define SCM_BYTEVECTOR_LENGTH(_bv) \
|
||||
((size_t) SCM_CELL_WORD_1 (_bv))
|
||||
#define SCM_BYTEVECTOR_CONTENTS(_bv) \
|
||||
(SCM_BYTEVECTOR_INLINE_P (_bv) \
|
||||
? (signed char *) SCM_CELL_OBJECT_LOC ((_bv), 2) \
|
||||
: (signed char *) SCM_CELL_WORD_2 (_bv))
|
||||
#define SCM_BYTEVECTOR_CONTENTS(_bv) \
|
||||
((signed char *) SCM_CELL_OBJECT_LOC ((_bv), \
|
||||
SCM_BYTEVECTOR_HEADER_SIZE))
|
||||
|
||||
|
||||
SCM_API SCM scm_endianness_big;
|
||||
|
|
@ -116,14 +119,12 @@ SCM_API SCM scm_utf32_to_string (SCM, SCM);
|
|||
(!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_bytevector)
|
||||
#define SCM_BYTEVECTOR_FLAGS(_bv) \
|
||||
(SCM_CELL_TYPE (_bv) >> 7UL)
|
||||
#define SCM_SET_BYTEVECTOR_FLAGS(_bv, _f) \
|
||||
SCM_SET_CELL_TYPE ((_bv), scm_tc7_bytevector | ((_f) << 7UL))
|
||||
#define SCM_SET_BYTEVECTOR_FLAGS(_bv, _f) \
|
||||
SCM_SET_CELL_TYPE ((_bv), \
|
||||
scm_tc7_bytevector | ((scm_t_bits)(_f) << 7UL))
|
||||
|
||||
#define SCM_F_BYTEVECTOR_INLINE 0x1
|
||||
#define SCM_BYTEVECTOR_INLINE_P(_bv) \
|
||||
(SCM_BYTEVECTOR_FLAGS (_bv) & SCM_F_BYTEVECTOR_INLINE)
|
||||
#define SCM_BYTEVECTOR_ELEMENT_TYPE(_bv) \
|
||||
(SCM_BYTEVECTOR_FLAGS (_bv) >> 1UL)
|
||||
(SCM_BYTEVECTOR_FLAGS (_bv))
|
||||
|
||||
/* Hint that is passed to `scm_gc_malloc ()' and friends. */
|
||||
#define SCM_GC_BYTEVECTOR "bytevector"
|
||||
|
|
@ -140,13 +141,7 @@ SCM_INTERNAL SCM scm_c_take_bytevector (signed char *, size_t);
|
|||
|
||||
SCM_INTERNAL int scm_i_print_bytevector (SCM, SCM, scm_print_state *);
|
||||
|
||||
|
||||
#define scm_c_shrink_bytevector(_bv, _len) \
|
||||
(SCM_BYTEVECTOR_INLINE_P (_bv) \
|
||||
? (_bv) \
|
||||
: scm_i_shrink_bytevector ((_bv), (_len)))
|
||||
|
||||
SCM_INTERNAL SCM scm_i_shrink_bytevector (SCM, size_t);
|
||||
SCM_INTERNAL SCM scm_c_shrink_bytevector (SCM, size_t);
|
||||
SCM_INTERNAL void scm_i_bytevector_generalized_set_x (SCM, size_t, SCM);
|
||||
SCM_INTERNAL SCM scm_null_bytevector;
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue