mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 20:00:19 +02:00
Code Activity

Re-add an indirection in bytevectors.

Browse source 
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.
This commit is contained in:
Ludovic Courtès 2009-11-15 19:34:38 +01:00
parent c4daa51910
commit 3fe87cf7af
2 changed files with 55 additions and 30 deletions
Download patch file Download diff file Expand all files Collapse all files

70
libguile/bytevectors.c
View file

@ -182,13 +182,21 @@
#define SCM_BYTEVECTOR_SET_LENGTH(_bv, _len) \ #define SCM_BYTEVECTOR_SET_LENGTH(_bv, _len) \
SCM_SET_CELL_WORD_1 ((_bv), (scm_t_bits) (_len)) SCM_SET_CELL_WORD_1 ((_bv), (scm_t_bits) (_len))
#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) \ #define SCM_BYTEVECTOR_SET_ELEMENT_TYPE(bv, hint) \
SCM_SET_BYTEVECTOR_FLAGS ((bv), (hint)) SCM_SET_BYTEVECTOR_FLAGS ((bv), \
(hint) \
| (SCM_BYTEVECTOR_CONTIGUOUS_P (bv) << 8UL))
#define SCM_BYTEVECTOR_TYPE_SIZE(var) \ #define SCM_BYTEVECTOR_TYPE_SIZE(var) \
(scm_i_array_element_type_sizes[SCM_BYTEVECTOR_ELEMENT_TYPE (var)]/8) (scm_i_array_element_type_sizes[SCM_BYTEVECTOR_ELEMENT_TYPE (var)]/8)
#define SCM_BYTEVECTOR_TYPED_LENGTH(var) \ #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. */ /* The empty bytevector. */
SCM scm_null_bytevector = SCM_UNSPECIFIED; 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; ret = scm_null_bytevector;
else else
{ {
signed char *contents;
c_len = len * (scm_i_array_element_type_sizes[element_type] / 8); c_len = len * (scm_i_array_element_type_sizes[element_type] / 8);
ret = PTR2SCM (scm_gc_malloc_pointerless (SCM_BYTEVECTOR_HEADER_BYTES + c_len, contents = scm_gc_malloc_pointerless (SCM_BYTEVECTOR_HEADER_BYTES + c_len,
SCM_GC_BYTEVECTOR)); 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_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_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 /* 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 static inline SCM
make_bytevector_from_buffer (size_t len, void *contents, make_bytevector_from_buffer (size_t len, void *contents,
scm_t_array_element_type element_type) scm_t_array_element_type element_type)
{ {
SCM ret; SCM ret;
/* We actually never reuse storage from CONTENTS. Hans Boehm says in if (SCM_UNLIKELY (len == 0))
<gc/gc.h> that realloc(3) "shouldn't have been invented" and he may well ret = make_bytevector (len, element_type);
be right. */ else
ret = make_bytevector (len, element_type);
if (len > 0)
{ {
size_t c_len; size_t c_len;
c_len = len * (scm_i_array_element_type_sizes[element_type] / 8); ret = PTR2SCM (scm_gc_malloc (SCM_BYTEVECTOR_HEADER_BYTES,
memcpy (SCM_BYTEVECTOR_CONTENTS (ret), SCM_GC_BYTEVECTOR));
contents,
c_len);
scm_gc_free (contents, c_len, SCM_GC_BYTEVECTOR); c_len = len * (scm_i_array_element_type_sizes[element_type] / 8);
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; 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); SCM_BYTEVECTOR_SET_LENGTH (bv, c_new_len);
/* Resize the existing buffer. */ if (SCM_BYTEVECTOR_CONTIGUOUS_P (bv))
new_bv = PTR2SCM (scm_gc_realloc (SCM2PTR (bv), new_bv = PTR2SCM (scm_gc_realloc (SCM2PTR (bv),
c_len + SCM_BYTEVECTOR_HEADER_BYTES, c_len + SCM_BYTEVECTOR_HEADER_BYTES,
c_new_len + SCM_BYTEVECTOR_HEADER_BYTES, c_new_len + SCM_BYTEVECTOR_HEADER_BYTES,
SCM_GC_BYTEVECTOR)); 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; return new_bv;
} }

15
libguile/bytevectors.h
View file

@ -26,15 +26,14 @@
/* R6RS bytevectors. */ /* R6RS bytevectors. */
/* The size in words of the bytevector header (type tag, flags, and /* The size in words of the bytevector header (type tag and flags, length,
length). */ and pointer to the underlying buffer). */
#define SCM_BYTEVECTOR_HEADER_SIZE 2U #define SCM_BYTEVECTOR_HEADER_SIZE 3U
#define SCM_BYTEVECTOR_LENGTH(_bv) \ #define SCM_BYTEVECTOR_LENGTH(_bv) \
((size_t) SCM_CELL_WORD_1 (_bv)) ((size_t) SCM_CELL_WORD_1 (_bv))
#define SCM_BYTEVECTOR_CONTENTS(_bv) \ #define SCM_BYTEVECTOR_CONTENTS(_bv) \
((signed char *) SCM_CELL_OBJECT_LOC ((_bv), \ ((signed char *) SCM_CELL_WORD_2 (_bv))
SCM_BYTEVECTOR_HEADER_SIZE))
SCM_API SCM scm_endianness_big; 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)) scm_tc7_bytevector | ((scm_t_bits)(_f) << 7UL))
#define SCM_BYTEVECTOR_ELEMENT_TYPE(_bv) \ #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. */ /* Hint that is passed to `scm_gc_malloc ()' and friends. */
#define SCM_GC_BYTEVECTOR "bytevector" #define SCM_GC_BYTEVECTOR "bytevector"