[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/02: bitvector-set-all-bits! / bitvector-clear-all-bit
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] 01/02: bitvector-set-all-bits! / bitvector-clear-all-bits! replace bitvector-fill! |
|
Date: |
Sat, 18 Apr 2020 16:19:17 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit d7fea134530e552e15732fba01257cf6fba10fec
Author: Andy Wingo <address@hidden>
AuthorDate: Wed Apr 15 22:14:25 2020 +0200
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.
---
NEWS | 8 ++++
doc/ref/api-data.texi | 21 +++++-----
libguile/bitvectors.c | 87 +++++++++++++++++++++-------------------
libguile/bitvectors.h | 3 +-
libguile/deprecated.c | 36 +++++++++++++++++
libguile/deprecated.h | 1 +
module/ice-9/sandbox.scm | 3 +-
module/system/vm/frame.scm | 6 ++-
test-suite/tests/bitvectors.test | 9 ++++-
9 files changed, 116 insertions(+), 58 deletions(-)
diff --git a/NEWS b/NEWS
index 68e5d08..386e5fd 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 141b214..f9b14d1 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 87ad6e8..077bc55 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 7061d38..ffeb5a8 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 24a50ee..3682a0c 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 a243831..a0ccac7 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 86d8cba..75c7f0d 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 112187e..18987d9 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 87b201b..9bbd6e2 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)))