[COMMITTED] a68: make SET, CLEAR and TEST bits operators zero-based
Jose E. Marchesi
jemarch@gnu.org
Thu Feb 5 09:46:16 GMT 2026
After some discussion at the working group we have decided that the
bits operators SET, CLEAR and TEST, which are a GNU extension, shall
get bit numbers which are zero-based rather than one-based.
Signed-off-by: Jose E. Marchesi <jemarch@gnu.org>
gcc/algol68/ChangeLog
* a68-low-bits.cc (a68_bits_set): Make bit number zero-based rathe
than one-based.
(a68_bits_clear): Likewise.
(a68_bits_test): Likewise.
* ga68.texi (Extended bits operators): Adapt documentation
accordingly.
gcc/testsuite/ChangeLog
* algol68/execute/bits-clear-1.a68: Adapt test to new CLEAR
semantics.
* algol68/execute/bits-set-1.a68: Likewise for SET.
* algol68/execute/bits-test-1.a68: Likewise for TEST.
---
gcc/algol68/a68-low-bits.cc | 31 +++++++------------
gcc/algol68/ga68.texi | 13 ++++----
.../algol68/execute/bits-clear-1.a68 | 25 +++++++++------
gcc/testsuite/algol68/execute/bits-set-1.a68 | 25 +++++++++------
gcc/testsuite/algol68/execute/bits-test-1.a68 | 6 ++--
5 files changed, 52 insertions(+), 48 deletions(-)
diff --git a/gcc/algol68/a68-low-bits.cc b/gcc/algol68/a68-low-bits.cc
index 7ec058ee1b0..81b4f98c4fa 100644
--- a/gcc/algol68/a68-low-bits.cc
+++ b/gcc/algol68/a68-low-bits.cc
@@ -310,7 +310,7 @@ a68_bits_ne (tree a, tree b, location_t loc)
/* Set the bit NUMBIT in BITS.
- NUMBIT is one based and counts bits from least significative to most
+ NUMBIT is zero based and counts bits from least significative to most
significative, i.e. from "right" to "left". If NUMBIT is not in range then
this is a nop. */
@@ -323,20 +323,18 @@ a68_bits_set (MOID_T *m, tree bits, tree numbit, location_t loc)
bits = save_expr (bits);
numbit = save_expr (numbit);
- tree numbit_minus_one = fold_build2 (MINUS_EXPR, int_type,
- numbit, build_int_cst (int_type, 1));
tree mask = fold_build2 (BIT_IOR_EXPR, bits_type,
bits,
fold_build2 (LSHIFT_EXPR,
bits_type,
build_int_cst (bits_type, 1),
- numbit_minus_one));
+ numbit));
tree res = fold_build2 (BIT_IOR_EXPR, bits_type, bits, mask);
tree in_range = fold_build2 (TRUTH_AND_EXPR,
int_type,
fold_build2 (GE_EXPR, int_type,
- numbit, build_int_cst (int_type, 1)),
- fold_build2 (LE_EXPR, int_type,
+ numbit, build_zero_cst (int_type)),
+ fold_build2 (LT_EXPR, int_type,
numbit, a68_bits_width (bits_type)));
return fold_build3_loc (loc, COND_EXPR,
@@ -346,7 +344,7 @@ a68_bits_set (MOID_T *m, tree bits, tree numbit, location_t loc)
/* Clear the bit NUMBIT in BITS.
- NUMBIT is one based and counts bits from least significative to most
+ NUMBIT is zero based and counts bits from least significative to most
significative, i.e. from "right" to "left". If NUMBIT is not in range then
this is a nop. */
@@ -364,16 +362,13 @@ a68_bits_clear (MOID_T *m, tree bits, tree numbit, location_t loc)
fold_build2 (LSHIFT_EXPR,
bits_type,
build_int_cst (bits_type, 1),
- fold_build2 (MINUS_EXPR,
- int_type,
- numbit,
- build_int_cst (int_type, 1))));
+ numbit));
tree res = fold_build2 (BIT_AND_EXPR, bits_type, bits, mask);
tree in_range = fold_build2 (TRUTH_AND_EXPR,
int_type,
fold_build2 (GE_EXPR, int_type,
- numbit, build_int_cst (int_type, 1)),
- fold_build2 (LE_EXPR, int_type,
+ numbit, build_zero_cst (int_type)),
+ fold_build2 (LT_EXPR, int_type,
numbit, a68_bits_width (bits_type)));
return fold_build3_loc (loc, COND_EXPR,
bits_type,
@@ -382,7 +377,7 @@ a68_bits_clear (MOID_T *m, tree bits, tree numbit, location_t loc)
/* Test the bit NUMBIT in BITS.
- NUMBIT is one based and counts bits from least significative to most
+ NUMBIT is zero based and counts bits from least significative to most
significative, i.e. from "right" to "left". If NUMBIT is not in range then
the operator yields false. */
@@ -395,14 +390,12 @@ a68_bits_test (tree bits, tree numbit, location_t loc)
bits = save_expr (bits);
numbit = save_expr (numbit);
- tree numbit_minus_one = fold_build2 (MINUS_EXPR, int_type,
- numbit, build_one_cst (int_type));
tree mask = fold_build2 (BIT_AND_EXPR, bits_type,
bits,
fold_build2 (LSHIFT_EXPR,
bits_type,
build_one_cst (bits_type),
- fold_convert (bits_type, numbit_minus_one)));
+ numbit));
tree res = fold_build2 (NE_EXPR,
a68_bool_type,
fold_build2 (BIT_AND_EXPR, bits_type, bits, mask),
@@ -410,8 +403,8 @@ a68_bits_test (tree bits, tree numbit, location_t loc)
tree in_range = fold_build2 (TRUTH_AND_EXPR,
int_type,
fold_build2 (GE_EXPR, int_type,
- numbit, build_int_cst (int_type, 1)),
- fold_build2 (LE_EXPR, int_type,
+ numbit, build_zero_cst (int_type)),
+ fold_build2 (LT_EXPR, int_type,
numbit, a68_bits_width (bits_type)));
return fold_build3_loc (loc, COND_EXPR,
diff --git a/gcc/algol68/ga68.texi b/gcc/algol68/ga68.texi
index 811f34f7d9f..b0945bf8535 100644
--- a/gcc/algol68/ga68.texi
+++ b/gcc/algol68/ga68.texi
@@ -3045,20 +3045,21 @@ given bits arguments.
@deftypefn Operator {} {@B{set}} {= (@B{l} @B{bits} b, @B{int} n) @B{l} @B{bits}}
Dyadic operator that sets the @code{n}th least significant bit in
-@code{@B{b}}. If @code{n} is not in the range @code{[1,L_bits_width]}
-then the operator yields @B{b}.
+@code{@B{b}}, where @code{n} is zero based. If @code{n} is not in the
+range @code{[0,L_bits_width)} then the operator yields @B{b}.
@end deftypefn
@deftypefn Operator {} {@B{clear}} {= (@B{l} @B{bits} b, @B{int} n) @B{l} @B{bits}}
Dyadic operator that clears the @code{n}th least significant bit in
-@code{@B{b}}. If @code{n} is not in the range @code{[1,L_bits_width]}
-then the operator yields @B{b}.
+@code{@B{b}}, where @code{n} is zero based. If @code{n} is not in the
+range @code{[0,L_bits_width)} then the operator yields @B{b}.
@end deftypefn
@deftypefn Operator {} {@B{test}} {= (@B{l} @B{bits} b, @B{int} n) @B{bool}}
Dyadic operator that tests whether the @code{n}th least significant
-bit in @code{@B{b}} is set. If @code{n} is not in the range
-@code{1,L_bits_width]} then the operator yields @B{false}.
+bit in @code{@B{b}} is set, where @code{n} is zero based. If @code{n}
+is not in the range @code{0,L_bits_width)} then the operator yields
+@B{false}.
@end deftypefn
@node Extended math procedures
diff --git a/gcc/testsuite/algol68/execute/bits-clear-1.a68 b/gcc/testsuite/algol68/execute/bits-clear-1.a68
index 8c5502737dc..8fad9d38c9f 100644
--- a/gcc/testsuite/algol68/execute/bits-clear-1.a68
+++ b/gcc/testsuite/algol68/execute/bits-clear-1.a68
@@ -1,30 +1,35 @@
begin (short short bits a = short short 16rf;
assert (a CLEAR (short_short_bits_width + 1) = a);
assert (a CLEAR -1 = a);
- assert (a CLEAR short_short_bits_width = short short 16rf);
- assert (a CLEAR 1 CLEAR 2 = BIN short short 12));
+ assert (a CLEAR short_short_bits_width = a);
+ assert (a CLEAR (short_short_bits_width-1) = short short 16rf);
+ assert (a CLEAR 0 CLEAR 1 = BIN short short 12));
(short bits a = short 16rf;
assert (a CLEAR (short_bits_width + 1) = a);
assert (a CLEAR -1 = a);
- assert (a CLEAR short_bits_width = short 16rf);
- assert (a CLEAR 1 CLEAR 2 = BIN short 12));
+ assert (a CLEAR short_bits_width = a);
+ assert (a CLEAR (short_bits_width-1) = short 16rf);
+ assert (a CLEAR 0 CLEAR 1 = BIN short 12));
(bits a = 16rf;
assert (a CLEAR (bits_width + 1) = a);
assert (a CLEAR -1 = a);
- assert (a CLEAR bits_width = 16rf);
- assert (a CLEAR 1 CLEAR 2 = BIN 12));
+ assert (a CLEAR bits_width = a);
+ assert (a CLEAR (bits_width-1) = 16rf);
+ assert (a CLEAR 0 CLEAR 1 = BIN 12));
(long bits a = long 16rf;
assert (a CLEAR (long_bits_width + 1) = a);
assert (a CLEAR -1 = a);
- assert (a CLEAR long_bits_width = long 16rf);
- assert (a CLEAR 1 CLEAR 2 = BIN long 12));
+ assert (a CLEAR long_bits_width = a);
+ assert (a CLEAR (long_bits_width-1) = long 16rf);
+ assert (a CLEAR 0 CLEAR 1 = BIN long 12));
(long long bits a = long long 16rf;
assert (a CLEAR (long_long_bits_width + 1) = a);
assert (a CLEAR -1 = a);
- assert (a CLEAR long_long_bits_width = long long 16rf);
- assert (a CLEAR 1 CLEAR 2 = BIN long long 12))
+ assert (a CLEAR long_long_bits_width = a);
+ assert (a CLEAR (long_long_bits_width-1) = long long 16rf);
+ assert (a CLEAR 0 CLEAR 1 = BIN long long 12))
end
diff --git a/gcc/testsuite/algol68/execute/bits-set-1.a68 b/gcc/testsuite/algol68/execute/bits-set-1.a68
index eac8d6883f7..6a8a8409e30 100644
--- a/gcc/testsuite/algol68/execute/bits-set-1.a68
+++ b/gcc/testsuite/algol68/execute/bits-set-1.a68
@@ -1,30 +1,35 @@
begin (short short bits a = short short 16r0;
assert (a SET (short_short_bits_width + 1) = a);
assert (a SET -1 = a);
- assert (a SET short_short_bits_width = short short 16r1 SHL (short_short_bits_width-1));
- assert (a SET 1 SET 2 = BIN short short 3));
+ assert (a SET short_short_bits_width = a);
+ assert (a SET (short_short_bits_width-1) = short short 16r1 SHL (short_short_bits_width-1));
+ assert (a SET 0 SET 1 = BIN short short 3));
(short bits a = short 16r0;
assert (a SET (short_bits_width + 1) = a);
assert (a SET -1 = a);
- assert (a SET short_bits_width = short 16r1 SHL (short_bits_width-1));
- assert (a SET 1 SET 2 = BIN short 3));
+ assert (a SET short_bits_width = a);
+ assert (a SET (short_bits_width-1) = short 16r1 SHL (short_bits_width-1));
+ assert (a SET 0 SET 1 = BIN short 3));
(bits a = 16r0;
assert (a SET (bits_width + 1) = a);
assert (a SET -1 = a);
- assert (a SET bits_width = 16r1 SHL (bits_width-1));
- assert (a SET 1 SET 2 = BIN 3));
+ assert (a SET bits_width = a);
+ assert (a SET (bits_width-1) = 16r1 SHL (bits_width-1));
+ assert (a SET 0 SET 1 = BIN 3));
(long bits a = long 16r0;
assert (a SET (long_bits_width + 1) = a);
assert (a SET -1 = a);
- assert (a SET long_bits_width = long 16r1 SHL (long_bits_width-1));
- assert (a SET 1 SET 2 = BIN long 3));
+ assert (a SET long_bits_width = a);
+ assert (a SET (long_bits_width-1) = long 16r1 SHL (long_bits_width-1));
+ assert (a SET 0 SET 1 = BIN long 3));
(long long bits a = long long 16r0;
assert (a SET (long_long_bits_width + 1) = a);
assert (a SET -1 = a);
- assert (a SET long_long_bits_width = long long 16r1 SHL (long_long_bits_width-1));
- assert (a SET 1 SET 2 = BIN long long 3))
+ assert (a SET long_long_bits_width = a);
+ assert (a SET (long_long_bits_width-1) = long long 16r1 SHL (long_long_bits_width-1));
+ assert (a SET 0 SET 1 = BIN long long 3))
end
diff --git a/gcc/testsuite/algol68/execute/bits-test-1.a68 b/gcc/testsuite/algol68/execute/bits-test-1.a68
index 6ffd7fb94b3..a7e0ba9c6ac 100644
--- a/gcc/testsuite/algol68/execute/bits-test-1.a68
+++ b/gcc/testsuite/algol68/execute/bits-test-1.a68
@@ -1,5 +1,5 @@
-begin assert (NOT (16rff TEST 9));
- assert (NOT (16rff TEST 0));
+begin assert (NOT (16rff TEST 8));
assert (NOT (16rff TEST -1));
- assert (2r100 TEST 3)
+ assert (NOT (16rff TEST -2));
+ assert (2r100 TEST 2)
end
--
2.39.5
More information about the Algol68
mailing list