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

Rework treatment of bytevector flags

Browse source 
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.
This commit is contained in:
Andy Wingo 2025-05-30 14:19:30 +02:00
parent 464ec999de
commit 043a5b62bb
3 changed files with 28 additions and 49 deletions
Download patch file Download diff file Expand all files Collapse all files

54
libguile/bytevectors.c
View file

@ -196,8 +196,6 @@
#define SCM_BYTEVECTOR_HEADER_BYTES \ #define SCM_BYTEVECTOR_HEADER_BYTES \
(SCM_BYTEVECTOR_HEADER_SIZE * sizeof (scm_t_bits)) (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) \ #define SCM_BYTEVECTOR_SET_LENGTH(_bv, _len) \
SCM_SET_CELL_WORD_1 ((_bv), (scm_t_bits) (_len)) SCM_SET_CELL_WORD_1 ((_bv), (scm_t_bits) (_len))
#define SCM_BYTEVECTOR_SET_CONTENTS(_bv, _contents) \ #define SCM_BYTEVECTOR_SET_CONTENTS(_bv, _contents) \
@ -213,6 +211,12 @@
SCM scm_null_bytevector = SCM_UNSPECIFIED; 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 static inline SCM
make_bytevector (size_t len, scm_t_array_element_type element_type) 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); ret = SCM_PACK_POINTER (contents);
contents += SCM_BYTEVECTOR_HEADER_BYTES; contents += SCM_BYTEVECTOR_HEADER_BYTES;
SCM_SET_BYTEVECTOR_FLAGS (ret, scm_t_bits flags = SCM_F_BYTEVECTOR_CONTIGUOUS;
element_type | 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_LENGTH (ret, c_len);
SCM_BYTEVECTOR_SET_CONTENTS (ret, contents); SCM_BYTEVECTOR_SET_CONTENTS (ret, contents);
SCM_BYTEVECTOR_SET_PARENT (ret, SCM_BOOL_F); 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. */ automatically reclaimed when it becomes unreachable. */
static inline SCM static inline SCM
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 ret; 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); 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_LENGTH (ret, c_len);
SCM_BYTEVECTOR_SET_CONTENTS (ret, contents); SCM_BYTEVECTOR_SET_CONTENTS (ret, contents);
SCM_BYTEVECTOR_SET_PARENT (ret, SCM_BOOL_F); SCM_BYTEVECTOR_SET_PARENT (ret, parent);
} }
return ret; return ret;
@ -306,24 +312,15 @@ 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)
{ {
SCM ret; return make_bytevector_from_buffer (len, contents, SCM_ARRAY_ELEMENT_TYPE_VU8,
parent, 0);
ret = make_bytevector_from_buffer (len, contents, SCM_ARRAY_ELEMENT_TYPE_VU8);
SCM_BYTEVECTOR_SET_PARENT (ret, parent);
return ret;
} }
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)
{ {
SCM ret; return make_bytevector_from_buffer (len, contents, element_type, parent, 0);
ret = make_bytevector_from_buffer (len, contents, element_type);
SCM_BYTEVECTOR_SET_PARENT (ret, parent);
return ret;
} }
SCM_DEFINE (scm_bytevector_slice, "bytevector-slice", 2, 1, 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") "on its element type size.\n")
#define FUNC_NAME s_scm_bytevector_slice #define FUNC_NAME s_scm_bytevector_slice
{ {
SCM ret;
size_t c_offset, c_size; size_t c_offset, c_size;
scm_t_array_element_type element_type; scm_t_array_element_type element_type;
@ -373,19 +369,11 @@ SCM_DEFINE (scm_bytevector_slice, "bytevector-slice", 2, 1, 0,
else else
c_size /= (scm_i_array_element_type_sizes[element_type] / 8); c_size /= (scm_i_array_element_type_sizes[element_type] / 8);
ret = make_bytevector_from_buffer (c_size, return make_bytevector_from_buffer (c_size,
SCM_BYTEVECTOR_CONTENTS (bv) + c_offset, SCM_BYTEVECTOR_CONTENTS (bv) + c_offset,
element_type); element_type,
if (!SCM_MUTABLE_BYTEVECTOR_P (bv)) bv,
{ !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;
} }
#undef FUNC_NAME #undef FUNC_NAME

15
libguile/bytevectors.h
View file

@ -1,7 +1,7 @@
#ifndef SCM_BYTEVECTORS_H #ifndef SCM_BYTEVECTORS_H
#define SCM_BYTEVECTORS_H #define SCM_BYTEVECTORS_H
/* Copyright 2009, 2011, 2018, 2023 /* Copyright 2009, 2011, 2018, 2023, 2025
Free Software Foundation, Inc. Free Software Foundation, Inc.
This file is part of Guile. This file is part of Guile.
@ -121,24 +121,19 @@ SCM_API SCM scm_utf32_to_string (SCM, SCM);
/* Internal API. */ /* Internal API. */
#define SCM_BYTEVECTOR_P(x) \ #define SCM_BYTEVECTOR_P(x) (SCM_HAS_TYP7 (x, scm_tc7_bytevector))
(SCM_HAS_TYP7 (x, scm_tc7_bytevector)) #define SCM_BYTEVECTOR_FLAGS(_bv) (SCM_CELL_TYPE (_bv) & 0xff00)
#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_F_BYTEVECTOR_CONTIGUOUS 0x100UL #define SCM_F_BYTEVECTOR_CONTIGUOUS 0x100UL
#define SCM_F_BYTEVECTOR_IMMUTABLE 0x200UL #define SCM_F_BYTEVECTOR_IMMUTABLE 0x200UL
#define SCM_MUTABLE_BYTEVECTOR_P(x) \ #define SCM_MUTABLE_BYTEVECTOR_P(x) \
(SCM_NIMP (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)) == scm_tc7_bytevector))
#define SCM_BYTEVECTOR_ELEMENT_TYPE(_bv) \ #define SCM_BYTEVECTOR_ELEMENT_TYPE(_bv) \
(SCM_BYTEVECTOR_FLAGS (_bv) & 0xffUL) (SCM_CELL_TYPE (_bv) >> 16)
#define SCM_BYTEVECTOR_CONTIGUOUS_P(_bv) \ #define SCM_BYTEVECTOR_CONTIGUOUS_P(_bv) \
(SCM_BYTEVECTOR_FLAGS (_bv) & SCM_F_BYTEVECTOR_CONTIGUOUS) (SCM_BYTEVECTOR_FLAGS (_bv) & SCM_F_BYTEVECTOR_CONTIGUOUS)

8
module/system/vm/assembler.scm
View file

@ -1864,7 +1864,6 @@ should be .data or .rodata), and return the resulting linker object.
(define tc7-program #x45) (define tc7-program #x45)
(define tc7-bytevector #x4d) (define tc7-bytevector #x4d)
;; This flag is intended to be left-shifted by 7 bits.
(define bytevector-immutable-flag #x200) (define bytevector-immutable-flag #x200)
(define tc7-array #x5d) (define tc7-array #x5d)
@ -2029,11 +2028,8 @@ should be .data or .rodata), and return the resulting linker object.
(logior tc7-bitvector (logior tc7-bitvector
bitvector-immutable-flag) bitvector-immutable-flag)
(logior tc7-bytevector (logior tc7-bytevector
;; Bytevector immutable flag also shifted bytevector-immutable-flag
;; left. (ash (array-type-code obj) 16)))))
(ash (logior bytevector-immutable-flag
(array-type-code obj))
7)))))
(case word-size (case word-size
((4) ((4)
(bytevector-u32-set! buf pos tag endianness) (bytevector-u32-set! buf pos tag endianness)