summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2020-04-15 22:14:25 +0200
committerAndy Wingo <wingo@pobox.com>2020-04-15 22:14:25 +0200
commitd7fea134530e552e15732fba01257cf6fba10fec (patch)
tree92c4c938c414fcdb13187fc576a56f6ba3ffafb8
parent8110061e647134ab9071ecb5ce59b69b4ed6ed35 (diff)
downloadguile-d7fea134530e552e15732fba01257cf6fba10fec.tar.gz
bitvector-set-all-bits! / bitvector-clear-all-bits! replace bitvector-fill!
* NEWS: Add entry. * doc/ref/api-data.texi (Bit Vectors): Update. * libguile/bitvectors.h: * libguile/bitvectors.c (scm_c_bitvector_set_all_bits_x) (scm_c_bitvector_clear_all_bits_x): New functions. * libguile/deprecated.h: * libguile/deprecated.c (scm_bitvector_fill_x): Deprecate. * module/ice-9/sandbox.scm (mutable-bitvector-bindings): Replace bitvector-fill! with bitvector-set-all-bits! / bitvector-clear-all-bits!. * module/system/vm/disassembler.scm (static-opcode-set): Use bitvector-set-bit!. * module/system/vm/frame.scm (available-bindings): Use the new interfaces. * test-suite/tests/bitvectors.test: Update.
-rw-r--r--NEWS8
-rw-r--r--doc/ref/api-data.texi21
-rw-r--r--libguile/bitvectors.c87
-rw-r--r--libguile/bitvectors.h3
-rw-r--r--libguile/deprecated.c36
-rw-r--r--libguile/deprecated.h1
-rw-r--r--module/ice-9/sandbox.scm3
-rw-r--r--module/system/vm/frame.scm6
-rw-r--r--test-suite/tests/bitvectors.test9
9 files changed, 116 insertions, 58 deletions
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,56 +344,59 @@ 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))
- {
- size_t len = BITVECTOR_LENGTH (vec);
-
- 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);
+ VALIDATE_MUTABLE_BITVECTOR (1, bv);
+ size_t len = BITVECTOR_LENGTH (bv);
- 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;
- }
- }
- }
- else
+ if (len > 0)
{
- scm_t_array_handle handle;
- size_t off, len;
- ssize_t inc;
+ 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_bitvector_writable_elements (vec, &handle, &off, &len, &inc);
+ memset (bits, 0xFF, sizeof(uint32_t)*(word_len-1));
+ bits[word_len-1] |= last_mask;
+ }
+}
+#undef FUNC_NAME
- scm_c_issue_deprecation_warning
- ("Using bitvector-fill! on arrays is deprecated. "
- "Use array-set! instead.");
+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);
- size_t i;
- for (i = 0; i < len; i++)
- scm_array_handle_set (&handle, i*inc, val);
+ 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_array_handle_release (&handle);
+ 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;
}
-#undef FUNC_NAME
SCM_DEFINE (scm_list_to_bitvector, "list->bitvector", 1, 0, 0,
(SCM list),
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)))