diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c index ad3212a62..ade3c85b9 100644 --- a/libguile/bitvectors.c +++ b/libguile/bitvectors.c @@ -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)<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 () diff --git a/libguile/bitvectors.h b/libguile/bitvectors.h index 0ed96c356..8b8eb765f 100644 --- a/libguile/bitvectors.h +++ b/libguile/bitvectors.h @@ -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); diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c index 2fe58c0ac..95fcae5b1 100644 --- a/libguile/bytevectors.c +++ b/libguile/bytevectors.c @@ -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); diff --git a/libguile/posix.c b/libguile/posix.c index 5a4739e42..cbdf9659b 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -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); } diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index 1f341a2f7..2ec0c0e4b 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -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