wingo pushed a commit to branch wip-whippet
in repository guile.
commit 043a5b62bb288b73890634369a0f9b5e37fd03b0
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Fri May 30 14:19:30 2025 +0200
Rework treatment of bytevector flags
Before, they were always shifted by 7. Now the flags are just above
0x7f and just the element type is shifted, but by 16.
* libguile/bytevectors.h (SCM_BYTEVECTOR_FLAGS): Rework to not shift.
(SCM_SET_BYTEVECTOR_FLAGS): Remove.
(SCM_MUTABLE_BYTEVECTOR_P): Don't shift the immutable flag.
(SCM_BYTEVECTOR_ELEMENT_TYPE): Shift right by 16.
* libguile/bytevectors.c (SCM_BYTEVECTOR_SET_FLAG): Remove unused
helper.
(make_bytevector_tag): New helper.
(make_bytevector): Use new helper.
(make_bytevector_from_buffer): Add flags and parent args, and use new
helper.
(scm_c_take_gc_bytevector):
(scm_c_take_typed_bytevector):
(scm_bytevector_slice): Update callers.
* module/system/vm/assembler.scm (link-data): Don't shift the flag by 7;
instead shift the element type by 16.
---
libguile/bytevectors.c | 54 ++++++++++++++++--------------------------
libguile/bytevectors.h | 15 ++++--------
module/system/vm/assembler.scm | 8 ++-----
3 files changed, 28 insertions(+), 49 deletions(-)
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index 2ec26730b..34da576d4 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -196,8 +196,6 @@
#define SCM_BYTEVECTOR_HEADER_BYTES \
(SCM_BYTEVECTOR_HEADER_SIZE * sizeof (scm_t_bits))
-#define SCM_BYTEVECTOR_SET_FLAG(bv, flag) \
- SCM_SET_BYTEVECTOR_FLAGS ((bv), SCM_BYTEVECTOR_FLAGS (bv) | flag)
#define SCM_BYTEVECTOR_SET_LENGTH(_bv, _len) \
SCM_SET_CELL_WORD_1 ((_bv), (scm_t_bits) (_len))
#define SCM_BYTEVECTOR_SET_CONTENTS(_bv, _contents) \
@@ -213,6 +211,12 @@
SCM scm_null_bytevector = SCM_UNSPECIFIED;
+static scm_t_bits
+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
make_bytevector (size_t len, scm_t_array_element_type element_type)
{
@@ -245,8 +249,8 @@ make_bytevector (size_t len, scm_t_array_element_type
element_type)
ret = SCM_PACK_POINTER (contents);
contents += SCM_BYTEVECTOR_HEADER_BYTES;
- SCM_SET_BYTEVECTOR_FLAGS (ret,
- element_type | SCM_F_BYTEVECTOR_CONTIGUOUS);
+ 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);
@@ -260,7 +264,8 @@ make_bytevector (size_t len, scm_t_array_element_type
element_type)
automatically reclaimed when it becomes unreachable. */
static inline SCM
make_bytevector_from_buffer (size_t len, void *contents,
- scm_t_array_element_type element_type)
+ scm_t_array_element_type element_type,
+ SCM parent, int is_immutable)
{
SCM ret;
@@ -275,10 +280,11 @@ make_bytevector_from_buffer (size_t len, void *contents,
c_len = len * (scm_i_array_element_type_sizes[element_type] / 8);
- SCM_SET_BYTEVECTOR_FLAGS (ret, element_type);
+ 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, SCM_BOOL_F);
+ SCM_BYTEVECTOR_SET_PARENT (ret, parent);
}
return ret;
@@ -306,24 +312,15 @@ 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)
{
- SCM ret;
-
- ret = make_bytevector_from_buffer (len, contents,
SCM_ARRAY_ELEMENT_TYPE_VU8);
- SCM_BYTEVECTOR_SET_PARENT (ret, parent);
-
- return ret;
+ return 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)
{
- SCM ret;
-
- ret = make_bytevector_from_buffer (len, contents, element_type);
- SCM_BYTEVECTOR_SET_PARENT (ret, parent);
-
- return ret;
+ return make_bytevector_from_buffer (len, contents, element_type, parent, 0);
}
SCM_DEFINE (scm_bytevector_slice, "bytevector-slice", 2, 1, 0,
@@ -339,7 +336,6 @@ SCM_DEFINE (scm_bytevector_slice, "bytevector-slice", 2, 1,
0,
"on its element type size.\n")
#define FUNC_NAME s_scm_bytevector_slice
{
- SCM ret;
size_t c_offset, c_size;
scm_t_array_element_type element_type;
@@ -373,19 +369,11 @@ SCM_DEFINE (scm_bytevector_slice, "bytevector-slice", 2,
1, 0,
else
c_size /= (scm_i_array_element_type_sizes[element_type] / 8);
- ret = make_bytevector_from_buffer (c_size,
- SCM_BYTEVECTOR_CONTENTS (bv) + c_offset,
- element_type);
- if (!SCM_MUTABLE_BYTEVECTOR_P (bv))
- {
- /* Preserve the immutability property. */
- scm_t_bits flags = SCM_BYTEVECTOR_FLAGS (ret);
- SCM_SET_BYTEVECTOR_FLAGS (ret, flags | SCM_F_BYTEVECTOR_IMMUTABLE);
- }
-
- SCM_BYTEVECTOR_SET_PARENT (ret, bv);
-
- return ret;
+ return make_bytevector_from_buffer (c_size,
+ SCM_BYTEVECTOR_CONTENTS (bv) + c_offset,
+ element_type,
+ bv,
+ !SCM_MUTABLE_BYTEVECTOR_P (bv));
}
#undef FUNC_NAME
diff --git a/libguile/bytevectors.h b/libguile/bytevectors.h
index 593c94859..05a45576b 100644
--- a/libguile/bytevectors.h
+++ b/libguile/bytevectors.h
@@ -1,7 +1,7 @@
#ifndef SCM_BYTEVECTORS_H
#define SCM_BYTEVECTORS_H
-/* Copyright 2009, 2011, 2018, 2023
+/* Copyright 2009, 2011, 2018, 2023, 2025
Free Software Foundation, Inc.
This file is part of Guile.
@@ -121,24 +121,19 @@ 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_BYTEVECTOR_FLAGS(_bv) \
- (SCM_CELL_TYPE (_bv) >> 7UL)
-#define SCM_SET_BYTEVECTOR_FLAGS(_bv, _f) \
- SCM_SET_CELL_TYPE ((_bv), \
- scm_tc7_bytevector | ((scm_t_bits)(_f) << 7UL))
+#define SCM_BYTEVECTOR_P(x) (SCM_HAS_TYP7 (x, scm_tc7_bytevector))
+#define SCM_BYTEVECTOR_FLAGS(_bv) (SCM_CELL_TYPE (_bv) & 0xff00)
#define SCM_F_BYTEVECTOR_CONTIGUOUS 0x100UL
#define SCM_F_BYTEVECTOR_IMMUTABLE 0x200UL
#define SCM_MUTABLE_BYTEVECTOR_P(x) \
(SCM_NIMP (x) && \
- ((SCM_CELL_TYPE (x) & (0x7fUL | (SCM_F_BYTEVECTOR_IMMUTABLE << 7UL))) \
+ ((SCM_CELL_TYPE (x) & (0x7fUL | SCM_F_BYTEVECTOR_IMMUTABLE)) \
== scm_tc7_bytevector))
#define SCM_BYTEVECTOR_ELEMENT_TYPE(_bv) \
- (SCM_BYTEVECTOR_FLAGS (_bv) & 0xffUL)
+ (SCM_CELL_TYPE (_bv) >> 16)
#define SCM_BYTEVECTOR_CONTIGUOUS_P(_bv) \
(SCM_BYTEVECTOR_FLAGS (_bv) & SCM_F_BYTEVECTOR_CONTIGUOUS)
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index d92399b26..c81301762 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -1864,7 +1864,6 @@ should be .data or .rodata), and return the resulting
linker object.
(define tc7-program #x45)
(define tc7-bytevector #x4d)
- ;; This flag is intended to be left-shifted by 7 bits.
(define bytevector-immutable-flag #x200)
(define tc7-array #x5d)
@@ -2029,11 +2028,8 @@ should be .data or .rodata), and return the resulting
linker object.
(logior tc7-bitvector
bitvector-immutable-flag)
(logior tc7-bytevector
- ;; Bytevector immutable flag also shifted
- ;; left.
- (ash (logior bytevector-immutable-flag
- (array-type-code obj))
- 7)))))
+ bytevector-immutable-flag
+ (ash (array-type-code obj) 16)))))
(case word-size
((4)
(bytevector-u32-set! buf pos tag endianness)
