diff --git a/NEWS b/NEWS index a006dd6ce..f7383cc76 100644 --- a/NEWS +++ b/NEWS @@ -14,6 +14,11 @@ Changes in 3.0.3 (since 3.0.2) These replace the wonky "bit-count" and "bit-position" procedures. See "Bit Vectors" in the manual, for more. +** New bitvector-set-bits!, bitvector-clear-bits! procedures + +These replace the wonky "bit-set*!" procedure. See "Bit Vectors" in the +manual, for more. + * New deprecations ** bit-count, bit-position deprecated @@ -21,6 +26,10 @@ These replace the wonky "bit-count" and "bit-position" procedures. See Use bitvector-count or bitvector-position instead. See "Bit Vectors" in the manual. +** 'bit-set*!' deprecated + +Use 'bitvector-set-bits!' or 'bitvector-clear-bits!' instead. + ** Passing a u32vector to 'bit-set*!' and 'bit-count*' deprecated These functions had an interface that allowed the second bit-selection diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index 732884213..1df634205 100644 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -6640,24 +6640,34 @@ entry between @var{start} and the end of @var{bitvector}, then return Modify @var{bitvector} by replacing each element with its negation. @end deffn -@deffn {Scheme Procedure} bit-set*! bitvector bits bool -@deffnx {C Function} scm_bit_set_star_x (bitvector, bits, bool) -Set entries of @var{bitvector} to @var{bool}, with @var{bits} selecting -the entries to change. The return value is unspecified. Those bits in -the bitvector @var{bits} which are set to one indicate the bits in -@var{bitvector} to set to @var{bool}. @var{bitvector} must be at least -as long as @var{bits}. When @var{bool} is @code{#t} it is as if -@var{bits} is OR'ed into @var{bitvector}, whereas when @var{bool} is -@code{#f} is like an ANDNOT. +@deffn {Scheme Procedure} bitvector-set-bits! bitvector bits +@deffnx {C Function} scm_bit_set_star_x (bitvector, bits) +Set entries of @var{bitvector} to @code{#t}, with @var{bits} selecting +the bits to set. The return value is unspecified. @var{bitvector} must +be at least as long as @var{bits}. @example -(define bv #*01000010) -(bit-set*! bv #*10010001 #t) +(define bv (bitvector-copy #*11000010)) +(bitvector-set-bits! bv #*10010001) bv @result{} #*11010011 @end example @end deffn +@deffn {Scheme Procedure} bitvector-clear-bits! bitvector bits +@deffnx {C Function} scm_bitvector_clear_bits_x (bitvector, bits) +Set entries of @var{bitvector} to @code{#f}, with @var{bits} selecting +the bits to clear. The return value is unspecified. @var{bitvector} +must be at least as long as @var{bits}. + +@example +(define bv (bitvector-copy #*11000010)) +(bitvector-clear-bits! bv #*10010001) +bv +@result{} #*01000010 +@end example +@end deffn + @deffn {Scheme Procedure} bit-count* bitvector bits bool @deffnx {C Function} scm_bit_count_star (bitvector, bits, bool) Return a count of how many entries in @var{bitvector} are equal to diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c index 356b1c743..40da4757e 100644 --- a/libguile/bitvectors.c +++ b/libguile/bitvectors.c @@ -61,6 +61,9 @@ #define VALIDATE_BITVECTOR(_pos, _obj) \ 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), \ + FUNC_NAME, "mutable bitvector") uint32_t * scm_i_bitvector_bits (SCM vec) @@ -575,124 +578,86 @@ SCM_DEFINE (scm_bitvector_position, "bitvector-position", 2, 1, 0, } #undef FUNC_NAME -SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, - (SCM v, SCM kv, SCM obj), - "Set entries of bit vector @var{v} to @var{obj}, with @var{kv}\n" - "selecting the entries to change. The return value is\n" - "unspecified.\n" - "\n" - "If @var{kv} is a bit vector, then those entries where it has\n" - "@code{#t} are the ones in @var{v} which are set to @var{obj}.\n" - "@var{v} must be at least as long as @var{kv}. When @var{obj}\n" - "is @code{#t} it's like @var{kv} is OR'ed into @var{v}. Or when\n" - "@var{obj} is @code{#f} it can be seen as an ANDNOT.\n" +SCM_DEFINE (scm_bitvector_set_bits_x, "bitvector-set-bits!", 2, 0, 0, + (SCM v, SCM bits), + "Update the bitvector @var{v} in place by performing a logical\n" + "OR of its bits with those of @var{bits}.\n" + "For example:\n" "\n" "@example\n" - "(define bv #*01000010)\n" - "(bit-set*! bv #*10010001 #t)\n" + "(define bv (bitvector-copy #*11000010))\n" + "(bitvector-set-bits! bv #*10010001)\n" "bv\n" "@result{} #*11010011\n" - "@end example\n" - "\n" - "If @var{kv} is a u32vector, then its elements are\n" - "indices into @var{v} which are set to @var{obj}.\n" - "\n" - "@example\n" - "(define bv #*01000010)\n" - "(bit-set*! bv #u32(5 2 7) #t)\n" - "bv\n" - "@result{} #*01100111\n" "@end example") -#define FUNC_NAME s_scm_bit_set_star_x +#define FUNC_NAME s_scm_bitvector_set_bits_x { - /* Validate that OBJ is a boolean so this is done even if we don't - need BIT. */ - int bit = scm_to_bool (obj); + 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); - if (IS_MUTABLE_BITVECTOR (v) && IS_BITVECTOR (kv)) - { - size_t v_len = BITVECTOR_LENGTH (v); - uint32_t *v_bits = BITVECTOR_BITS (v); - size_t kv_len = BITVECTOR_LENGTH (kv); - const uint32_t *kv_bits = BITVECTOR_BITS (kv); - - if (v_len < kv_len) - scm_misc_error (NULL, - "selection bitvector longer than target bitvector", - SCM_EOL); + if (v_len < kv_len) + scm_misc_error (NULL, + "selection bitvector longer than target bitvector", + SCM_EOL); - 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 i; - - if (bit == 0) - { - for (i = 0; i < word_len-1; i++) - v_bits[i] &= ~kv_bits[i]; - v_bits[i] &= ~(kv_bits[i] & last_mask); - } - else - { - for (i = 0; i < word_len-1; i++) - v_bits[i] |= kv_bits[i]; - v_bits[i] |= kv_bits[i] & last_mask; - } - } - } - else + if (kv_len > 0) { - scm_t_array_handle v_handle; - size_t v_off, v_len; - ssize_t v_inc; - scm_bitvector_writable_elements (v, &v_handle, &v_off, &v_len, &v_inc); - - if (!IS_MUTABLE_BITVECTOR (v)) - scm_c_issue_deprecation_warning - ("Using bit-set*! on arrays is deprecated. " - "Use array-set! in a loop instead."); - - if (IS_BITVECTOR (kv)) - { - size_t kv_len = BITVECTOR_LENGTH (kv); - - if (v_len < kv_len) - scm_misc_error (NULL, - "selection bitvector longer than target bitvector", - SCM_EOL); - - for (size_t i = 0; i < kv_len; i++) - if (scm_is_true (scm_c_bitvector_ref (kv, i))) - scm_array_handle_set (&v_handle, i*v_inc, obj); - } - else if (scm_is_true (scm_u32vector_p (kv))) - { - scm_c_issue_deprecation_warning - ("Passing a u32vector to bit-set*! is deprecated. " - "Use bitvector-set! in a loop instead."); - - scm_t_array_handle kv_handle; - size_t kv_len; - ssize_t kv_inc; - const uint32_t *kv_elts; - - kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc); - for (size_t i = 0; i < kv_len; i++, kv_elts += kv_inc) - scm_array_handle_set (&v_handle, (*kv_elts)*v_inc, obj); - - scm_array_handle_release (&kv_handle); - } - else - scm_wrong_type_arg_msg (NULL, 0, kv, "bitvector or u32vector"); - - scm_array_handle_release (&v_handle); + size_t word_len = (kv_len + 31) / 32; + uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - kv_len); + size_t i; + for (i = 0; i < word_len-1; i++) + v_bits[i] |= kv_bits[i]; + v_bits[i] |= kv_bits[i] & last_mask; } return SCM_UNSPECIFIED; } #undef FUNC_NAME +SCM_DEFINE (scm_bitvector_clear_bits_x, "bitvector-clear-bits!", 2, 0, 0, + (SCM v, SCM bits), + "Update the bitvector @var{v} in place by performing a logical\n" + "AND of its bits with the complement of those of @var{bits}.\n" + "For example:\n" + "\n" + "@example\n" + "(define bv (bitvector-copy #*11000010))\n" + "(bitvector-clear-bits! bv #*10010001)\n" + "bv\n" + "@result{} #*01000010\n" + "@end example") +#define FUNC_NAME s_scm_bitvector_clear_bits_x +{ + 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); + + if (v_len < kv_len) + scm_misc_error (NULL, + "selection bitvector longer than target bitvector", + SCM_EOL); + + 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 i; + + for (i = 0; i < word_len-1; i++) + v_bits[i] &= ~kv_bits[i]; + v_bits[i] &= ~(kv_bits[i] & last_mask); + } + + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, (SCM v, SCM kv, SCM obj), diff --git a/libguile/bitvectors.h b/libguile/bitvectors.h index 09a9a6147..82c8b3236 100644 --- a/libguile/bitvectors.h +++ b/libguile/bitvectors.h @@ -44,8 +44,9 @@ 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); +SCM_API SCM scm_bitvector_set_bits_x (SCM v, SCM bits); +SCM_API SCM scm_bitvector_clear_bits_x (SCM v, SCM bits); -SCM_API SCM scm_bit_set_star_x (SCM v, SCM kv, SCM obj); SCM_API SCM scm_bit_count_star (SCM v, SCM kv, SCM obj); SCM_API SCM scm_bit_invert_x (SCM v); diff --git a/libguile/deprecated.c b/libguile/deprecated.c index 2b1a338a5..d5cb0dfca 100644 --- a/libguile/deprecated.c +++ b/libguile/deprecated.c @@ -32,6 +32,7 @@ #include "deprecation.h" #include "gc.h" #include "gsubr.h" +#include "srfi-4.h" #include "strings.h" #include "deprecated.h" @@ -100,7 +101,7 @@ SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0, ("bit-count is deprecated. Use bitvector-count, or a loop over array-ref " "if array support is needed."); - if (scm_is_true (scm_bitvector_p (bitvector))) + if (scm_is_bitvector (bitvector)) { len = scm_to_size_t (scm_bitvector_length (bitvector)); count = scm_to_size_t (scm_bitvector_count (bitvector)); @@ -141,7 +142,7 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0, ("bit-position is deprecated. Use bitvector-position, or " "array-ref in a loop if you need generic arrays instead."); - if (scm_is_true (scm_bitvector_p (v))) + if (scm_is_bitvector (v)) return scm_bitvector_position (v, item, k); scm_t_array_handle handle; @@ -166,6 +167,87 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0, } #undef FUNC_NAME +SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, + (SCM v, SCM kv, SCM obj), + "Set entries of bit vector @var{v} to @var{obj}, with @var{kv}\n" + "selecting the entries to change. The return value is\n" + "unspecified.\n" + "\n" + "If @var{kv} is a bit vector, then those entries where it has\n" + "@code{#t} are the ones in @var{v} which are set to @var{obj}.\n" + "@var{v} must be at least as long as @var{kv}. When @var{obj}\n" + "is @code{#t} it's like @var{kv} is OR'ed into @var{v}. Or when\n" + "@var{obj} is @code{#f} it can be seen as an ANDNOT.\n" + "\n" + "@example\n" + "(define bv #*01000010)\n" + "(bit-set*! bv #*10010001 #t)\n" + "bv\n" + "@result{} #*11010011\n" + "@end example\n" + "\n" + "If @var{kv} is a u32vector, then its elements are\n" + "indices into @var{v} which are set to @var{obj}.\n" + "\n" + "@example\n" + "(define bv #*01000010)\n" + "(bit-set*! bv #u32(5 2 7) #t)\n" + "bv\n" + "@result{} #*01100111\n" + "@end example") +#define FUNC_NAME s_scm_bit_set_star_x +{ + scm_c_issue_deprecation_warning + ("bit-set*! is deprecated. Use bitvector-set-bits! or " + "bitvector-clear-bits! on bitvectors, or array-set! in a loop " + "if you need to work on generic arrays."); + + int bit = scm_to_bool (obj); + if (scm_is_bitvector (v) && scm_is_bitvector (kv)) + return bit + ? scm_bitvector_set_bits_x (v, kv) + : scm_bitvector_clear_bits_x (v, kv); + + scm_t_array_handle v_handle; + size_t v_off, v_len; + ssize_t v_inc; + scm_bitvector_writable_elements (v, &v_handle, &v_off, &v_len, &v_inc); + + if (scm_is_bitvector (kv)) + { + size_t kv_len = scm_c_bitvector_length (kv); + + if (v_len < kv_len) + scm_misc_error (NULL, + "selection bitvector longer than target bitvector", + SCM_EOL); + + for (size_t i = 0; i < kv_len; i++) + if (scm_is_true (scm_c_bitvector_ref (kv, i))) + scm_array_handle_set (&v_handle, i*v_inc, obj); + } + else if (scm_is_true (scm_u32vector_p (kv))) + { + scm_t_array_handle kv_handle; + size_t kv_len; + ssize_t kv_inc; + const uint32_t *kv_elts; + + kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc); + for (size_t i = 0; i < kv_len; i++, kv_elts += kv_inc) + scm_array_handle_set (&v_handle, (*kv_elts)*v_inc, obj); + + scm_array_handle_release (&kv_handle); + } + else + scm_wrong_type_arg_msg (NULL, 0, kv, "bitvector or u32vector"); + + scm_array_handle_release (&v_handle); + + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME + SCM scm_istr2bve (SCM str) { diff --git a/libguile/deprecated.h b/libguile/deprecated.h index edbbff418..3411ab7c6 100644 --- a/libguile/deprecated.h +++ b/libguile/deprecated.h @@ -117,6 +117,7 @@ SCM_DEPRECATED char* scm_find_executable (const char *name); 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); SCM_DEPRECATED SCM scm_istr2bve (SCM str); void scm_i_init_deprecated (void); diff --git a/module/ice-9/sandbox.scm b/module/ice-9/sandbox.scm index bd80a49fe..b2c0658e9 100644 --- a/module/ice-9/sandbox.scm +++ b/module/ice-9/sandbox.scm @@ -1092,7 +1092,8 @@ allocation limit is exceeded, an exception will be thrown to the (define mutating-bitvector-bindings '(((guile) bit-invert! - bit-set*! + bitvector-clear-bits! + bitvector-set-bits! bitvector-fill! bitvector-set!))) diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm index 3800d5bf6..1d507d18d 100644 --- a/module/system/vm/frame.scm +++ b/module/system/vm/frame.scm @@ -180,7 +180,8 @@ (compute-frame-sizes code parsed initial-frame-size)) ((killv) (make-vector (vector-length parsed) #f))) (define (kill-slot! n slot) - (bit-set*! (vector-ref killv n) (vector-ref defs-by-slot slot) #t)) + (bitvector-set-bits! (vector-ref killv n) + (vector-ref defs-by-slot slot))) (let lp ((n 0)) (when (< n (vector-length killv)) (vector-set! killv n (make-bitvector (vector-length defs) #f)) @@ -224,11 +225,11 @@ (tmp (make-bitvector (vector-length defs) #f))) (define (bitvector-copy! dst src) (bitvector-fill! dst #f) - (bit-set*! dst src #t)) + (bitvector-set-bits! dst src)) (define (bitvector-meet! accum src) (bitvector-copy! tmp src) (bit-invert! tmp) - (bit-set*! accum tmp #f)) + (bitvector-clear-bits! accum tmp)) (let lp ((n 0)) (when (< n len) @@ -253,7 +254,7 @@ (bitvector-meet! in (vector-ref outv pred))) (lp preds)))) (bitvector-copy! out in) - (bit-set*! out kill #f) + (bitvector-clear-bits! out kill) (for-each (lambda (def) (bitvector-set! out def #t)) gen) @@ -280,7 +281,7 @@ ;; values defined by the call. (begin (bitvector-copy! tmp (vector-ref inv (1- n))) - (bit-set*! tmp (vector-ref killv (1- n)) #f) + (bitvector-clear-bits! tmp (vector-ref killv (1- n))) tmp)))) (let lp ((n 0)) (let ((n (bitvector-position live #t n))) diff --git a/test-suite/tests/bitvectors.test b/test-suite/tests/bitvectors.test index 332c8ff55..b615705c6 100644 --- a/test-suite/tests/bitvectors.test +++ b/test-suite/tests/bitvectors.test @@ -53,22 +53,24 @@ (array-set! bv #t 0) (pass-if (eqv? (array-ref bv 0) #t))))) -(with-test-prefix "bit-set*!" +(with-test-prefix "bitvector-set-bits!" (pass-if "#t" (let ((v (bitvector #t #t #f #f))) - (bit-set*! v #*1010 #t) + (bitvector-set-bits! v #*1010) (equal? v #*1110))) - (pass-if "#f" - (let ((v (bitvector #t #t #f #f))) - (bit-set*! v #*1010 #f) - (equal? v #*0100))) (pass-if "#t, shorter" (let ((v (bitvector #t #t #f #f))) - (bit-set*! v #*101 #t) - (equal? v #*1110))) + (bitvector-set-bits! v #*101) + (equal? v #*1110)))) + +(with-test-prefix "bitvector-clear-bits!" + (pass-if "#f" + (let ((v (bitvector #t #t #f #f))) + (bitvector-clear-bits! v #*1010) + (equal? v #*0100))) (pass-if "#f, shorter" (let ((v (bitvector #t #t #f #f))) - (bit-set*! v #*101 #f) + (bitvector-clear-bits! v #*101) (equal? v #*0100)))) (with-test-prefix "bitvector-count"