summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/bytevectors.c146
-rw-r--r--libguile/bytevectors.h29
2 files changed, 70 insertions, 105 deletions
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index 5a0ae501b..4246f0111 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -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_INLINEABLE_SIZE_P(_size) \
- ((_size) <= SCM_BYTEVECTOR_INLINE_THRESHOLD)
+#define SCM_BYTEVECTOR_HEADER_BYTES \
+ (SCM_BYTEVECTOR_HEADER_SIZE * sizeof (SCM))
+
#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))
- {
- 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
+ if (len > 0)
{
- 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);
- c_bv = SCM_BYTEVECTOR_CONTENTS (bv);
+ c_len = SCM_BYTEVECTOR_LENGTH (bv);
+ if (SCM_UNLIKELY (c_new_len > c_len))
+ abort ();
- SCM_BYTEVECTOR_SET_LENGTH (bv, c_new_len);
+ SCM_BYTEVECTOR_SET_LENGTH (bv, 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);
- }
- 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);
+ /* 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));
- 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"));
diff --git a/libguile/bytevectors.h b/libguile/bytevectors.h
index e3296500f..506312638 100644
--- a/libguile/bytevectors.h
+++ b/libguile/bytevectors.h
@@ -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;