diff --git a/NEWS b/NEWS index 68e5d08f0..386e5fd76 100644 --- a/NEWS +++ b/NEWS @@ -26,6 +26,10 @@ more consistent with other bitvector procedures. These replace bitvector-set!, for similar reasons as the bitvector-ref replacement above. +** New bitvector-set-all-bits!, bitvector-clear-all-bits! procedures + +These replace bitvector-fill!. + ** New bitvector-set-bits!, bitvector-clear-bits! procedures These replace the wonky "bit-set*!" procedure. See "Bit Vectors" in the @@ -46,6 +50,10 @@ Use 'bitvector-bit-set?' or 'bitvector-bit-clear?' instead. Use 'bitvector-set-bit!' or 'bitvector-clear-bit!' instead. +** 'bitvector-fill!' deprecated + +Use 'bitvector-set-all-bits!' or 'bitvector-clear-all-bits!' instead. + ** 'bit-set*!' deprecated Use 'bitvector-set-bits!' or 'bitvector-clear-bits!' instead. diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index 141b214d8..f9b14d13f 100644 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -6593,22 +6593,21 @@ Set (for @code{bitvector-set-bit!}) or clear (for @var{vec}. @end deffn -@deftypefn {C Function} void scm_bitvector_set_bit_x (SCM vec, size_t idx) -@deftypefnx {C Function} void scm_bitvector_clear_bit_x (SCM vec, size_t idx) +@deftypefn {C Function} void scm_c_bitvector_set_bit_x (SCM vec, size_t idx) +@deftypefnx {C Function} void scm_c_bitvector_clear_bit_x (SCM vec, size_t idx) Set or clear the bit at index @var{idx} of the bitvector @var{vec}. @end deftypefn -@deftypefn {C Function} SCM scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val) -Set the element at index @var{idx} of the bitvector -@var{vec} when @var{val} is true, else clear it. -@end deftypefn - -@deffn {Scheme Procedure} bitvector-fill! vec val -@deffnx {C Function} scm_bitvector_fill_x (vec, val) -Set all elements of the bitvector -@var{vec} when @var{val} is true, else clear them. +@deffn {Scheme Procedure} bitvector-set-all-bits! vec +@deffnx {Scheme Procedure} bitvector-clear-all-bits! vec +Set or clear all bits of @var{vec}. @end deffn +@deftypefn {C Function} void scm_c_bitvector_set_all_bits_x (SCM vec) +@deftypefnx {C Function} void scm_c_bitvector_clear_all_bits_x (SCM vec) +Set or clear all bits in the bitvector @var{vec}. +@end deftypefn + @deffn {Scheme Procedure} list->bitvector list @deffnx {C Function} scm_list_to_bitvector (list) Return a new bitvector initialized with the elements diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c index 87ad6e84a..077bc556c 100644 --- a/libguile/bitvectors.c +++ b/libguile/bitvectors.c @@ -149,10 +149,10 @@ scm_c_make_bitvector (size_t len, SCM fill) "bitvector"); res = scm_double_cell (scm_tc7_bitvector, len, (scm_t_bits)bits, 0); - if (!SCM_UNBNDP (fill)) - scm_bitvector_fill_x (res, fill); + if (SCM_UNBNDP (fill) || !scm_is_true (fill)) + scm_c_bitvector_clear_all_bits_x (res); else - memset (bits, 0, sizeof (uint32_t) * word_len); + scm_c_bitvector_set_all_bits_x (res); return res; } @@ -344,57 +344,60 @@ SCM_DEFINE_STATIC (scm_bitvector_clear_bit_x, "bitvector-clear-bit!", 2, 0, 0, } #undef FUNC_NAME -SCM_DEFINE (scm_bitvector_fill_x, "bitvector-fill!", 2, 0, 0, - (SCM vec, SCM val), - "Set all elements of the bitvector\n" - "@var{vec} when @var{val} is true, else clear them.") -#define FUNC_NAME s_scm_bitvector_fill_x +void +scm_c_bitvector_set_all_bits_x (SCM bv) +#define FUNC_NAME "bitvector-set-all-bits!" { - if (IS_MUTABLE_BITVECTOR (vec)) + VALIDATE_MUTABLE_BITVECTOR (1, bv); + size_t len = BITVECTOR_LENGTH (bv); + + if (len > 0) { - size_t len = BITVECTOR_LENGTH (vec); + uint32_t *bits = BITVECTOR_BITS (bv); + size_t word_len = (len + 31) / 32; + uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - len); - if (len > 0) - { - uint32_t *bits = BITVECTOR_BITS (vec); - size_t word_len = (len + 31) / 32; - uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - len); - - if (scm_is_true (val)) - { - memset (bits, 0xFF, sizeof(uint32_t)*(word_len-1)); - bits[word_len-1] |= last_mask; - } - else - { - memset (bits, 0x00, sizeof(uint32_t)*(word_len-1)); - bits[word_len-1] &= ~last_mask; - } - } + memset (bits, 0xFF, sizeof(uint32_t)*(word_len-1)); + bits[word_len-1] |= last_mask; } - else - { - scm_t_array_handle handle; - size_t off, len; - ssize_t inc; - - scm_bitvector_writable_elements (vec, &handle, &off, &len, &inc); - - scm_c_issue_deprecation_warning - ("Using bitvector-fill! on arrays is deprecated. " - "Use array-set! instead."); - - size_t i; - for (i = 0; i < len; i++) - scm_array_handle_set (&handle, i*inc, val); - - scm_array_handle_release (&handle); - } - - return SCM_UNSPECIFIED; } #undef FUNC_NAME +void +scm_c_bitvector_clear_all_bits_x (SCM bv) +#define FUNC_NAME "bitvector-clear-all-bits!" +{ + VALIDATE_MUTABLE_BITVECTOR (1, bv); + 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); + + memset (bits, 0x00, sizeof(uint32_t)*(word_len-1)); + bits[word_len-1] &= ~last_mask; + } +} +#undef FUNC_NAME + +SCM_DEFINE_STATIC (scm_bitvector_set_all_bits_x, + "bitvector-set-all-bits!", 1, 0, 0, (SCM vec), + "Set all elements of the bitvector @var{vec}.") +{ + scm_c_bitvector_set_all_bits_x (vec); + return SCM_UNSPECIFIED; +} + +SCM_DEFINE_STATIC (scm_bitvector_clear_all_bits_x, + "bitvector-clear-all-bits!", 1, 0, 0, (SCM vec), + "Clear all elements of the bitvector @var{vec}.") +{ + scm_c_bitvector_clear_all_bits_x (vec); + return SCM_UNSPECIFIED; +} + SCM_DEFINE (scm_list_to_bitvector, "list->bitvector", 1, 0, 0, (SCM list), "Return a new bitvector initialized with the elements\n" diff --git a/libguile/bitvectors.h b/libguile/bitvectors.h index 7061d3848..ffeb5a894 100644 --- a/libguile/bitvectors.h +++ b/libguile/bitvectors.h @@ -38,7 +38,6 @@ SCM_API SCM scm_make_bitvector (SCM len, SCM fill); SCM_API SCM scm_bitvector_length (SCM vec); SCM_API SCM scm_list_to_bitvector (SCM list); SCM_API SCM scm_bitvector_to_list (SCM vec); -SCM_API SCM scm_bitvector_fill_x (SCM vec, SCM val); SCM_API SCM scm_bitvector_count (SCM v); SCM_API SCM scm_bitvector_position (SCM v, SCM item, SCM start); @@ -55,6 +54,8 @@ SCM_API int scm_c_bitvector_bit_is_set (SCM vec, size_t idx); SCM_API int scm_c_bitvector_bit_is_clear (SCM vec, size_t idx); SCM_API void scm_c_bitvector_set_bit_x (SCM vec, size_t idx); SCM_API void scm_c_bitvector_clear_bit_x (SCM vec, size_t idx); +SCM_API void scm_c_bitvector_set_all_bits_x (SCM vec); +SCM_API void scm_c_bitvector_clear_all_bits_x (SCM vec); 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 size_t scm_array_handle_bit_elements_offset (scm_t_array_handle *h); diff --git a/libguile/deprecated.c b/libguile/deprecated.c index 24a50ee3b..3682a0c04 100644 --- a/libguile/deprecated.c +++ b/libguile/deprecated.c @@ -170,6 +170,42 @@ SCM_DEFINE (scm_bitvector_set_x, "bitvector-set!", 3, 0, 0, } #undef FUNC_NAME +SCM_DEFINE (scm_bitvector_fill_x, "bitvector-fill!", 2, 0, 0, + (SCM vec, SCM val), + "Set all elements of the bitvector\n" + "@var{vec} when @var{val} is true, else clear them.") +#define FUNC_NAME s_scm_bitvector_fill_x +{ + scm_c_issue_deprecation_warning + ("bitvector-fill! is deprecated. Use bitvector-set-all-bits! or " + "bitvector-clear-all-bits! instead."); + + if (scm_is_bitvector (vec)) + { + if (scm_is_true (val)) + scm_c_bitvector_set_all_bits_x (vec); + else + scm_c_bitvector_clear_all_bits_x (vec); + + return SCM_UNSPECIFIED; + } + + scm_t_array_handle handle; + size_t off, len; + ssize_t inc; + + scm_bitvector_writable_elements (vec, &handle, &off, &len, &inc); + + size_t i; + for (i = 0; i < len; i++) + scm_array_handle_set (&handle, i*inc, val); + + scm_array_handle_release (&handle); + + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME + SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0, (SCM b, SCM bitvector), "Return the number of occurrences of the boolean @var{b} in\n" diff --git a/libguile/deprecated.h b/libguile/deprecated.h index a2438310b..a0ccac75d 100644 --- a/libguile/deprecated.h +++ b/libguile/deprecated.h @@ -119,6 +119,7 @@ SCM_DEPRECATED SCM scm_c_bitvector_ref (SCM vec, size_t idx); SCM_DEPRECATED SCM scm_bitvector_ref (SCM vec, SCM idx); SCM_DEPRECATED void scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val); SCM_DEPRECATED SCM scm_bitvector_set_x (SCM vec, SCM idx, SCM val); +SCM_DEPRECATED SCM scm_bitvector_fill_x (SCM vec, SCM val); SCM_DEPRECATED SCM scm_bit_count (SCM item, SCM seq); SCM_DEPRECATED SCM scm_bit_position (SCM item, SCM v, SCM k); SCM_DEPRECATED SCM scm_bit_set_star_x (SCM v, SCM kv, SCM obj); diff --git a/module/ice-9/sandbox.scm b/module/ice-9/sandbox.scm index 86d8cbadd..75c7f0dc3 100644 --- a/module/ice-9/sandbox.scm +++ b/module/ice-9/sandbox.scm @@ -1095,7 +1095,8 @@ allocation limit is exceeded, an exception will be thrown to the bit-invert! bitvector-clear-bit! bitvector-clear-bits! - bitvector-fill! + bitvector-set-all-bits! + bitvector-clear-all-bits! bitvector-set-bit! bitvector-set-bits!))) diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm index 112187e8f..18987d994 100644 --- a/module/system/vm/frame.scm +++ b/module/system/vm/frame.scm @@ -224,7 +224,7 @@ (outv (make-vector len #f)) (tmp (make-bitvector (vector-length defs) #f))) (define (bitvector-copy! dst src) - (bitvector-fill! dst #f) + (bitvector-clear-all-bits! dst) (bitvector-set-bits! dst src)) (define (bitvector-meet! accum src) (bitvector-copy! tmp src) @@ -245,7 +245,9 @@ (kill (vector-ref killv n)) (gen (vector-ref genv n))) (let ((out-count (or changed? (bitvector-count out)))) - (bitvector-fill! in (not (zero? n))) + (if (zero? n) + (bitvector-clear-all-bits! in) + (bitvector-set-all-bits! in)) (let lp ((preds (vector-ref preds n))) (match preds (() #t) diff --git a/test-suite/tests/bitvectors.test b/test-suite/tests/bitvectors.test index 87b201b7a..9bbd6e2ac 100644 --- a/test-suite/tests/bitvectors.test +++ b/test-suite/tests/bitvectors.test @@ -25,7 +25,6 @@ (pass-if (array? #*1010101010)) (pass-if (eq? (array-type #*1010101010) 'b))) - (with-test-prefix "equality" (pass-if (equal? #*1010101 #*1010101)) (pass-if (array-equal? #*1010101 #*1010101)) @@ -57,6 +56,14 @@ (array-set! bv #t 0) (pass-if (eqv? (array-ref bv 0) #t))))) +(with-test-prefix "all bits" + (let ((bv (make-bitvector 5))) + (pass-if-equal #*00000 bv) + (bitvector-set-all-bits! bv) + (pass-if-equal #*11111 bv) + (bitvector-clear-all-bits! bv) + (pass-if-equal #*00000 bv))) + (with-test-prefix "bitvector-set-bits!" (pass-if "#t" (let ((v (bitvector #t #t #f #f)))