[COMMITTED] a68: add TEST operator for bits to expanded prelude
Jose E. Marchesi
jemarch@gnu.org
Sat Jan 31 17:58:08 GMT 2026
This patch adds support for a TEST operator for L bits. Documentation
and tests are included.
Signed-off-by: Jose E. Marchesi <jemarch@gnu.org>
gcc/algol68/ChangeLog
* a68.h: Prototypes for a68_bits_test and a68_lower_test3.
* a68-low-bits.cc (a68_bits_test): New function.
* a68-low-prelude.cc (a68_lower_test3): Likewise.
* a68-parser-prelude.cc (gnu_prelude): Declare TEST operators and
their priority.
* ga68.texi (Extended bits operators): New section.
gcc/testsuite/ChangeLog
* algol68/execute/bits-test-1.a68: New test.
---
gcc/algol68/a68-low-bits.cc | 40 +++++++++++++++++++
gcc/algol68/a68-low-prelude.cc | 8 ++++
gcc/algol68/a68-parser-prelude.cc | 11 +++++
gcc/algol68/a68.h | 2 +
gcc/algol68/ga68.texi | 6 +++
gcc/testsuite/algol68/execute/bits-test-1.a68 | 5 +++
6 files changed, 72 insertions(+)
create mode 100644 gcc/testsuite/algol68/execute/bits-test-1.a68
diff --git a/gcc/algol68/a68-low-bits.cc b/gcc/algol68/a68-low-bits.cc
index 6a272ca633d..16205fa6351 100644
--- a/gcc/algol68/a68-low-bits.cc
+++ b/gcc/algol68/a68-low-bits.cc
@@ -367,3 +367,43 @@ a68_bits_clear (MOID_T *m, tree bits, tree numbit, location_t loc)
bits_type,
in_range, res, bits);
}
+
+/* Test the bit NUMBIT in BITS.
+
+ NUMBIT is one 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. */
+
+tree
+a68_bits_test (MOID_T *m ATTRIBUTE_UNUSED,
+ tree bits, tree numbit, location_t loc)
+{
+ tree bits_type = TREE_TYPE (bits);
+ tree int_type = TREE_TYPE (numbit);
+
+ 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)));
+ tree res = fold_build2 (NE_EXPR,
+ a68_bool_type,
+ fold_build2 (BIT_AND_EXPR, bits_type, bits, mask),
+ build_int_cst (bits_type, 0));
+ 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, a68_bits_width (bits_type)));
+
+ return fold_build3_loc (loc, COND_EXPR,
+ a68_bool_type,
+ in_range, res, build_zero_cst (a68_bool_type));
+}
diff --git a/gcc/algol68/a68-low-prelude.cc b/gcc/algol68/a68-low-prelude.cc
index 3a1db5e7f65..331e865ffff 100644
--- a/gcc/algol68/a68-low-prelude.cc
+++ b/gcc/algol68/a68-low-prelude.cc
@@ -766,6 +766,14 @@ a68_lower_clear3 (NODE_T *p, LOW_CTX_T ctx)
return a68_bits_clear (MOID (p), op1, op2, a68_get_node_location (p));
}
+tree
+a68_lower_test3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+ return a68_bits_test (MOID (p), op1, op2, a68_get_node_location (p));
+}
+
tree
a68_lower_pow_int (NODE_T *p, LOW_CTX_T ctx)
{
diff --git a/gcc/algol68/a68-parser-prelude.cc b/gcc/algol68/a68-parser-prelude.cc
index bf58c4039c3..1184da333de 100644
--- a/gcc/algol68/a68-parser-prelude.cc
+++ b/gcc/algol68/a68-parser-prelude.cc
@@ -1317,6 +1317,7 @@ gnu_prelude (void)
a68_prio ("ELEMS", 8);
a68_prio ("SET", 7);
a68_prio ("CLEAR", 7);
+ a68_prio ("TEST", 7);
/* Identifiers. */
a68_idf (A68_EXT, "infinity", M_REAL, a68_lower_infinity);
a68_idf (A68_EXT, "minusinfinity", M_REAL, a68_lower_minusinfinity);
@@ -1370,22 +1371,32 @@ gnu_prelude (void)
m = a68_proc (M_SHORT_SHORT_BITS, M_SHORT_SHORT_BITS, M_INT, NO_MOID);
a68_op (A68_EXT, "SET", m, a68_lower_set3);
a68_op (A68_EXT, "CLEAR", m, a68_lower_clear3);
+ m = a68_proc (M_BOOL, M_SHORT_SHORT_BITS, M_INT, NO_MOID);
+ a68_op (A68_EXT, "TEST", m, a68_lower_test3);
/* SHORT BITS operators. */
m = a68_proc (M_SHORT_BITS, M_SHORT_BITS, M_INT, NO_MOID);
a68_op (A68_EXT, "SET", m, a68_lower_set3);
a68_op (A68_EXT, "CLEAR", m, a68_lower_clear3);
+ m = a68_proc (M_BOOL, M_SHORT_BITS, M_INT, NO_MOID);
+ a68_op (A68_EXT, "TEST", m, a68_lower_test3);
/* BITS operators. */
m = a68_proc (M_BITS, M_BITS, M_INT, NO_MOID);
a68_op (A68_EXT, "SET", m, a68_lower_set3);
a68_op (A68_EXT, "CLEAR", m, a68_lower_clear3);
+ m = a68_proc (M_BOOL, M_BITS, M_INT, NO_MOID);
+ a68_op (A68_EXT, "TEST", m, a68_lower_test3);
/* LONG BITS operators. */
m = a68_proc (M_LONG_BITS, M_LONG_BITS, M_INT, NO_MOID);
a68_op (A68_EXT, "SET", m, a68_lower_set3);
a68_op (A68_EXT, "CLEAR", m, a68_lower_clear3);
+ m = a68_proc (M_BOOL, M_LONG_BITS, M_INT, NO_MOID);
+ a68_op (A68_EXT, "TEST", m, a68_lower_test3);
/* LONG LONG BITS operators. */
m = a68_proc (M_LONG_LONG_BITS, M_LONG_LONG_BITS, M_INT, NO_MOID);
a68_op (A68_EXT, "SET", m, a68_lower_set3);
a68_op (A68_EXT, "CLEAR", m, a68_lower_clear3);
+ m = a68_proc (M_BOOL, M_LONG_LONG_BITS, M_INT, NO_MOID);
+ a68_op (A68_EXT, "TEST", m, a68_lower_test3);
}
/* POSIX prelude. */
diff --git a/gcc/algol68/a68.h b/gcc/algol68/a68.h
index f4ee6a1faf9..cb8bcef4950 100644
--- a/gcc/algol68/a68.h
+++ b/gcc/algol68/a68.h
@@ -539,6 +539,7 @@ tree a68_bits_eq (tree a, tree b, location_t loc = UNKNOWN_LOCATION);
tree a68_bits_ne (tree a, tree b, location_t loc = UNKNOWN_LOCATION);
tree a68_bits_set (MOID_T *m, tree bits, tree numbit, location_t loc = UNKNOWN_LOCATION);
tree a68_bits_clear (MOID_T *m, tree bits, tree numbit, location_t loc = UNKNOWN_LOCATION);
+tree a68_bits_test (MOID_T *m, tree bits, tree numbit, location_t loc = UNKNOWN_LOCATION);
/* a68-low_bools.cc */
@@ -1074,6 +1075,7 @@ tree a68_lower_longrandom (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_longlongrandom (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_set3 (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_clear3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_test3 (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_posixargc (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_posixargv (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_posixputchar (NODE_T *p, LOW_CTX_T ctx);
diff --git a/gcc/algol68/ga68.texi b/gcc/algol68/ga68.texi
index 00085c74133..1d40530c3f4 100644
--- a/gcc/algol68/ga68.texi
+++ b/gcc/algol68/ga68.texi
@@ -3049,6 +3049,12 @@ Dyadic operator that clears the @code{n}th least significant bit in
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}.
+@end deftypefn
+
@node Extended math procedures
@section Extended math procedures
diff --git a/gcc/testsuite/algol68/execute/bits-test-1.a68 b/gcc/testsuite/algol68/execute/bits-test-1.a68
new file mode 100644
index 00000000000..6ffd7fb94b3
--- /dev/null
+++ b/gcc/testsuite/algol68/execute/bits-test-1.a68
@@ -0,0 +1,5 @@
+begin assert (NOT (16rff TEST 9));
+ assert (NOT (16rff TEST 0));
+ assert (NOT (16rff TEST -1));
+ assert (2r100 TEST 3)
+end
--
2.39.5
More information about the Algol68
mailing list