This patch adds support for a TEST operator for L bits. Documentation and tests are included.
Signed-off-by: Jose E. Marchesi <[email protected]> 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
