a68: make SET, CLEAR and TEST bits operators zero-based

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.

diff --git a/gcc/algol68/a68-low-bits.cc b/gcc/algol68/a68-low-bits.cc
index 7ec058ee1b0632b0435092aec0657fe83723709d..81b4f98c4fa0c5ba1644b7a4018340079f919044 100644 (file)
--- 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 811f34f7d9f3ab8a378747119817b8dff8c17e03..b0945bf8535ceaffe41ab8587f631e33c9ebff57 100644 (file)
--- 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 8c5502737dcaa95ec0466f5b18290703a0dedd33..8fad9d38c9fb97f2cf68c9a99845697d57516d13 100644 (file)
--- 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 eac8d6883f72b999cbd2d57cab5cbc629c9a4ad0..6a8a8409e30629cde7265b77311ed58b9ccd8611 100644 (file)
--- 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 6ffd7fb94b37cacd7c403e71f72e791e5ee9c256..a7e0ba9c6accdbeb3e12ef860b5a78c1ef4d658e 100644 (file)
--- 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