[PATCH] algol68: Add runtime bounds checks for row displays
Jose E. Marchesi
jemarch@gnu.org
Sat Aug 29 18:06:31 GMT 2026
> Hi Jose,
>
> No problem! Here is the patch.
>
> As mentioned in my previous email, the patch is not working as expected
> because the variable dim is equal to 1 even for:
>
> begin [,]int foo = ((1,2,3),
> (4,5));
>
> skip
>
> end
>
> I am having some trouble understanding why this is happening. Could you
> please help me understand this?
There are three row displays involved in that example:
(1,2,3) with mode []int and DIM 1
(4,5) with mode []int and DIM 1
((1,2,3),(4,5)) with mode [,]int and DIM 2
> From 8444a870bfe406533e0a1e55672766c89018f88f Mon Sep 17 00:00:00 2001
> From: Kanishka Solanki <kanishkasolanki456s@gmail.com>
> Date: Sat, 4 Jul 2026 02:33:42 +0530
> Subject: [PATCH] algol68: Add runtime bounds checks for row displays
>
> Introduce a68_lower_row_display to lower multidimensional row
> displays. Move the lowering logic for multidimensional row displays
> out of a68_lower_collateral_clause into this helper.
>
> While lowering, compare the descriptor of each sub-multiple against
> that of the first sub-multiple. Report a runtime error if the lower
> bound, upper bound, or stride differs.
>
> Signed-off-by: Kanishka Solanki <kanishkasolanki456s@gmail.com>
>
> gcc/algol68/
> * a68-low-clauses.cc (a68_lower_row_display): New helper to
> lower multidimensional row displays and check descriptor
> consistency.
> (a68_lower_collateral_clause): Use a68_lower_row_display for
> multidimensional row displays.
> * a68-low-runtime.def
> (A68_LIBCALL_ROWDISPLAYBOUNDSMISMATCH): New libcall.
>
> libga68/
> * ga68-error.c (libga68_rowdisplayboundsmismatch): New.
> ---
> gcc/algol68/a68-low-clauses.cc | 329 +++++++++++++++++++-------------
> gcc/algol68/a68-low-runtime.def | 2 +
> libga68/ga68-error.c | 13 ++
> libga68/ga68.h | 3 +
> libga68/ga68.map | 1 +
> 5 files changed, 217 insertions(+), 131 deletions(-)
>
> diff --git a/gcc/algol68/a68-low-clauses.cc b/gcc/algol68/a68-low-clauses.cc
> index 29ccc43b076..652ceb23a98 100644
> --- a/gcc/algol68/a68-low-clauses.cc
> +++ b/gcc/algol68/a68-low-clauses.cc
> @@ -41,7 +41,6 @@
> #include "convert.h"
>
> #include "a68.h"
> -
> /* Given a serial_clause node P, return whether it performs dynamic stack
> allocations.
>
> @@ -1053,6 +1052,201 @@ a68_lower_unit_list (NODE_T *p, LOW_CTX_T ctx)
> return NULL_TREE;
> }
>
> +/* Lower a multidimensional row display.
> +
> + Lower each constituent row, verify that all inner row descriptors
> + match, copy their elements into a new multiple, and return the
> + resulting row value. */
> +
> +static tree
> +a68_lower_row_display (NODE_T *unit_list, NODE_T *p, LOW_CTX_T ctx)
> +{
> + MOID_T *mode = MOID (p);
> + tree row_type = CTYPE (mode);
> + size_t dim = DIM (DEFLEX (mode));
> + bool first = true;
> + tree *lower_bounds = (tree *) xmalloc(sizeof(tree) * dim);
> + tree *upper_bounds = (tree *) xmalloc(sizeof(tree) * dim);
> + tree sub_multiple_lb = NULL_TREE;
> + tree sub_multiple_ub = NULL_TREE;
> + tree sub_multiple_stride = NULL_TREE;
> +
> + tree multiple_elements = NULL_TREE;
> + tree multiple_elements_size = NULL_TREE;
> +
> + size_t num_units = 0;
> + for (NODE_T *s = SUB(unit_list); s != NO_NODE; FORWARD(s))
> + {
> + if (IS(s, UNIT))
> + {
> + num_units++;
> + }
> + }
> +
> + a68_push_range(mode);
> +
> + tree index = a68_lower_tmpvar("index%",
> + sizetype,
> + size_zero_node);
> + tree ssize_zero_node = fold_convert(ssizetype, size_zero_node);
> + for (NODE_T *s = SUB(unit_list); s != NO_NODE; FORWARD(s))
> + {
> + if (IS(s, UNIT))
> + {
> + tree elem = a68_lower_tree(s, ctx);
> + if(first)
> + {
> + first = false;
> + sub_multiple_lb
> + = a68_lower_tmpvar ("sub_multiple_lb%",
> + ssizetype,
> + a68_multiple_lower_bound (elem,
> + ssize_zero_node));
> + sub_multiple_ub
> + = a68_lower_tmpvar ("sub_multiple_ub%",
> + ssizetype,
> + a68_multiple_upper_bound (elem,
> + ssize_zero_node));
> + sub_multiple_stride
> + = a68_lower_tmpvar ("sub_multiple_stride%",
> + sizetype,
> + a68_multiple_stride (elem,
> + size_zero_node));
> + tree sub_multiple_elements
> + = a68_multiple_elements (elem);
> + tree elements_pointer_type
> + = TREE_TYPE (sub_multiple_elements);
> + tree elements_type
> + = TREE_TYPE (elements_pointer_type);
> + MOID_T *elements_moid
> + = a68_type_moid (elements_type);
> +
> + multiple_elements_size = fold_build2 (
> + MULT_EXPR,
> + sizetype,
> + size_int (num_units),
> + size_in_bytes (elements_type));
> +
> + multiple_elements_size = fold_build2 (
> + MULT_EXPR,
> + sizetype,
> + multiple_elements_size,
> + a68_multiple_num_elems (elem));
> +
> + multiple_elements = a68_lower_tmpvar (
> + "multiple_elements%",
> + elements_pointer_type,
> + a68_lower_alloca (
> + elements_moid,
> + multiple_elements_size));
> + lower_bounds[0] = fold_convert (ssizetype, size_one_node);
> + upper_bounds[0] = ssize_int (num_units);
> + for (size_t d = 1; d < dim; ++d)
> + {
> + lower_bounds[d] = a68_multiple_lower_bound (elem,
> + ssize_int (d - 1));
> + upper_bounds[d] = a68_multiple_upper_bound (elem,
> + ssize_int (d - 1));
> + }
> + }
> + else
> + {
> + tree current_lb = a68_lower_tmpvar ("current_lb%",
> + ssizetype,
> + a68_multiple_lower_bound (elem,
> + size_zero_node));
> + tree current_ub = a68_lower_tmpvar ("current_ub%",
> + ssizetype,
> + a68_multiple_upper_bound (elem,
> + size_zero_node));
> + tree current_stride = a68_lower_tmpvar ("current_stride%",
> + sizetype,
> + a68_multiple_stride (elem,
> + size_zero_node));
> + tree lb_equal = fold_build2 (EQ_EXPR,
> + boolean_type_node,
> + current_lb,
> + sub_multiple_lb);
> + tree ub_equal = fold_build2 (EQ_EXPR,
> + boolean_type_node,
> + current_ub,
> + sub_multiple_ub);
> + tree stride_equal = fold_build2 (EQ_EXPR,
> + boolean_type_node,
> + current_stride,
> + sub_multiple_stride);
> + tree bounds_equal = fold_build2 (TRUTH_AND_EXPR,
> + boolean_type_node,
> + lb_equal,
> + ub_equal);
> + tree descriptors_equal = fold_build2 (TRUTH_AND_EXPR,
> + boolean_type_node,
> + bounds_equal,
> + stride_equal);
> + unsigned int lineno = NUMBER (LINE (INFO (s)));
> + const char *filename_str = FILENAME (LINE (INFO (s)));
> + tree filename = build_string_literal (strlen (filename_str) + 1,
> + filename_str);
> + tree call = a68_build_libcall (A68_LIBCALL_ROWDISPLAYBOUNDSMISMATCH,
> + void_type_node, 6,
> + filename,
> + build_int_cst (unsigned_type_node, lineno),
> + fold_convert (ssizetype, current_lb),
> + fold_convert (ssizetype, current_ub),
> + fold_convert (ssizetype, sub_multiple_lb),
> + fold_convert (ssizetype, sub_multiple_ub));
> + call = fold_build2 (COMPOUND_EXPR,
> + a68_bool_type,
> + call,
> + boolean_false_node);
> + tree check = fold_build2 (TRUTH_ORIF_EXPR,
> + Your nesting at the bottom is: boolean_type_node,
> + descriptors_equal,
> + call);
> + a68_add_stmt (check);
> + }
> + /* Copy the elements of a copy of the sub-multiple in the
> + elements of the multiple. */
> + tree sub_multiple_elements = a68_multiple_elements (elem);
> +
> + // XXX should we make a copy of the sub_multiple_elements here?
> + // We DO need to iterate slicing, because of strides: if
> + // the sub_multiple is a trimmer.
> + tree sub_multiple_elements_type = TREE_TYPE (sub_multiple_elements);
> + tree sub_multiple_num_elems = a68_multiple_num_elems (elem);
> + tree sub_multiple_element_type = TREE_TYPE (sub_multiple_elements_type);
> + tree sub_multiple_elements_size = fold_build2 (MULT_EXPR, sizetype,
> + sub_multiple_num_elems,
> + size_in_bytes (sub_multiple_element_type));
> +
> + /* memcpy (multiple_elements[index], sub_multiple_elements) */
> + a68_add_stmt (a68_lower_memcpy (fold_build2 (POINTER_PLUS_EXPR,
> + sub_multiple_elements_type,
> + multiple_elements,
> + index),
> + sub_multiple_elements,
> + sub_multiple_elements_size));
> + /* index += sub_multiple_elements_size */
> + a68_add_stmt (fold_build2 (MODIFY_EXPR, sizetype,
> + index,
> + fold_build2 (PLUS_EXPR, sizetype,
> + index, sub_multiple_elements_size)));
> + }
> + }
> + tree multiple = a68_lower_tmpvar ("multiple%",
> + row_type,
> + a68_row_value (row_type, dim,
> + multiple_elements,
> + multiple_elements_size,
> + lower_bounds, upper_bounds));
> + free (lower_bounds);
> + free (upper_bounds);
> +
> + /* Yield the multiple. */
> + a68_add_stmt (multiple);
> + return a68_pop_range ();
> +}
> +
> /* Lower a collateral clause.
>
> collateral clause : open symbol, unit list, close symbol;
> @@ -1128,7 +1322,6 @@ a68_lower_collateral_clause (NODE_T *p ATTRIBUTE_UNUSED,
> free (upper_bounds);
> return row;
> }
> -
> if (dim == 1)
> {
> /* Create a constructor with the multiple's elements. */
> @@ -1161,8 +1354,7 @@ a68_lower_collateral_clause (NODE_T *p ATTRIBUTE_UNUSED,
> &lower_bound, &upper_bound);
> return row;
> }
> - else
> - {
> + else {
> gcc_assert (dim > 1);
>
> /* The units in the collateral clause are multiples, whose elements
> @@ -1194,140 +1386,15 @@ a68_lower_collateral_clause (NODE_T *p ATTRIBUTE_UNUSED,
> ((1, 2, 3), (4, 5, 6))
> {triplets: {{lb: 1 ub: 2 stride: 3S}, {lb: 1 ub: 3 stride: 1S}}
> elements: {1, 2, 3, 4, 5, 6}} */
> -
> - tree *lower_bounds = (tree *) xmalloc (sizeof (tree) * dim);
> - tree *upper_bounds = (tree *) xmalloc (sizeof (tree) * dim);
> - size_t num_units = 0;
> -
> - for (tree_stmt_iterator si = tsi_start (units); !tsi_end_p (si); tsi_next (&si))
> - num_units++;
> -
> - a68_push_range (mode);
> -
> - /* Process each sub-multiple. The first sub-multiple establishes the
> - bounds that all subsequent sub-multiples shall match. */
> - tree multiple_elements = NULL_TREE;
> - tree multiple_elements_size = NULL_TREE;
> - tree sub_multiple = NULL_TREE;
> - // tree sub_multiple_lb = NULL_TREE;
> - // tree sub_multiple_ub = NULL_TREE;
> - // tree sub_multiple_stride = NULL_TREE;
> - tree index = a68_lower_tmpvar ("index%", sizetype, size_zero_node);
> - for (tree_stmt_iterator si = tsi_start (units); !tsi_end_p (si); tsi_next (&si))
> - {
> - if (sub_multiple == NULL)
> - sub_multiple = a68_lower_tmpvar ("sub_multiple%",
> - TREE_TYPE (tsi_stmt (si)),
> - tsi_stmt (si));
> - else
> - a68_add_stmt (fold_build2 (MODIFY_EXPR,
> - TREE_TYPE (tsi_stmt (si)),
> - sub_multiple,
> - tsi_stmt (si)));
> -
> - if (si == tsi_start (units))
> - {
> -#if 0
> - tree ssize_zero_node = fold_convert (ssizetype, size_zero_node);
> - /* The first sub-multiple establishes the bounds that all
> - subsequent sub-multiples shall match. */
> - sub_multiple_lb = a68_lower_tmpvar ("sub_multiple_lb%",
> - ssizetype,
> - a68_multiple_lower_bound (sub_multiple,
> - ssize_zero_node));
> - sub_multiple_ub = a68_lower_tmpvar ("sub_multiple_ub%",
> - ssizetype,
> - a68_multiple_upper_bound (sub_multiple,
> - ssize_zero_node));
> - sub_multiple_stride = a68_lower_tmpvar ("sub_multiple_stride%",
> - sizetype,
> - a68_multiple_stride (sub_multiple,
> - size_zero_node));
> -#endif
> - /* Now we have enough information to calculate the size of
> - the elements of the new multiple and allocate
> - multiple_elements. */
> - tree sub_multiple_elements = a68_multiple_elements (sub_multiple);
> - tree elements_pointer_type = TREE_TYPE (sub_multiple_elements);
> - tree elements_type = TREE_TYPE (elements_pointer_type);
> - MOID_T *elements_moid = a68_type_moid (elements_type);
> - multiple_elements_size = fold_build2 (MULT_EXPR, sizetype,
> - size_int (num_units),
> - size_in_bytes (elements_type));
> - multiple_elements_size = fold_build2 (MULT_EXPR, sizetype,
> - multiple_elements_size,
> - a68_multiple_num_elems (sub_multiple));
> - multiple_elements = a68_lower_tmpvar ("multiple_elements%",
> - elements_pointer_type,
> - a68_lower_alloca (elements_moid,
> - multiple_elements_size));
> -
> /* We can also now calculate the bounds of the new multiple.
> The top-level triplet has lower bound 1, upper bound is
> num_units, and stride is the number of elements in each
> sub-multiple multiplied by the element size. Bounds for
> the subsequent DIM-1 dimensions are copied from the
> sub-multiple's descriptor. */
> - lower_bounds[0] = fold_convert (ssizetype, size_one_node);
> - upper_bounds[0] = ssize_int (num_units);
> - for (size_t d = 1; d < dim; ++d)
> - {
> - lower_bounds[d] = a68_multiple_lower_bound (sub_multiple,
> - ssize_int (d - 1));
> - upper_bounds[d] = a68_multiple_upper_bound (sub_multiple,
> - ssize_int (d - 1));
> - }
> - }
> - else
> - {
> - /* Check bounds of this sub-multiple. Note that this is
> - always done at run-time, since the interpretation of a row
> - display depens on the target type, whether it is a row row
> - or a row of rows, for example. */
> - // XXX use sub_multiple_lb, sub_multiple_ub and sub_multiple_stride
> - }
> -
> - /* Copy the elements of a copy of the sub-multiple in the
> - elements of the multiple. */
> - tree sub_multiple_elements = a68_multiple_elements (sub_multiple);
> - // XXX should we make a copy of the sub_multiple_elements here?
> - // We DO need to iterate slicing, because of strides: if
> - // the sub_multiple is a trimmer.
> - tree sub_multiple_elements_type = TREE_TYPE (sub_multiple_elements);
> - tree sub_multiple_num_elems = a68_multiple_num_elems (sub_multiple);
> - tree sub_multiple_element_type = TREE_TYPE (sub_multiple_elements_type);
> - tree sub_multiple_elements_size = fold_build2 (MULT_EXPR, sizetype,
> - sub_multiple_num_elems,
> - size_in_bytes (sub_multiple_element_type));
> -
> - /* memcpy (multiple_elements[index], sub_multiple_elements) */
> - a68_add_stmt (a68_lower_memcpy (fold_build2 (POINTER_PLUS_EXPR,
> - sub_multiple_elements_type,
> - multiple_elements,
> - index),
> - sub_multiple_elements,
> - sub_multiple_elements_size));
> - /* index += sub_multiple_elements_size */
> - a68_add_stmt (fold_build2 (MODIFY_EXPR, sizetype,
> - index,
> - fold_build2 (PLUS_EXPR, sizetype,
> - index, sub_multiple_elements_size)));
> - }
> -
> - tree multiple = a68_lower_tmpvar ("multiple%",
> - row_type,
> - a68_row_value (row_type, dim,
> - multiple_elements,
> - multiple_elements_size,
> - lower_bounds, upper_bounds));
> - free (lower_bounds);
> - free (upper_bounds);
> -
> - /* Yield the multiple. */
> - a68_add_stmt (multiple);
> - return a68_pop_range ();
> + return a68_lower_row_display (NEXT (SUB (p)), p, ctx);
> }
> - }
> + }
> else if (IS_STRUCT (mode))
> {
> /* This is a struct display. There are as many units in the clause as
> diff --git a/gcc/algol68/a68-low-runtime.def b/gcc/algol68/a68-low-runtime.def
> index 5f12906a0ce..a3a0ab505aa 100644
> --- a/gcc/algol68/a68-low-runtime.def
> +++ b/gcc/algol68/a68-low-runtime.def
> @@ -56,6 +56,8 @@ DEF_A68_RUNTIME (ARRAYBOUNDS, "_libga68_bounds", RT(VOID),
> P5(CONSTCHARPTR, UINT, SSIZE, SSIZE, SSIZE), ECF_NORETURN)
> DEF_A68_RUNTIME (ARRAYBOUNDSMISMATCH, "_libga68_bounds_mismatch", RT(VOID),
> P7(CONSTCHARPTR, UINT, SIZE, SSIZE, SSIZE, SSIZE, SSIZE), ECF_NORETURN)
> +DEF_A68_RUNTIME (ROWDISPLAYBOUNDSMISMATCH, "_libga68_row_display_bounds_mismatch", RT(VOID),
> + P6(CONSTCHARPTR, UINT, SSIZE, SSIZE, SSIZE, SSIZE), 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)
> diff --git a/libga68/ga68-error.c b/libga68/ga68-error.c
> index 1bb0530ffdc..d3b80f67ab5 100644
> --- a/libga68/ga68-error.c
> +++ b/libga68/ga68-error.c
> @@ -150,3 +150,16 @@ _libga68_bounds_mismatch (const char *filename, unsigned int lineno,
> assignation: dim %zu: [%zd:%zd] /= [%zd:%zd]\n",
> filename, lineno, dim, lb1, ub1, lb2, ub2);
> }
> +
> +/* Row display sub-multiples have different bounds. */
> +
> +void
> +_libga68_row_display_bounds_mismatch (const char *filename,
> + unsigned int lineno,
> + ssize_t lb1, ssize_t ub1,
> + ssize_t lb2, ssize_t ub2)
> +{
> + _libga68_abort ("%s:%u: runtime error: row display bounds mismatch: "
> + "[%zd:%zd] /= [%zd:%zd]\n",
> + filename, lineno, lb1, ub1, lb2, ub2);
> +}
> \ No newline at end of file
> diff --git a/libga68/ga68.h b/libga68/ga68.h
> index 9c104e60437..0571ce53ee9 100644
> --- a/libga68/ga68.h
> +++ b/libga68/ga68.h
> @@ -65,6 +65,9 @@ void _libga68_dim (const char *filename, unsigned int lineno,
> void _libga68_bounds_mismatch (const char *filename, unsigned int lineno,
> size_t dim, ssize_t lb1, ssize_t ub1,
> ssize_t lb2, ssize_t ub2);
> +void _libga68_row_display_bounds_mismatch (const char *filename, unsigned int lineno,
> + ssize_t lb1, ssize_t ub1,
> + ssize_t lb2, ssize_t ub2);
>
> /* ga68-alloc.c */
>
> diff --git a/libga68/ga68.map b/libga68/ga68.map
> index 57610931961..44d2619157c 100644
> --- a/libga68/ga68.map
> +++ b/libga68/ga68.map
> @@ -4,6 +4,7 @@ LIBGA68_2.0 {
> _libga68_bitsboundserror;
> _libga68_bounds;
> _libga68_bounds_mismatch;
> + _libga68_row_display_bounds_mismatch;
> _libga68_derefnil;
> _libga68_dim;
> _libga68_invalidcharerror;
More information about the Algol68
mailing list