[COMMITTED] algol68: run-time bound checking of trimmers

[Jose E. Marchesi]

This patch implements run-time bound checking (which can be controlled
with -f[no-]a68-bounds-checking) in trimmers.

Note that the bounds of trimmers resulting in flat multiples are not
checked, as mandated by the specification.  Thus, given

  [20]REAL reals;

Then reals[1000:] results in a flat multiple with bounds [1:0].
---
 gcc/algol68/a68-low-multiples.cc | 56 ++++++++++++++++++++++++++++++++
 gcc/algol68/a68-low-units.cc     | 26 +++++++++++++--
 gcc/algol68/a68.h                |  1 +
 3 files changed, 80 insertions(+), 3 deletions(-)

diff --git a/gcc/algol68/a68-low-multiples.cc b/gcc/algol68/a68-low-multiples.cc
index 0432bf56516..58ae45d59d7 100644
--- a/gcc/algol68/a68-low-multiples.cc
+++ b/gcc/algol68/a68-low-multiples.cc
@@ -802,3 +802,59 @@ a68_rows_upper_bound (tree rows, tree dim)
 {
   return rows_lower_or_upper_bound (rows, dim, true);
 }
+
+/* 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.
+
+   DIM must be a sizetype.
+   MULTIPLE must be a multiple value.
+   INDEX must be a ssizetype.
+
+   The parse tree node P is used as the source for the filename and line number
+   passed to the run-time function.  */
+
+tree
+a68_multiple_bounds_check (NODE_T *p, tree dim,
+			   tree multiple, tree index)
+{
+  index = save_expr (index);
+  multiple = save_expr (multiple);
+
+  tree upper_bound = a68_multiple_upper_bound (multiple, dim);
+  tree lower_bound = a68_multiple_lower_bound (multiple, dim);
+
+  /* Build the call to ARRAYBOUNDS. */
+  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_ARRAYBOUNDS,
+				 void_type_node, 5,
+				 filename,
+				 build_int_cst (unsigned_type_node, lineno),
+				 fold_convert (ssizetype, index),
+				 fold_convert (ssizetype, lower_bound),
+				 fold_convert (ssizetype, upper_bound));
+  call = fold_build2 (COMPOUND_EXPR, a68_bool_type, call, boolean_false_node);
+
+  /* If LB > UB, the dimension contains no elements.
+     Otherwise, it must hold IDX >= LB && IDX <= UB */
+  tree bounds_check = fold_build2 (TRUTH_AND_EXPR, sizetype,
+				   fold_build2 (LE_EXPR, ssizetype,
+						lower_bound, upper_bound),
+				   fold_build2 (TRUTH_AND_EXPR,
+						boolean_type_node,
+						fold_build2 (GE_EXPR, ssizetype,
+							     fold_convert (ssizetype,
+									   index),
+							     lower_bound),
+						fold_build2 (LE_EXPR, ssizetype,
+							     fold_convert (ssizetype,
+									   index),
+							     upper_bound)));
+  return fold_build2_loc (a68_get_node_location (p),
+			  TRUTH_ORIF_EXPR,
+			  ssizetype,
+			  bounds_check, call);
+}
diff --git a/gcc/algol68/a68-low-units.cc b/gcc/algol68/a68-low-units.cc
index 1c0381843fa..8505d8c6e39 100644
--- a/gcc/algol68/a68-low-units.cc
+++ b/gcc/algol68/a68-low-units.cc
@@ -451,7 +451,9 @@ lower_subscript_for_trimmers (NODE_T *p, LOW_CTX_T ctx,
 	    tree dim_lower_bound = save_expr (a68_multiple_lower_bound (multiple, size_dim));
 	    tree stride = save_expr (a68_multiple_stride (multiple, size_dim));
 
-	    /* XXX validate bounds.  */
+	    /* Validate bounds.  */
+	    if (OPTION_BOUNDS_CHECKING (&A68_JOB))
+	      a68_add_stmt (a68_multiple_bounds_check (p, size_dim, multiple, unit));
 
 	    /* new_elements += i * strides[dim] */
 	    tree offset = fold_build2 (MULT_EXPR, sizetype,
@@ -540,8 +542,26 @@ 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.  */
-	    // XXX validate bounds
+	       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.  */
+	    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);
+	      }
 
 	    /* new_elements += i * strides[dim] */
 	    tree stride = save_expr (a68_multiple_stride (multiple, size_dim));
diff --git a/gcc/algol68/a68.h b/gcc/algol68/a68.h
index 74c0f53592f..6fdcd2a0780 100644
--- a/gcc/algol68/a68.h
+++ b/gcc/algol68/a68.h
@@ -623,6 +623,7 @@ 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);
 
 /* a68-low-ranges.cc  */
 
-- 
2.30.2