[COMMITTED] algol68: perform dimension checking on rows and multiples
Jose E. Marchesi
jemarch@gnu.org
Wed Mar 19 10:22:37 GMT 2025
---
gcc/algol68/a68-low-multiples.cc | 95 +++++++++++++++++++++++++++-----
gcc/algol68/a68-low-prelude.cc | 47 +++++++++-------
gcc/algol68/a68-low-runtime.def | 2 +
gcc/algol68/a68.h | 2 +
libga68/ga68-error.c | 10 ++++
libga68/ga68.h | 2 +
6 files changed, 126 insertions(+), 32 deletions(-)
diff --git a/gcc/algol68/a68-low-multiples.cc b/gcc/algol68/a68-low-multiples.cc
index d86ecbffd90..12e03881d2b 100644
--- a/gcc/algol68/a68-low-multiples.cc
+++ b/gcc/algol68/a68-low-multiples.cc
@@ -229,7 +229,8 @@ multiple_triplet (tree exp, tree dim)
NULL_TREE);
}
-/* Return the lower bound of dimension DIM of the multiple EXP. */
+/* Return the lower bound of dimension DIM of the multiple EXP. The returned
+ value is a ssizetype. */
tree
a68_multiple_lower_bound (tree exp, tree dim)
@@ -259,7 +260,8 @@ a68_multiple_set_lower_bound (tree exp, tree dim, tree bound)
bound);
}
-/* Return the upper bound of dimension DIM of the multiple EXP. */
+/* Return the upper bound of dimension DIM of the multiple EXP. The returned
+ value is a ssizetype. */
tree
a68_multiple_upper_bound (tree exp, tree dim)
@@ -763,8 +765,9 @@ a68_rows_value (tree multiple)
}
/* Given a rows value and a dimension number, return the upper bound or the
- lower of the given dimension. DIM must be a sizetype. This function does
- bound checking. */
+ lower of the given dimension. The returned bound is a ssizetype.
+
+ DIM must be a sizetype. */
static tree
rows_lower_or_upper_bound (tree rows, tree dim, bool upper)
@@ -780,23 +783,28 @@ rows_lower_or_upper_bound (tree rows, tree dim, bool upper)
tree triplet_offset = fold_build2 (MULT_EXPR, sizetype,
dim,
size_in_bytes (triplet_type));
- /* XXX add dimension checking */
- return fold_build3 (COMPONENT_REF, ssizetype,
- fold_build1 (INDIRECT_REF, triplet_type,
- fold_build2 (POINTER_PLUS_EXPR,
- triplet_pointer_type,
- triplets,
- triplet_offset)),
- upper ? triplet_ub_field : triplet_lb_field,
- NULL_TREE);
+ tree bound = fold_build3 (COMPONENT_REF, ssizetype,
+ fold_build1 (INDIRECT_REF, triplet_type,
+ fold_build2 (POINTER_PLUS_EXPR,
+ triplet_pointer_type,
+ triplets,
+ triplet_offset)),
+ upper ? triplet_ub_field : triplet_lb_field,
+ NULL_TREE);
+
+ return bound;
}
+/* Return the lower bound of dimension DIM of ROWS. */
+
tree
a68_rows_lower_bound (tree rows, tree dim)
{
return rows_lower_or_upper_bound (rows, dim, false);
}
+/* Return the upper bound of dimension DIM of ROWS. */
+
tree
a68_rows_upper_bound (tree rows, tree dim)
{
@@ -851,6 +859,67 @@ a68_multiple_single_bound_check (NODE_T *p, tree dim,
bounds_check, call);
}
+/* Return a tree that checks whether the given DIM is a valid dimension/rank of
+ a boundable object with dimension BOUNDABLE_DIM. If the provided DIM is not
+ a valid dimention then a call to the run-time function ARRAYDIM is
+ performed.
+
+ BOUNDABLE_DIM and DIM must be of type sizetype. They are both one-based.
+
+ The parse tree node P is used as the source for the filename and line number
+ passed to the run-time function. */
+
+static tree
+a68_boundable_dim_check (NODE_T *p, tree boundable_dim, tree dim)
+{
+ boundable_dim = save_expr (boundable_dim);
+ dim = save_expr (dim);
+
+ /* Build the call to ARRAYDIM. */
+ 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_ARRAYDIM,
+ void_type_node, 4,
+ filename,
+ build_int_cst (unsigned_type_node, lineno),
+ boundable_dim, dim);
+ call = fold_build2 (COMPOUND_EXPR, a68_bool_type, call, boolean_false_node);
+
+ tree dim_check = fold_build2 (LE_EXPR, sizetype, dim, boundable_dim);
+ return fold_build2_loc (a68_get_node_location (p),
+ TRUTH_ORIF_EXPR,
+ ssizetype,
+ dim_check, call);
+}
+
+/* Return a tree that checks whether the given DIM is a valid dimension/rank of
+ the given rows value ROWS.
+
+ DIM is a sizetype.
+ The parse tree node P is used as the source for the filename and line
+ number. */
+
+tree
+a68_rows_dim_check (NODE_T *p, tree rows, tree dim)
+{
+ return a68_boundable_dim_check (p, a68_rows_dim (rows), dim);
+}
+
+/* Return a tree that checks whether the given DIM is a valid dimension/rank of
+ the given multiple value MULTIPLE.
+
+ DIM is a sizetype.
+ The parse tree node P is used as the source for the filename and line
+ number. */
+
+tree
+a68_multiple_dim_check (NODE_T *p, tree multiple, tree dim)
+{
+ return a68_boundable_dim_check (p, a68_multiple_dimensions (multiple), dim);
+}
+
/* 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-prelude.cc b/gcc/algol68/a68-low-prelude.cc
index c7874e6135e..31d51e4e4ce 100644
--- a/gcc/algol68/a68-low-prelude.cc
+++ b/gcc/algol68/a68-low-prelude.cc
@@ -513,25 +513,29 @@ a68_lower_divab3 (NODE_T *p, LOW_CTX_T ctx)
The binary operator returns the upper bound of the given dimension of the
operand multiple. The dimension is one-based. If the specified dimension
- is out of bounds then an a run-time error is raised (XXX). */
+ is out of bounds then an a run-time error is raised. */
static tree
-upb (tree boundable, tree dim)
+upb (NODE_T *p, tree boundable, tree dim)
{
- /* Make DIM zero based. */
- dim = fold_build2 (MINUS_EXPR, TREE_TYPE (dim), dim, size_one_node);
+ boundable = save_expr (boundable);
+ dim = save_expr (dim);
/* BOUNDABLE can be a multiple or a ROWS. */
+ tree zero_based_dim
+ = save_expr (fold_build2 (MINUS_EXPR, TREE_TYPE (dim), dim, size_one_node));
tree type = TREE_TYPE (boundable);
if (A68_ROW_TYPE_P (type))
{
- /* XXX check dimension at run-time. */
- return a68_multiple_upper_bound (boundable, dim);
+ return fold_build2 (COMPOUND_EXPR, ssizetype,
+ a68_multiple_dim_check (p, boundable, dim),
+ a68_multiple_upper_bound (boundable, zero_based_dim));
}
else if (A68_ROWS_TYPE_P (type))
{
- /* Fetch requested bound from the rows value. */
- return a68_rows_upper_bound (boundable, dim);
+ return fold_build2 (COMPOUND_EXPR, ssizetype,
+ a68_rows_dim_check (p, boundable, dim),
+ a68_rows_upper_bound (boundable, zero_based_dim));
}
else
gcc_unreachable ();
@@ -541,7 +545,7 @@ tree
a68_lower_upb2 (NODE_T *p, LOW_CTX_T ctx)
{
tree multiple = a68_lower_tree (NEXT (SUB (p)), ctx);
- return fold_convert (CTYPE (MOID (p)), upb (multiple, size_one_node));
+ return fold_convert (CTYPE (MOID (p)), upb (p, multiple, size_one_node));
}
tree
@@ -549,7 +553,7 @@ a68_lower_upb3 (NODE_T *p, LOW_CTX_T ctx)
{
tree dim = fold_convert (sizetype, a68_lower_tree (SUB (p), ctx));
tree multiple = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
- return fold_convert (CTYPE (MOID (p)), upb (multiple, dim));
+ return fold_convert (CTYPE (MOID (p)), upb (p, multiple, dim));
}
/* LWB comes in two flavors.
@@ -559,25 +563,30 @@ a68_lower_upb3 (NODE_T *p, LOW_CTX_T ctx)
The binary operator returns the lower bound of the given dimension of the
operand multiple. The dimension is one-based. If the specified dimension
- is out of bounds then an a run-time error is raised (XXX). */
+ is out of bounds then an a run-time error is raised. */
static tree
-lwb (tree boundable, tree dim)
+lwb (NODE_T *p, tree boundable, tree dim)
{
- /* Make DIM zero based. */
- dim = fold_build2 (MINUS_EXPR, TREE_TYPE (dim), dim, size_one_node);
+ boundable = save_expr (boundable);
+ dim = save_expr (dim);
/* BOUNDABLE can be a multiple or an union whose all alternatives yield a
multiple. */
+ tree zero_based_dim
+ = save_expr (fold_build2 (MINUS_EXPR, TREE_TYPE (dim), dim, size_one_node));
tree type = TREE_TYPE (boundable);
if (A68_ROW_TYPE_P (type))
{
- /* XXX check dimension at run-time. */
- return a68_multiple_lower_bound (boundable, dim);
+ return fold_build2 (COMPOUND_EXPR, ssizetype,
+ a68_multiple_dim_check (p, boundable, dim),
+ a68_multiple_lower_bound (boundable, zero_based_dim));
}
else if (A68_ROWS_TYPE_P (type))
{
- return a68_rows_lower_bound (boundable, dim);
+ return fold_build2 (COMPOUND_EXPR, ssizetype,
+ a68_rows_dim_check (p, boundable, dim),
+ a68_rows_lower_bound (boundable, zero_based_dim));
}
else
gcc_unreachable ();
@@ -587,7 +596,7 @@ tree
a68_lower_lwb2 (NODE_T *p, LOW_CTX_T ctx)
{
tree multiple = a68_lower_tree (NEXT (SUB (p)), ctx);
- return fold_convert (CTYPE (MOID (p)), lwb (multiple, size_one_node));
+ return fold_convert (CTYPE (MOID (p)), lwb (p, multiple, size_one_node));
}
tree
@@ -595,7 +604,7 @@ a68_lower_lwb3 (NODE_T *p, LOW_CTX_T ctx)
{
tree dim = fold_convert (sizetype, a68_lower_tree (SUB (p), ctx));
tree multiple = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
- return fold_convert (CTYPE (MOID (p)), lwb (multiple, dim));
+ return fold_convert (CTYPE (MOID (p)), lwb (p, multiple, dim));
}
/* ELEMS comes in two flavors.
diff --git a/gcc/algol68/a68-low-runtime.def b/gcc/algol68/a68-low-runtime.def
index ccda530e8e3..3740eb1ffa7 100644
--- a/gcc/algol68/a68-low-runtime.def
+++ b/gcc/algol68/a68-low-runtime.def
@@ -50,6 +50,8 @@ 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 (ARRAYDIM, "_libga68_dim", RT(VOID),
+ P4(CONSTCHARPTR, UINT, SIZE, SIZE), ECF_NORETURN)
DEF_A68_RUNTIME (RANDOM, "_libga68_random", RT(FLOAT), P0(), 0)
DEF_A68_RUNTIME (LONGRANDOM, "_libga68_longrandom", RT(DOUBLE), P0(), 0)
DEF_A68_RUNTIME (LONGLONGRANDOM, "_libga68_longlongrandom", RT(LONGDOUBLE), P0(), 0)
diff --git a/gcc/algol68/a68.h b/gcc/algol68/a68.h
index 730ec13e890..1b0fd18d0db 100644
--- a/gcc/algol68/a68.h
+++ b/gcc/algol68/a68.h
@@ -623,6 +623,8 @@ 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_rows_dim_check (NODE_T *p, tree rows, tree dim);
+tree a68_multiple_dim_check (NODE_T *p, tree multiple, tree dim);
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,
diff --git a/libga68/ga68-error.c b/libga68/ga68-error.c
index 4a538afca64..0ca41f9a250 100644
--- a/libga68/ga68-error.c
+++ b/libga68/ga68-error.c
@@ -112,3 +112,13 @@ _libga68_bounds (const char *filename, unsigned int lineno,
_libga68_abort ("%s:%d: runtime error: bound %d out of range [%d:%d]\n",
filename, lineno, index, lower_bound, upper_bound);
}
+
+/* Dimension failure. */
+
+void
+_libga68_dim (const char *filename, unsigned int lineno,
+ size_t dim, size_t index)
+{
+ _libga68_abort ("%s:%d: runtime error: invalid dimension %d; shall be <= %d\n",
+ filename, lineno, index, dim);
+}
diff --git a/libga68/ga68.h b/libga68/ga68.h
index e8f3fc38654..5a27e9f57b4 100644
--- a/libga68/ga68.h
+++ b/libga68/ga68.h
@@ -45,6 +45,8 @@ 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);
+void _libga68_dim (const char *filename, unsigned int lineno,
+ size_t dim, size_t index);
/* ga68-alloc.c */
--
2.30.2
More information about the Algol68
mailing list