From 3fe87cf7aff396d7bd993aa009f48eb8afd6c1cd Mon Sep 17 00:00:00 2001 From: =?utf8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 15 Nov 2009 19:34:38 +0100 Subject: [PATCH] Re-add an indirection in bytevectors. The intent is to allow for mmap(3) bindings and to actually reuse user-provided buffers in `scm_c_take_bytevector ()'. * libguile/bytevectors.h (SCM_BYTEVECTOR_HEADER_SIZE): Increment. (SCM_BYTEVECTOR_CONTENTS): Take the pointer from the second word. (SCM_BYTEVECTOR_CONTIGUOUS_P): New macro. (SCM_BYTEVECTOR_ELEMENT_TYPE): Adjust to live alongside the CONTIGUOUS flag. * libguile/bytevectors.c (SCM_BYTEVECTOR_SET_CONTENTS, SCM_BYTEVECTOR_SET_CONTIGUOUS_P): New macros. (SCM_BYTEVECTOR_SET_ELEMENT_TYPE): Adjust. (SCM_BYTEVECTOR_TYPED_LENGTH): Properly parenthesize. (make_bytevector): Adjust to new bytevector header. (make_bytevector_from_buffer): Reuse CONTENTS. (scm_c_shrink_bytevector): Differentiate between contiguous and non-contiguous bytevectors. --- libguile/bytevectors.c | 70 ++++++++++++++++++++++++++++-------------- libguile/bytevectors.h | 15 ++++----- 2 files changed, 55 insertions(+), 30 deletions(-) diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c index 9a0698550..992fa3fd2 100644 --- a/libguile/bytevectors.c +++ b/libguile/bytevectors.c @@ -182,13 +182,21 @@ #define SCM_BYTEVECTOR_SET_LENGTH(_bv, _len) \ SCM_SET_CELL_WORD_1 ((_bv), (scm_t_bits) (_len)) - -#define SCM_BYTEVECTOR_SET_ELEMENT_TYPE(bv, hint) \ - SCM_SET_BYTEVECTOR_FLAGS ((bv), (hint)) +#define SCM_BYTEVECTOR_SET_CONTENTS(_bv, _contents) \ + SCM_SET_CELL_WORD_2 ((_bv), (scm_t_bits) (_contents)) +#define SCM_BYTEVECTOR_SET_CONTIGUOUS_P(bv, contiguous_p) \ + SCM_SET_BYTEVECTOR_FLAGS ((bv), \ + SCM_BYTEVECTOR_ELEMENT_TYPE (bv) \ + | ((contiguous_p) << 8UL)) + +#define SCM_BYTEVECTOR_SET_ELEMENT_TYPE(bv, hint) \ + SCM_SET_BYTEVECTOR_FLAGS ((bv), \ + (hint) \ + | (SCM_BYTEVECTOR_CONTIGUOUS_P (bv) << 8UL)) #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) + (SCM_BYTEVECTOR_LENGTH (var) / SCM_BYTEVECTOR_TYPE_SIZE (var)) /* The empty bytevector. */ SCM scm_null_bytevector = SCM_UNSPECIFIED; @@ -212,13 +220,18 @@ make_bytevector (size_t len, scm_t_array_element_type element_type) ret = scm_null_bytevector; else { + signed char *contents; + 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)); + contents = scm_gc_malloc_pointerless (SCM_BYTEVECTOR_HEADER_BYTES + c_len, + SCM_GC_BYTEVECTOR); + ret = PTR2SCM (contents); + contents += SCM_BYTEVECTOR_HEADER_BYTES; - SCM_SET_CELL_TYPE (ret, scm_tc7_bytevector); 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); } @@ -226,28 +239,29 @@ make_bytevector (size_t len, scm_t_array_element_type element_type) } /* Return a bytevector of LEN elements of type ELEMENT_TYPE, with element - values taken from CONTENTS. */ + values taken from CONTENTS. Assume that the storage for CONTENTS will be + automatically reclaimed when it becomes unreachable. */ static inline SCM make_bytevector_from_buffer (size_t len, void *contents, scm_t_array_element_type element_type) { SCM ret; - /* We actually never reuse storage from CONTENTS. Hans Boehm says in - that realloc(3) "shouldn't have been invented" and he may well - be right. */ - ret = make_bytevector (len, element_type); - - if (len > 0) + if (SCM_UNLIKELY (len == 0)) + ret = make_bytevector (len, element_type); + else { size_t c_len; + ret = PTR2SCM (scm_gc_malloc (SCM_BYTEVECTOR_HEADER_BYTES, + SCM_GC_BYTEVECTOR)); + 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); + SCM_BYTEVECTOR_SET_LENGTH (ret, c_len); + SCM_BYTEVECTOR_SET_CONTENTS (ret, contents); + SCM_BYTEVECTOR_SET_CONTIGUOUS_P (ret, 0); + SCM_BYTEVECTOR_SET_ELEMENT_TYPE (ret, element_type); } return ret; @@ -287,11 +301,21 @@ scm_c_shrink_bytevector (SCM bv, size_t 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_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)); + else + { + signed char *c_bv; + + c_bv = scm_gc_realloc (SCM_BYTEVECTOR_CONTENTS (bv), + c_len, c_new_len, SCM_GC_BYTEVECTOR); + SCM_BYTEVECTOR_SET_CONTENTS (bv, c_bv); + + new_bv = bv; + } return new_bv; } diff --git a/libguile/bytevectors.h b/libguile/bytevectors.h index 525b02078..59db89e86 100644 --- a/libguile/bytevectors.h +++ b/libguile/bytevectors.h @@ -26,15 +26,14 @@ /* R6RS bytevectors. */ -/* The size in words of the bytevector header (type tag, flags, and - length). */ -#define SCM_BYTEVECTOR_HEADER_SIZE 2U +/* The size in words of the bytevector header (type tag and flags, length, + and pointer to the underlying buffer). */ +#define SCM_BYTEVECTOR_HEADER_SIZE 3U #define SCM_BYTEVECTOR_LENGTH(_bv) \ ((size_t) SCM_CELL_WORD_1 (_bv)) -#define SCM_BYTEVECTOR_CONTENTS(_bv) \ - ((signed char *) SCM_CELL_OBJECT_LOC ((_bv), \ - SCM_BYTEVECTOR_HEADER_SIZE)) +#define SCM_BYTEVECTOR_CONTENTS(_bv) \ + ((signed char *) SCM_CELL_WORD_2 (_bv)) SCM_API SCM scm_endianness_big; @@ -124,7 +123,9 @@ SCM_API SCM scm_utf32_to_string (SCM, SCM); scm_tc7_bytevector | ((scm_t_bits)(_f) << 7UL)) #define SCM_BYTEVECTOR_ELEMENT_TYPE(_bv) \ - (SCM_BYTEVECTOR_FLAGS (_bv)) + (SCM_BYTEVECTOR_FLAGS (_bv) & 0xffUL) +#define SCM_BYTEVECTOR_CONTIGUOUS_P(_bv) \ + (SCM_BYTEVECTOR_FLAGS (_bv) >> 8UL) /* Hint that is passed to `scm_gc_malloc ()' and friends. */ #define SCM_GC_BYTEVECTOR "bytevector" -- 2.20.1