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)