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 <[email protected]> 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
