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

Convert bitvectors to use inline-only word-size units

Browse source 
* 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 2025-06-03 16:54:19 +02:00
parent 9ff7c0651c
commit d6e59a1d3e
5 changed files with 303 additions and 208 deletions
Download patch file Download diff file Expand all files Collapse all files

431
libguile/bitvectors.c
View file

@ -41,59 +41,112 @@
#include "bitvectors.h" #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) #define SCM_F_BITVECTOR_IMMUTABLE (0x80)
/* To do in Guile 3.1.x: /* 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 - Replace primitives that operator on bitvectors but don't have
bitvector- prefix. bitvector- prefix.
- Add Scheme compiler support for bitvector primitives. */ - Add Scheme compiler support for bitvector primitives. */
#define IS_BITVECTOR(obj) SCM_HAS_TYP7 ((obj), scm_tc7_bitvector) static inline int
#define IS_MUTABLE_BITVECTOR(x) \ is_bitvector (SCM obj)
(SCM_NIMP (x) && \ {
((SCM_CELL_TYPE (x) & (0x7f | SCM_F_BITVECTOR_IMMUTABLE)) \ return SCM_HAS_TYP7 ((obj), scm_tc7_bitvector);
== 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_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) \ #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") "bitvector")
#define VALIDATE_MUTABLE_BITVECTOR(_pos, _obj) \ #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") FUNC_NAME, "mutable bitvector")
uint32_t * scm_t_bits *
scm_i_bitvector_bits (SCM vec) scm_i_bitvector_bits (SCM vec)
{ {
if (!IS_BITVECTOR (vec)) return bitvector_bits (to_bitvector (vec));
abort ();
return BITVECTOR_BITS (vec);
} }
int int
scm_i_is_mutable_bitvector (SCM vec) 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 int
scm_i_print_bitvector (SCM vec, SCM port, scm_print_state *pstate) scm_i_print_bitvector (SCM vec, SCM port, scm_print_state *pstate)
{ {
size_t bit_len = BITVECTOR_LENGTH (vec); struct scm_bitvector *bv = to_bitvector (vec);
size_t word_len = (bit_len+31)/32; size_t bit_len = bitvector_length (bv);
uint32_t *bits = BITVECTOR_BITS (vec); size_t word_len = bitvector_word_length (bv);
scm_t_bits *bits = bitvector_bits (bv);
size_t i, j; size_t i, j;
scm_puts ("#*", port); scm_puts ("#*", port);
for (i = 0; i < word_len; i++, bit_len -= 32) for (i = 0; i < word_len; i++, bit_len -= bits_per_word)
{ for (j = 0; j < bits_per_word && j < bit_len; j++)
uint32_t mask = 1; scm_putc ((bits[i] & (((scm_t_bits) 1) << j)) ? '1' : '0', port);
for (j = 0; j < 32 && j < bit_len; j++, mask <<= 1)
scm_putc ((bits[i] & mask)? '1' : '0', port);
}
return 1; return 1;
} }
@ -101,20 +154,22 @@ scm_i_print_bitvector (SCM vec, SCM port, scm_print_state *pstate)
SCM SCM
scm_i_bitvector_equal_p (SCM vec1, SCM vec2) scm_i_bitvector_equal_p (SCM vec1, SCM vec2)
{ {
size_t bit_len = BITVECTOR_LENGTH (vec1); struct scm_bitvector *bv1 = to_bitvector (vec1);
size_t word_len = (bit_len + 31) / 32; struct scm_bitvector *bv2 = to_bitvector (vec2);
uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - bit_len); size_t bit_len = bitvector_length (bv1);
uint32_t *bits1 = BITVECTOR_BITS (vec1); size_t word_len = bitvector_word_length (bv1);
uint32_t *bits2 = BITVECTOR_BITS (vec2); 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 */ /* compare lengths */
if (BITVECTOR_LENGTH (vec2) != bit_len) if (bitvector_length (bv2) != bit_len)
return SCM_BOOL_F; return SCM_BOOL_F;
/* avoid underflow in word_len-1 below. */ /* avoid underflow in word_len-1 below. */
if (bit_len == 0) if (bit_len == 0)
return SCM_BOOL_T; return SCM_BOOL_T;
/* compare full words */ /* 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; return SCM_BOOL_F;
/* compare partial last words */ /* compare partial last words */
if ((bits1[word_len-1] & last_mask) != (bits2[word_len-1] & last_mask)) 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 int
scm_is_bitvector (SCM vec) scm_is_bitvector (SCM vec)
{ {
return IS_BITVECTOR (vec); return is_bitvector (vec);
} }
SCM_DEFINE_STATIC (bitvector_p, "bitvector?", 1, 0, 0, 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 #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
scm_c_make_bitvector (size_t len, SCM fill) scm_c_make_bitvector (size_t len, SCM fill)
{ {
size_t word_len = (len + 31) / 32; int c_fill = !SCM_UNBNDP (fill) && scm_is_true (fill);
uint32_t *bits; return from_bitvector (make_bitvector (len, c_fill));
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;
} }
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), (SCM len, SCM fill),
"Create a new bitvector of length @var{len} and\n" "Create a new bitvector of length @var{len} and\n"
"optionally initialize all elements to @var{fill}.") "optionally initialize all elements to @var{fill}.")
@ -179,12 +240,12 @@ SCM_DEFINE_STATIC (bitvector, "bitvector", 0, 0, 1,
size_t size_t
scm_c_bitvector_length (SCM vec) scm_c_bitvector_length (SCM vec)
{ {
if (!IS_BITVECTOR (vec)) if (!is_bitvector (vec))
scm_wrong_type_arg_msg (NULL, 0, vec, "bitvector"); 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), (SCM vec),
"Return the length of the bitvector @var{vec}.") "Return the length of the bitvector @var{vec}.")
#define FUNC_NAME s_bitvector_length #define FUNC_NAME s_bitvector_length
@ -193,29 +254,29 @@ SCM_DEFINE_STATIC (bitvector_length, "bitvector-length", 1, 0, 0,
} }
#undef FUNC_NAME #undef FUNC_NAME
const uint32_t * const scm_t_bits *
scm_array_handle_bit_elements (scm_t_array_handle *h) scm_array_handle_bit_elements (scm_t_array_handle *h)
{ {
if (h->element_type != SCM_ARRAY_ELEMENT_TYPE_BIT) if (h->element_type != SCM_ARRAY_ELEMENT_TYPE_BIT)
scm_wrong_type_arg_msg (NULL, 0, h->array, "bit array"); 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) scm_array_handle_bit_writable_elements (scm_t_array_handle *h)
{ {
if (h->writable_elements != h->elements) if (h->writable_elements != h->elements)
scm_wrong_type_arg_msg (NULL, 0, h->array, "mutable bit array"); 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 size_t
scm_array_handle_bit_elements_offset (scm_t_array_handle *h) 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_bitvector_elements (SCM vec,
scm_t_array_handle *h, scm_t_array_handle *h,
size_t *offp, size_t *offp,
@ -239,19 +300,19 @@ scm_bitvector_elements (SCM vec,
} }
uint32_t * scm_t_bits *
scm_bitvector_writable_elements (SCM vec, scm_bitvector_writable_elements (SCM vec,
scm_t_array_handle *h, scm_t_array_handle *h,
size_t *offp, size_t *offp,
size_t *lenp, size_t *lenp,
ssize_t *incp) 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) if (h->writable_elements != h->elements)
scm_wrong_type_arg_msg (NULL, 0, h->array, "mutable bit array"); scm_wrong_type_arg_msg (NULL, 0, h->array, "mutable bit array");
return (uint32_t *) ret; return (scm_t_bits *) ret;
} }
int int
@ -259,11 +320,12 @@ scm_c_bitvector_bit_is_set (SCM vec, size_t idx)
#define FUNC_NAME "bitvector-bit-set?" #define FUNC_NAME "bitvector-bit-set?"
{ {
VALIDATE_BITVECTOR (1, vec); 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)); SCM_OUT_OF_RANGE (2, scm_from_size_t (idx));
const uint32_t *bits = BITVECTOR_BITS (vec); const scm_t_bits *bits = bitvector_bits (bv);
return (bits[idx/32] & (1L << (idx%32))) ? 1 : 0; return (bits[idx/bits_per_word] & (1L << (idx%bits_per_word))) ? 1 : 0;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -299,12 +361,13 @@ scm_c_bitvector_set_bit_x (SCM vec, size_t idx)
#define FUNC_NAME "bitvector-set-bit!" #define FUNC_NAME "bitvector-set-bit!"
{ {
VALIDATE_MUTABLE_BITVECTOR (1, vec); 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)); SCM_OUT_OF_RANGE (2, scm_from_size_t (idx));
uint32_t *bits = BITVECTOR_BITS (vec); scm_t_bits *bits = bitvector_bits (bv);
uint32_t mask = 1L << (idx%32); scm_t_bits mask = 1LL << (idx%bits_per_word);
bits[idx/32] |= mask; bits[idx/bits_per_word] |= mask;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -313,12 +376,13 @@ scm_c_bitvector_clear_bit_x (SCM vec, size_t idx)
#define FUNC_NAME "bitvector-clear-bit!" #define FUNC_NAME "bitvector-clear-bit!"
{ {
VALIDATE_MUTABLE_BITVECTOR (1, vec); 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)); SCM_OUT_OF_RANGE (2, scm_from_size_t (idx));
uint32_t *bits = BITVECTOR_BITS (vec); scm_t_bits *bits = bitvector_bits (bv);
uint32_t mask = 1L << (idx%32); scm_t_bits mask = 1L << (idx%bits_per_word);
bits[idx/32] &= ~mask; bits[idx/bits_per_word] &= ~mask;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -345,38 +409,40 @@ SCM_DEFINE_STATIC (scm_bitvector_clear_bit_x, "bitvector-clear-bit!", 2, 0, 0,
#undef FUNC_NAME #undef FUNC_NAME
void 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!" #define FUNC_NAME "bitvector-set-all-bits!"
{ {
VALIDATE_MUTABLE_BITVECTOR (1, bv); VALIDATE_MUTABLE_BITVECTOR (1, vec);
size_t len = BITVECTOR_LENGTH (bv); struct scm_bitvector *bv = to_bitvector (vec);
size_t len = bitvector_length (bv);
if (len > 0) if (len > 0)
{ {
uint32_t *bits = BITVECTOR_BITS (bv); scm_t_bits *bits = bitvector_bits (bv);
size_t word_len = (len + 31) / 32; size_t word_len = bitvector_word_length (bv);
uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - len); 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; bits[word_len-1] |= last_mask;
} }
} }
#undef FUNC_NAME #undef FUNC_NAME
void 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!" #define FUNC_NAME "bitvector-clear-all-bits!"
{ {
VALIDATE_MUTABLE_BITVECTOR (1, bv); VALIDATE_MUTABLE_BITVECTOR (1, vec);
size_t len = BITVECTOR_LENGTH (bv); struct scm_bitvector *bv = to_bitvector (vec);
size_t len = bitvector_length (bv);
if (len > 0) if (len > 0)
{ {
uint32_t *bits = BITVECTOR_BITS (bv); scm_t_bits *bits = bitvector_bits (bv);
size_t word_len = (len + 31) / 32; size_t word_len = bitvector_word_length (bv);
uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - len); 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; 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 #define FUNC_NAME s_scm_list_to_bitvector
{ {
size_t bit_len = scm_to_size_t (scm_length (list)); size_t bit_len = scm_to_size_t (scm_length (list));
SCM vec = scm_c_make_bitvector (bit_len, SCM_UNDEFINED); struct scm_bitvector *bv = make_bitvector (bit_len, 0);
size_t word_len = (bit_len+31)/32; size_t word_len = bitvector_word_length (bv);
uint32_t *bits = BITVECTOR_BITS (vec); scm_t_bits *bits = bitvector_bits (bv);
size_t i, j; 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; scm_t_bits word = 0;
bits[i] = 0; for (j = 0; j < bits_per_word && j < bit_len; j++, list = SCM_CDR (list))
for (j = 0; j < 32 && j < bit_len;
j++, mask <<= 1, list = SCM_CDR (list))
if (scm_is_true (SCM_CAR (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 #undef FUNC_NAME
@ -434,16 +499,14 @@ SCM_DEFINE (scm_bitvector_to_list, "bitvector->list", 1, 0, 0,
VALIDATE_BITVECTOR (1, vec); VALIDATE_BITVECTOR (1, vec);
const uint32_t *bits = BITVECTOR_BITS (vec); struct scm_bitvector *bv = to_bitvector (vec);
size_t len = BITVECTOR_LENGTH (vec); const scm_t_bits *bits = bitvector_bits (bv);
size_t word_len = (len + 31) / 32; 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) 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++)
uint32_t mask = 1; res = scm_cons (scm_from_bool (bits[i] & (((scm_t_bits)1)<<j)), res);
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);
}
return scm_reverse_x (res, SCM_EOL); 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 static size_t
count_ones (uint32_t x) count_ones (scm_t_bits x)
{ {
x=x-((x>>1)&0x55555555); if (sizeof (x) <= sizeof (int))
x=(x&0x33333333)+((x>>2)&0x33333333); return __builtin_popcount((int) x);
x=(x+(x>>4))&0x0f0f0f0f; else if (sizeof (x) <= sizeof (long))
x=x+(x>>8); return __builtin_popcountl((long) x);
return (x+(x>>16)) & 0xff; else
return __builtin_popcountll((long long) x);
} }
size_t size_t
scm_c_bitvector_count (SCM bitvector) scm_c_bitvector_count (SCM vec)
#define FUNC_NAME "bitvector-count" #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) if (len == 0)
return 0; return 0;
const uint32_t *bits = BITVECTOR_BITS (bitvector); const scm_t_bits *bits = bitvector_bits (bv);
size_t count = 0; size_t count = 0;
size_t word_len = (len + 31) / 32; size_t word_len = bitvector_word_length (bv);
size_t i; size_t i;
for (i = 0; i < word_len-1; i++) for (i = 0; i < word_len-1; i++)
count += count_ones (bits[i]); count += count_ones (bits[i]);
count += count_ones (bits[i] & bitvector_last_mask (bv));
uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - len);
count += count_ones (bits[i] & last_mask);
return count; return count;
} }
@ -506,24 +569,19 @@ SCM_DEFINE_STATIC (scm_bitvector_count, "bitvector-count", 1, 0, 0,
} }
#undef FUNC_NAME #undef FUNC_NAME
/* returns 32 for x == 0. /* returns bits_ for x == 0.
*/ */
static size_t static size_t
find_first_one (uint32_t x) find_first_one (scm_t_bits x)
{ {
size_t pos = 0; if (!x) return bits_per_word;
/* do a binary search in x. */
if ((x & 0xFFFF) == 0) if (sizeof (x) <= sizeof (int))
x >>= 16, pos += 16; return __builtin_ctz((int) x);
if ((x & 0xFF) == 0) else if (sizeof (x) <= sizeof (long))
x >>= 8, pos += 8; return __builtin_ctzl((long) x);
if ((x & 0xF) == 0) else
x >>= 4, pos += 4; return __builtin_ctzll((long long) x);
if ((x & 0x3) == 0)
x >>= 2, pos += 2;
if ((x & 0x1) == 0)
pos += 1;
return pos;
} }
SCM_DEFINE (scm_bitvector_position, "bitvector-position", 2, 1, 0, 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); 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); int c_bit = scm_to_bool (bit);
size_t first_bit = size_t first_bit =
SCM_UNBNDP (start) ? 0 : scm_to_unsigned_integer (start, 0, len); 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) if (first_bit == len)
return SCM_BOOL_F; return SCM_BOOL_F;
const uint32_t *bits = BITVECTOR_BITS (v); const scm_t_bits *bits = bitvector_bits (bv);
size_t word_len = (len + 31) / 32; size_t word_len = bitvector_word_length (bv);
uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - len); scm_t_bits last_mask = bitvector_last_mask (bv);
size_t first_word = first_bit / 32; size_t first_word = first_bit / bits_per_word;
uint32_t first_mask = scm_t_bits first_mask =
((uint32_t)-1) << (first_bit - 32*first_word); ((scm_t_bits)-1) << (first_bit - bits_per_word*first_word);
for (size_t i = first_word; i < word_len; i++) 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) if (i == first_word)
w &= first_mask; w &= first_mask;
if (i == word_len-1) if (i == word_len-1)
w &= last_mask; w &= last_mask;
if (w) 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; return SCM_BOOL_F;
@ -577,10 +636,12 @@ scm_c_bitvector_set_bits_x (SCM v, SCM bits)
{ {
VALIDATE_MUTABLE_BITVECTOR (1, v); VALIDATE_MUTABLE_BITVECTOR (1, v);
VALIDATE_BITVECTOR (2, bits); VALIDATE_BITVECTOR (2, bits);
size_t v_len = BITVECTOR_LENGTH (v); struct scm_bitvector *bv = to_bitvector (v);
uint32_t *v_bits = BITVECTOR_BITS (v); struct scm_bitvector *bitsv = to_bitvector (bits);
size_t kv_len = BITVECTOR_LENGTH (bits); size_t v_len = bitvector_length (bv);
const uint32_t *kv_bits = BITVECTOR_BITS (bits); 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) if (v_len < kv_len)
scm_misc_error (NULL, scm_misc_error (NULL,
@ -589,8 +650,8 @@ scm_c_bitvector_set_bits_x (SCM v, SCM bits)
if (kv_len > 0) if (kv_len > 0)
{ {
size_t word_len = (kv_len + 31) / 32; size_t word_len = bitvector_word_length (bitsv);
uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - kv_len); scm_t_bits last_mask = bitvector_last_mask (bitsv);
size_t i; size_t i;
for (i = 0; i < word_len-1; i++) for (i = 0; i < word_len-1; i++)
v_bits[i] |= kv_bits[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_MUTABLE_BITVECTOR (1, v);
VALIDATE_BITVECTOR (2, bits); VALIDATE_BITVECTOR (2, bits);
size_t v_len = BITVECTOR_LENGTH (v); struct scm_bitvector *bv = to_bitvector (v);
uint32_t *v_bits = BITVECTOR_BITS (v); struct scm_bitvector *bitsv = to_bitvector (bits);
size_t kv_len = BITVECTOR_LENGTH (bits); size_t v_len = bitvector_length (bv);
const uint32_t *kv_bits = BITVECTOR_BITS (bits); 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) if (v_len < kv_len)
scm_misc_error (NULL, scm_misc_error (NULL,
@ -617,8 +680,8 @@ scm_c_bitvector_clear_bits_x (SCM v, SCM bits)
if (kv_len > 0) if (kv_len > 0)
{ {
size_t word_len = (kv_len + 31) / 32; size_t word_len = bitvector_word_length (bitsv);
uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - kv_len); scm_t_bits last_mask = bitvector_last_mask (bitsv);
size_t i; size_t i;
for (i = 0; i < word_len-1; 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 #undef FUNC_NAME
SCM_DEFINE (scm_bitvector_copy, "bitvector-copy", 1, 2, 0, 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" "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" "@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 #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 */ /* cf scm_vector_copy */
size_t cstart = 0, cend = BITVECTOR_LENGTH (bv); size_t cstart = 0, cend = bitvector_length (bv);
if (!SCM_UNBNDP (start)) if (!SCM_UNBNDP (start))
{ {
cstart = scm_to_size_t (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; size_t len = cend-cstart;
SCM result = scm_c_make_bitvector (len, SCM_BOOL_F); struct scm_bitvector *result = make_bitvector (len, 0);
const uint32_t *kv_bits = BITVECTOR_BITS (bv); const scm_t_bits *kv_bits = bitvector_bits (bv);
uint32_t *v_bits = BITVECTOR_BITS (result); scm_t_bits *v_bits = bitvector_bits (result);
if (len > 0) if (len > 0)
{ {
size_t wlen = (len + 31u) / 32u; size_t wlen = bit_count_to_word_count (len);
size_t wshift = cstart / 32u; size_t wshift = cstart / bits_per_word;
size_t bshift = cstart % 32u; size_t bshift = cstart % bits_per_word;
if (0 == bshift) 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 else
for (size_t i = 0; i < wlen; ++i) 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 #undef FUNC_NAME
size_t 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" #define FUNC_NAME "bitvector-count-bits"
{ {
VALIDATE_BITVECTOR (1, bv); VALIDATE_BITVECTOR (1, vec);
VALIDATE_BITVECTOR (2, bits); 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); size_t v_len = bitvector_length (bv);
const uint32_t *v_bits = BITVECTOR_BITS (bv); const scm_t_bits *v_bits = bitvector_bits (bv);
size_t kv_len = BITVECTOR_LENGTH (bits); size_t kv_len = bitvector_length (bitsv);
const uint32_t *kv_bits = BITVECTOR_BITS (bits); const scm_t_bits *kv_bits = bitvector_bits (bitsv);
if (v_len < kv_len) if (v_len < kv_len)
SCM_MISC_ERROR ("selection bitvector longer than target bitvector", SCM_MISC_ERROR ("selection bitvector longer than target bitvector",
SCM_EOL); SCM_EOL);
size_t i, word_len = (kv_len + 31) / 32; size_t i, word_len = bitvector_word_length (bitsv);
uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - kv_len); scm_t_bits last_mask = bitvector_last_mask (bitsv);
size_t count = 0; size_t count = 0;
for (i = 0; i < word_len-1; i++) 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!" #define FUNC_NAME "bitvector-flip-all-bits!"
{ {
VALIDATE_MUTABLE_BITVECTOR (1, v); VALIDATE_MUTABLE_BITVECTOR (1, v);
struct scm_bitvector *bv = to_bitvector (v);
size_t len = BITVECTOR_LENGTH (v); scm_t_bits *bits = bitvector_bits (bv);
uint32_t *bits = BITVECTOR_BITS (v); size_t word_len = bitvector_word_length (bv);
size_t word_len = (len + 31) / 32; scm_t_bits last_mask = bitvector_last_mask (bv);
uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - len);
size_t i; size_t i;
for (i = 0; i < word_len-1; 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 #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 void
scm_init_bitvectors () scm_init_bitvectors ()

12
libguile/bitvectors.h
View file

@ -1,7 +1,7 @@
#ifndef SCM_BITVECTORS_H #ifndef SCM_BITVECTORS_H
#define 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. Free Software Foundation, Inc.
This file is part of Guile. 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 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 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 const scm_t_bits *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 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 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, scm_t_array_handle *h,
size_t *offp, size_t *offp,
size_t *lenp, size_t *lenp,
ssize_t *incp); 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, scm_t_array_handle *h,
size_t *offp, size_t *offp,
size_t *lenp, size_t *lenp,
ssize_t *incp); 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_is_mutable_bitvector (SCM vec);
SCM_INTERNAL int scm_i_print_bitvector (SCM vec, SCM port, scm_print_state *pstate); 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); SCM_INTERNAL SCM scm_i_bitvector_equal_p (SCM vec1, SCM vec2);

12
libguile/bytevectors.c
View file

@ -699,9 +699,15 @@ SCM_DEFINE (scm_uniform_array_to_bytevector, "uniform-array->bytevector",
if (sz >= 8 && ((sz % 8) == 0)) if (sz >= 8 && ((sz % 8) == 0))
byte_len = len * (sz / 8); byte_len = len * (sz / 8);
else if (sz < 8) else if (sz < 8)
/* Elements of sub-byte size (bitvectors) are addressed in 32-bit {
units. */ if (sz != 1)
byte_len = ((len * sz + 31) / 32) * 4; 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 else
/* an internal guile error, really */ /* an internal guile error, really */
SCM_MISC_ERROR ("uniform elements larger than 8 bits must fill whole bytes", SCM_EOL); SCM_MISC_ERROR ("uniform elements larger than 8 bits must fill whole bytes", SCM_EOL);

5
libguile/posix.c
View file

@ -2341,12 +2341,13 @@ SCM_DEFINE (scm_setaffinity, "setaffinity", 2, 0, 0,
{ {
cpu_set_t cs; cpu_set_t cs;
scm_t_array_handle handle; scm_t_array_handle handle;
const uint32_t *c_mask; const scm_t_bits *c_mask;
size_t len, off, cpu; size_t len, off, cpu;
ssize_t inc; ssize_t inc;
int err; int err;
c_mask = scm_bitvector_elements (mask, &handle, &off, &len, &inc); c_mask = scm_bitvector_elements (mask, &handle, &off, &len, &inc);
size_t bits_per_word = sizeof (scm_t_bits) * 8;
CPU_ZERO (&cs); CPU_ZERO (&cs);
for (cpu = 0; cpu < len; cpu++) for (cpu = 0; cpu < len; cpu++)
@ -2354,7 +2355,7 @@ SCM_DEFINE (scm_setaffinity, "setaffinity", 2, 0, 0,
size_t idx; size_t idx;
idx = cpu * inc + off; 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); CPU_SET (cpu, &cs);
} }

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

@ -1338,14 +1338,16 @@ table, its existing label is used directly."
(emit-static-set! asm 1 label 0) (emit-static-set! asm 1 label 0)
1)))) 1))))
((uniform-vector-backing-store? obj)) ((uniform-vector-backing-store? obj))
((bitvector? obj))
((simple-uniform-vector? obj) ((simple-uniform-vector? obj)
(let ((width (case (array-type obj) (let ((width (case (array-type obj)
((vu8 u8 s8) 1) ((vu8 u8 s8) 1)
((u16 s16) 2) ((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, ;; Although a complex number is 8 or 16 bytes wide,
;; it should be byteswapped in 4 or 8 byte units. ;; 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) ((u64 s64 f64 c64) 8)
(else (else
(error "unhandled array type" obj))))) (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))) ((4) (+ word-size (* 4 3)))
((8) (+ word-size (* 4 4))) ;; One additional uint32_t for padding. ((8) (+ word-size (* 4 4))) ;; One additional uint32_t for padding.
(else (error word-size)))) (else (error word-size))))
((bitvector? x)
(* word-size (+ 2 (ceiling/ (bitvector-length x) (* word-size 8)))))
((simple-uniform-vector? x) ((simple-uniform-vector? x)
(* 4 word-size)) (* 4 word-size))
((uniform-vector-backing-store? x) ((uniform-vector-backing-store? x)
@ -2025,29 +2029,46 @@ should be .data or .rodata), and return the resulting linker object.
((number? obj) ((number? obj)
(write-placeholder asm buf pos)) (write-placeholder asm buf pos))
((simple-uniform-vector? obj) ((bitvector? obj)
(let ((tag (if (bitvector? obj) (let ((tag (logior tc7-bitvector
(logior tc7-bitvector bitvector-immutable-flag))
bitvector-immutable-flag) (bytes (uniform-array->bytevector obj)))
(logior tc7-bytevector
bytevector-immutable-flag
(ash (array-type-code obj) 16)))))
(case word-size (case word-size
((4) ((4)
(bytevector-u32-set! buf pos tag endianness) (bytevector-u32-set! buf pos tag endianness)
(bytevector-u32-set! buf (+ pos 4) (bytevector-u32-set! buf (+ pos 4)
(if (bitvector? obj) (bitvector-length obj)
(bitvector-length obj) endianness))
(bytevector-length obj)) ((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 endianness) ; length
(bytevector-u32-set! buf (+ pos 8) 0 endianness) ; pointer (bytevector-u32-set! buf (+ pos 8) 0 endianness) ; pointer
(write-placeholder asm buf (+ pos 12))) ; owner (write-placeholder asm buf (+ pos 12))) ; owner
((8) ((8)
(bytevector-u64-set! buf pos tag endianness) (bytevector-u64-set! buf pos tag endianness)
(bytevector-u64-set! buf (+ pos 8) (bytevector-u64-set! buf (+ pos 8)
(if (bitvector? obj) (bytevector-length obj)
(bitvector-length obj)
(bytevector-length obj))
endianness) ; length endianness) ; length
(bytevector-u64-set! buf (+ pos 16) 0 endianness) ; pointer (bytevector-u64-set! buf (+ pos 16) 0 endianness) ; pointer
(write-placeholder asm buf (+ pos 24))) ; owner (write-placeholder asm buf (+ pos 24))) ; owner