wingo pushed a commit to branch wip-whippet
in repository guile.
commit 0134abce741b90800d4cbf07bb75efb0f51bc04b
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Mon Jun 2 09:08:35 2025 +0200
Move private bytevectors API to a separate header
Also give bytevectors a private type (a struct).
* libguile/bytevectors.h (SCM_BYTEVECTOR_HEADER_SIZE): Remove.
(SCM_BYTEVECTOR_LENGTH):
(SCM_BYTEVECTOR_CONTENTS): Proxy to the C accessors.
(SCM_BYTEVECTOR_PARENT): Remove from public API.
(SCM_BYTEVECTOR_P, SCM_VALIDATE_BYTEVECTOR): Make public.
(scm_c_bytevector_contents): New function.
* libguile/bytevectors-internal.h: New file.
* libguile/Makefile.am (noinst_HEADERS): Add new file.
* libguile/bytevectors.c:
* libguile/array-handle.c:
* libguile/arrays.c:
* libguile/foreign.c:
* libguile/goops.c:
* libguile/init.c:
* libguile/loader.c:
* libguile/print.c:
* libguile/r6rs-ports.c:
* libguile/srfi-4.c:
* libguile/strings.c: Adapt to use bytevectors-internal.h as needed, and
sometimes to use the internal bytevector type.
---
libguile/Makefile.am | 1 +
libguile/array-handle.c | 40 +++---
libguile/arrays.c | 3 +-
libguile/bytevectors-internal.h | 125 ++++++++++++++++
libguile/bytevectors.c | 308 ++++++++++++++++++----------------------
libguile/bytevectors.h | 70 ++-------
libguile/foreign.c | 3 +-
libguile/goops.c | 4 +-
libguile/init.c | 2 +-
libguile/loader.c | 2 +-
libguile/print.c | 1 +
libguile/r6rs-ports.c | 5 +-
libguile/srfi-4.c | 21 ++-
libguile/strings.c | 3 +-
14 files changed, 311 insertions(+), 277 deletions(-)
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index 8b5f7a238..ef1dc6970 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -525,6 +525,7 @@ noinst_HEADERS = custom-ports.h
\
intrinsics.h \
quicksort.i.c \
atomics-internal.h \
+ bytevectors-internal.h \
cache-internal.h \
gc-inline.h \
gc-internal.h \
diff --git a/libguile/array-handle.c b/libguile/array-handle.c
index e51e133bb..37eaab688 100644
--- a/libguile/array-handle.c
+++ b/libguile/array-handle.c
@@ -1,4 +1,4 @@
-/* Copyright 1995-1998,2000-2006,2009,2011,2013-2014,2018
+/* Copyright 1995-1998,2000-2006,2009,2011,2013-2014,2018,2025
Free Software Foundation, Inc.
This file is part of Guile.
@@ -30,6 +30,7 @@
#include "boolean.h"
#include "bitvectors.h"
#include "bytevectors.h"
+#include "bytevectors-internal.h"
#include "list.h"
#include "numbers.h"
#include "pairs.h"
@@ -78,11 +79,10 @@ bytevector_c32_ref (SCM bv, size_t pos)
char *c_bv;
float real, imag;
- if (!SCM_BYTEVECTOR_P (bv))
- abort ();
- c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
+ struct scm_bytevector *bvp = scm_to_bytevector (bv);
+ c_bv = (char *) bvp->contents;
pos *= 2 * sizeof (float);
- if (pos + 2 * sizeof (float) - 1 >= SCM_BYTEVECTOR_LENGTH (bv))
+ if (pos + 2 * sizeof (float) - 1 >= bvp->length)
abort ();
memcpy (&real, &c_bv[pos], sizeof (float));
@@ -96,11 +96,10 @@ bytevector_c64_ref (SCM bv, size_t pos)
char *c_bv;
double real, imag;
- if (!SCM_BYTEVECTOR_P (bv))
- abort ();
- c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
+ struct scm_bytevector *bvp = scm_to_bytevector (bv);
+ c_bv = (char *) bvp->contents;
pos *= 2 * sizeof (double);
- if (pos + 2 * sizeof (double) - 1 >= SCM_BYTEVECTOR_LENGTH (bv))
+ if (pos + 2 * sizeof (double) - 1 >= bvp->length)
abort ();
memcpy (&real, &c_bv[pos], sizeof (double));
@@ -114,11 +113,10 @@ bytevector_c32_set (SCM bv, size_t pos, SCM val)
char *c_bv;
float real, imag;
- if (!SCM_BYTEVECTOR_P (bv))
- abort ();
- c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
+ struct scm_bytevector *bvp = scm_to_bytevector (bv);
+ c_bv = (char *) bvp->contents;
pos *= 2 * sizeof (float);
- if (pos + 2 * sizeof (float) - 1 >= SCM_BYTEVECTOR_LENGTH (bv))
+ if (pos + 2 * sizeof (float) - 1 >= bvp->length)
abort ();
real = scm_c_real_part (val);
@@ -133,11 +131,10 @@ bytevector_c64_set (SCM bv, size_t pos, SCM val)
char *c_bv;
double real, imag;
- if (!SCM_BYTEVECTOR_P (bv))
- abort ();
- c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
+ struct scm_bytevector *bvp = scm_to_bytevector (bv);
+ c_bv = (char *) bvp->contents;
pos *= 2 * sizeof (double);
- if (pos + 2 * sizeof (double) - 1 >= SCM_BYTEVECTOR_LENGTH (bv))
+ if (pos + 2 * sizeof (double) - 1 >= bvp->length)
abort ();
real = scm_c_real_part (val);
@@ -222,8 +219,9 @@ scm_array_get_handle (SCM array, scm_t_array_handle *h)
scm_t_vector_ref vref;
scm_t_vector_set vset;
- element_type = SCM_BYTEVECTOR_ELEMENT_TYPE (array);
- length = SCM_BYTEVECTOR_TYPED_LENGTH (array);
+ struct scm_bytevector *bv = scm_to_bytevector (array);
+ element_type = scm_bytevector_element_type (bv);
+ length = scm_bytevector_typed_length (bv);
switch (element_type)
{
@@ -257,8 +255,8 @@ scm_array_get_handle (SCM array, scm_t_array_handle *h)
}
initialize_vector_handle (h, length, element_type, vref, vset,
- SCM_BYTEVECTOR_CONTENTS (array),
- SCM_MUTABLE_BYTEVECTOR_P (array));
+ bv->contents,
+ !scm_bytevector_is_immutable (bv));
}
break;
case scm_tc7_array:
diff --git a/libguile/arrays.c b/libguile/arrays.c
index 25391d4c3..cf9ec8c62 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -1,4 +1,4 @@
-/* Copyright 1995-1998,2000-2006,2009-2015,2018, 2021
+/* Copyright 1995-1998,2000-2006,2009-2015,2018, 2021, 2025
Free Software Foundation, Inc.
This file is part of Guile.
@@ -31,7 +31,6 @@
#include "array-map.h"
#include "bitvectors.h"
#include "boolean.h"
-#include "bytevectors.h"
#include "chars.h"
#include "dynwind.h"
#include "eq.h"
diff --git a/libguile/bytevectors-internal.h b/libguile/bytevectors-internal.h
new file mode 100644
index 000000000..0bee8ccdc
--- /dev/null
+++ b/libguile/bytevectors-internal.h
@@ -0,0 +1,125 @@
+#ifndef SCM_BYTEVECTORS_INTERNAL_H
+#define SCM_BYTEVECTORS_INTERNAL_H
+
+/* Copyright 2009, 2011, 2018, 2023, 2025
+ Free Software Foundation, Inc.
+
+ This file is part of Guile.
+
+ Guile is free software: you can redistribute it and/or modify it
+ under the terms of the GNU Lesser General Public License as published
+ by the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ Guile is distributed in the hope that it will be useful, but WITHOUT
+ ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
+ License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with Guile. If not, see
+ <https://www.gnu.org/licenses/>. */
+
+
+
+#include <libguile/bytevectors.h>
+#include <libguile/error.h>
+#include <libguile/uniform.h>
+
+struct scm_bytevector
+{
+ scm_t_bits tag_flags_and_element_type;
+ size_t length;
+ signed char *contents;
+ SCM parent;
+ signed char inline_contents[];
+};
+
+static inline struct scm_bytevector *
+scm_to_bytevector (SCM x)
+{
+ if (!SCM_BYTEVECTOR_P (x))
+ abort ();
+ return (struct scm_bytevector *) SCM_UNPACK_POINTER (x);
+}
+
+static inline SCM
+scm_from_bytevector (struct scm_bytevector *bv)
+{
+ return SCM_PACK_POINTER (bv);
+}
+
+enum scm_bytevector_flags
+ {
+ SCM_F_BYTEVECTOR_IMMUTABLE = 0x80UL,
+ SCM_F_BYTEVECTOR_CONTIGUOUS = 0x100UL
+ };
+
+static inline signed char*
+scm_bytevector_contents (struct scm_bytevector *bv)
+{
+ return bv->contents;
+}
+
+static inline SCM
+scm_bytevector_parent (struct scm_bytevector *bv)
+{
+ return bv->parent;
+}
+
+static inline int
+scm_is_mutable_bytevector (SCM x)
+{
+ scm_t_bits tag = SCM_CELL_TYPE (x);
+ return (tag & (0x7f | SCM_F_BYTEVECTOR_IMMUTABLE)) == scm_tc7_bytevector;
+}
+
+static inline scm_t_array_element_type
+scm_bytevector_element_type (struct scm_bytevector *bv)
+{
+ return bv->tag_flags_and_element_type >> 16;
+}
+
+static inline int
+scm_bytevector_is_contiguous (struct scm_bytevector *bv)
+{
+ return bv->tag_flags_and_element_type & SCM_F_BYTEVECTOR_CONTIGUOUS;
+}
+
+static inline int
+scm_bytevector_is_immutable (struct scm_bytevector *bv)
+{
+ return bv->tag_flags_and_element_type & SCM_F_BYTEVECTOR_IMMUTABLE;
+}
+
+static inline size_t
+scm_bytevector_type_size (struct scm_bytevector *bv)
+{
+ return scm_i_array_element_type_sizes[scm_bytevector_element_type (bv)]/8;
+}
+
+static inline size_t
+scm_bytevector_typed_length (struct scm_bytevector *bv)
+{
+ return bv->length / scm_bytevector_type_size (bv);
+}
+
+SCM_INTERNAL struct scm_bytevector*
+scm_i_make_typed_bytevector (size_t, scm_t_array_element_type);
+SCM_INTERNAL SCM scm_c_take_typed_bytevector (signed char *, size_t,
+ scm_t_array_element_type, SCM);
+
+SCM_INTERNAL void scm_bootstrap_bytevectors (void);
+SCM_INTERNAL void scm_init_bytevectors (void);
+
+SCM_INTERNAL SCM scm_i_native_endianness;
+SCM_INTERNAL SCM scm_c_take_gc_bytevector (signed char *, size_t, SCM);
+
+SCM_INTERNAL int scm_i_print_bytevector (SCM, SCM, scm_print_state *);
+
+SCM_INTERNAL struct scm_bytevector*
+scm_c_shrink_bytevector (struct scm_bytevector*, size_t);
+SCM_INTERNAL void scm_i_bytevector_generalized_set_x (SCM, size_t, SCM);
+SCM_INTERNAL SCM scm_null_bytevector;
+
+#endif /* SCM_BYTEVECTORS_INTERNAL_H */
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index 34da576d4..2fe58c0ac 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -44,6 +44,7 @@
#include "array-handle.h"
#include "arrays.h"
#include "boolean.h"
+#include "bytevectors-internal.h"
#include "dynwind.h"
#include "extensions.h"
#include "generalized-vectors.h"
@@ -92,10 +93,11 @@
_sign char *c_bv; \
\
SCM_VALIDATE_##validate (1, bv); \
+ struct scm_bytevector *bvp = scm_to_bytevector (bv); \
c_index = scm_to_size_t (index); \
\
- c_len = SCM_BYTEVECTOR_LENGTH (bv); \
- c_bv = (_sign char *) SCM_BYTEVECTOR_CONTENTS (bv); \
+ c_len = bvp->length; \
+ c_bv = (_sign char *) bvp->contents; \
\
if (SCM_UNLIKELY (c_len < c_index \
|| (c_len - c_index < (_len) / 8))) \
@@ -193,21 +195,13 @@
/* Bytevector type. */
-#define SCM_BYTEVECTOR_HEADER_BYTES \
- (SCM_BYTEVECTOR_HEADER_SIZE * sizeof (scm_t_bits))
-
-#define SCM_BYTEVECTOR_SET_LENGTH(_bv, _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_PARENT(_bv, _parent) \
- SCM_SET_CELL_OBJECT_3 ((_bv), (_parent))
-
+#define SCM_MUTABLE_BYTEVECTOR_P(v) (scm_is_mutable_bytevector (v))
#define SCM_VALIDATE_MUTABLE_BYTEVECTOR(pos, v) \
SCM_MAKE_VALIDATE_MSG (pos, v, MUTABLE_BYTEVECTOR_P, "mutable bytevector")
/* The empty bytevector. */
+static struct scm_bytevector *null_bytevector;
SCM scm_null_bytevector = SCM_UNSPECIFIED;
@@ -217,77 +211,63 @@ make_bytevector_tag (scm_t_bits flags,
scm_t_array_element_type element_type)
return scm_tc7_bytevector | flags | (element_type << 16);
}
-static inline SCM
+static inline struct scm_bytevector *
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))
/* This would be an internal Guile programming error */
abort ();
- /* Make sure that the total allocation size will not overflow size_t,
- with ~30 extra bytes to spare to avoid an overflow within the
- allocator. */
- if (SCM_UNLIKELY (len >= (((size_t) -(SCM_BYTEVECTOR_HEADER_BYTES + 32))
- /
(scm_i_array_element_type_sizes[element_type]/8))))
+ /* Make sure that the total allocation size will not overflow
+ * size_t. */
+ size_t bytes_per_elt = scm_i_array_element_type_sizes[element_type]/8;
+ size_t max_size = (size_t) -1024;
+ if (SCM_UNLIKELY (len >= max_size / bytes_per_elt))
scm_num_overflow ("make-bytevector");
if (SCM_UNLIKELY (len == 0 && element_type == SCM_ARRAY_ELEMENT_TYPE_VU8
- && SCM_BYTEVECTOR_P (scm_null_bytevector)))
- ret = scm_null_bytevector;
- else
- {
- signed char *contents;
+ && null_bytevector))
+ return null_bytevector;
- c_len = len * (scm_i_array_element_type_sizes[element_type] / 8);
+ size_t c_len = len * bytes_per_elt;
+ struct scm_bytevector *bv =
+ scm_gc_malloc_pointerless (sizeof (struct scm_bytevector) + c_len,
+ "bytevector");
- contents = scm_gc_malloc_pointerless (SCM_BYTEVECTOR_HEADER_BYTES +
c_len,
- SCM_GC_BYTEVECTOR);
- ret = SCM_PACK_POINTER (contents);
- contents += SCM_BYTEVECTOR_HEADER_BYTES;
+ scm_t_bits flags = SCM_F_BYTEVECTOR_CONTIGUOUS;
+ bv->tag_flags_and_element_type = make_bytevector_tag (flags, element_type);
+ bv->length = c_len;
+ bv->contents = bv->inline_contents;
+ bv->parent = SCM_BOOL_F;
- scm_t_bits flags = SCM_F_BYTEVECTOR_CONTIGUOUS;
- SCM_SET_CELL_TYPE (ret, make_bytevector_tag (flags, element_type));
- SCM_BYTEVECTOR_SET_LENGTH (ret, c_len);
- SCM_BYTEVECTOR_SET_CONTENTS (ret, contents);
- SCM_BYTEVECTOR_SET_PARENT (ret, SCM_BOOL_F);
- }
-
- return ret;
+ return bv;
}
/* Return a bytevector of LEN elements of type ELEMENT_TYPE, with element
values taken from CONTENTS. Assume that the storage for CONTENTS will be
automatically reclaimed when it becomes unreachable. */
-static inline SCM
+static inline struct scm_bytevector *
make_bytevector_from_buffer (size_t len, void *contents,
scm_t_array_element_type element_type,
SCM parent, int is_immutable)
{
- SCM ret;
-
if (SCM_UNLIKELY (len == 0))
- ret = make_bytevector (len, element_type);
- else
- {
- size_t c_len;
+ return make_bytevector (len, element_type);
- ret = SCM_PACK_POINTER (scm_gc_malloc (SCM_BYTEVECTOR_HEADER_BYTES,
- SCM_GC_BYTEVECTOR));
+ size_t bytes_per_elt = scm_i_array_element_type_sizes[element_type]/8;
+ size_t c_len = len * bytes_per_elt;
+ struct scm_bytevector *bv =
+ scm_gc_malloc (sizeof (struct scm_bytevector) + c_len,
+ "bytevector");
- c_len = len * (scm_i_array_element_type_sizes[element_type] / 8);
+ scm_t_bits flags = is_immutable ? SCM_F_BYTEVECTOR_IMMUTABLE : 0;
+ bv->tag_flags_and_element_type = make_bytevector_tag (flags, element_type);
+ bv->length = c_len;
+ bv->contents = contents;
+ bv->parent = parent;
- scm_t_bits flags = is_immutable ? SCM_F_BYTEVECTOR_IMMUTABLE : 0;
- SCM_SET_CELL_TYPE (ret, make_bytevector_tag (flags, element_type));
- SCM_BYTEVECTOR_SET_LENGTH (ret, c_len);
- SCM_BYTEVECTOR_SET_CONTENTS (ret, contents);
- SCM_BYTEVECTOR_SET_PARENT (ret, parent);
- }
-
- return ret;
+ return bv;
}
@@ -295,11 +275,11 @@ make_bytevector_from_buffer (size_t len, void *contents,
SCM
scm_c_make_bytevector (size_t len)
{
- return make_bytevector (len, SCM_ARRAY_ELEMENT_TYPE_VU8);
+ return scm_from_bytevector (make_bytevector (len,
SCM_ARRAY_ELEMENT_TYPE_VU8));
}
/* Return a new bytevector of size LEN elements. */
-SCM
+struct scm_bytevector*
scm_i_make_typed_bytevector (size_t len, scm_t_array_element_type element_type)
{
return make_bytevector (len, element_type);
@@ -312,15 +292,17 @@ scm_i_make_typed_bytevector (size_t len,
scm_t_array_element_type element_type)
SCM
scm_c_take_gc_bytevector (signed char *contents, size_t len, SCM parent)
{
- return make_bytevector_from_buffer (len, contents,
SCM_ARRAY_ELEMENT_TYPE_VU8,
- parent, 0);
+ return scm_from_bytevector
+ (make_bytevector_from_buffer (len, contents, SCM_ARRAY_ELEMENT_TYPE_VU8,
+ parent, 0));
}
SCM
scm_c_take_typed_bytevector (signed char *contents, size_t len,
scm_t_array_element_type element_type, SCM parent)
{
- return make_bytevector_from_buffer (len, contents, element_type, parent, 0);
+ return scm_from_bytevector
+ (make_bytevector_from_buffer (len, contents, element_type, parent, 0));
}
SCM_DEFINE (scm_bytevector_slice, "bytevector-slice", 2, 1, 0,
@@ -340,67 +322,66 @@ SCM_DEFINE (scm_bytevector_slice, "bytevector-slice", 2,
1, 0,
scm_t_array_element_type element_type;
SCM_VALIDATE_BYTEVECTOR (1, bv);
+ struct scm_bytevector *bvp = scm_to_bytevector (bv);
c_offset = scm_to_size_t (offset);
if (SCM_UNBNDP (size))
{
- if (c_offset < SCM_BYTEVECTOR_LENGTH (bv))
- c_size = SCM_BYTEVECTOR_LENGTH (bv) - c_offset;
+ if (c_offset < bvp->length)
+ c_size = bvp->length - c_offset;
else
c_size = 0;
}
else
c_size = scm_to_size_t (size);
- if (c_offset == 0 && c_size == SCM_BYTEVECTOR_LENGTH (bv))
+ if (c_offset == 0 && c_size == bvp->length)
return bv;
- if (INT_ADD_OVERFLOW (c_offset, c_size)
- || (c_offset + c_size > SCM_BYTEVECTOR_LENGTH (bv)))
+ if (INT_ADD_OVERFLOW (c_offset, c_size) || (c_offset + c_size > bvp->length))
scm_out_of_range (FUNC_NAME, offset);
/* Preserve the element type of BV, unless we're not slicing on type
boundaries. */
- element_type = SCM_BYTEVECTOR_ELEMENT_TYPE (bv);
- if ((c_offset % SCM_BYTEVECTOR_TYPE_SIZE (bv) != 0)
- || (c_size % SCM_BYTEVECTOR_TYPE_SIZE (bv) != 0))
+ element_type = scm_bytevector_element_type (bvp);
+ size_t elt_size = scm_bytevector_type_size (bvp);
+ if ((c_offset % elt_size != 0) || (c_size % elt_size != 0))
element_type = SCM_ARRAY_ELEMENT_TYPE_VU8;
else
- c_size /= (scm_i_array_element_type_sizes[element_type] / 8);
+ c_size /= elt_size;
- return make_bytevector_from_buffer (c_size,
- SCM_BYTEVECTOR_CONTENTS (bv) + c_offset,
- element_type,
- bv,
- !SCM_MUTABLE_BYTEVECTOR_P (bv));
+ return scm_from_bytevector
+ (make_bytevector_from_buffer (c_size,
+ bvp->contents + c_offset,
+ element_type,
+ bv,
+ scm_bytevector_is_immutable (bvp)));
}
#undef FUNC_NAME
/* Shrink BV to C_NEW_LEN (which is assumed to be smaller than its current
size) and return the new bytevector (possibly different from BV). */
-SCM
-scm_c_shrink_bytevector (SCM bv, size_t c_new_len)
+struct scm_bytevector*
+scm_c_shrink_bytevector (struct scm_bytevector *bv, size_t new_len)
{
- if (SCM_UNLIKELY (c_new_len % SCM_BYTEVECTOR_TYPE_SIZE (bv)))
+ if (SCM_UNLIKELY (new_len % scm_bytevector_type_size (bv)))
/* This would be an internal Guile programming error */
abort ();
- size_t c_len = SCM_BYTEVECTOR_LENGTH (bv);
- if (SCM_UNLIKELY (c_new_len > c_len))
+ if (SCM_UNLIKELY (new_len > bv->length))
abort ();
- if (SCM_BYTEVECTOR_CONTIGUOUS_P (bv) && c_new_len > c_len / 2)
+ if (scm_bytevector_is_contiguous (bv) && new_len > bv->length / 2)
{
- SCM_BYTEVECTOR_SET_LENGTH (bv, c_new_len);
+ bv->length = new_len;
return bv;
}
- SCM new_bv =
- scm_i_make_typed_bytevector (c_new_len, SCM_BYTEVECTOR_ELEMENT_TYPE (bv));
+ struct scm_bytevector *new_bv =
+ scm_i_make_typed_bytevector (new_len, scm_bytevector_element_type (bv));
- memcpy (SCM_BYTEVECTOR_CONTENTS (new_bv), SCM_BYTEVECTOR_CONTENTS (bv),
- c_new_len);
+ memcpy (new_bv->inline_contents, bv->contents, new_len);
return new_bv;
}
@@ -416,8 +397,20 @@ scm_c_bytevector_length (SCM bv)
#define FUNC_NAME "scm_c_bytevector_length"
{
SCM_VALIDATE_BYTEVECTOR (1, bv);
+ struct scm_bytevector *bvp = scm_to_bytevector (bv);
- return SCM_BYTEVECTOR_LENGTH (bv);
+ return bvp->length;
+}
+#undef FUNC_NAME
+
+signed char*
+scm_c_bytevector_contents (SCM bv)
+#define FUNC_NAME "scm_c_bytevector_contents"
+{
+ SCM_VALIDATE_BYTEVECTOR (1, bv);
+ struct scm_bytevector *bvp = scm_to_bytevector (bv);
+
+ return scm_bytevector_contents (bvp);
}
#undef FUNC_NAME
@@ -429,9 +422,10 @@ scm_c_bytevector_ref (SCM bv, size_t index)
const uint8_t *c_bv;
SCM_VALIDATE_BYTEVECTOR (1, bv);
+ struct scm_bytevector *bvp = scm_to_bytevector (bv);
- c_len = SCM_BYTEVECTOR_LENGTH (bv);
- c_bv = (uint8_t *) SCM_BYTEVECTOR_CONTENTS (bv);
+ c_len = bvp->length;
+ c_bv = (uint8_t *) bvp->contents;
if (SCM_UNLIKELY (index >= c_len))
scm_out_of_range (FUNC_NAME, scm_from_size_t (index));
@@ -448,9 +442,10 @@ scm_c_bytevector_set_x (SCM bv, size_t index, uint8_t
value)
uint8_t *c_bv;
SCM_VALIDATE_MUTABLE_BYTEVECTOR (1, bv);
+ struct scm_bytevector *bvp = scm_to_bytevector (bv);
- c_len = SCM_BYTEVECTOR_LENGTH (bv);
- c_bv = (uint8_t *) SCM_BYTEVECTOR_CONTENTS (bv);
+ c_len = bvp->length;
+ c_bv = (uint8_t *) bvp->contents;
if (SCM_UNLIKELY (index >= c_len))
scm_out_of_range (FUNC_NAME, scm_from_size_t (index));
@@ -528,7 +523,6 @@ SCM_DEFINE (scm_make_bytevector, "make-bytevector", 1, 1, 0,
"optionally filled with @var{fill}.")
#define FUNC_NAME s_scm_make_bytevector
{
- SCM bv;
size_t c_len;
uint8_t c_fill = 0;
@@ -543,20 +537,12 @@ SCM_DEFINE (scm_make_bytevector, "make-bytevector", 1, 1,
0,
c_fill = (uint8_t) value;
}
- bv = make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
- if (!scm_is_eq (fill, SCM_UNDEFINED))
- {
- size_t i;
- uint8_t *contents;
-
- contents = (uint8_t *) SCM_BYTEVECTOR_CONTENTS (bv);
- for (i = 0; i < c_len; i++)
- contents[i] = c_fill;
- }
- else
- memset (SCM_BYTEVECTOR_CONTENTS (bv), 0, c_len);
+ struct scm_bytevector *bv =
+ make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
+ if (c_fill)
+ memset (bv->contents, c_fill, bv->length);
- return bv;
+ return scm_from_bytevector (bv);
}
#undef FUNC_NAME
@@ -575,27 +561,17 @@ SCM_DEFINE (scm_bytevector_eq_p, "bytevector=?", 2, 0, 0,
"have the same length and contents.")
#define FUNC_NAME s_scm_bytevector_eq_p
{
- SCM result = SCM_BOOL_F;
- size_t c_len1, c_len2;
-
SCM_VALIDATE_BYTEVECTOR (1, bv1);
SCM_VALIDATE_BYTEVECTOR (2, bv2);
+ struct scm_bytevector *bvp1 = scm_to_bytevector (bv1);
+ struct scm_bytevector *bvp2 = scm_to_bytevector (bv2);
- c_len1 = SCM_BYTEVECTOR_LENGTH (bv1);
- c_len2 = SCM_BYTEVECTOR_LENGTH (bv2);
-
- if (c_len1 == c_len2 && (SCM_BYTEVECTOR_ELEMENT_TYPE (bv1)
- == SCM_BYTEVECTOR_ELEMENT_TYPE (bv2)))
- {
- signed char *c_bv1, *c_bv2;
-
- c_bv1 = SCM_BYTEVECTOR_CONTENTS (bv1);
- c_bv2 = SCM_BYTEVECTOR_CONTENTS (bv2);
-
- result = scm_from_bool (!memcmp (c_bv1, c_bv2, c_len1));
- }
+ if (bvp1->length != bvp2->length)
+ return SCM_BOOL_F;
+ if (scm_bytevector_element_type (bvp1) != scm_bytevector_element_type (bvp2))
+ return SCM_BOOL_F;
- return result;
+ return scm_from_bool (!memcmp (bvp1->contents, bvp2->contents,
bvp1->length));
}
#undef FUNC_NAME
@@ -688,20 +664,14 @@ SCM_DEFINE (scm_bytevector_copy, "bytevector-copy", 1, 0,
0,
"Return a newly allocated copy of @var{bv}.")
#define FUNC_NAME s_scm_bytevector_copy
{
- SCM copy;
- size_t c_len;
- signed char *c_bv, *c_copy;
-
SCM_VALIDATE_BYTEVECTOR (1, bv);
+ struct scm_bytevector *bvp = scm_to_bytevector (bv);
- c_len = SCM_BYTEVECTOR_LENGTH (bv);
- c_bv = SCM_BYTEVECTOR_CONTENTS (bv);
-
- copy = make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
- c_copy = SCM_BYTEVECTOR_CONTENTS (copy);
- memcpy (c_copy, c_bv, c_len);
+ struct scm_bytevector *copy =
+ make_bytevector (bvp->length, SCM_ARRAY_ELEMENT_TYPE_VU8);
+ memcpy (copy->inline_contents, bvp->contents, bvp->length);
- return copy;
+ return scm_from_bytevector (copy);
}
#undef FUNC_NAME
@@ -711,7 +681,7 @@ SCM_DEFINE (scm_uniform_array_to_bytevector,
"uniform-array->bytevector",
"will be copied from the uniform array @var{array}.")
#define FUNC_NAME s_scm_uniform_array_to_bytevector
{
- SCM contents, ret;
+ SCM contents;
size_t len, sz, byte_len;
scm_t_array_handle h;
const void *elts;
@@ -736,16 +706,13 @@ SCM_DEFINE (scm_uniform_array_to_bytevector,
"uniform-array->bytevector",
/* an internal guile error, really */
SCM_MISC_ERROR ("uniform elements larger than 8 bits must fill whole
bytes", SCM_EOL);
- ret = make_bytevector (byte_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
- if (byte_len != 0)
- /* Empty arrays may have elements == NULL. We must avoid passing
- NULL to memcpy, even if the length is zero, to avoid undefined
- behavior. */
- memcpy (SCM_BYTEVECTOR_CONTENTS (ret), elts, byte_len);
+ struct scm_bytevector *ret =
+ make_bytevector (byte_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
+ memcpy (ret->inline_contents, elts, byte_len);
scm_array_handle_release (&h);
- return ret;
+ return scm_from_bytevector (ret);
}
#undef FUNC_NAME
@@ -821,16 +788,14 @@ SCM_DEFINE (scm_u8_list_to_bytevector,
"u8-list->bytevector", 1, 0, 0,
"Turn @var{lst}, a list of octets, into a bytevector.")
#define FUNC_NAME s_scm_u8_list_to_bytevector
{
- SCM bv, item;
- size_t c_len, i;
- uint8_t *c_bv;
+ SCM item;
+ size_t len, i;
- SCM_VALIDATE_LIST_COPYLEN (1, lst, c_len);
+ SCM_VALIDATE_LIST_COPYLEN (1, lst, len);
- bv = make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
- c_bv = (uint8_t *) SCM_BYTEVECTOR_CONTENTS (bv);
+ struct scm_bytevector *bv = make_bytevector (len,
SCM_ARRAY_ELEMENT_TYPE_VU8);
- for (i = 0; i < c_len; lst = SCM_CDR (lst), i++)
+ for (i = 0; i < len; lst = SCM_CDR (lst), i++)
{
item = SCM_CAR (lst);
@@ -840,7 +805,7 @@ SCM_DEFINE (scm_u8_list_to_bytevector,
"u8-list->bytevector", 1, 0, 0,
c_item = SCM_I_INUM (item);
if (SCM_LIKELY ((c_item >= 0) && (c_item < 256)))
- c_bv[i] = (uint8_t) c_item;
+ bv->contents[i] = (uint8_t) c_item;
else
goto type_error;
}
@@ -848,7 +813,7 @@ SCM_DEFINE (scm_u8_list_to_bytevector,
"u8-list->bytevector", 1, 0, 0,
goto type_error;
}
- return bv;
+ return scm_from_bytevector (bv);
type_error:
scm_wrong_type_arg (FUNC_NAME, 1, item);
@@ -1260,10 +1225,8 @@ SCM_DEFINE (scm_bytevector_to_uint_list,
"bytevector->uint-list",
#define INTEGER_LIST_TO_BYTEVECTOR(_sign) \
- SCM bv; \
size_t c_len;
\
size_t c_size; \
- char *c_bv, *c_bv_ptr; \
\
SCM_VALIDATE_LIST_COPYLEN (1, lst, c_len); \
SCM_VALIDATE_SYMBOL (2, endianness); \
@@ -1272,19 +1235,19 @@ SCM_DEFINE (scm_bytevector_to_uint_list,
"bytevector->uint-list",
if (SCM_UNLIKELY (c_size == 0 || c_size >= (SIZE_MAX >> 3))) \
scm_out_of_range (FUNC_NAME, size);
\
\
- bv = make_bytevector (c_len * c_size, SCM_ARRAY_ELEMENT_TYPE_VU8); \
- c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
\
+ struct scm_bytevector *bv = \
+ make_bytevector (c_len * c_size, SCM_ARRAY_ELEMENT_TYPE_VU8); \
\
- for (c_bv_ptr = c_bv;
\
+ for (char *walk = (char *) bv->contents; \
!scm_is_null (lst); \
- lst = SCM_CDR (lst), c_bv_ptr += c_size)
\
+ lst = SCM_CDR (lst), walk += c_size) \
{ \
- bytevector_ ## _sign ## _set (c_bv_ptr, c_size, \
+ bytevector_ ## _sign ## _set (walk, c_size, \
SCM_CAR (lst), endianness, \
FUNC_NAME); \
} \
\
- return bv;
+ return scm_from_bytevector (bv);
SCM_DEFINE (scm_uint_list_to_bytevector, "uint-list->bytevector",
@@ -1980,7 +1943,6 @@ utf_encoding_name (char *name, size_t utf_width, SCM
endianness)
/* Produce the body of a `string->utf' function. */
#define STRING_TO_UTF(_utf_width) \
- SCM utf; \
int err; \
char c_utf_name[MAX_UTF_ENCODING_NAME_LEN]; \
char *c_utf = NULL; \
@@ -2018,11 +1980,12 @@ utf_encoding_name (char *name, size_t utf_width, SCM
endianness)
} \
scm_dynwind_begin (0); \
scm_dynwind_free (c_utf); \
- utf = make_bytevector (c_utf_len, SCM_ARRAY_ELEMENT_TYPE_VU8); \
- memcpy (SCM_BYTEVECTOR_CONTENTS (utf), c_utf, c_utf_len); \
+ struct scm_bytevector *utf = \
+ make_bytevector (c_utf_len, SCM_ARRAY_ELEMENT_TYPE_VU8); \
+ memcpy (utf->contents, c_utf, c_utf_len); \
scm_dynwind_end (); \
\
- return (utf);
+ return scm_from_bytevector (utf);
@@ -2033,18 +1996,18 @@ SCM_DEFINE (scm_string_to_utf8, "string->utf8",
"encoding of @var{str}.")
#define FUNC_NAME s_scm_string_to_utf8
{
- SCM utf;
uint8_t *c_utf;
size_t c_utf_len = 0;
SCM_VALIDATE_STRING (1, str);
c_utf = (uint8_t *) scm_to_utf8_stringn (str, &c_utf_len);
- utf = make_bytevector (c_utf_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
- memcpy (SCM_BYTEVECTOR_CONTENTS (utf), c_utf, c_utf_len);
+ struct scm_bytevector *utf =
+ make_bytevector (c_utf_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
+ memcpy (utf->contents, c_utf, c_utf_len);
free (c_utf);
- return (utf);
+ return scm_from_bytevector (utf);
}
#undef FUNC_NAME
@@ -2074,7 +2037,6 @@ SCM_DEFINE (scm_string_to_utf32, "string->utf32",
"encoding of @var{str}.")
#define FUNC_NAME s_scm_string_to_utf32
{
- SCM bv;
scm_t_wchar *wchars;
size_t wchar_len, bytes_len;
@@ -2084,11 +2046,12 @@ SCM_DEFINE (scm_string_to_utf32, "string->utf32",
scm_i_native_endianness))
swap_u32 (wchars, wchar_len);
- bv = make_bytevector (bytes_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
- memcpy (SCM_BYTEVECTOR_CONTENTS (bv), wchars, bytes_len);
+ struct scm_bytevector *bv =
+ make_bytevector (bytes_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
+ memcpy (bv->contents, wchars, bytes_len);
free (wchars);
- return bv;
+ return scm_from_bytevector (bv);
}
#undef FUNC_NAME
@@ -2180,7 +2143,8 @@ scm_bootstrap_bytevectors (void)
/* This must be instantiated here because the generalized-vector API may
want to access bytevectors even though `(rnrs bytevectors)' hasn't been
loaded. */
- scm_null_bytevector = make_bytevector (0, SCM_ARRAY_ELEMENT_TYPE_VU8);
+ null_bytevector = make_bytevector (0, SCM_ARRAY_ELEMENT_TYPE_VU8);
+ scm_null_bytevector = scm_from_bytevector (null_bytevector);
scm_endianness_big = sym_big = scm_from_latin1_symbol ("big");
diff --git a/libguile/bytevectors.h b/libguile/bytevectors.h
index 4ee862ca5..a1d291171 100644
--- a/libguile/bytevectors.h
+++ b/libguile/bytevectors.h
@@ -22,25 +22,17 @@
+#include <libguile/scm.h>
#include <libguile/error.h>
-#include "libguile/gc.h"
-
-#include "libguile/uniform.h"
-
/* R6RS bytevectors. */
-/* The size in words of the bytevector header (type tag and flags, length,
- and pointer to the underlying buffer). */
-#define SCM_BYTEVECTOR_HEADER_SIZE 4U
-
-#define SCM_BYTEVECTOR_LENGTH(_bv) \
- ((size_t) SCM_CELL_WORD_1 (_bv))
-#define SCM_BYTEVECTOR_CONTENTS(_bv) \
- ((signed char *) SCM_CELL_WORD_2 (_bv))
-#define SCM_BYTEVECTOR_PARENT(_bv) \
- (SCM_CELL_OBJECT_3 (_bv))
-
+#define SCM_BYTEVECTOR_P(x) (SCM_HAS_TYP7 (x, scm_tc7_bytevector))
+#define SCM_VALIDATE_BYTEVECTOR(_pos, _obj) \
+ SCM_ASSERT_TYPE (SCM_BYTEVECTOR_P (_obj), (_obj), (_pos), \
+ FUNC_NAME, "bytevector")
+#define SCM_BYTEVECTOR_LENGTH(bv) (scm_c_bytevector_length (bv))
+#define SCM_BYTEVECTOR_CONTENTS(bv) (scm_c_bytevector_contents (bv))
SCM_API SCM scm_endianness_big;
SCM_API SCM scm_endianness_little;
@@ -48,6 +40,7 @@ SCM_API SCM scm_endianness_little;
SCM_API SCM scm_c_make_bytevector (size_t);
SCM_API int scm_is_bytevector (SCM);
SCM_API size_t scm_c_bytevector_length (SCM);
+SCM_API signed char* scm_c_bytevector_contents (SCM);
SCM_API uint8_t scm_c_bytevector_ref (SCM, size_t);
SCM_API void scm_c_bytevector_set_x (SCM, size_t, uint8_t);
@@ -117,51 +110,4 @@ SCM_API SCM scm_utf8_to_string (SCM);
SCM_API SCM scm_utf16_to_string (SCM, SCM);
SCM_API SCM scm_utf32_to_string (SCM, SCM);
-
-
-/* Internal API. */
-
-#define SCM_BYTEVECTOR_P(x) (SCM_HAS_TYP7 (x, scm_tc7_bytevector))
-
-#define SCM_F_BYTEVECTOR_IMMUTABLE 0x80UL
-#define SCM_F_BYTEVECTOR_CONTIGUOUS 0x100UL
-
-#define SCM_MUTABLE_BYTEVECTOR_P(x) \
- (SCM_NIMP (x) && \
- ((SCM_CELL_TYPE (x) & (0x7fUL | SCM_F_BYTEVECTOR_IMMUTABLE)) \
- == scm_tc7_bytevector))
-
-#define SCM_BYTEVECTOR_ELEMENT_TYPE(_bv) \
- (SCM_CELL_TYPE (_bv) >> 16)
-#define SCM_BYTEVECTOR_CONTIGUOUS_P(_bv) \
- (SCM_CELL_TYPE (_bv) & SCM_F_BYTEVECTOR_CONTIGUOUS)
-
-#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))
-
-/* Hint that is passed to `scm_gc_malloc ()' and friends. */
-#define SCM_GC_BYTEVECTOR "bytevector"
-
-#define SCM_VALIDATE_BYTEVECTOR(_pos, _obj) \
- SCM_ASSERT_TYPE (SCM_BYTEVECTOR_P (_obj), (_obj), (_pos), \
- FUNC_NAME, "bytevector")
-
-SCM_INTERNAL SCM scm_i_make_typed_bytevector (size_t,
scm_t_array_element_type);
-SCM_INTERNAL SCM scm_c_take_typed_bytevector (signed char *, size_t,
- scm_t_array_element_type, SCM);
-
-SCM_INTERNAL void scm_bootstrap_bytevectors (void);
-SCM_INTERNAL void scm_init_bytevectors (void);
-
-SCM_INTERNAL SCM scm_i_native_endianness;
-SCM_INTERNAL SCM scm_c_take_gc_bytevector (signed char *, size_t, SCM);
-
-SCM_INTERNAL int scm_i_print_bytevector (SCM, SCM, scm_print_state *);
-
-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;
-
#endif /* SCM_BYTEVECTORS_H */
diff --git a/libguile/foreign.c b/libguile/foreign.c
index ee6fc28b3..232532504 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -34,7 +34,7 @@
#endif
#include "boolean.h"
-#include "bytevectors.h"
+#include "bytevectors-internal.h"
#include "dynwind.h"
#include "eq.h"
#include "eval.h"
@@ -54,6 +54,7 @@
#include "symbols.h"
#include "threads.h"
#include "version.h"
+#include "uniform.h"
#include "foreign.h"
diff --git a/libguile/goops.c b/libguile/goops.c
index d5fffd04d..8907dce50 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -31,6 +31,7 @@
#include "async.h"
#include "boolean.h"
+#include "bytevectors-internal.h"
#include "chars.h"
#include "dynwind.h"
#include "ephemerons.h"
@@ -252,7 +253,8 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
case scm_tc7_vm_cont:
return class_vm_cont;
case scm_tc7_bytevector:
- if (SCM_BYTEVECTOR_ELEMENT_TYPE (x) == SCM_ARRAY_ELEMENT_TYPE_VU8)
+ if (scm_bytevector_element_type (scm_to_bytevector (x))
+ == SCM_ARRAY_ELEMENT_TYPE_VU8)
return class_bytevector;
else
return class_uvec;
diff --git a/libguile/init.c b/libguile/init.c
index 7a00024a3..a5935a437 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -48,7 +48,7 @@
#include "backtrace.h"
#include "bitvectors.h"
#include "boolean.h"
-#include "bytevectors.h"
+#include "bytevectors-internal.h"
#include "chars.h"
#include "continuations.h"
#include "control.h"
diff --git a/libguile/loader.c b/libguile/loader.c
index 5c6e14789..699931eec 100644
--- a/libguile/loader.c
+++ b/libguile/loader.c
@@ -38,7 +38,7 @@
#endif
#include "boolean.h"
-#include "bytevectors.h"
+#include "bytevectors-internal.h"
#include "elf.h"
#include "eval.h"
#include "extensions.h"
diff --git a/libguile/print.c b/libguile/print.c
index f2921d5cc..db8996371 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -34,6 +34,7 @@
#include "arrays.h"
#include "atomic.h"
#include "bitvectors.h"
+#include "bytevectors-internal.h"
#include "boolean.h"
#include "chars.h"
#include "continuations.h"
diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
index 034564cfd..b4ce456ec 100644
--- a/libguile/r6rs-ports.c
+++ b/libguile/r6rs-ports.c
@@ -27,7 +27,7 @@
#include <string.h>
#include <stdio.h>
#include "boolean.h"
-#include "bytevectors.h"
+#include "bytevectors-internal.h"
#include "chars.h"
#include "eval.h"
#include "extensions.h"
@@ -275,7 +275,8 @@ SCM_DEFINE (scm_get_bytevector_n, "get-bytevector-n", 2, 0,
0,
if (c_read == 0)
result = SCM_EOF_VAL;
else
- result = scm_c_shrink_bytevector (result, c_read);
+ result = scm_from_bytevector
+ (scm_c_shrink_bytevector (scm_to_bytevector (result), c_read));
}
return result;
diff --git a/libguile/srfi-4.c b/libguile/srfi-4.c
index 48f90f0b6..5096bf121 100644
--- a/libguile/srfi-4.c
+++ b/libguile/srfi-4.c
@@ -26,7 +26,7 @@
#include <string.h>
#include "boolean.h"
-#include "bytevectors.h"
+#include "bytevectors-internal.h"
#include "error.h"
#include "eval.h"
#include "extensions.h"
@@ -119,7 +119,7 @@
#define DEFINE_SRFI_4_C_FUNCS(TAG, tag, ctype, width) \
SCM scm_take_##tag##vector (ctype *data, size_t n) \
{ \
- return scm_c_take_typed_bytevector ((int8_t*)data, n, ETYPE (TAG), \
+ return scm_c_take_typed_bytevector ((int8_t*)data, n, ETYPE (TAG), \
SCM_BOOL_F); \
} \
const ctype* scm_array_handle_##tag##_elements (scm_t_array_handle *h) \
@@ -248,17 +248,12 @@ SCM_DEFINE (scm_make_srfi_4_vector, "make-srfi-4-vector",
2, 1, 0,
case SCM_ARRAY_ELEMENT_TYPE_C32:
case SCM_ARRAY_ELEMENT_TYPE_C64:
{
- SCM ret;
-
c_len = scm_to_size_t (len);
- ret = scm_i_make_typed_bytevector (c_len, c_type);
-
- if (SCM_UNBNDP (fill) || scm_is_eq (len, SCM_INUM0))
- ; /* pass */
- else if (scm_is_true (scm_zero_p (fill)))
- memset (SCM_BYTEVECTOR_CONTENTS (ret), 0,
- SCM_BYTEVECTOR_LENGTH (ret));
- else
+ SCM ret = scm_from_bytevector
+ (scm_i_make_typed_bytevector (c_len, c_type));
+
+ /* FIXME: Shouldn't be able to fill a u16 vector with 0.0. */
+ if (!SCM_UNBNDP (fill) && scm_is_false (scm_zero_p (fill)))
{
scm_t_array_handle h;
size_t i;
@@ -283,7 +278,7 @@ SCM_DEFINE (scm_srfi_4_vector_type_size,
"srfi-4-vector-type-size", 1, 0, 0,
#define FUNC_NAME s_scm_srfi_4_vector_type_size
{
SCM_VALIDATE_BYTEVECTOR (1, vec);
- return scm_from_size_t (SCM_BYTEVECTOR_TYPE_SIZE (vec));
+ return scm_from_size_t (scm_bytevector_type_size (scm_to_bytevector (vec)));
}
#undef FUNC_NAME
diff --git a/libguile/strings.c b/libguile/strings.c
index 5eebb3300..9d87d0d14 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -1,4 +1,4 @@
-/* Copyright 1995-1996,1998,2000-2001,2004,2006,2008-2016,2018-2019
+/* Copyright 1995-1996,1998,2000-2001,2004,2006,2008-2016,2018-2019,2025
Free Software Foundation, Inc.
This file is part of Guile.
@@ -34,6 +34,7 @@
#include <c-strcase.h>
#include <intprops.h>
+#include "bytevectors-internal.h"
#include "chars.h"
#include "deprecation.h"
#include "error.h"
