mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-06 20:20:20 +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 \
quicksort.i.c \
atomics-internal.h \
bytevectors-internal.h \
cache-internal.h \
gc-inline.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.
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:

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.
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"

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 "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;
struct scm_bytevector *bv =
make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
if (c_fill)
memset (bv->contents, c_fill, bv->length);
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);
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 (bvp1->length != bvp2->length)
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)
== 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;
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);
struct scm_bytevector *copy =
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);
c_copy = SCM_BYTEVECTOR_CONTENTS (copy);
memcpy (c_copy, c_bv, c_len);
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");

70
libguile/bytevectors.h
View file

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

3
libguile/foreign.c
View file

@ -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"

4
libguile/goops.c
View file

@ -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;

2
libguile/init.c
View file

@ -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"

2
libguile/loader.c
View file

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

1
libguile/print.c
View file

@ -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"

5
libguile/r6rs-ports.c
View file

@ -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;

19
libguile/srfi-4.c
View file

@ -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);
SCM ret = scm_from_bytevector
(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
/* 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

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.
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"