mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-07 12:40:19 +02:00
Code Activity

Move private bytevectors API to a separate header

Browse source 
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.
This commit is contained in:
Andy Wingo 2025-06-02 09:08:35 +02:00
parent 51bc69dd1c
commit 0134abce74
14 changed files with 310 additions and 276 deletions
Download patch file Download diff file Expand all files Collapse all files

1
libguile/Makefile.am
View file

@ -525,6 +525,7 @@ noinst_HEADERS = custom-ports.h \
intrinsics.h \ intrinsics.h \
quicksort.i.c \ quicksort.i.c \
atomics-internal.h \ atomics-internal.h \
bytevectors-internal.h \
cache-internal.h \ cache-internal.h \
gc-inline.h \ gc-inline.h \
gc-internal.h \ gc-internal.h \

40
libguile/array-handle.c
View file

@ -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. Free Software Foundation, Inc.
This file is part of Guile. This file is part of Guile.
@ -30,6 +30,7 @@
#include "boolean.h" #include "boolean.h"
#include "bitvectors.h" #include "bitvectors.h"
#include "bytevectors.h" #include "bytevectors.h"
#include "bytevectors-internal.h"
#include "list.h" #include "list.h"
#include "numbers.h" #include "numbers.h"
#include "pairs.h" #include "pairs.h"
@ -78,11 +79,10 @@ bytevector_c32_ref (SCM bv, size_t pos)
char *c_bv; char *c_bv;
float real, imag; float real, imag;
if (!SCM_BYTEVECTOR_P (bv)) struct scm_bytevector *bvp = scm_to_bytevector (bv);
abort (); c_bv = (char *) bvp->contents;
c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
pos *= 2 * sizeof (float); pos *= 2 * sizeof (float);
if (pos + 2 * sizeof (float) - 1 >= SCM_BYTEVECTOR_LENGTH (bv)) if (pos + 2 * sizeof (float) - 1 >= bvp->length)
abort (); abort ();
memcpy (&real, &c_bv[pos], sizeof (float)); memcpy (&real, &c_bv[pos], sizeof (float));
@ -96,11 +96,10 @@ bytevector_c64_ref (SCM bv, size_t pos)
char *c_bv; char *c_bv;
double real, imag; double real, imag;
if (!SCM_BYTEVECTOR_P (bv)) struct scm_bytevector *bvp = scm_to_bytevector (bv);
abort (); c_bv = (char *) bvp->contents;
c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
pos *= 2 * sizeof (double); pos *= 2 * sizeof (double);
if (pos + 2 * sizeof (double) - 1 >= SCM_BYTEVECTOR_LENGTH (bv)) if (pos + 2 * sizeof (double) - 1 >= bvp->length)
abort (); abort ();
memcpy (&real, &c_bv[pos], sizeof (double)); memcpy (&real, &c_bv[pos], sizeof (double));
@ -114,11 +113,10 @@ bytevector_c32_set (SCM bv, size_t pos, SCM val)
char *c_bv; char *c_bv;
float real, imag; float real, imag;
if (!SCM_BYTEVECTOR_P (bv)) struct scm_bytevector *bvp = scm_to_bytevector (bv);
abort (); c_bv = (char *) bvp->contents;
c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
pos *= 2 * sizeof (float); pos *= 2 * sizeof (float);
if (pos + 2 * sizeof (float) - 1 >= SCM_BYTEVECTOR_LENGTH (bv)) if (pos + 2 * sizeof (float) - 1 >= bvp->length)
abort (); abort ();
real = scm_c_real_part (val); real = scm_c_real_part (val);
@ -133,11 +131,10 @@ bytevector_c64_set (SCM bv, size_t pos, SCM val)
char *c_bv; char *c_bv;
double real, imag; double real, imag;
if (!SCM_BYTEVECTOR_P (bv)) struct scm_bytevector *bvp = scm_to_bytevector (bv);
abort (); c_bv = (char *) bvp->contents;
c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
pos *= 2 * sizeof (double); pos *= 2 * sizeof (double);
if (pos + 2 * sizeof (double) - 1 >= SCM_BYTEVECTOR_LENGTH (bv)) if (pos + 2 * sizeof (double) - 1 >= bvp->length)
abort (); abort ();
real = scm_c_real_part (val); 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_ref vref;
scm_t_vector_set vset; scm_t_vector_set vset;
element_type = SCM_BYTEVECTOR_ELEMENT_TYPE (array); struct scm_bytevector *bv = scm_to_bytevector (array);
length = SCM_BYTEVECTOR_TYPED_LENGTH (array); element_type = scm_bytevector_element_type (bv);
length = scm_bytevector_typed_length (bv);
switch (element_type) 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, initialize_vector_handle (h, length, element_type, vref, vset,
SCM_BYTEVECTOR_CONTENTS (array), bv->contents,
SCM_MUTABLE_BYTEVECTOR_P (array)); !scm_bytevector_is_immutable (bv));
} }
break; break;
case scm_tc7_array: case scm_tc7_array:

