mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-06 20:20:20 +02:00
Convert bitvectors to use inline-only word-size units
* libguile/bitvectors.h: Unit of bitvectors is scm_t_bits, not uint32_t. * libguile/bitvectors.c: Adapt implementation. (make_bitvector): Malloc pointerless instead, with inline bits. * libguile/posix.c (scm_setaffinity): * libguile/bytevectors.c (uniform-array->bytevector): Adapt to unit size change. * module/system/vm/assembler.scm (intern-constant, link-data): Adapt to bitvector representation change.
This commit is contained in:
Andy Wingo
parent
9ff7c0651c
commit
d6e59a1d3e
5 changed files with 303 additions and 208 deletions
|
|
@ -41,59 +41,112 @@
|
|||
#include "bitvectors.h"
|
||||
|
||||
|
||||
struct scm_bitvector
|
||||
{
|
||||
scm_t_bits tag_and_flags;
|
||||
size_t length;
|
||||
scm_t_bits bits[];
|
||||
};
|
||||
|
||||
#define SCM_F_BITVECTOR_IMMUTABLE (0x80)
|
||||
|
||||
/* To do in Guile 3.1.x:
|
||||
- Allocate bits inline with bitvector, starting from &SCM_CELL_WORD_2.
|
||||
- Use uintptr_t for bitvector component instead of uint32_t.
|
||||
- Remove deprecated support for bitvector-ref et al on arrays.
|
||||
- Replace primitives that operator on bitvectors but don't have
|
||||
bitvector- prefix.
|
||||
- Add Scheme compiler support for bitvector primitives. */
|
||||
#define IS_BITVECTOR(obj) SCM_HAS_TYP7 ((obj), scm_tc7_bitvector)
|
||||
#define IS_MUTABLE_BITVECTOR(x) \
|
||||
(SCM_NIMP (x) && \
|
||||
((SCM_CELL_TYPE (x) & (0x7f | SCM_F_BITVECTOR_IMMUTABLE)) \
|
||||
== scm_tc7_bitvector))
|
||||
#define BITVECTOR_LENGTH(obj) ((size_t)SCM_CELL_WORD_1(obj))
|
||||
#define BITVECTOR_BITS(obj) ((uint32_t *)SCM_CELL_WORD_2(obj))
|
||||
static inline int
|
||||
is_bitvector (SCM obj)
|
||||
{
|
||||
return SCM_HAS_TYP7 ((obj), scm_tc7_bitvector);
|
||||
}
|
||||
|
||||
static inline int
|
||||
is_mutable_bitvector (SCM obj)
|
||||
{
|
||||
return SCM_NIMP (obj) &&
|
||||
((SCM_CELL_TYPE (obj) & (0x7f | SCM_F_BITVECTOR_IMMUTABLE))
|
||||
== scm_tc7_bitvector);
|
||||
}
|
||||
|
||||
static inline struct scm_bitvector*
|
||||
to_bitvector (SCM obj)
|
||||
{
|
||||
if (!is_bitvector (obj))
|
||||
abort ();
|
||||
return (struct scm_bitvector*) SCM_UNPACK_POINTER (obj);
|
||||
}
|
||||
|
||||
static inline SCM
|
||||
from_bitvector (struct scm_bitvector *bv)
|
||||
{
|
||||
return SCM_PACK_POINTER (bv);
|
||||
}
|
||||
|
||||
static inline size_t
|
||||
bitvector_length (struct scm_bitvector *bv)
|
||||
{
|
||||
return bv->length;
|
||||
}
|
||||
|
||||
static inline scm_t_bits*
|
||||
bitvector_bits (struct scm_bitvector *bv)
|
||||
{
|
||||
return bv->bits;
|
||||
}
|
||||
|
||||
#define VALIDATE_BITVECTOR(_pos, _obj) \
|
||||
SCM_ASSERT_TYPE (IS_BITVECTOR (_obj), (_obj), (_pos), FUNC_NAME, \
|
||||
SCM_ASSERT_TYPE (is_bitvector (_obj), (_obj), (_pos), FUNC_NAME, \
|
||||
"bitvector")
|
||||
#define VALIDATE_MUTABLE_BITVECTOR(_pos, _obj) \
|
||||
SCM_ASSERT_TYPE (IS_MUTABLE_BITVECTOR (_obj), (_obj), (_pos), \
|
||||
SCM_ASSERT_TYPE (is_mutable_bitvector (_obj), (_obj), (_pos), \
|
||||
FUNC_NAME, "mutable bitvector")
|
||||
|
||||
uint32_t *
|
||||
scm_t_bits *
|
||||
scm_i_bitvector_bits (SCM vec)
|
||||
{
|
||||
if (!IS_BITVECTOR (vec))
|
||||
abort ();
|
||||
return BITVECTOR_BITS (vec);
|
||||
return bitvector_bits (to_bitvector (vec));
|
||||
}
|
||||
|
||||
int
|
||||
scm_i_is_mutable_bitvector (SCM vec)
|
||||
{
|
||||
return IS_MUTABLE_BITVECTOR (vec);
|
||||
return is_mutable_bitvector (vec);
|
||||
}
|
||||
|
||||
static const size_t bits_per_word = sizeof (scm_t_bits) * 8;
|
||||
|
||||
static const size_t
|
||||
bit_count_to_word_count (size_t sz)
|
||||
{
|
||||
return (sz + bits_per_word - 1) / bits_per_word;
|
||||
}
|
||||
|
||||
static const size_t
|
||||
bitvector_word_length (struct scm_bitvector *bv)
|
||||
{
|
||||
return bit_count_to_word_count (bv->length);
|
||||
}
|
||||
|
||||
static const scm_t_bits
|
||||
bitvector_last_mask (struct scm_bitvector *bv)
|
||||
{
|
||||
size_t rem = bv->length % bits_per_word;
|
||||
return rem ? (((scm_t_bits) 1) << rem) - 1 : -1;
|
||||
}
|
||||
|
||||
int
|
||||
scm_i_print_bitvector (SCM vec, SCM port, scm_print_state *pstate)
|
||||
{
|
||||
size_t bit_len = BITVECTOR_LENGTH (vec);
|
||||
size_t word_len = (bit_len+31)/32;
|
||||
uint32_t *bits = BITVECTOR_BITS (vec);
|
||||
struct scm_bitvector *bv = to_bitvector (vec);
|
||||
size_t bit_len = bitvector_length (bv);
|
||||
size_t word_len = bitvector_word_length (bv);
|
||||
scm_t_bits *bits = bitvector_bits (bv);
|
||||
size_t i, j;
|
||||
|
||||
scm_puts ("#*", port);
|
||||
for (i = 0; i < word_len; i++, bit_len -= 32)
|
||||
{
|
||||
uint32_t mask = 1;
|
||||
for (j = 0; j < 32 && j < bit_len; j++, mask <<= 1)
|
||||
scm_putc ((bits[i] & mask)? '1' : '0', port);
|
||||
}
|
||||
for (i = 0; i < word_len; i++, bit_len -= bits_per_word)
|
||||
for (j = 0; j < bits_per_word && j < bit_len; j++)
|
||||
scm_putc ((bits[i] & (((scm_t_bits) 1) << j)) ? '1' : '0', port);
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
|
@ -101,20 +154,22 @@ scm_i_print_bitvector (SCM vec, SCM port, scm_print_state *pstate)
|
|||
SCM
|
||||
scm_i_bitvector_equal_p (SCM vec1, SCM vec2)
|
||||
{
|
||||
size_t bit_len = BITVECTOR_LENGTH (vec1);
|
||||
size_t word_len = (bit_len + 31) / 32;
|
||||
uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - bit_len);
|
||||
uint32_t *bits1 = BITVECTOR_BITS (vec1);
|
||||
uint32_t *bits2 = BITVECTOR_BITS (vec2);
|
||||
struct scm_bitvector *bv1 = to_bitvector (vec1);
|
||||
struct scm_bitvector *bv2 = to_bitvector (vec2);
|
||||
size_t bit_len = bitvector_length (bv1);
|
||||
size_t word_len = bitvector_word_length (bv1);
|
||||
scm_t_bits last_mask = bitvector_last_mask (bv1);
|
||||
scm_t_bits *bits1 = bitvector_bits (bv1);
|
||||
scm_t_bits *bits2 = bitvector_bits (bv2);
|
||||
|
||||
/* compare lengths */
|
||||
if (BITVECTOR_LENGTH (vec2) != bit_len)
|
||||
if (bitvector_length (bv2) != bit_len)
|
||||
return SCM_BOOL_F;
|
||||
/* avoid underflow in word_len-1 below. */
|
||||
if (bit_len == 0)
|
||||
return SCM_BOOL_T;
|
||||
/* compare full words */
|
||||
if (memcmp (bits1, bits2, sizeof (uint32_t) * (word_len-1)))
|
||||
if (memcmp (bits1, bits2, sizeof (scm_t_bits) * (word_len-1)))
|
||||
return SCM_BOOL_F;
|
||||
/* compare partial last words */
|
||||
if ((bits1[word_len-1] & last_mask) != (bits2[word_len-1] & last_mask))
|
||||
|
|
@ -125,7 +180,7 @@ scm_i_bitvector_equal_p (SCM vec1, SCM vec2)
|
|||
int
|
||||
scm_is_bitvector (SCM vec)
|
||||
{
|
||||
return IS_BITVECTOR (vec);
|
||||
return is_bitvector (vec);
|
||||
}
|
||||
|
||||
SCM_DEFINE_STATIC (bitvector_p, "bitvector?", 1, 0, 0,
|
||||
|
|
@ -138,26 +193,32 @@ SCM_DEFINE_STATIC (bitvector_p, "bitvector?", 1, 0, 0,
|
|||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
static struct scm_bitvector *
|
||||
make_bitvector (size_t len, int fill)
|
||||
{
|
||||
size_t word_len = bit_count_to_word_count (len);
|
||||
struct scm_bitvector *bv;
|
||||
|
||||
bv = scm_gc_malloc_pointerless (sizeof (struct scm_bitvector)
|
||||
+ sizeof (scm_t_bits) * word_len,
|
||||
"bitvector");
|
||||
|
||||
bv->tag_and_flags = scm_tc7_bitvector;
|
||||
bv->length = len;
|
||||
if (fill)
|
||||
memset (bv->bits, -1, word_len * sizeof (scm_t_bits));
|
||||
|
||||
return bv;
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_c_make_bitvector (size_t len, SCM fill)
|
||||
{
|
||||
size_t word_len = (len + 31) / 32;
|
||||
uint32_t *bits;
|
||||
SCM res;
|
||||
|
||||
bits = scm_gc_malloc_pointerless (sizeof (uint32_t) * word_len,
|
||||
"bitvector");
|
||||
res = scm_double_cell (scm_tc7_bitvector, len, (scm_t_bits)bits, 0);
|
||||
|
||||
if (SCM_UNBNDP (fill) || !scm_is_true (fill))
|
||||
scm_c_bitvector_clear_all_bits_x (res);
|
||||
else
|
||||
scm_c_bitvector_set_all_bits_x (res);
|
||||
|
||||
return res;
|
||||
int c_fill = !SCM_UNBNDP (fill) && scm_is_true (fill);
|
||||
return from_bitvector (make_bitvector (len, c_fill));
|
||||
}
|
||||
|
||||
SCM_DEFINE_STATIC (make_bitvector, "make-bitvector", 1, 1, 0,
|
||||
SCM_DEFINE_STATIC (make_scm_bitvector, "make-bitvector", 1, 1, 0,
|
||||
(SCM len, SCM fill),
|
||||
"Create a new bitvector of length @var{len} and\n"
|
||||
"optionally initialize all elements to @var{fill}.")
|
||||
|
|
@ -179,12 +240,12 @@ SCM_DEFINE_STATIC (bitvector, "bitvector", 0, 0, 1,
|
|||
size_t
|
||||
scm_c_bitvector_length (SCM vec)
|
||||
{
|
||||
if (!IS_BITVECTOR (vec))
|
||||
if (!is_bitvector (vec))
|
||||
scm_wrong_type_arg_msg (NULL, 0, vec, "bitvector");
|
||||
return BITVECTOR_LENGTH (vec);
|
||||
return bitvector_length (to_bitvector (vec));
|
||||
}
|
||||
|
||||
SCM_DEFINE_STATIC (bitvector_length, "bitvector-length", 1, 0, 0,
|
||||
SCM_DEFINE_STATIC (scm_bitvector_length, "bitvector-length", 1, 0, 0,
|
||||
(SCM vec),
|
||||
"Return the length of the bitvector @var{vec}.")
|
||||
#define FUNC_NAME s_bitvector_length
|
||||
|
|
@ -193,29 +254,29 @@ SCM_DEFINE_STATIC (bitvector_length, "bitvector-length", 1, 0, 0,
|
|||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
const uint32_t *
|
||||
const scm_t_bits *
|
||||
scm_array_handle_bit_elements (scm_t_array_handle *h)
|
||||
{
|
||||
if (h->element_type != SCM_ARRAY_ELEMENT_TYPE_BIT)
|
||||
scm_wrong_type_arg_msg (NULL, 0, h->array, "bit array");
|
||||
return ((const uint32_t *) h->elements) + h->base/32;
|
||||
return ((const scm_t_bits *) h->elements) + h->base/bits_per_word;
|
||||
}
|
||||
|
||||
uint32_t *
|
||||
scm_t_bits *
|
||||
scm_array_handle_bit_writable_elements (scm_t_array_handle *h)
|
||||
{
|
||||
if (h->writable_elements != h->elements)
|
||||
scm_wrong_type_arg_msg (NULL, 0, h->array, "mutable bit array");
|
||||
return (uint32_t *) scm_array_handle_bit_elements (h);
|
||||
return (scm_t_bits *) scm_array_handle_bit_elements (h);
|
||||
}
|
||||
|
||||
size_t
|
||||
scm_array_handle_bit_elements_offset (scm_t_array_handle *h)
|
||||
{
|
||||
return h->base % 32;
|
||||
return h->base % bits_per_word;
|
||||
}
|
||||
|
||||
const uint32_t *
|
||||
const scm_t_bits *
|
||||
scm_bitvector_elements (SCM vec,
|
||||
scm_t_array_handle *h,
|
||||
size_t *offp,
|
||||
|
|
@ -239,19 +300,19 @@ scm_bitvector_elements (SCM vec,
|
|||
}
|
||||
|
||||
|
||||
uint32_t *
|
||||
scm_t_bits *
|
||||
scm_bitvector_writable_elements (SCM vec,
|
||||
scm_t_array_handle *h,
|
||||
size_t *offp,
|
||||
size_t *lenp,
|
||||
ssize_t *incp)
|
||||
{
|
||||
const uint32_t *ret = scm_bitvector_elements (vec, h, offp, lenp, incp);
|
||||
const scm_t_bits *ret = scm_bitvector_elements (vec, h, offp, lenp, incp);
|
||||
|
||||
if (h->writable_elements != h->elements)
|
||||
scm_wrong_type_arg_msg (NULL, 0, h->array, "mutable bit array");
|
||||
|
||||
return (uint32_t *) ret;
|
||||
return (scm_t_bits *) ret;
|
||||
}
|
||||
|
||||
int
|
||||
|
|
@ -259,11 +320,12 @@ scm_c_bitvector_bit_is_set (SCM vec, size_t idx)
|
|||
#define FUNC_NAME "bitvector-bit-set?"
|
||||
{
|
||||
VALIDATE_BITVECTOR (1, vec);
|
||||
if (idx >= BITVECTOR_LENGTH (vec))
|
||||
struct scm_bitvector *bv = to_bitvector (vec);
|
||||
if (idx >= bitvector_length (bv))
|
||||
SCM_OUT_OF_RANGE (2, scm_from_size_t (idx));
|
||||
|
||||
const uint32_t *bits = BITVECTOR_BITS (vec);
|
||||
return (bits[idx/32] & (1L << (idx%32))) ? 1 : 0;
|
||||
const scm_t_bits *bits = bitvector_bits (bv);
|
||||
return (bits[idx/bits_per_word] & (1L << (idx%bits_per_word))) ? 1 : 0;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
@ -299,12 +361,13 @@ scm_c_bitvector_set_bit_x (SCM vec, size_t idx)
|
|||
#define FUNC_NAME "bitvector-set-bit!"
|
||||
{
|
||||
VALIDATE_MUTABLE_BITVECTOR (1, vec);
|
||||
if (idx >= BITVECTOR_LENGTH (vec))
|
||||
struct scm_bitvector *bv = to_bitvector (vec);
|
||||
if (idx >= bitvector_length (bv))
|
||||
SCM_OUT_OF_RANGE (2, scm_from_size_t (idx));
|
||||
|
||||
uint32_t *bits = BITVECTOR_BITS (vec);
|
||||
uint32_t mask = 1L << (idx%32);
|
||||
bits[idx/32] |= mask;
|
||||
scm_t_bits *bits = bitvector_bits (bv);
|
||||
scm_t_bits mask = 1LL << (idx%bits_per_word);
|
||||
bits[idx/bits_per_word] |= mask;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
@ -313,12 +376,13 @@ scm_c_bitvector_clear_bit_x (SCM vec, size_t idx)
|
|||
#define FUNC_NAME "bitvector-clear-bit!"
|
||||
{
|
||||
VALIDATE_MUTABLE_BITVECTOR (1, vec);
|
||||
if (idx >= BITVECTOR_LENGTH (vec))
|
||||
struct scm_bitvector *bv = to_bitvector (vec);
|
||||
if (idx >= bitvector_length (bv))
|
||||
SCM_OUT_OF_RANGE (2, scm_from_size_t (idx));
|
||||
|
||||
uint32_t *bits = BITVECTOR_BITS (vec);
|
||||
uint32_t mask = 1L << (idx%32);
|
||||
bits[idx/32] &= ~mask;
|
||||
scm_t_bits *bits = bitvector_bits (bv);
|
||||
scm_t_bits mask = 1L << (idx%bits_per_word);
|
||||
bits[idx/bits_per_word] &= ~mask;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
@ -345,38 +409,40 @@ SCM_DEFINE_STATIC (scm_bitvector_clear_bit_x, "bitvector-clear-bit!", 2, 0, 0,
|
|||
#undef FUNC_NAME
|
||||
|
||||
void
|
||||
scm_c_bitvector_set_all_bits_x (SCM bv)
|
||||
scm_c_bitvector_set_all_bits_x (SCM vec)
|
||||
#define FUNC_NAME "bitvector-set-all-bits!"
|
||||
{
|
||||
VALIDATE_MUTABLE_BITVECTOR (1, bv);
|
||||
size_t len = BITVECTOR_LENGTH (bv);
|
||||
VALIDATE_MUTABLE_BITVECTOR (1, vec);
|
||||
struct scm_bitvector *bv = to_bitvector (vec);
|
||||
size_t len = bitvector_length (bv);
|
||||
|
||||
if (len > 0)
|
||||
{
|
||||
uint32_t *bits = BITVECTOR_BITS (bv);
|
||||
size_t word_len = (len + 31) / 32;
|
||||
uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - len);
|
||||
scm_t_bits *bits = bitvector_bits (bv);
|
||||
size_t word_len = bitvector_word_length (bv);
|
||||
scm_t_bits last_mask = bitvector_last_mask (bv);
|
||||
|
||||
memset (bits, 0xFF, sizeof(uint32_t)*(word_len-1));
|
||||
memset (bits, 0xFF, sizeof(scm_t_bits)*(word_len-1));
|
||||
bits[word_len-1] |= last_mask;
|
||||
}
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
void
|
||||
scm_c_bitvector_clear_all_bits_x (SCM bv)
|
||||
scm_c_bitvector_clear_all_bits_x (SCM vec)
|
||||
#define FUNC_NAME "bitvector-clear-all-bits!"
|
||||
{
|
||||
VALIDATE_MUTABLE_BITVECTOR (1, bv);
|
||||
size_t len = BITVECTOR_LENGTH (bv);
|
||||
VALIDATE_MUTABLE_BITVECTOR (1, vec);
|
||||
struct scm_bitvector *bv = to_bitvector (vec);
|
||||
size_t len = bitvector_length (bv);
|
||||
|
||||
if (len > 0)
|
||||
{
|
||||
uint32_t *bits = BITVECTOR_BITS (bv);
|
||||
size_t word_len = (len + 31) / 32;
|
||||
uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - len);
|
||||
scm_t_bits *bits = bitvector_bits (bv);
|
||||
size_t word_len = bitvector_word_length (bv);
|
||||
scm_t_bits last_mask = bitvector_last_mask (bv);
|
||||
|
||||
memset (bits, 0x00, sizeof(uint32_t)*(word_len-1));
|
||||
memset (bits, 0x00, sizeof(scm_t_bits)*(word_len-1));
|
||||
bits[word_len-1] &= ~last_mask;
|
||||
}
|
||||
}
|
||||
|
|
@ -405,22 +471,21 @@ SCM_DEFINE (scm_list_to_bitvector, "list->bitvector", 1, 0, 0,
|
|||
#define FUNC_NAME s_scm_list_to_bitvector
|
||||
{
|
||||
size_t bit_len = scm_to_size_t (scm_length (list));
|
||||
SCM vec = scm_c_make_bitvector (bit_len, SCM_UNDEFINED);
|
||||
size_t word_len = (bit_len+31)/32;
|
||||
uint32_t *bits = BITVECTOR_BITS (vec);
|
||||
struct scm_bitvector *bv = make_bitvector (bit_len, 0);
|
||||
size_t word_len = bitvector_word_length (bv);
|
||||
scm_t_bits *bits = bitvector_bits (bv);
|
||||
size_t i, j;
|
||||
|
||||
for (i = 0; i < word_len && scm_is_pair (list); i++, bit_len -= 32)
|
||||
for (i = 0; i < word_len && scm_is_pair (list); i++, bit_len -= bits_per_word)
|
||||
{
|
||||
uint32_t mask = 1;
|
||||
bits[i] = 0;
|
||||
for (j = 0; j < 32 && j < bit_len;
|
||||
j++, mask <<= 1, list = SCM_CDR (list))
|
||||
scm_t_bits word = 0;
|
||||
for (j = 0; j < bits_per_word && j < bit_len; j++, list = SCM_CDR (list))
|
||||
if (scm_is_true (SCM_CAR (list)))
|
||||
bits[i] |= mask;
|
||||
word |= ((scm_t_bits) 1) << j;
|
||||
bits[i] = word;
|
||||
}
|
||||
|
||||
return vec;
|
||||
return from_bitvector (bv);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
@ -434,16 +499,14 @@ SCM_DEFINE (scm_bitvector_to_list, "bitvector->list", 1, 0, 0,
|
|||
|
||||
VALIDATE_BITVECTOR (1, vec);
|
||||
|
||||
const uint32_t *bits = BITVECTOR_BITS (vec);
|
||||
size_t len = BITVECTOR_LENGTH (vec);
|
||||
size_t word_len = (len + 31) / 32;
|
||||
struct scm_bitvector *bv = to_bitvector (vec);
|
||||
const scm_t_bits *bits = bitvector_bits (bv);
|
||||
size_t len = bitvector_length (bv);
|
||||
size_t word_len = bitvector_word_length (bv);
|
||||
|
||||
for (size_t i = 0; i < word_len; i++, len -= 32)
|
||||
{
|
||||
uint32_t mask = 1;
|
||||
for (size_t j = 0; j < 32 && j < len; j++, mask <<= 1)
|
||||
res = scm_cons ((bits[i] & mask)? SCM_BOOL_T : SCM_BOOL_F, res);
|
||||
}
|
||||
for (size_t i = 0; i < word_len; i++, len -= bits_per_word)
|
||||
for (size_t j = 0; j < bits_per_word && j < len; j++)
|
||||
res = scm_cons (scm_from_bool (bits[i] & (((scm_t_bits)1)<<j)), res);
|
||||
|
||||
return scm_reverse_x (res, SCM_EOL);
|
||||
}
|
||||
|
|
@ -462,36 +525,36 @@ SCM_DEFINE (scm_bitvector_to_list, "bitvector->list", 1, 0, 0,
|
|||
*/
|
||||
|
||||
static size_t
|
||||
count_ones (uint32_t x)
|
||||
count_ones (scm_t_bits x)
|
||||
{
|
||||
x=x-((x>>1)&0x55555555);
|
||||
x=(x&0x33333333)+((x>>2)&0x33333333);
|
||||
x=(x+(x>>4))&0x0f0f0f0f;
|
||||
x=x+(x>>8);
|
||||
return (x+(x>>16)) & 0xff;
|
||||
if (sizeof (x) <= sizeof (int))
|
||||
return __builtin_popcount((int) x);
|
||||
else if (sizeof (x) <= sizeof (long))
|
||||
return __builtin_popcountl((long) x);
|
||||
else
|
||||
return __builtin_popcountll((long long) x);
|
||||
}
|
||||
|
||||
size_t
|
||||
scm_c_bitvector_count (SCM bitvector)
|
||||
scm_c_bitvector_count (SCM vec)
|
||||
#define FUNC_NAME "bitvector-count"
|
||||
{
|
||||
VALIDATE_BITVECTOR (1, bitvector);
|
||||
VALIDATE_BITVECTOR (1, vec);
|
||||
|
||||
size_t len = BITVECTOR_LENGTH (bitvector);
|
||||
struct scm_bitvector *bv = to_bitvector (vec);
|
||||
size_t len = bitvector_length (bv);
|
||||
|
||||
if (len == 0)
|
||||
return 0;
|
||||
|
||||
const uint32_t *bits = BITVECTOR_BITS (bitvector);
|
||||
const scm_t_bits *bits = bitvector_bits (bv);
|
||||
size_t count = 0;
|
||||
|
||||
size_t word_len = (len + 31) / 32;
|
||||
size_t word_len = bitvector_word_length (bv);
|
||||
size_t i;
|
||||
for (i = 0; i < word_len-1; i++)
|
||||
count += count_ones (bits[i]);
|
||||
|
||||
uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - len);
|
||||
count += count_ones (bits[i] & last_mask);
|
||||
count += count_ones (bits[i] & bitvector_last_mask (bv));
|
||||
|
||||
return count;
|
||||
}
|
||||
|
|
@ -506,24 +569,19 @@ SCM_DEFINE_STATIC (scm_bitvector_count, "bitvector-count", 1, 0, 0,
|
|||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
/* returns 32 for x == 0.
|
||||
/* returns bits_ for x == 0.
|
||||
*/
|
||||
static size_t
|
||||
find_first_one (uint32_t x)
|
||||
find_first_one (scm_t_bits x)
|
||||
{
|
||||
size_t pos = 0;
|
||||
/* do a binary search in x. */
|
||||
if ((x & 0xFFFF) == 0)
|
||||
x >>= 16, pos += 16;
|
||||
if ((x & 0xFF) == 0)
|
||||
x >>= 8, pos += 8;
|
||||
if ((x & 0xF) == 0)
|
||||
x >>= 4, pos += 4;
|
||||
if ((x & 0x3) == 0)
|
||||
x >>= 2, pos += 2;
|
||||
if ((x & 0x1) == 0)
|
||||
pos += 1;
|
||||
return pos;
|
||||
if (!x) return bits_per_word;
|
||||
|
||||
if (sizeof (x) <= sizeof (int))
|
||||
return __builtin_ctz((int) x);
|
||||
else if (sizeof (x) <= sizeof (long))
|
||||
return __builtin_ctzl((long) x);
|
||||
else
|
||||
return __builtin_ctzll((long long) x);
|
||||
}
|
||||
|
||||
SCM_DEFINE (scm_bitvector_position, "bitvector-position", 2, 1, 0,
|
||||
|
|
@ -541,7 +599,8 @@ SCM_DEFINE (scm_bitvector_position, "bitvector-position", 2, 1, 0,
|
|||
{
|
||||
VALIDATE_BITVECTOR (1, v);
|
||||
|
||||
size_t len = BITVECTOR_LENGTH (v);
|
||||
struct scm_bitvector *bv = to_bitvector (v);
|
||||
size_t len = bitvector_length (bv);
|
||||
int c_bit = scm_to_bool (bit);
|
||||
size_t first_bit =
|
||||
SCM_UNBNDP (start) ? 0 : scm_to_unsigned_integer (start, 0, len);
|
||||
|
|
@ -549,22 +608,22 @@ SCM_DEFINE (scm_bitvector_position, "bitvector-position", 2, 1, 0,
|
|||
if (first_bit == len)
|
||||
return SCM_BOOL_F;
|
||||
|
||||
const uint32_t *bits = BITVECTOR_BITS (v);
|
||||
size_t word_len = (len + 31) / 32;
|
||||
uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - len);
|
||||
size_t first_word = first_bit / 32;
|
||||
uint32_t first_mask =
|
||||
((uint32_t)-1) << (first_bit - 32*first_word);
|
||||
const scm_t_bits *bits = bitvector_bits (bv);
|
||||
size_t word_len = bitvector_word_length (bv);
|
||||
scm_t_bits last_mask = bitvector_last_mask (bv);
|
||||
size_t first_word = first_bit / bits_per_word;
|
||||
scm_t_bits first_mask =
|
||||
((scm_t_bits)-1) << (first_bit - bits_per_word*first_word);
|
||||
|
||||
for (size_t i = first_word; i < word_len; i++)
|
||||
{
|
||||
uint32_t w = c_bit ? bits[i] : ~bits[i];
|
||||
scm_t_bits w = c_bit ? bits[i] : ~bits[i];
|
||||
if (i == first_word)
|
||||
w &= first_mask;
|
||||
if (i == word_len-1)
|
||||
w &= last_mask;
|
||||
if (w)
|
||||
return scm_from_size_t (32*i + find_first_one (w));
|
||||
return scm_from_size_t (bits_per_word*i + find_first_one (w));
|
||||
}
|
||||
|
||||
return SCM_BOOL_F;
|
||||
|
|
@ -577,10 +636,12 @@ scm_c_bitvector_set_bits_x (SCM v, SCM bits)
|
|||
{
|
||||
VALIDATE_MUTABLE_BITVECTOR (1, v);
|
||||
VALIDATE_BITVECTOR (2, bits);
|
||||
size_t v_len = BITVECTOR_LENGTH (v);
|
||||
uint32_t *v_bits = BITVECTOR_BITS (v);
|
||||
size_t kv_len = BITVECTOR_LENGTH (bits);
|
||||
const uint32_t *kv_bits = BITVECTOR_BITS (bits);
|
||||
struct scm_bitvector *bv = to_bitvector (v);
|
||||
struct scm_bitvector *bitsv = to_bitvector (bits);
|
||||
size_t v_len = bitvector_length (bv);
|
||||
scm_t_bits *v_bits = bitvector_bits (bv);
|
||||
size_t kv_len = bitvector_length (bitsv);
|
||||
const scm_t_bits *kv_bits = bitvector_bits (bitsv);
|
||||
|
||||
if (v_len < kv_len)
|
||||
scm_misc_error (NULL,
|
||||
|
|
@ -589,8 +650,8 @@ scm_c_bitvector_set_bits_x (SCM v, SCM bits)
|
|||
|
||||
if (kv_len > 0)
|
||||
{
|
||||
size_t word_len = (kv_len + 31) / 32;
|
||||
uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - kv_len);
|
||||
size_t word_len = bitvector_word_length (bitsv);
|
||||
scm_t_bits last_mask = bitvector_last_mask (bitsv);
|
||||
size_t i;
|
||||
for (i = 0; i < word_len-1; i++)
|
||||
v_bits[i] |= kv_bits[i];
|
||||
|
|
@ -605,10 +666,12 @@ scm_c_bitvector_clear_bits_x (SCM v, SCM bits)
|
|||
{
|
||||
VALIDATE_MUTABLE_BITVECTOR (1, v);
|
||||
VALIDATE_BITVECTOR (2, bits);
|
||||
size_t v_len = BITVECTOR_LENGTH (v);
|
||||
uint32_t *v_bits = BITVECTOR_BITS (v);
|
||||
size_t kv_len = BITVECTOR_LENGTH (bits);
|
||||
const uint32_t *kv_bits = BITVECTOR_BITS (bits);
|
||||
struct scm_bitvector *bv = to_bitvector (v);
|
||||
struct scm_bitvector *bitsv = to_bitvector (bits);
|
||||
size_t v_len = bitvector_length (bv);
|
||||
scm_t_bits *v_bits = bitvector_bits (bv);
|
||||
size_t kv_len = bitvector_length (bitsv);
|
||||
const scm_t_bits *kv_bits = bitvector_bits (bitsv);
|
||||
|
||||
if (v_len < kv_len)
|
||||
scm_misc_error (NULL,
|
||||
|
|
@ -617,8 +680,8 @@ scm_c_bitvector_clear_bits_x (SCM v, SCM bits)
|
|||
|
||||
if (kv_len > 0)
|
||||
{
|
||||
size_t word_len = (kv_len + 31) / 32;
|
||||
uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - kv_len);
|
||||
size_t word_len = bitvector_word_length (bitsv);
|
||||
scm_t_bits last_mask = bitvector_last_mask (bitsv);
|
||||
size_t i;
|
||||
|
||||
for (i = 0; i < word_len-1; i++)
|
||||
|
|
@ -667,18 +730,19 @@ SCM_DEFINE_STATIC (scm_bitvector_clear_bits_x, "bitvector-clear-bits!", 2, 0, 0,
|
|||
#undef FUNC_NAME
|
||||
|
||||
SCM_DEFINE (scm_bitvector_copy, "bitvector-copy", 1, 2, 0,
|
||||
(SCM bv, SCM start, SCM end),
|
||||
(SCM vec, SCM start, SCM end),
|
||||
"Returns a freshly allocated bitvector containing the elements\n"
|
||||
"of bitvector @var{bv} between @var{start} and @var{end}.\n\n"
|
||||
"of bitvector @var{vec} between @var{start} and @var{end}.\n\n"
|
||||
"@var{start} defaults to 0 and @var{end} defaults to the\n"
|
||||
"length of @var{bv}.")
|
||||
"length of @var{vec}.")
|
||||
#define FUNC_NAME s_scm_bitvector_copy
|
||||
{
|
||||
VALIDATE_BITVECTOR (1, bv);
|
||||
VALIDATE_BITVECTOR (1, vec);
|
||||
struct scm_bitvector *bv = to_bitvector (vec);
|
||||
|
||||
/* cf scm_vector_copy */
|
||||
|
||||
size_t cstart = 0, cend = BITVECTOR_LENGTH (bv);
|
||||
size_t cstart = 0, cend = bitvector_length (bv);
|
||||
if (!SCM_UNBNDP (start))
|
||||
{
|
||||
cstart = scm_to_size_t (start);
|
||||
|
|
@ -693,44 +757,47 @@ SCM_DEFINE (scm_bitvector_copy, "bitvector-copy", 1, 2, 0,
|
|||
}
|
||||
|
||||
size_t len = cend-cstart;
|
||||
SCM result = scm_c_make_bitvector (len, SCM_BOOL_F);
|
||||
const uint32_t *kv_bits = BITVECTOR_BITS (bv);
|
||||
uint32_t *v_bits = BITVECTOR_BITS (result);
|
||||
struct scm_bitvector *result = make_bitvector (len, 0);
|
||||
const scm_t_bits *kv_bits = bitvector_bits (bv);
|
||||
scm_t_bits *v_bits = bitvector_bits (result);
|
||||
|
||||
if (len > 0)
|
||||
{
|
||||
size_t wlen = (len + 31u) / 32u;
|
||||
size_t wshift = cstart / 32u;
|
||||
size_t bshift = cstart % 32u;
|
||||
size_t wlen = bit_count_to_word_count (len);
|
||||
size_t wshift = cstart / bits_per_word;
|
||||
size_t bshift = cstart % bits_per_word;
|
||||
if (0 == bshift)
|
||||
memcpy (v_bits, kv_bits + wshift, wlen*sizeof(uint32_t));
|
||||
memcpy (v_bits, kv_bits + wshift, wlen*sizeof(scm_t_bits));
|
||||
else
|
||||
for (size_t i = 0; i < wlen; ++i)
|
||||
v_bits[i] = (kv_bits[i + wshift] >> bshift) | (kv_bits[i + wshift + 1] << (32-bshift));
|
||||
v_bits[i] = ((kv_bits[i + wshift] >> bshift)
|
||||
| (kv_bits[i + wshift + 1] << (bits_per_word-bshift)));
|
||||
}
|
||||
|
||||
return result;
|
||||
return from_bitvector (result);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
size_t
|
||||
scm_c_bitvector_count_bits (SCM bv, SCM bits)
|
||||
scm_c_bitvector_count_bits (SCM vec, SCM bits)
|
||||
#define FUNC_NAME "bitvector-count-bits"
|
||||
{
|
||||
VALIDATE_BITVECTOR (1, bv);
|
||||
VALIDATE_BITVECTOR (1, vec);
|
||||
VALIDATE_BITVECTOR (2, bits);
|
||||
struct scm_bitvector *bv = to_bitvector (vec);
|
||||
struct scm_bitvector *bitsv = to_bitvector (bits);
|
||||
|
||||
size_t v_len = BITVECTOR_LENGTH (bv);
|
||||
const uint32_t *v_bits = BITVECTOR_BITS (bv);
|
||||
size_t kv_len = BITVECTOR_LENGTH (bits);
|
||||
const uint32_t *kv_bits = BITVECTOR_BITS (bits);
|
||||
size_t v_len = bitvector_length (bv);
|
||||
const scm_t_bits *v_bits = bitvector_bits (bv);
|
||||
size_t kv_len = bitvector_length (bitsv);
|
||||
const scm_t_bits *kv_bits = bitvector_bits (bitsv);
|
||||
|
||||
if (v_len < kv_len)
|
||||
SCM_MISC_ERROR ("selection bitvector longer than target bitvector",
|
||||
SCM_EOL);
|
||||
|
||||
size_t i, word_len = (kv_len + 31) / 32;
|
||||
uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - kv_len);
|
||||
size_t i, word_len = bitvector_word_length (bitsv);
|
||||
scm_t_bits last_mask = bitvector_last_mask (bitsv);
|
||||
|
||||
size_t count = 0;
|
||||
for (i = 0; i < word_len-1; i++)
|
||||
|
|
@ -762,11 +829,11 @@ scm_c_bitvector_flip_all_bits_x (SCM v)
|
|||
#define FUNC_NAME "bitvector-flip-all-bits!"
|
||||
{
|
||||
VALIDATE_MUTABLE_BITVECTOR (1, v);
|
||||
struct scm_bitvector *bv = to_bitvector (v);
|
||||
|
||||
size_t len = BITVECTOR_LENGTH (v);
|
||||
uint32_t *bits = BITVECTOR_BITS (v);
|
||||
size_t word_len = (len + 31) / 32;
|
||||
uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - len);
|
||||
scm_t_bits *bits = bitvector_bits (bv);
|
||||
size_t word_len = bitvector_word_length (bv);
|
||||
scm_t_bits last_mask = bitvector_last_mask (bv);
|
||||
size_t i;
|
||||
|
||||
for (i = 0; i < word_len-1; i++)
|
||||
|
|
@ -786,7 +853,7 @@ SCM_DEFINE_STATIC (scm_bitvector_flip_all_bits_x,
|
|||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_BIT, make_bitvector)
|
||||
SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_BIT, make_scm_bitvector)
|
||||
|
||||
void
|
||||
scm_init_bitvectors ()
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#ifndef SCM_BITVECTORS_H
|
||||
#define SCM_BITVECTORS_H
|
||||
|
||||
/* Copyright 1995-1997,1999-2001,2004,2006,2008-2009,2014,2018,2020
|
||||
/* Copyright 1995-1997,1999-2001,2004,2006,2008-2009,2014,2018,2020,2025
|
||||
Free Software Foundation, Inc.
|
||||
|
||||
This file is part of Guile.
|
||||
|
|
@ -53,21 +53,21 @@ SCM_API void scm_c_bitvector_clear_all_bits_x (SCM vec);
|
|||
SCM_API void scm_c_bitvector_flip_all_bits_x (SCM vec);
|
||||
SCM_API size_t scm_c_bitvector_count_bits (SCM v, SCM bits);
|
||||
|
||||
SCM_API const uint32_t *scm_array_handle_bit_elements (scm_t_array_handle *h);
|
||||
SCM_API uint32_t *scm_array_handle_bit_writable_elements (scm_t_array_handle *h);
|
||||
SCM_API const scm_t_bits *scm_array_handle_bit_elements (scm_t_array_handle *h);
|
||||
SCM_API scm_t_bits *scm_array_handle_bit_writable_elements (scm_t_array_handle *h);
|
||||
SCM_API size_t scm_array_handle_bit_elements_offset (scm_t_array_handle *h);
|
||||
SCM_API const uint32_t *scm_bitvector_elements (SCM vec,
|
||||
SCM_API const scm_t_bits *scm_bitvector_elements (SCM vec,
|
||||
scm_t_array_handle *h,
|
||||
size_t *offp,
|
||||
size_t *lenp,
|
||||
ssize_t *incp);
|
||||
SCM_API uint32_t *scm_bitvector_writable_elements (SCM vec,
|
||||
SCM_API scm_t_bits *scm_bitvector_writable_elements (SCM vec,
|
||||
scm_t_array_handle *h,
|
||||
size_t *offp,
|
||||
size_t *lenp,
|
||||
ssize_t *incp);
|
||||
|
||||
SCM_INTERNAL uint32_t *scm_i_bitvector_bits (SCM vec);
|
||||
SCM_INTERNAL scm_t_bits *scm_i_bitvector_bits (SCM vec);
|
||||
SCM_INTERNAL int scm_i_is_mutable_bitvector (SCM vec);
|
||||
SCM_INTERNAL int scm_i_print_bitvector (SCM vec, SCM port, scm_print_state *pstate);
|
||||
SCM_INTERNAL SCM scm_i_bitvector_equal_p (SCM vec1, SCM vec2);
|
||||
|
|
|
|||
|
|
@ -699,9 +699,15 @@ SCM_DEFINE (scm_uniform_array_to_bytevector, "uniform-array->bytevector",
|
|||
if (sz >= 8 && ((sz % 8) == 0))
|
||||
byte_len = len * (sz / 8);
|
||||
else if (sz < 8)
|
||||
/* Elements of sub-byte size (bitvectors) are addressed in 32-bit
|
||||
units. */
|
||||
byte_len = ((len * sz + 31) / 32) * 4;
|
||||
{
|
||||
if (sz != 1)
|
||||
abort ();
|
||||
size_t bits_per_word = sizeof (scm_t_bits) * 8;
|
||||
/* Elements of sub-byte size (bitvectors) are addressed in word-sized
|
||||
units. */
|
||||
size_t word_len = (len + bits_per_word - 1) / bits_per_word;
|
||||
byte_len = word_len * sizeof (scm_t_bits);
|
||||
}
|
||||
else
|
||||
/* an internal guile error, really */
|
||||
SCM_MISC_ERROR ("uniform elements larger than 8 bits must fill whole bytes", SCM_EOL);
|
||||
|
|
|
|||
|
|
@ -2341,12 +2341,13 @@ SCM_DEFINE (scm_setaffinity, "setaffinity", 2, 0, 0,
|
|||
{
|
||||
cpu_set_t cs;
|
||||
scm_t_array_handle handle;
|
||||
const uint32_t *c_mask;
|
||||
const scm_t_bits *c_mask;
|
||||
size_t len, off, cpu;
|
||||
ssize_t inc;
|
||||
int err;
|
||||
|
||||
c_mask = scm_bitvector_elements (mask, &handle, &off, &len, &inc);
|
||||
size_t bits_per_word = sizeof (scm_t_bits) * 8;
|
||||
|
||||
CPU_ZERO (&cs);
|
||||
for (cpu = 0; cpu < len; cpu++)
|
||||
|
|
@ -2354,7 +2355,7 @@ SCM_DEFINE (scm_setaffinity, "setaffinity", 2, 0, 0,
|
|||
size_t idx;
|
||||
|
||||
idx = cpu * inc + off;
|
||||
if (c_mask[idx / 32] & (1UL << (idx % 32)))
|
||||
if (c_mask[idx / bits_per_word] & (1UL << (idx % bits_per_word)))
|
||||
CPU_SET (cpu, &cs);
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -1338,14 +1338,16 @@ table, its existing label is used directly."
|
|||
(emit-static-set! asm 1 label 0)
|
||||
1))))
|
||||
((uniform-vector-backing-store? obj))
|
||||
((bitvector? obj))
|
||||
((simple-uniform-vector? obj)
|
||||
(let ((width (case (array-type obj)
|
||||
((vu8 u8 s8) 1)
|
||||
((u16 s16) 2)
|
||||
;; Bitvectors are addressed in 32-bit units.
|
||||
;; Bitvectors are addressed in word-sized units.
|
||||
((b) (asm-word-size asm))
|
||||
;; Although a complex number is 8 or 16 bytes wide,
|
||||
;; it should be byteswapped in 4 or 8 byte units.
|
||||
((u32 s32 f32 c32 b) 4)
|
||||
((u32 s32 f32 c32) 4)
|
||||
((u64 s64 f64 c64) 8)
|
||||
(else
|
||||
(error "unhandled array type" obj)))))
|
||||
|
|
@ -1899,6 +1901,8 @@ should be .data or .rodata), and return the resulting linker object.
|
|||
((4) (+ word-size (* 4 3)))
|
||||
((8) (+ word-size (* 4 4))) ;; One additional uint32_t for padding.
|
||||
(else (error word-size))))
|
||||
((bitvector? x)
|
||||
(* word-size (+ 2 (ceiling/ (bitvector-length x) (* word-size 8)))))
|
||||
((simple-uniform-vector? x)
|
||||
(* 4 word-size))
|
||||
((uniform-vector-backing-store? x)
|
||||
|
|
@ -2025,29 +2029,46 @@ should be .data or .rodata), and return the resulting linker object.
|
|||
((number? obj)
|
||||
(write-placeholder asm buf pos))
|
||||
|
||||
((simple-uniform-vector? obj)
|
||||
(let ((tag (if (bitvector? obj)
|
||||
(logior tc7-bitvector
|
||||
bitvector-immutable-flag)
|
||||
(logior tc7-bytevector
|
||||
bytevector-immutable-flag
|
||||
(ash (array-type-code obj) 16)))))
|
||||
((bitvector? obj)
|
||||
(let ((tag (logior tc7-bitvector
|
||||
bitvector-immutable-flag))
|
||||
(bytes (uniform-array->bytevector obj)))
|
||||
(case word-size
|
||||
((4)
|
||||
(bytevector-u32-set! buf pos tag endianness)
|
||||
(bytevector-u32-set! buf (+ pos 4)
|
||||
(if (bitvector? obj)
|
||||
(bitvector-length obj)
|
||||
(bytevector-length obj))
|
||||
(bitvector-length obj)
|
||||
endianness))
|
||||
((8)
|
||||
(bytevector-u64-set! buf pos tag endianness)
|
||||
(bytevector-u64-set! buf (+ pos 8)
|
||||
(bitvector-length obj)
|
||||
endianness))
|
||||
(else (error "bad word size")))
|
||||
(let ((pos (+ pos (* word-size 2))))
|
||||
(bytevector-copy! bytes 0 buf pos (bytevector-length bytes))
|
||||
(unless (eq? endianness (native-endianness))
|
||||
(case word-size
|
||||
((4) (byte-swap/4! buf pos (+ pos (bytevector-length bytes))))
|
||||
((8) (byte-swap/8! buf pos (+ pos (bytevector-length bytes))))
|
||||
(else (error "bad word size")))))))
|
||||
|
||||
((simple-uniform-vector? obj)
|
||||
(let ((tag (logior tc7-bytevector
|
||||
bytevector-immutable-flag
|
||||
(ash (array-type-code obj) 16))))
|
||||
(case word-size
|
||||
((4)
|
||||
(bytevector-u32-set! buf pos tag endianness)
|
||||
(bytevector-u32-set! buf (+ pos 4)
|
||||
(bytevector-length obj)
|
||||
endianness) ; length
|
||||
(bytevector-u32-set! buf (+ pos 8) 0 endianness) ; pointer
|
||||
(write-placeholder asm buf (+ pos 12))) ; owner
|
||||
((8)
|
||||
(bytevector-u64-set! buf pos tag endianness)
|
||||
(bytevector-u64-set! buf (+ pos 8)
|
||||
(if (bitvector? obj)
|
||||
(bitvector-length obj)
|
||||
(bytevector-length obj))
|
||||
(bytevector-length obj)
|
||||
endianness) ; length
|
||||
(bytevector-u64-set! buf (+ pos 16) 0 endianness) ; pointer
|
||||
(write-placeholder asm buf (+ pos 24))) ; owner
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue