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.

diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index 9a06985..992fa3f 100644 (file)
--- 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
-     <gc/gc.h> 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 525b020..59db89e 100644 (file)
--- 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"