3
libguile/arrays.c
View file

@ -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. Free Software Foundation, Inc.
This file is part of Guile. This file is part of Guile.
@ -31,7 +31,6 @@
#include "array-map.h" #include "array-map.h"
#include "bitvectors.h" #include "bitvectors.h"
#include "boolean.h" #include "boolean.h"
#include "bytevectors.h"
#include "chars.h" #include "chars.h"
#include "dynwind.h" #include "dynwind.h"
#include "eq.h" #include "eq.h"

125
libguile/bytevectors-internal.h Normal file
View file

@ -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 */

308
libguile/bytevectors.c
View file

@ -44,6 +44,7 @@
#include "array-handle.h" #include "array-handle.h"
#include "arrays.h" #include "arrays.h"
#include "boolean.h" #include "boolean.h"
#include "bytevectors-internal.h"
#include "dynwind.h" #include "dynwind.h"
#include "extensions.h" #include "extensions.h"
#include "generalized-vectors.h" #include "generalized-vectors.h"
@ -92,10 +93,11 @@
_sign char *c_bv; \ _sign char *c_bv; \
\ \
SCM_VALIDATE_##validate (1, bv); \ SCM_VALIDATE_##validate (1, bv); \
struct scm_bytevector *bvp = scm_to_bytevector (bv); \
c_index = scm_to_size_t (index); \ c_index = scm_to_size_t (index); \
\ \
c_len = SCM_BYTEVECTOR_LENGTH (bv); \ c_len = bvp->length; \
c_bv = (_sign char *) SCM_BYTEVECTOR_CONTENTS (bv); \ c_bv = (_sign char *) bvp->contents; \
\ \
if (SCM_UNLIKELY (c_len < c_index \ if (SCM_UNLIKELY (c_len < c_index \
|| (c_len - c_index < (_len) / 8))) \ || (c_len - c_index < (_len) / 8))) \
@ -193,21 +195,13 @@
/* Bytevector type. */ /* Bytevector type. */
#define SCM_BYTEVECTOR_HEADER_BYTES \ #define SCM_MUTABLE_BYTEVECTOR_P(v) (scm_is_mutable_bytevector (v))
(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_VALIDATE_MUTABLE_BYTEVECTOR(pos, v) \ #define SCM_VALIDATE_MUTABLE_BYTEVECTOR(pos, v) \
SCM_MAKE_VALIDATE_MSG (pos, v, MUTABLE_BYTEVECTOR_P, "mutable bytevector") SCM_MAKE_VALIDATE_MSG (pos, v, MUTABLE_BYTEVECTOR_P, "mutable bytevector")
/* The empty bytevector. */ /* The empty bytevector. */
static struct scm_bytevector *null_bytevector;
SCM scm_null_bytevector = SCM_UNSPECIFIED; 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); 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) 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 if (SCM_UNLIKELY (element_type > SCM_ARRAY_ELEMENT_TYPE_LAST
|| scm_i_array_element_type_sizes[element_type] < 8)) || scm_i_array_element_type_sizes[element_type] < 8))
/* This would be an internal Guile programming error */ /* This would be an internal Guile programming error */
abort (); abort ();
/* Make sure that the total allocation size will not overflow size_t, /* Make sure that the total allocation size will not overflow
with ~30 extra bytes to spare to avoid an overflow within the * size_t. */
allocator. */ size_t bytes_per_elt = scm_i_array_element_type_sizes[element_type]/8;
if (SCM_UNLIKELY (len >= (((size_t) -(SCM_BYTEVECTOR_HEADER_BYTES + 32)) size_t max_size = (size_t) -1024;
/ (scm_i_array_element_type_sizes[element_type]/8)))) if (SCM_UNLIKELY (len >= max_size / bytes_per_elt))
scm_num_overflow ("make-bytevector"); scm_num_overflow ("make-bytevector");
if (SCM_UNLIKELY (len == 0 && element_type == SCM_ARRAY_ELEMENT_TYPE_VU8 if (SCM_UNLIKELY (len == 0 && element_type == SCM_ARRAY_ELEMENT_TYPE_VU8
&& SCM_BYTEVECTOR_P (scm_null_bytevector))) && null_bytevector))
ret = scm_null_bytevector; return null_bytevector;
else
{
signed char *contents;
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_t_bits flags = SCM_F_BYTEVECTOR_CONTIGUOUS;
SCM_GC_BYTEVECTOR); bv->tag_flags_and_element_type = make_bytevector_tag (flags, element_type);
ret = SCM_PACK_POINTER (contents); bv->length = c_len;
contents += SCM_BYTEVECTOR_HEADER_BYTES; bv->contents = bv->inline_contents;
bv->parent = SCM_BOOL_F;
scm_t_bits flags = SCM_F_BYTEVECTOR_CONTIGUOUS; return bv;
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 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. Assume that the storage for CONTENTS will be values taken from CONTENTS. Assume that the storage for CONTENTS will be
automatically reclaimed when it becomes unreachable. */ automatically reclaimed when it becomes unreachable. */
static inline SCM static inline struct scm_bytevector *
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 parent, int is_immutable) SCM parent, int is_immutable)
{ {
SCM ret;
if (SCM_UNLIKELY (len == 0)) if (SCM_UNLIKELY (len == 0))
ret = make_bytevector (len, element_type); return make_bytevector (len, element_type);
else
{
size_t c_len;
ret = SCM_PACK_POINTER (scm_gc_malloc (SCM_BYTEVECTOR_HEADER_BYTES, size_t bytes_per_elt = scm_i_array_element_type_sizes[element_type]/8;
SCM_GC_BYTEVECTOR)); 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; return bv;
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;
} }
@ -295,11 +275,11 @@ make_bytevector_from_buffer (size_t len, void *contents,
SCM SCM
scm_c_make_bytevector (size_t len) 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. */ /* 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) scm_i_make_typed_bytevector (size_t len, scm_t_array_element_type element_type)
{ {
return make_bytevector (len, 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
scm_c_take_gc_bytevector (signed char *contents, size_t len, SCM parent) 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, return scm_from_bytevector
parent, 0); (make_bytevector_from_buffer (len, contents, SCM_ARRAY_ELEMENT_TYPE_VU8,
parent, 0));
} }
SCM SCM
scm_c_take_typed_bytevector (signed char *contents, size_t len, scm_c_take_typed_bytevector (signed char *contents, size_t len,
scm_t_array_element_type element_type, SCM parent) 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, 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_t_array_element_type element_type;
SCM_VALIDATE_BYTEVECTOR (1, bv); SCM_VALIDATE_BYTEVECTOR (1, bv);
struct scm_bytevector *bvp = scm_to_bytevector (bv);
c_offset = scm_to_size_t (offset); c_offset = scm_to_size_t (offset);
if (SCM_UNBNDP (size)) if (SCM_UNBNDP (size))
{ {
if (c_offset < SCM_BYTEVECTOR_LENGTH (bv)) if (c_offset < bvp->length)
c_size = SCM_BYTEVECTOR_LENGTH (bv) - c_offset; c_size = bvp->length - c_offset;
else else
c_size = 0; c_size = 0;
} }
else else
c_size = scm_to_size_t (size); 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; return bv;
if (INT_ADD_OVERFLOW (c_offset, c_size) if (INT_ADD_OVERFLOW (c_offset, c_size) || (c_offset + c_size > bvp->length))
|| (c_offset + c_size > SCM_BYTEVECTOR_LENGTH (bv)))
scm_out_of_range (FUNC_NAME, offset); scm_out_of_range (FUNC_NAME, offset);
/* Preserve the element type of BV, unless we're not slicing on type /* Preserve the element type of BV, unless we're not slicing on type
boundaries. */ boundaries. */
element_type = SCM_BYTEVECTOR_ELEMENT_TYPE (bv); element_type = scm_bytevector_element_type (bvp);
if ((c_offset % SCM_BYTEVECTOR_TYPE_SIZE (bv) != 0) size_t elt_size = scm_bytevector_type_size (bvp);
|| (c_size % SCM_BYTEVECTOR_TYPE_SIZE (bv) != 0)) if ((c_offset % elt_size != 0) || (c_size % elt_size != 0))
element_type = SCM_ARRAY_ELEMENT_TYPE_VU8; element_type = SCM_ARRAY_ELEMENT_TYPE_VU8;
else else
c_size /= (scm_i_array_element_type_sizes[element_type] / 8); c_size /= elt_size;
return make_bytevector_from_buffer (c_size, return scm_from_bytevector
SCM_BYTEVECTOR_CONTENTS (bv) + c_offset, (make_bytevector_from_buffer (c_size,
element_type, bvp->contents + c_offset,
bv, element_type,
!SCM_MUTABLE_BYTEVECTOR_P (bv)); bv,
scm_bytevector_is_immutable (bvp)));
} }
#undef FUNC_NAME #undef FUNC_NAME
/* Shrink BV to C_NEW_LEN (which is assumed to be smaller than its current /* 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). */ size) and return the new bytevector (possibly different from BV). */
SCM struct scm_bytevector*
scm_c_shrink_bytevector (SCM bv, size_t c_new_len) 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 */ /* This would be an internal Guile programming error */
abort (); abort ();
size_t c_len = SCM_BYTEVECTOR_LENGTH (bv); if (SCM_UNLIKELY (new_len > bv->length))
if (SCM_UNLIKELY (c_new_len > c_len))
abort (); 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; return bv;
} }
SCM new_bv = struct scm_bytevector *new_bv =
scm_i_make_typed_bytevector (c_new_len, SCM_BYTEVECTOR_ELEMENT_TYPE (bv)); scm_i_make_typed_bytevector (new_len, scm_bytevector_element_type (bv));
memcpy (SCM_BYTEVECTOR_CONTENTS (new_bv), SCM_BYTEVECTOR_CONTENTS (bv), memcpy (new_bv->inline_contents, bv->contents, new_len);
c_new_len);
return new_bv; return new_bv;
} }
@ -416,8 +397,20 @@ scm_c_bytevector_length (SCM bv)
#define FUNC_NAME "scm_c_bytevector_length" #define FUNC_NAME "scm_c_bytevector_length"
{ {
SCM_VALIDATE_BYTEVECTOR (1, bv); 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 #undef FUNC_NAME
@ -429,9 +422,10 @@ scm_c_bytevector_ref (SCM bv, size_t index)
const uint8_t *c_bv; const uint8_t *c_bv;
SCM_VALIDATE_BYTEVECTOR (1, bv); SCM_VALIDATE_BYTEVECTOR (1, bv);
struct scm_bytevector *bvp = scm_to_bytevector (bv);
c_len = SCM_BYTEVECTOR_LENGTH (bv); c_len = bvp->length;
c_bv = (uint8_t *) SCM_BYTEVECTOR_CONTENTS (bv); c_bv = (uint8_t *) bvp->contents;
if (SCM_UNLIKELY (index >= c_len)) if (SCM_UNLIKELY (index >= c_len))
scm_out_of_range (FUNC_NAME, scm_from_size_t (index)); 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; uint8_t *c_bv;
SCM_VALIDATE_MUTABLE_BYTEVECTOR (1, bv); SCM_VALIDATE_MUTABLE_BYTEVECTOR (1, bv);
struct scm_bytevector *bvp = scm_to_bytevector (bv);
c_len = SCM_BYTEVECTOR_LENGTH (bv); c_len = bvp->length;
c_bv = (uint8_t *) SCM_BYTEVECTOR_CONTENTS (bv); c_bv = (uint8_t *) bvp->contents;
if (SCM_UNLIKELY (index >= c_len)) if (SCM_UNLIKELY (index >= c_len))
scm_out_of_range (FUNC_NAME, scm_from_size_t (index)); 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}.") "optionally filled with @var{fill}.")
#define FUNC_NAME s_scm_make_bytevector #define FUNC_NAME s_scm_make_bytevector
{ {
SCM bv;
size_t c_len; size_t c_len;
uint8_t c_fill = 0; uint8_t c_fill = 0;
@ -543,20 +537,12 @@ SCM_DEFINE (scm_make_bytevector, "make-bytevector", 1, 1, 0,
c_fill = (uint8_t) value; c_fill = (uint8_t) value;
} }
bv = make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8); struct scm_bytevector *bv =
if (!scm_is_eq (fill, SCM_UNDEFINED)) make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
{ if (c_fill)
size_t i; memset (bv->contents, c_fill, bv->length);
uint8_t *contents;
contents = (uint8_t *) SCM_BYTEVECTOR_CONTENTS (bv); return scm_from_bytevector (bv);
for (i = 0; i < c_len; i++)
contents[i] = c_fill;
}
else
memset (SCM_BYTEVECTOR_CONTENTS (bv), 0, c_len);
return bv;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -575,27 +561,17 @@ SCM_DEFINE (scm_bytevector_eq_p, "bytevector=?", 2, 0, 0,
"have the same length and contents.") "have the same length and contents.")
#define FUNC_NAME s_scm_bytevector_eq_p #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 (1, bv1);
SCM_VALIDATE_BYTEVECTOR (2, bv2); 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); if (bvp1->length != bvp2->length)
c_len2 = SCM_BYTEVECTOR_LENGTH (bv2); return SCM_BOOL_F;
if (scm_bytevector_element_type (bvp1) != scm_bytevector_element_type (bvp2))
return SCM_BOOL_F;
if (c_len1 == c_len2 && (SCM_BYTEVECTOR_ELEMENT_TYPE (bv1) return scm_from_bool (!memcmp (bvp1->contents, bvp2->contents, bvp1->length));
== 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));
}
return result;
} }
#undef FUNC_NAME #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}.") "Return a newly allocated copy of @var{bv}.")
#define FUNC_NAME s_scm_bytevector_copy #define FUNC_NAME s_scm_bytevector_copy
{ {
SCM copy;
size_t c_len;
signed char *c_bv, *c_copy;
SCM_VALIDATE_BYTEVECTOR (1, bv); SCM_VALIDATE_BYTEVECTOR (1, bv);
struct scm_bytevector *bvp = scm_to_bytevector (bv);
c_len = SCM_BYTEVECTOR_LENGTH (bv); struct scm_bytevector *copy =
c_bv = SCM_BYTEVECTOR_CONTENTS (bv); make_bytevector (bvp->length, SCM_ARRAY_ELEMENT_TYPE_VU8);
memcpy (copy->inline_contents, bvp->contents, bvp->length);
copy = make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8); return scm_from_bytevector (copy);
c_copy = SCM_BYTEVECTOR_CONTENTS (copy);
memcpy (c_copy, c_bv, c_len);
return copy;
} }
#undef FUNC_NAME #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}.") "will be copied from the uniform array @var{array}.")
#define FUNC_NAME s_scm_uniform_array_to_bytevector #define FUNC_NAME s_scm_uniform_array_to_bytevector
{ {
SCM contents, ret; SCM contents;
size_t len, sz, byte_len; size_t len, sz, byte_len;
scm_t_array_handle h; scm_t_array_handle h;
const void *elts; const void *elts;
@ -736,16 +706,13 @@ SCM_DEFINE (scm_uniform_array_to_bytevector, "uniform-array->bytevector",
/* an internal guile error, really */ /* an internal guile error, really */
SCM_MISC_ERROR ("uniform elements larger than 8 bits must fill whole bytes", SCM_EOL); 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); struct scm_bytevector *ret =
if (byte_len != 0) make_bytevector (byte_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
/* Empty arrays may have elements == NULL. We must avoid passing memcpy (ret->inline_contents, elts, byte_len);
NULL to memcpy, even if the length is zero, to avoid undefined
behavior. */
memcpy (SCM_BYTEVECTOR_CONTENTS (ret), elts, byte_len);
scm_array_handle_release (&h); scm_array_handle_release (&h);
return ret; return scm_from_bytevector (ret);
} }
#undef FUNC_NAME #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.") "Turn @var{lst}, a list of octets, into a bytevector.")
#define FUNC_NAME s_scm_u8_list_to_bytevector #define FUNC_NAME s_scm_u8_list_to_bytevector
{ {
SCM bv, item; SCM item;
size_t c_len, i; size_t len, i;
uint8_t *c_bv;
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); struct scm_bytevector *bv = make_bytevector (len, SCM_ARRAY_ELEMENT_TYPE_VU8);
c_bv = (uint8_t *) SCM_BYTEVECTOR_CONTENTS (bv);
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); 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); c_item = SCM_I_INUM (item);
if (SCM_LIKELY ((c_item >= 0) && (c_item < 256))) if (SCM_LIKELY ((c_item >= 0) && (c_item < 256)))
c_bv[i] = (uint8_t) c_item; bv->contents[i] = (uint8_t) c_item;
else else
goto type_error; goto type_error;
} }
@ -848,7 +813,7 @@ SCM_DEFINE (scm_u8_list_to_bytevector, "u8-list->bytevector", 1, 0, 0,
goto type_error; goto type_error;
} }
return bv; return scm_from_bytevector (bv);
type_error: type_error:
scm_wrong_type_arg (FUNC_NAME, 1, item); 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) \ #define INTEGER_LIST_TO_BYTEVECTOR(_sign) \
SCM bv; \
size_t c_len; \ size_t c_len; \
size_t c_size; \ size_t c_size; \
char *c_bv, *c_bv_ptr; \
\ \
SCM_VALIDATE_LIST_COPYLEN (1, lst, c_len); \ SCM_VALIDATE_LIST_COPYLEN (1, lst, c_len); \
SCM_VALIDATE_SYMBOL (2, endianness); \ 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))) \ if (SCM_UNLIKELY (c_size == 0 || c_size >= (SIZE_MAX >> 3))) \
scm_out_of_range (FUNC_NAME, size); \ scm_out_of_range (FUNC_NAME, size); \
\ \
bv = make_bytevector (c_len * c_size, SCM_ARRAY_ELEMENT_TYPE_VU8); \ struct scm_bytevector *bv = \
c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (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); \ !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, \ SCM_CAR (lst), endianness, \
FUNC_NAME); \ FUNC_NAME); \
} \ } \
\ \
return bv; return scm_from_bytevector (bv);
SCM_DEFINE (scm_uint_list_to_bytevector, "uint-list->bytevector", 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. */ /* Produce the body of a `string->utf' function. */
#define STRING_TO_UTF(_utf_width) \ #define STRING_TO_UTF(_utf_width) \
SCM utf; \
int err; \ int err; \
char c_utf_name[MAX_UTF_ENCODING_NAME_LEN]; \ char c_utf_name[MAX_UTF_ENCODING_NAME_LEN]; \
char *c_utf = NULL; \ 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_begin (0); \
scm_dynwind_free (c_utf); \ scm_dynwind_free (c_utf); \
utf = make_bytevector (c_utf_len, SCM_ARRAY_ELEMENT_TYPE_VU8); \ struct scm_bytevector *utf = \
memcpy (SCM_BYTEVECTOR_CONTENTS (utf), c_utf, c_utf_len); \ make_bytevector (c_utf_len, SCM_ARRAY_ELEMENT_TYPE_VU8); \
memcpy (utf->contents, c_utf, c_utf_len); \
scm_dynwind_end (); \ 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}.") "encoding of @var{str}.")
#define FUNC_NAME s_scm_string_to_utf8 #define FUNC_NAME s_scm_string_to_utf8
{ {
SCM utf;
uint8_t *c_utf; uint8_t *c_utf;
size_t c_utf_len = 0; size_t c_utf_len = 0;
SCM_VALIDATE_STRING (1, str); SCM_VALIDATE_STRING (1, str);
c_utf = (uint8_t *) scm_to_utf8_stringn (str, &c_utf_len); c_utf = (uint8_t *) scm_to_utf8_stringn (str, &c_utf_len);
utf = make_bytevector (c_utf_len, SCM_ARRAY_ELEMENT_TYPE_VU8); struct scm_bytevector *utf =
memcpy (SCM_BYTEVECTOR_CONTENTS (utf), c_utf, c_utf_len); make_bytevector (c_utf_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
memcpy (utf->contents, c_utf, c_utf_len);
free (c_utf); free (c_utf);
return (utf); return scm_from_bytevector (utf);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -2074,7 +2037,6 @@ SCM_DEFINE (scm_string_to_utf32, "string->utf32",
"encoding of @var{str}.") "encoding of @var{str}.")
#define FUNC_NAME s_scm_string_to_utf32 #define FUNC_NAME s_scm_string_to_utf32
{ {
SCM bv;
scm_t_wchar *wchars; scm_t_wchar *wchars;
size_t wchar_len, bytes_len; size_t wchar_len, bytes_len;
@ -2084,11 +2046,12 @@ SCM_DEFINE (scm_string_to_utf32, "string->utf32",
scm_i_native_endianness)) scm_i_native_endianness))
swap_u32 (wchars, wchar_len); swap_u32 (wchars, wchar_len);
bv = make_bytevector (bytes_len, SCM_ARRAY_ELEMENT_TYPE_VU8); struct scm_bytevector *bv =
memcpy (SCM_BYTEVECTOR_CONTENTS (bv), wchars, bytes_len); make_bytevector (bytes_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
memcpy (bv->contents, wchars, bytes_len);
free (wchars); free (wchars);
return bv; return scm_from_bytevector (bv);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -2180,7 +2143,8 @@ scm_bootstrap_bytevectors (void)
/* This must be instantiated here because the generalized-vector API may /* This must be instantiated here because the generalized-vector API may
want to access bytevectors even though `(rnrs bytevectors)' hasn't been want to access bytevectors even though `(rnrs bytevectors)' hasn't been
loaded. */ 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"); scm_endianness_big = sym_big = scm_from_latin1_symbol ("big");

70
libguile/bytevectors.h
View file

@ -22,25 +22,17 @@
#include <libguile/scm.h>
#include <libguile/error.h> #include <libguile/error.h>
#include "libguile/gc.h"
#include "libguile/uniform.h"
/* R6RS bytevectors. */ /* R6RS bytevectors. */
/* The size in words of the bytevector header (type tag and flags, length, #define SCM_BYTEVECTOR_P(x) (SCM_HAS_TYP7 (x, scm_tc7_bytevector))
and pointer to the underlying buffer). */ #define SCM_VALIDATE_BYTEVECTOR(_pos, _obj) \
#define SCM_BYTEVECTOR_HEADER_SIZE 4U SCM_ASSERT_TYPE (SCM_BYTEVECTOR_P (_obj), (_obj), (_pos), \
FUNC_NAME, "bytevector")
#define SCM_BYTEVECTOR_LENGTH(_bv) \ #define SCM_BYTEVECTOR_LENGTH(bv) (scm_c_bytevector_length (bv))
((size_t) SCM_CELL_WORD_1 (_bv)) #define SCM_BYTEVECTOR_CONTENTS(bv) (scm_c_bytevector_contents (bv))
#define SCM_BYTEVECTOR_CONTENTS(_bv) \
((signed char *) SCM_CELL_WORD_2 (_bv))
#define SCM_BYTEVECTOR_PARENT(_bv) \
(SCM_CELL_OBJECT_3 (_bv))
SCM_API SCM scm_endianness_big; SCM_API SCM scm_endianness_big;
SCM_API SCM scm_endianness_little; 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 SCM scm_c_make_bytevector (size_t);
SCM_API int scm_is_bytevector (SCM); SCM_API int scm_is_bytevector (SCM);
SCM_API size_t scm_c_bytevector_length (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 uint8_t scm_c_bytevector_ref (SCM, size_t);
SCM_API void scm_c_bytevector_set_x (SCM, size_t, uint8_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_utf16_to_string (SCM, SCM);
SCM_API SCM scm_utf32_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 */ #endif /* SCM_BYTEVECTORS_H */

3
libguile/foreign.c
View file

@ -34,7 +34,7 @@
#endif #endif
#include "boolean.h" #include "boolean.h"
#include "bytevectors.h" #include "bytevectors-internal.h"
#include "dynwind.h" #include "dynwind.h"
#include "eq.h" #include "eq.h"
#include "eval.h" #include "eval.h"
@ -54,6 +54,7 @@
#include "symbols.h" #include "symbols.h"
#include "threads.h" #include "threads.h"
#include "version.h" #include "version.h"
#include "uniform.h"
#include "foreign.h" #include "foreign.h"

4
libguile/goops.c
View file

@ -31,6 +31,7 @@
#include "async.h" #include "async.h"
#include "boolean.h" #include "boolean.h"
#include "bytevectors-internal.h"
#include "chars.h" #include "chars.h"
#include "dynwind.h" #include "dynwind.h"
#include "ephemerons.h" #include "ephemerons.h"
@ -252,7 +253,8 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
case scm_tc7_vm_cont: case scm_tc7_vm_cont:
return class_vm_cont; return class_vm_cont;
case scm_tc7_bytevector: 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; return class_bytevector;
else else
return class_uvec; return class_uvec;

2
libguile/init.c
View file

@ -48,7 +48,7 @@
#include "backtrace.h" #include "backtrace.h"
#include "bitvectors.h" #include "bitvectors.h"
#include "boolean.h" #include "boolean.h"
#include "bytevectors.h" #include "bytevectors-internal.h"
#include "chars.h" #include "chars.h"
#include "continuations.h" #include "continuations.h"
#include "control.h" #include "control.h"

2
libguile/loader.c
View file

@ -38,7 +38,7 @@
#endif #endif
#include "boolean.h" #include "boolean.h"
#include "bytevectors.h" #include "bytevectors-internal.h"
#include "elf.h" #include "elf.h"
#include "eval.h" #include "eval.h"
#include "extensions.h" #include "extensions.h"

1
libguile/print.c
View file

@ -34,6 +34,7 @@
#include "arrays.h" #include "arrays.h"
#include "atomic.h" #include "atomic.h"
#include "bitvectors.h" #include "bitvectors.h"
#include "bytevectors-internal.h"
#include "boolean.h" #include "boolean.h"
#include "chars.h" #include "chars.h"
#include "continuations.h" #include "continuations.h"

5
libguile/r6rs-ports.c
View file

@ -27,7 +27,7 @@
#include <string.h> #include <string.h>
#include <stdio.h> #include <stdio.h>
#include "boolean.h" #include "boolean.h"
#include "bytevectors.h" #include "bytevectors-internal.h"
#include "chars.h" #include "chars.h"
#include "eval.h" #include "eval.h"
#include "extensions.h" #include "extensions.h"
@ -275,7 +275,8 @@ SCM_DEFINE (scm_get_bytevector_n, "get-bytevector-n", 2, 0, 0,
if (c_read == 0) if (c_read == 0)
result = SCM_EOF_VAL; result = SCM_EOF_VAL;
else 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; return result;

19
libguile/srfi-4.c
View file

@ -26,7 +26,7 @@
#include <string.h> #include <string.h>
#include "boolean.h" #include "boolean.h"
#include "bytevectors.h" #include "bytevectors-internal.h"
#include "error.h" #include "error.h"
#include "eval.h" #include "eval.h"
#include "extensions.h" #include "extensions.h"
@ -119,7 +119,7 @@
#define DEFINE_SRFI_4_C_FUNCS(TAG, tag, ctype, width) \ #define DEFINE_SRFI_4_C_FUNCS(TAG, tag, ctype, width) \
SCM scm_take_##tag##vector (ctype *data, size_t n) \ 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); \ SCM_BOOL_F); \
} \ } \
const ctype* scm_array_handle_##tag##_elements (scm_t_array_handle *h) \ 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_C32:
case SCM_ARRAY_ELEMENT_TYPE_C64: case SCM_ARRAY_ELEMENT_TYPE_C64:
{ {
SCM ret;
c_len = scm_to_size_t (len); c_len = scm_to_size_t (len);
ret = scm_i_make_typed_bytevector (c_len, c_type); SCM ret = scm_from_bytevector
(scm_i_make_typed_bytevector (c_len, c_type));
if (SCM_UNBNDP (fill) || scm_is_eq (len, SCM_INUM0)) /* FIXME: Shouldn't be able to fill a u16 vector with 0.0. */
; /* pass */ if (!SCM_UNBNDP (fill) && scm_is_false (scm_zero_p (fill)))
else if (scm_is_true (scm_zero_p (fill)))
memset (SCM_BYTEVECTOR_CONTENTS (ret), 0,
SCM_BYTEVECTOR_LENGTH (ret));
else
{ {
scm_t_array_handle h; scm_t_array_handle h;
size_t i; 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 #define FUNC_NAME s_scm_srfi_4_vector_type_size
{ {
SCM_VALIDATE_BYTEVECTOR (1, vec); 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 #undef FUNC_NAME

3
libguile/strings.c
View file

@ -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. Free Software Foundation, Inc.
This file is part of Guile. This file is part of Guile.
@ -34,6 +34,7 @@
#include <c-strcase.h> #include <c-strcase.h>
#include <intprops.h> #include <intprops.h>
#include "bytevectors-internal.h"
#include "chars.h" #include "chars.h"
#include "deprecation.h" #include "deprecation.h"
#include "error.h" #include "error.h"