1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00

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.
This commit is contained in:
Andy Wingo 2020-04-15 22:14:25 +02:00
parent 8110061e64
commit d7fea13453
9 changed files with 121 additions and 63 deletions

8
NEWS
View file

@ -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.

View file

@ -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

View file

@ -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);
VALIDATE_MUTABLE_BITVECTOR (1, bv);
size_t len = BITVECTOR_LENGTH (bv);
if (len > 0)
{
uint32_t *bits = BITVECTOR_BITS (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 (scm_is_true (val))
{
memset (bits, 0xFF, sizeof(uint32_t)*(word_len-1));
bits[word_len-1] |= last_mask;
}
else
}
#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;
}
}
}
else
#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_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);
}
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),

View file

@ -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);

View file

@ -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"

View file

@ -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);

View file

@ -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!)))

View file

@ -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)

View file

@ -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)))