mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-12 06:41:13 +02:00
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.
This commit is contained in:
Andy Wingo
parent
464ec999de
commit
043a5b62bb
3 changed files with 28 additions and 49 deletions
|
|
@ -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,
|
||||
return 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;
|
||||
element_type,
|
||||
bv,
|
||||
!SCM_MUTABLE_BYTEVECTOR_P (bv));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue