[COMMITTED] algol68: fix checking of single bounds in trimmers
Jose E. Marchesi
jemarch@gnu.org
Tue Mar 18 08:52:52 GMT 2025
In trimmers, given the current dimension's bounds (L,U), we cannot
simply do the check:
L <= lower_bound <= U
L <= upper_bound <= U
This is because the multiple may be flat, and the dimension may have
bounds such like U < L. In that case, the expressions above would
always eval to false for any lower_bound and upper_bound.
So we check for this instead:
L <= lower_bound AND upper_bound <= U
This allows to trim a "flat dimension" using a trimmer where
upper_bound < lower_bound. The result is, of course, another "flat
dimension" in the multiple result of the trimming.
---
gcc/algol68/a68-low-multiples.cc | 48 ++++++++++++++++++++++++++++++++
gcc/algol68/a68-low-runtime.def | 4 +++
gcc/algol68/a68-low-units.cc | 47 ++++++++++++++++++-------------
gcc/algol68/a68.h | 5 +++-
libga68/ga68-error.c | 18 ++++++++++++
libga68/ga68.h | 4 +++
6 files changed, 106 insertions(+), 20 deletions(-)
diff --git a/gcc/algol68/a68-low-multiples.cc b/gcc/algol68/a68-low-multiples.cc
index 58ae45d59d7..d86ecbffd90 100644
--- a/gcc/algol68/a68-low-multiples.cc
+++ b/gcc/algol68/a68-low-multiples.cc
@@ -803,6 +803,54 @@ a68_rows_upper_bound (tree rows, tree dim)
return rows_lower_or_upper_bound (rows, dim, true);
}
+/* Return a tree that checks that a given INDEX is correct given a multiple's
+ bounds in a given rank DIM.
+
+ If UPPER_BOUND is true then INDEX shall be less or equal than the multiple's
+ upper bound. Otherwise INDEX shall be bigger or equal than the multiple's
+ lower bound.
+
+ If the condition above doesn't hold then a call to a run-time function is
+ performed: if UPPER_BOUND is true then ARRAYUPPERBOUND is called. Otherwise
+ ARRAYLOWERBOUND is called. */
+
+tree
+a68_multiple_single_bound_check (NODE_T *p, tree dim,
+ tree multiple, tree index, bool upper_bound)
+{
+ index = save_expr (index);
+ multiple = save_expr (multiple);
+
+ tree bound = (upper_bound
+ ? a68_multiple_upper_bound (multiple, dim)
+ : a68_multiple_lower_bound (multiple, dim));
+ a68_libcall_fn libcall = (upper_bound
+ ? A68_LIBCALL_ARRAYUPPERBOUND
+ : A68_LIBCALL_ARRAYLOWERBOUND);
+
+ /* Build the call to ARRAY*BOUNDS. */
+ 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 (libcall,
+ void_type_node, 4,
+ filename,
+ build_int_cst (unsigned_type_node, lineno),
+ fold_convert (ssizetype, index),
+ fold_convert (ssizetype, bound));
+ call = fold_build2 (COMPOUND_EXPR, a68_bool_type, call, boolean_false_node);
+
+ tree bounds_check = fold_build2 (upper_bound ? LE_EXPR : GE_EXPR,
+ ssizetype,
+ fold_convert (ssizetype, index),
+ bound);
+ return fold_build2_loc (a68_get_node_location (p),
+ TRUTH_ORIF_EXPR,
+ ssizetype,
+ bounds_check, call);
+}
+
/* Return a tree that checks whether the given INDEX falls within the bounds of
MULTIPLE in the rank DIM. If the provided index is out of bounds then a
call to the run-time function ARRAYBOUNDS is performed.
diff --git a/gcc/algol68/a68-low-runtime.def b/gcc/algol68/a68-low-runtime.def
index 86c85e28bc4..ccda530e8e3 100644
--- a/gcc/algol68/a68-low-runtime.def
+++ b/gcc/algol68/a68-low-runtime.def
@@ -44,6 +44,10 @@ DEF_A68_RUNTIME (MALLOC, "_libga68_malloc", RT(VOIDPTR), P1(SIZE), ECF_NOTHROW |
DEF_A68_RUNTIME (DEREFNIL, "_libga68_derefnil", RT(VOID), P2(CONSTCHARPTR, UINT), ECF_NORETURN)
DEF_A68_RUNTIME (UNREACHABLE, "_libga68_unreachable", RT(VOID), P2(CONSTCHARPTR, UINT), ECF_NORETURN)
DEF_A68_RUNTIME (BITSBOUNDSERROR, "_libga68_bitsboundserror", RT(VOID), P3(CONSTCHARPTR,UINT,INT), ECF_NORETURN)
+DEF_A68_RUNTIME (ARRAYLOWERBOUND, "_libga68_lower_bound", RT(VOID),
+ P4(CONSTCHARPTR, UINT, INT, INT), ECF_NORETURN)
+DEF_A68_RUNTIME (ARRAYUPPERBOUND, "_libga68_upper_bound", RT(VOID),
+ P4(CONSTCHARPTR, UINT, INT, INT), ECF_NORETURN)
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-low-units.cc b/gcc/algol68/a68-low-units.cc
index 8505d8c6e39..641a2e1d516 100644
--- a/gcc/algol68/a68-low-units.cc
+++ b/gcc/algol68/a68-low-units.cc
@@ -541,26 +541,35 @@ lower_subscript_for_trimmers (NODE_T *p, LOW_CTX_T ctx,
}
}
- /* Now lower_bound, upper_bound and at all have their appropriate
- values. First validate bounds, but note that bounds of a trim
- [a:b] should only be checked if a <= b. Otherwise the result of
- the trim is a flat array and bound checking shouln't be
- performed. */
+ /* Time for some bounds checking.
+
+ Note that in trimmers, given the current dimension's bounds
+ (L,U), we cannot simply do the check:
+
+ L <= lower_bound <= U
+ L <= upper_bound <= U
+
+ This is because the multiple may be flat, and the dimension may
+ have bounds such like U < L. In that case, the expressions
+ above would always eval to false for any lower_bound and
+ upper_bound.
+
+ So we check for this instead:
+
+ L <= lower_bound AND upper_bound <= U
+
+ This allows to trim a "flat dimension" using a trimmer where
+ upper_bound < lower_bound. The result is, of course, another
+ "flat dimension" in the multiple result of the trimming. */
+
if (OPTION_BOUNDS_CHECKING (&A68_JOB))
{
- tree is_flat = fold_build2 (GT_EXPR, ssizetype,
- lower_bound, upper_bound);
- tree bound_check
- = fold_build2 (TRUTH_ORIF_EXPR, integer_type_node,
- is_flat,
- fold_build2 (COMPOUND_EXPR, integer_type_node,
- a68_multiple_bounds_check (p, size_dim,
- multiple,
- lower_bound),
- a68_multiple_bounds_check (p, size_dim,
- multiple,
- upper_bound)));
- a68_add_stmt (bound_check);
+ a68_add_stmt (a68_multiple_single_bound_check (p, size_dim, multiple,
+ lower_bound,
+ false /* upper_bound */));
+ a68_add_stmt (a68_multiple_single_bound_check (p, size_dim, multiple,
+ upper_bound,
+ true /* upper_bound */));
}
/* new_elements += i * strides[dim] */
@@ -698,7 +707,7 @@ a68_lower_slice (NODE_T *p, LOW_CTX_T ctx)
tree new_multiple = a68_row_value (CTYPE (sliced_multiple_mode),
slice_num_dimensions,
a68_multiple_elements (sliced_multiple),
- a68_multiple_elements_size (sliced_multiple),
+ a68_multiple_elements_size (sliced_multiple),
lower_bounds, upper_bounds);
new_multiple = save_expr (new_multiple);
new_multiple = a68_lower_tmpvar ("new_multiple%", TREE_TYPE (new_multiple),
diff --git a/gcc/algol68/a68.h b/gcc/algol68/a68.h
index 6fdcd2a0780..730ec13e890 100644
--- a/gcc/algol68/a68.h
+++ b/gcc/algol68/a68.h
@@ -623,7 +623,10 @@ tree a68_rows_dim (tree exp);
tree a68_rows_value (tree multiple);
tree a68_rows_lower_bound (tree rows, tree dim);
tree a68_rows_upper_bound (tree rows, tree dim);
-tree a68_multiple_bounds_check (NODE_T *p, tree dim, tree multiple, tree index);
+tree a68_multiple_single_bound_check (NODE_T *p, tree dim, tree multiple,
+ tree index, bool upper_bound);
+tree a68_multiple_bounds_check (NODE_T *p, tree dim, tree multiple,
+ tree index);
/* a68-low-ranges.cc */
diff --git a/libga68/ga68-error.c b/libga68/ga68-error.c
index 317d99fdf4d..c75b8bd68f7 100644
--- a/libga68/ga68-error.c
+++ b/libga68/ga68-error.c
@@ -75,6 +75,24 @@ _libga68_unreachable (const char *filename, unsigned int lineno)
filename, lineno);
}
+/* Lower bound failure. */
+
+void _libga68_lower_bound (const char *filename, unsigned int lineno,
+ ssize_t index, ssize_t lower_bound)
+{
+ _libga68_abort ("run-time error: lower bound %d must be >= %d at %s:%d\n",
+ index, lower_bound, filename, lineno);
+}
+
+/* Upper bound failure. */
+
+void _libga68_upper_bound (const char *filename, unsigned int lineno,
+ ssize_t index, ssize_t upper_bound)
+{
+ _libga68_abort ("run-time error: upper bound %d must be <= %d at %s:%d\n",
+ index, upper_bound, filename, lineno);
+}
+
/* Bounds failure. */
void
diff --git a/libga68/ga68.h b/libga68/ga68.h
index 076787b722a..e8f3fc38654 100644
--- a/libga68/ga68.h
+++ b/libga68/ga68.h
@@ -39,6 +39,10 @@ void _libga68_derefnil (const char *filename, unsigned int lineno);
void _libga68_bitsboundserror (const char *filename, unsigned int lineno,
ssize_t pos);
void _libga68_unreachable (const char *filename, unsigned int lineno);
+void _libga68_lower_bound (const char *filename, unsigned int lineno,
+ ssize_t index, ssize_t lower_bound);
+void _libga68_upper_bound (const char *filename, unsigned int lineno,
+ ssize_t index, ssize_t upper_bound);
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