diff options
| -rw-r--r-- | NEWS | 19 | ||||
| -rw-r--r-- | doc/ref/api-data.texi | 14 | ||||
| -rw-r--r-- | libguile/array-handle.c | 11 | ||||
| -rw-r--r-- | libguile/bitvectors.c | 80 | ||||
| -rw-r--r-- | libguile/bitvectors.h | 4 | ||||
| -rw-r--r-- | libguile/deprecated.c | 47 | ||||
| -rw-r--r-- | libguile/deprecated.h | 2 | ||||
| -rw-r--r-- | libguile/posix.c | 2 | ||||
| -rw-r--r-- | module/ice-9/sandbox.scm | 5 | ||||
| -rw-r--r-- | module/system/vm/disassembler.scm | 2 | ||||
| -rw-r--r-- | module/system/vm/frame.scm | 4 | ||||
| -rw-r--r-- | test-suite/tests/bitvectors.test | 8 |
12 files changed, 140 insertions, 58 deletions
@@ -14,11 +14,6 @@ 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 bitvector-bit-set?, bitvector-bit-clear? procedures These replace bitvector-ref. The reason to migrate is that it's an @@ -26,6 +21,16 @@ opportunity be more efficient in 3.0 (because no generic array support), easier to read (no need for 'not' when checking for false bits), and more consistent with other bitvector procedures. +** New bitvector-set-bit!, bitvector-clear-bit! procedures + +These replace bitvector-set!, for similar reasons as the bitvector-ref +replacement above. + +** 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 @@ -37,6 +42,10 @@ the manual. Use 'bitvector-bit-set?' or 'bitvector-bit-clear?' instead. +** 'bitvector-set!' deprecated + +Use 'bitvector-set-bit!' or 'bitvector-clear-bit!' 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 d13fe3acc..141b214d8 100644 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -6586,12 +6586,18 @@ Return 1 if the bit at index @var{idx} of the bitvector @var{vec} is set or clear, respectively, or 0 otherwise. @end deftypefn -@deffn {Scheme Procedure} bitvector-set! vec idx val -@deffnx {C Function} scm_bitvector_set_x (vec, idx, val) -Set the element at index @var{idx} of the bitvector -@var{vec} when @var{val} is true, else clear it. +@deffn {Scheme Procedure} bitvector-set-bit! vec idx +@deffnx {Scheme Procedure} bitvector-clear-bit! vec idx +Set (for @code{bitvector-set-bit!}) or clear (for +@code{bitvector-clear-bit!}) the bit at index @var{idx} of the bitvector +@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) +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. diff --git a/libguile/array-handle.c b/libguile/array-handle.c index f547bf518..e51e133bb 100644 --- a/libguile/array-handle.c +++ b/libguile/array-handle.c @@ -174,6 +174,15 @@ bitvector_ref (SCM bv, size_t idx) return scm_from_bool (scm_c_bitvector_bit_is_set (bv, idx)); } +static void +bitvector_set_x (SCM bv, size_t idx, SCM val) +{ + if (scm_is_true (val)) + scm_c_bitvector_set_bit_x (bv, idx); + else + scm_c_bitvector_clear_bit_x (bv, idx); +} + void scm_array_get_handle (SCM array, scm_t_array_handle *h) { @@ -202,7 +211,7 @@ scm_array_get_handle (SCM array, scm_t_array_handle *h) initialize_vector_handle (h, scm_c_bitvector_length (array), SCM_ARRAY_ELEMENT_TYPE_BIT, bitvector_ref, - scm_c_bitvector_set_x, + bitvector_set_x, scm_i_bitvector_bits (array), scm_i_is_mutable_bitvector (array)); break; diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c index 9755f24d8..87ad6e84a 100644 --- a/libguile/bitvectors.c +++ b/libguile/bitvectors.c @@ -256,15 +256,16 @@ scm_bitvector_writable_elements (SCM vec, int scm_c_bitvector_bit_is_set (SCM vec, size_t idx) +#define FUNC_NAME "bitvector-bit-set?" { - if (!IS_BITVECTOR (vec)) - scm_wrong_type_arg_msg (NULL, 0, vec, "bitvector"); + VALIDATE_BITVECTOR (1, vec); if (idx >= BITVECTOR_LENGTH (vec)) - scm_out_of_range (NULL, scm_from_size_t (idx)); + 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; } +#undef FUNC_NAME int scm_c_bitvector_bit_is_clear (SCM vec, size_t idx) @@ -294,48 +295,51 @@ SCM_DEFINE_STATIC (scm_bitvector_bit_clear_p, "bitvector-bit-clear?", 2, 0, 0, #undef FUNC_NAME void -scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val) +scm_c_bitvector_set_bit_x (SCM vec, size_t idx) +#define FUNC_NAME "bitvector-set-bit!" { - scm_t_array_handle handle; - uint32_t *bits, mask; + VALIDATE_MUTABLE_BITVECTOR (1, vec); + if (idx >= BITVECTOR_LENGTH (vec)) + SCM_OUT_OF_RANGE (2, scm_from_size_t (idx)); - if (IS_MUTABLE_BITVECTOR (vec)) - { - if (idx >= BITVECTOR_LENGTH (vec)) - scm_out_of_range (NULL, scm_from_size_t (idx)); - bits = BITVECTOR_BITS(vec); - } - else - { - size_t len, off; - ssize_t inc; - - bits = scm_bitvector_writable_elements (vec, &handle, &off, &len, &inc); - scm_c_issue_deprecation_warning - ("Using bitvector-set! on arrays is deprecated. " - "Use array-set! instead."); - if (idx >= len) - scm_out_of_range (NULL, scm_from_size_t (idx)); - idx = idx*inc + off; - } + uint32_t *bits = BITVECTOR_BITS (vec); + uint32_t mask = 1L << (idx%32); + bits[idx/32] |= mask; +} +#undef FUNC_NAME - mask = 1L << (idx%32); - if (scm_is_true (val)) - bits[idx/32] |= mask; - else - bits[idx/32] &= ~mask; +void +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)) + SCM_OUT_OF_RANGE (2, scm_from_size_t (idx)); - if (!IS_MUTABLE_BITVECTOR (vec)) - scm_array_handle_release (&handle); + uint32_t *bits = BITVECTOR_BITS (vec); + uint32_t mask = 1L << (idx%32); + bits[idx/32] &= ~mask; } +#undef FUNC_NAME -SCM_DEFINE (scm_bitvector_set_x, "bitvector-set!", 3, 0, 0, - (SCM vec, SCM idx, SCM val), - "Set the element at index @var{idx} of the bitvector\n" - "@var{vec} when @var{val} is true, else clear it.") -#define FUNC_NAME s_scm_bitvector_set_x +SCM_DEFINE_STATIC (scm_bitvector_set_bit_x, "bitvector-set-bit!", 2, 0, 0, + (SCM vec, SCM idx), + "Set the element at index @var{idx} of the bitvector\n" + "@var{vec}.") +#define FUNC_NAME s_scm_bitvector_set_bit_x +{ + scm_c_bitvector_set_bit_x (vec, scm_to_size_t (idx)); + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME + +SCM_DEFINE_STATIC (scm_bitvector_clear_bit_x, "bitvector-clear-bit!", 2, 0, 0, + (SCM vec, SCM idx), + "Clear the element at index @var{idx} of the bitvector\n" + "@var{vec}.") +#define FUNC_NAME s_scm_bitvector_set_bit_x { - scm_c_bitvector_set_x (vec, scm_to_size_t (idx), val); + scm_c_bitvector_clear_bit_x (vec, scm_to_size_t (idx)); return SCM_UNSPECIFIED; } #undef FUNC_NAME diff --git a/libguile/bitvectors.h b/libguile/bitvectors.h index 136f22953..7061d3848 100644 --- a/libguile/bitvectors.h +++ b/libguile/bitvectors.h @@ -36,7 +36,6 @@ SCM_API SCM scm_bitvector_p (SCM vec); SCM_API SCM scm_bitvector (SCM bits); SCM_API SCM scm_make_bitvector (SCM len, SCM fill); SCM_API SCM scm_bitvector_length (SCM vec); -SCM_API SCM scm_bitvector_set_x (SCM vec, SCM idx, SCM val); 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); @@ -54,7 +53,8 @@ SCM_API SCM scm_c_make_bitvector (size_t len, SCM fill); SCM_API size_t scm_c_bitvector_length (SCM vec); 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_x (SCM vec, size_t idx, SCM val); +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 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 dde780be9..24a50ee3b 100644 --- a/libguile/deprecated.c +++ b/libguile/deprecated.c @@ -123,6 +123,53 @@ SCM_DEFINE (scm_bitvector_ref, "bitvector-ref", 2, 0, 0, } #undef FUNC_NAME +void +scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val) +{ + scm_c_issue_deprecation_warning + ("bitvector-set! is deprecated. Use bitvector-set-bit! or " + "bitvector-clear-bit! instead."); + + if (scm_is_bitvector (vec)) + { + if (scm_is_true (val)) + scm_c_bitvector_set_bit_x (vec, idx); + else + scm_c_bitvector_clear_bit_x (vec, idx); + } + else + { + scm_t_array_handle handle; + uint32_t *bits, mask; + size_t len, off; + ssize_t inc; + + bits = scm_bitvector_writable_elements (vec, &handle, &off, &len, &inc); + if (idx >= len) + scm_out_of_range (NULL, scm_from_size_t (idx)); + idx = idx*inc + off; + + mask = 1L << (idx%32); + if (scm_is_true (val)) + bits[idx/32] |= mask; + else + bits[idx/32] &= ~mask; + + scm_array_handle_release (&handle); + } +} + +SCM_DEFINE (scm_bitvector_set_x, "bitvector-set!", 3, 0, 0, + (SCM vec, SCM idx, SCM val), + "Set the element at index @var{idx} of the bitvector\n" + "@var{vec} when @var{val} is true, else clear it.") +#define FUNC_NAME s_scm_bitvector_set_x +{ + scm_c_bitvector_set_x (vec, scm_to_size_t (idx), val); + 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 6dadaad1d..a2438310b 100644 --- a/libguile/deprecated.h +++ b/libguile/deprecated.h @@ -117,6 +117,8 @@ SCM_DEPRECATED char* scm_find_executable (const char *name); 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_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/libguile/posix.c b/libguile/posix.c index 9b9b47636..5d51633ce 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -2137,7 +2137,7 @@ cpu_set_to_bitvector (const cpu_set_t *cs) { if (CPU_ISSET (cpu, cs)) /* XXX: This is inefficient but avoids code duplication. */ - scm_c_bitvector_set_x (bv, cpu, SCM_BOOL_T); + scm_c_bitvector_set_bit_x (bv, cpu); } return bv; diff --git a/module/ice-9/sandbox.scm b/module/ice-9/sandbox.scm index 26958cce4..86d8cbadd 100644 --- a/module/ice-9/sandbox.scm +++ b/module/ice-9/sandbox.scm @@ -1093,10 +1093,11 @@ allocation limit is exceeded, an exception will be thrown to the (define mutating-bitvector-bindings '(((guile) bit-invert! + bitvector-clear-bit! bitvector-clear-bits! - bitvector-set-bits! bitvector-fill! - bitvector-set!))) + bitvector-set-bit! + bitvector-set-bits!))) (define fluid-bindings '(((guile) diff --git a/module/system/vm/disassembler.scm b/module/system/vm/disassembler.scm index 4d539a17d..710797793 100644 --- a/module/system/vm/disassembler.scm +++ b/module/system/vm/disassembler.scm @@ -496,7 +496,7 @@ address of that offset." ((static-opcode-set inst ...) (let ((bv (make-bitvector 256 #f))) (for-each (lambda (inst) - (bitvector-set! bv (instruction-opcode inst) #t)) + (bitvector-set-bit! bv (instruction-opcode inst))) (syntax->datum #'(inst ...))) (datum->syntax #'static-opcode-set bv)))))) diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm index 1d507d18d..112187e8f 100644 --- a/module/system/vm/frame.scm +++ b/module/system/vm/frame.scm @@ -169,7 +169,7 @@ (when (< n (vector-length defs)) (match (vector-ref defs n) (#(_ _ slot _) - (bitvector-set! (vector-ref by-slot slot) n #t) + (bitvector-set-bit! (vector-ref by-slot slot) n) (lp (1+ n)))))) by-slot)) @@ -256,7 +256,7 @@ (bitvector-copy! out in) (bitvector-clear-bits! out kill) (for-each (lambda (def) - (bitvector-set! out def #t)) + (bitvector-set-bit! out def)) gen) (lp (1+ n) first? (or changed? (not (eqv? out-count (bitvector-count out)))))))) diff --git a/test-suite/tests/bitvectors.test b/test-suite/tests/bitvectors.test index de6f95d30..87b201b7a 100644 --- a/test-suite/tests/bitvectors.test +++ b/test-suite/tests/bitvectors.test @@ -43,8 +43,12 @@ (let ((bv (list->bitvector '(#f #f #t #f #t)))) (pass-if (eqv? (bitvector-bit-set? bv 0) #f)) (pass-if (eqv? (bitvector-bit-set? bv 2) #t)) - (bitvector-set! bv 0 #t) - (pass-if (eqv? (bitvector-bit-set? bv 0) #t)))) + (bitvector-set-bit! bv 0) + (pass-if (eqv? (bitvector-bit-set? bv 0) #t)) + (pass-if (eqv? (bitvector-bit-clear? bv 0) #f)) + (bitvector-clear-bit! bv 0) + (pass-if (eqv? (bitvector-bit-set? bv 0) #f)) + (pass-if (eqv? (bitvector-bit-clear? bv 0) #t)))) (with-test-prefix "as array" (let ((bv (list->bitvector '(#f #f #t #f #t)))) |