[COMMITTED] algol68: do bound checking in bits ELEM operator
Jose E. Marchesi
jemarch@gnu.org
Fri Mar 14 22:25:40 GMT 2025
This patch adds a run-time checking (subject to
-f[no]-bounds-checking) for the ELEM standard operator of L BITS
values.
---
gcc/algol68/a68-low-bits.cc | 54 +++++++++++++++++++++++++--------
gcc/algol68/a68-low-prelude.cc | 2 +-
gcc/algol68/a68-low-runtime.def | 1 +
gcc/algol68/a68.h | 2 +-
libga68/ga68-error.c | 10 ++++++
libga68/ga68.h | 2 ++
6 files changed, 57 insertions(+), 14 deletions(-)
diff --git a/gcc/algol68/a68-low-bits.cc b/gcc/algol68/a68-low-bits.cc
index 736ce9a757c..2beba19edf7 100644
--- a/gcc/algol68/a68-low-bits.cc
+++ b/gcc/algol68/a68-low-bits.cc
@@ -168,24 +168,54 @@ a68_bits_xor (tree bits1, tree bits2)
If POS is out of range a run-time error is emitted. */
tree
-a68_bits_elem (tree pos, tree bits)
+a68_bits_elem (NODE_T *p, tree pos, tree bits)
{
- /* XXX check bound positive and in range and emit run-time error. */
+ pos = save_expr (pos);
tree one = build_int_cst (TREE_TYPE (bits), 1);
- /* XXX check bound positive and in range and emit run-time error */
tree shift = fold_build2 (MINUS_EXPR, bitsizetype,
TYPE_SIZE (TREE_TYPE (bits)),
fold_convert (bitsizetype, pos));
- return fold_build2 (EQ_EXPR,
- CTYPE (M_BOOL),
- fold_build2 (BIT_AND_EXPR,
- TREE_TYPE (bits),
- fold_build2 (RSHIFT_EXPR,
- TREE_TYPE (bits),
- bits, shift),
- one),
- one);
+ tree elem = fold_build2 (EQ_EXPR,
+ CTYPE (M_BOOL),
+ fold_build2 (BIT_AND_EXPR,
+ TREE_TYPE (bits),
+ fold_build2 (RSHIFT_EXPR,
+ TREE_TYPE (bits),
+ bits, shift),
+ one),
+ one);
+
+ /* Do bounds checking if requested. */
+ if (OPTION_BOUNDS_CHECKING (&A68_JOB))
+ {
+ unsigned int lineno = NUMBER (LINE (INFO (p)));
+ const char *filename_str = FILENAME (LINE (INFO (p)));
+ tree filename = build_string_literal (strlen (filename_str) + 1,
+ filename_str);
+ tree call = a68_build_libcall (A68_LIBCALL_BITSBOUNDSERROR,
+ void_type_node, 3,
+ filename,
+ build_int_cst (unsigned_type_node, lineno),
+ fold_convert (ssizetype, pos));
+ tree check = fold_build2 (TRUTH_AND_EXPR, integer_type_node,
+ fold_build2 (GT_EXPR, integer_type_node,
+ pos, fold_convert (TREE_TYPE (pos), integer_zero_node)),
+ fold_build2 (LE_EXPR, integer_type_node,
+ fold_convert (bitsizetype, pos),
+ TYPE_SIZE (TREE_TYPE (bits))));
+
+ check = fold_build2_loc (a68_get_node_location (p),
+ TRUTH_ORIF_EXPR,
+ ssizetype,
+ check,
+ fold_build2 (COMPOUND_EXPR, CTYPE (M_BOOL),
+ call, boolean_false_node));
+ elem = fold_build2 (COMPOUND_EXPR, CTYPE (M_BOOL),
+ check, elem);
+ }
+
+ return elem;
}
/* Given two SIZETY BITS values BITS1 and BITS2, return a BOOL value indicating
diff --git a/gcc/algol68/a68-low-prelude.cc b/gcc/algol68/a68-low-prelude.cc
index f84e67e27f1..4ed93aed2e0 100644
--- a/gcc/algol68/a68-low-prelude.cc
+++ b/gcc/algol68/a68-low-prelude.cc
@@ -988,7 +988,7 @@ a68_lower_bitelem3 (NODE_T *p, LOW_CTX_T ctx)
{
tree pos = a68_lower_tree (SUB (p), ctx);
tree bits = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
- return a68_bits_elem (pos, bits);
+ return a68_bits_elem (p, pos, bits);
}
tree
diff --git a/gcc/algol68/a68-low-runtime.def b/gcc/algol68/a68-low-runtime.def
index 1c5265d8dd5..cf023bc98ed 100644
--- a/gcc/algol68/a68-low-runtime.def
+++ b/gcc/algol68/a68-low-runtime.def
@@ -41,6 +41,7 @@ along with GCC; see the file COPYING3. If not see
DEF_A68_RUNTIME (ASSERT, "_libga68_assert", RT(VOID), P2(CONSTCHARPTR, UINT), ECF_NORETURN)
DEF_A68_RUNTIME (DEREFNIL, "_libga68_derefnil", RT(VOID), P2(CONSTCHARPTR, UINT), 0)
+DEF_A68_RUNTIME (BITSBOUNDSERROR, "_libga68_bitsboundserror", RT(VOID), P3(CONSTCHARPTR,UINT,INT), 0)
DEF_A68_RUNTIME (ARRAYBOUNDS, "_libga68_bounds", RT(VOID),
P5(CONSTCHARPTR, UINT, INT, INT, INT), ECF_NORETURN)
DEF_A68_RUNTIME (RANDOM, "_libga68_random", RT(FLOAT), P0(), 0)
diff --git a/gcc/algol68/a68.h b/gcc/algol68/a68.h
index 76a211743f5..975b2764cb9 100644
--- a/gcc/algol68/a68.h
+++ b/gcc/algol68/a68.h
@@ -447,7 +447,7 @@ tree a68_bits_not (tree bits);
tree a68_bits_and (tree bits1, tree bits2);
tree a68_bits_ior (tree bits1, tree bits2);
tree a68_bits_xor (tree bits1, tree bits2);
-tree a68_bits_elem (tree pos, tree bits);
+tree a68_bits_elem (NODE_T *p, tree pos, tree bits);
tree a68_bits_subset (tree bits1, tree bits2);
tree a68_bits_shift (tree shift, tree bits);
diff --git a/libga68/ga68-error.c b/libga68/ga68-error.c
index e695343f086..9cee47e3c0d 100644
--- a/libga68/ga68-error.c
+++ b/libga68/ga68-error.c
@@ -56,6 +56,16 @@ _libga68_derefnil (const char *filename, unsigned int lineno)
filename, lineno);
}
+/* Out of bounds error in bits ELEM operator. */
+
+void
+_libga68_bitsboundserror (const char *filename, unsigned int lineno,
+ ssize_t pos)
+{
+ _libga68_abort ("run-time error: bound %d out of range in ELEM at %s:%d\n",
+ pos, filename, lineno);
+}
+
/* Bounds failure. */
void
diff --git a/libga68/ga68.h b/libga68/ga68.h
index 1733fc951e3..41657b8321a 100644
--- a/libga68/ga68.h
+++ b/libga68/ga68.h
@@ -36,6 +36,8 @@
void _libga68_abort (const char *fmt, ...);
void _libga68_assert (const char *filename, unsigned int lineno);
void _libga68_derefnil (const char *filename, unsigned int lineno);
+void _libga68_bitsboundserror (const char *filename, unsigned int lineno,
+ ssize_t pos);
void _libga68_bounds (const char *filename, unsigned int lineno,
ssize_t index, ssize_t lower_bound, ssize_t upper_bound);
--
2.30.2
More information about the Algol68
mailing list