path: root/gcc/algol68/a68-low-multiples.cc

/* Lowering routines for all things related to multiples.
   Copyright (C) 2025 Jose E. Marchesi.

   Written by Jose E. Marchesi.

   GCC is free software; you can redistribute it and/or modify it
   under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 3, or (at your option)
   any later version.

   GCC is distributed in the hope that it will be useful, but WITHOUT
   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
   or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
   License for more details.

   You should have received a copy of the GNU General Public License
   along with GCC; see the file COPYING3.  If not see
   <http://www.gnu.org/licenses/>.  */

#define INCLUDE_MEMORY
#include "config.h"
#include "system.h"
#include "coretypes.h"

#include "tree.h"
#include "fold-const.h"
#include "diagnostic.h"
#include "langhooks.h"
#include "tm.h"
#include "function.h"
#include "cgraph.h"
#include "toplev.h"
#include "varasm.h"
#include "predict.h"
#include "stor-layout.h"
#include "tree-iterator.h"
#include "stringpool.h"
#include "print-tree.h"
#include "gimplify.h"
#include "dumpfile.h"
#include "convert.h"

#include "a68.h"

/* Algol 68 multiples are multi-dimensional and dynamically sized. They have a
   static part and a dynamic part.  The static part is conformed by a
   "descriptor", which contains information about each of the dimensions, and a
   pointer to the actual elements stored in the multiple.  The dynamic part are
   the elements, which are stored in column order.  Both the descriptor and the
   elements may reside on the stack, data section, or the heap.  The mode of a
   multiple is a "row".

   Schematically, the descriptor contains:

      triplets%
        lb% ub% stride%
	...
      elements%
      elements_size%

   Where elements_size% is the size of the buffer pointed by elements%, in
   bytes.

   There is a triplet per dimension in the multiple.  The number of dimensions
   in a row mode is static and is determined at compile-time.

   The infomation stored for each triplet is:

     lb%     is the lower bound of the dimension.
     ub%     is the upper bound of the dimension.
     stride% is the stride of the dimension.

   The stride of each dimension is the number of bytes to skip in order to
   access the next element in that dimension.  They express the layout of the
   multiple in memory.

   Algol 68 multi-dimensional multiples are stored in row-major (generalized,
   lexicographical) order:

     [1:3,1:2]AMODE = ((e1, e2, e3),
                       (e4, e5, e6))

   is stored as:

          1  2  3
       1  e1 e2 e3      | stride 2S ->  stride 1S
       2  e4 e5 e6      v

   Where S is the size in bytes of a single element.  That means that for two
   dimensional multiples, the column stride is always 1S and the row stride is
   the column size.

   In general, given a mode with number of elements N1, N2, N3, ...:

     [N1,N2,N3...,Nn]AMODE

   the strides of the dimensions are:

     S1 = N2 * S2
     S2 = N3 * S3
     S3 = N4 * S4
     ...
     Si = N1 * N2 * ... * Ni-1

   Indexing is then performed by a dot-product of an element coordinate and the
   strides:

     (i1,i2,i3) . (S1,S2,S3) = offset + i1*S1 + i2*S2 + i3*S3 = index in elements array.

   Note that the number of elements in each dimension can be easily derived
   from the bounds and there is no need to store them explicitly, save for
   performance reasons.  Descriptors are bulky enough and often they they are
   stored on the stack, so we prefer to pay in performance and save in
   storage.  */

/* Return a tree with the yielding of SKIP for the given row mode, a
   multiple.  */

tree
a68_get_multiple_skip_tree (MOID_T *m)
{
  tree res = NULL_TREE;
  int dim = DIM (m);
  tree *lower_bounds = (tree *) xmalloc (sizeof (tree) * dim);
  tree *upper_bounds = (tree *) xmalloc (sizeof (tree) * dim);
  tree ssize_one_node = fold_convert (ssizetype, size_one_node);
  tree ssize_zero_node = fold_convert (ssizetype, size_zero_node);
  for (int i = 0; i < dim; ++i)
    {
      lower_bounds[i] = ssize_one_node;
      upper_bounds[i] = ssize_zero_node;
    }
  res = a68_row_value (CTYPE (m), dim,
		       build_int_cst (build_pointer_type (void_type_node), 0),
		       size_zero_node, /* elements_size */
		       lower_bounds, upper_bounds);
  free (lower_bounds);
  free (upper_bounds);
  return res;
}

/* Return the number of dimensions of the multiple EXP as an integer
   constant.  */

tree
a68_multiple_dimensions (tree exp)
{
  gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (exp)));

  /* triplets% is the first field in the descriptor.  */
  tree triplets_field = TYPE_FIELDS (TREE_TYPE (exp));
  return array_type_nelts_top (TREE_TYPE (triplets_field));
}

/* Return an expression that evaluates to the total number of elements stored
   in a multiple as a sizetype.  */

tree
a68_multiple_num_elems (tree exp)
{
  /* We have to calculate the number of elements based on the dimension
     triplets in the array type.  The number of dimensions is known at compile
     time, so we don't really need a loop.  */

  tree num_dimensions_tree = a68_multiple_dimensions (exp);
  gcc_assert (TREE_CODE (num_dimensions_tree) == INTEGER_CST);
  int num_dimensions = tree_to_shwi (num_dimensions_tree);

  tree size = NULL_TREE;
  for (int dim = 0; dim < num_dimensions; ++dim)
    {
      tree size_dim = size_int (dim);
      tree lower_bound = a68_multiple_lower_bound (exp, size_dim);
      tree upper_bound = a68_multiple_upper_bound (exp, size_dim);
      tree dim_size = fold_build2 (PLUS_EXPR, sizetype,
				   fold_convert (sizetype, fold_build2 (MINUS_EXPR,
									ssizetype,
									upper_bound,
									lower_bound)),
				   size_one_node);

      if (size == NULL_TREE)
	size = dim_size;
      else
	size = fold_build2 (MULT_EXPR, sizetype, size, dim_size);
    }

  return size;
}

/* Return a size expression that evaluates to the total size, in bytes, of the
   elements stored in the multiple.  */

tree
a68_multiple_elements_size (tree exp)
{
  tree type = TREE_TYPE (exp);
  gcc_assert (A68_ROW_TYPE_P (type));

  /* elements_size% is the third field in the descriptor.  */
  tree elements_size_field = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (type)));
  return fold_build3 (COMPONENT_REF, TREE_TYPE (elements_size_field),
		      exp, elements_size_field, NULL_TREE);
}

/* Return the triplet for dimension DIM in the multiple EXP.  */

static tree
multiple_triplet (tree exp, tree dim)
{
  gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (exp)));

  /* triplets% is the first field in the descriptor.  */
  tree triplets_field = TYPE_FIELDS (TREE_TYPE (exp));
  tree triplets = fold_build3 (COMPONENT_REF,
			       TREE_TYPE (triplets_field),
			       exp,
			       triplets_field,
			       NULL_TREE);

  /* Get the triplet for the given dimension.  */
  return build4 (ARRAY_REF,
		 TREE_TYPE (TREE_TYPE (triplets)),
		 triplets,
		 dim,
		 NULL_TREE,
		 NULL_TREE);
}

/* 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)
{
  gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (exp)));

  /* lb% is the first field in the triplet.  */
  tree triplet = multiple_triplet (exp, dim);
  tree lower_bound_field = TYPE_FIELDS (TREE_TYPE (triplet));
  return fold_build3 (COMPONENT_REF,
		      TREE_TYPE (lower_bound_field),
		      triplet,
		      lower_bound_field,
		      NULL_TREE);
}

/* Return an expression that sets the lower bound of dimension DIM of the
   multiple EXP to BOUND.  */

tree
a68_multiple_set_lower_bound (tree exp, tree dim, tree bound)
{
  gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (exp)));
  return fold_build2 (MODIFY_EXPR,
		      TREE_TYPE (bound),
		      a68_multiple_lower_bound (exp, dim),
		      bound);
}

/* 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)
{
  gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (exp)));

  /* ub% is the second field in the triplet.  */
  tree triplet = multiple_triplet (exp, dim);
  tree upper_bound_field = TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (triplet)));
  return fold_build3 (COMPONENT_REF,
		      TREE_TYPE (upper_bound_field),
		      triplet,
		      upper_bound_field,
		      NULL_TREE);
}

/* Return an expression that sets the upper bound of dimension DIM of the
   multiple EXP to BOUND.  */

tree
a68_multiple_set_upper_bound (tree exp, tree dim, tree bound)
{
  gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (exp)));
  return fold_build2 (MODIFY_EXPR,
		      TREE_TYPE (bound),
		      a68_multiple_upper_bound (exp, dim),
		      bound);
}

/* Return the stride of dimension DIM of the multiple EXP.  */

tree
a68_multiple_stride (tree exp, tree dim)
{
  gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (exp)));

  /* stride% is the third field in the triplet.  */
  tree triplet = multiple_triplet (exp, dim);
  tree stride_field = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (triplet))));
  return fold_build3 (COMPONENT_REF,
		      TREE_TYPE (stride_field),
		      triplet,
		      stride_field,
		      NULL_TREE);
}

/* Return an expression that sets the stride of dimension DIM of the multiple
   EXP to STRIDE.

   STRIDE must be a sizetype.  */

tree
a68_multiple_set_stride (tree exp, tree dim, tree stride)
{
  gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (exp)));
  return fold_build2 (MODIFY_EXPR,
		      TREE_TYPE (stride),
		      a68_multiple_stride (exp, dim),
		      stride);
}

/* Return the triplets of the multiple EXP.  */

tree
a68_multiple_triplets (tree exp)
{
  gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (exp)));

  /* triplets% is the first field in the descriptor.  */
  tree triplets_field = TYPE_FIELDS (TREE_TYPE (exp));
  return fold_build3 (COMPONENT_REF,
		      TREE_TYPE (triplets_field),
		      exp,
		      triplets_field,
		      NULL_TREE);
}

/* Return the pointer to the elements of the multiple EXP.  */

tree
a68_multiple_elements (tree exp)
{
  gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (exp)));

  /* elements% is the second field in the descriptor.  */
  tree elements_field = TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (exp)));
  return fold_build3 (COMPONENT_REF,
		      TREE_TYPE (elements_field),
		      exp,
		      elements_field,
		      NULL_TREE);
}

/* Return an expression that sets the elements% field of EXP to ELEMENTS.  */

tree
a68_multiple_set_elements (tree exp, tree elements)
{
  /* elements% is the second field in the descriptor.  */
  tree elements_field = TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (exp)));
  return fold_build2 (MODIFY_EXPR,
		      TREE_TYPE (elements_field),
		      fold_build3 (COMPONENT_REF,
				   TREE_TYPE (elements_field),
				   exp,
				   elements_field,
				   NULL_TREE),
		      elements);
}

/* Return an expression that sets the elements_size% field of EXP to
   ELEMENTS_SIZE, which must be a sizetype.  */

tree
a68_multiple_set_elements_size (tree exp, tree elements_size)
{
  /* elements_size% is the third field in the descriptor.  */
  tree elements_size_field = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (exp))));
  return fold_build2 (MODIFY_EXPR,
		      TREE_TYPE (elements_size_field),
		      fold_build3 (COMPONENT_REF,
				   TREE_TYPE (elements_size_field),
				   exp,
				   elements_size_field,
				   NULL_TREE),
		      elements_size);
}

/* Given two arrays of LOWER_BOUNDs and UPPER_BOUNDs corresponding to DIM
   dimensions of a multiple of type TYPE, fill in the strides in STRIDES, which
   is assumed to be a buffer big enough to hold DIM tree nodes.  The bounds
   shall be of type ssizetype, and the calculated strides are of type sizetype,
   i.e. unsigned.  */

void
a68_multiple_compute_strides (tree type, size_t dim,
			      tree *lower_bounds, tree *upper_bounds,
			      tree *strides)
{
  tree stride = size_in_bytes (a68_row_elements_type (type));
  for (ssize_t i = dim - 1; i >= 0; --i)
    {
      strides[i] = stride;

      /* Calculate the stride for the previous dimension.  */
      tree dim_num_elems
	= save_expr (fold_build2 (PLUS_EXPR,
				  sizetype,
				  fold_convert (sizetype,
						fold_build2 (MINUS_EXPR, ssizetype,
							     upper_bounds[i], lower_bounds[i])),
				  size_one_node));
      stride = fold_build2 (MULT_EXPR, sizetype, stride, dim_num_elems);
    }
}

/* Return a constructor for a multiple of row type TYPE, using TRIPLETS and
   ELEMENTS.  ELEMENTS_SIZE is the size in bytes of the memory pointed by
   ELEMENTS.  */

tree
a68_row_value_raw (tree type, tree triplets,
		   tree elements, tree elements_size)
{
  tree triplets_field;
  tree elements_field;
  tree elements_size_field;
  vec <constructor_elt, va_gc> *ce = NULL;

  gcc_assert (A68_ROW_TYPE_P (type));
  triplets_field = TYPE_FIELDS (type);
  elements_field = TREE_CHAIN (triplets_field);
  elements_size_field = TREE_CHAIN (elements_field);
  CONSTRUCTOR_APPEND_ELT (ce, triplets_field, triplets);
  CONSTRUCTOR_APPEND_ELT (ce, elements_field,
			  fold_build1 (CONVERT_EXPR ,TREE_TYPE (elements_field), elements));
  CONSTRUCTOR_APPEND_ELT (ce, elements_size_field, elements_size);
  return build_constructor (type, ce);
}

/* Return a constructor for a multiple of row type TYPE, of DIM dimensions and
   pointing to ELEMENTS.

   ELEMENTS_SIZE contains the size in bytes of the memory pointed by ELEMENTS.

   *LOWER_BOUND and *UPPER_BOUND are the bounds for the DIM dimensions.
*/

tree
a68_row_value (tree type, size_t dim,
	       tree elements, tree elements_size,
	       tree *lower_bound, tree *upper_bound)
{
  tree triplets_field;
  tree elements_field;
  tree elements_size_field;
  vec <constructor_elt, va_gc> *ce = NULL;

  gcc_assert (A68_ROW_TYPE_P (type));
  triplets_field = TYPE_FIELDS (type);
  elements_field = TREE_CHAIN (triplets_field);
  elements_size_field = TREE_CHAIN (elements_field);

  tree triplet_type = TREE_TYPE (TREE_TYPE (triplets_field));
  tree lower_bound_field = TYPE_FIELDS (triplet_type);
  tree upper_bound_field = TREE_CHAIN (TYPE_FIELDS (triplet_type));
  tree stride_field = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (triplet_type)));

  /* Calculate strides.  */
  tree *strides = (tree *) xmalloc (sizeof (tree) * dim);
  a68_multiple_compute_strides (type, dim, lower_bound, upper_bound, strides);

  vec <constructor_elt, va_gc> *triplets_ce = NULL;
  for (size_t i = 0; i < dim; ++i)
    {
      CONSTRUCTOR_APPEND_ELT (triplets_ce,
			      size_int (i),
			      build_constructor_va (triplet_type,
						    3,
						    lower_bound_field, lower_bound[i],
						    upper_bound_field, upper_bound[i],
						    stride_field, strides[i]));
    }
  free (strides);
  CONSTRUCTOR_APPEND_ELT (ce, triplets_field,
			  build_constructor (TREE_TYPE (triplets_field), triplets_ce));
  CONSTRUCTOR_APPEND_ELT (ce, elements_field,
			  fold_build1 (CONVERT_EXPR, TREE_TYPE (elements_field), elements));
  CONSTRUCTOR_APPEND_ELT (ce, elements_size_field,
			  elements_size ? elements_size : size_zero_node);
  tree multiple = build_constructor (type, ce);
  return multiple;
}

/* Build a tree to slice a multiple given a set of indexes.

   P is the tree node corresponding to the slice.  It is used as the source of
   location information.

   MULTIPLE is the multiple value being sliced.  If SLICING_NAME is true, it
   means the slicing operation is for a name and therefore it must yield a
   name.

   INDEXES is a list of NUM_INDEXES indexes, which are units.
   NUM_INDEXES must match the dimension of the multiple.  */

tree
a68_multiple_slice (NODE_T *p,
		    tree multiple, bool slicing_name,
		    int num_indexes, tree *indexes)
{
  tree slice = NULL_TREE;
  tree bounds_check = NULL_TREE;

  multiple = save_expr (multiple);
  tree index = NULL_TREE;
  for (int idx = 0; idx < num_indexes; ++idx)
    {
      tree lower_bound = a68_multiple_lower_bound (multiple, size_int (idx));
      tree index_expr = save_expr (indexes[idx]);

      /* Do run-time bound checking if requested.  */
      if (OPTION_BOUNDS_CHECKING (&A68_JOB))
	{
	  tree upper_bound = a68_multiple_upper_bound (multiple, size_int (idx));
	  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_expr),
					 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 dim_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_expr),
									 lower_bound),
							    fold_build2 (LE_EXPR, ssizetype,
									 fold_convert (ssizetype,
										       index_expr),
									 upper_bound)));
	  dim_bounds_check = fold_build2_loc (a68_get_node_location (p),
					      TRUTH_ORIF_EXPR,
					      ssizetype,
					      dim_bounds_check, call);

	  /* bounds_check_ok || call_runtime_error */
	  if (bounds_check == NULL_TREE)
	    bounds_check = dim_bounds_check;
	  else
	    bounds_check = fold_build2 (TRUTH_ANDIF_EXPR,
					ssizetype,
					bounds_check,
					dim_bounds_check);
	}

      /* Now add the effect of this dimension's subscript in the index.  Note
	 that the stride is expressed in bytes.  */
      tree stride = a68_multiple_stride (multiple, size_int (idx));
      tree adjusted_index
	= fold_convert (sizetype, fold_build2 (MINUS_EXPR, ssizetype,
					       fold_convert (ssizetype, index_expr),
					       lower_bound));
      tree term = fold_build2 (MULT_EXPR, sizetype,
			       adjusted_index, stride);
      if (index == NULL_TREE)
	index = term;
      else
	index = fold_build2 (PLUS_EXPR, sizetype,
			     index, term);
    }

  tree elements = a68_multiple_elements (multiple);
  tree element_pointer_type = TREE_TYPE (elements);
  tree element_type = TREE_TYPE (element_pointer_type);

  /* Now refer to the indexed element.  In case we are slicing a ref to a
     multiple, return the address of the element and not the element
     itself.  */
  tree element_address = fold_build2 (POINTER_PLUS_EXPR,
				      element_pointer_type,
				      elements,
				      index);
  if (slicing_name)
    slice = element_address;
  else
    slice = fold_build2 (MEM_REF,
			 element_type,
			 fold_build2 (POINTER_PLUS_EXPR,
				      element_pointer_type,
				      elements,
				      index),
			 fold_convert (element_pointer_type,
				       integer_zero_node));

  /* Prepend bounds checking code if necessary.  */
  if (bounds_check != NULL_TREE)
    {
      slice = fold_build2_loc (a68_get_node_location (p),
			       COMPOUND_EXPR,
			       TREE_TYPE (slice),
			       bounds_check,
			       slice);
    }

  return slice;
}

/* Auxiliary routine for a68_multiple_copy_elemens.  */

static tree
copy_multiple_dimension_elems (size_t dim, size_t num_dimensions,
			       tree to, tree from,
			       tree to_elements, tree from_elements,
			       tree *to_offset, tree *from_offset,
			       tree *indexes)
{
  tree element_pointer_type = TREE_TYPE (from_elements);
  tree element_type = TREE_TYPE (element_pointer_type);
  tree upb = a68_multiple_upper_bound (from, size_int (dim));

  char *name = xasprintf ("r" HOST_SIZE_T_PRINT_DEC "%%", (fmt_size_t) dim);
  indexes[dim] = a68_lower_tmpvar (name, ssizetype,
				   a68_multiple_lower_bound (from,
							     size_int (dim)));
  free (name);

  /* Loop body.  */
  a68_push_range (NULL);
  {
    /* if (indexes[dim] > upb) break; */
    a68_add_stmt (fold_build1 (EXIT_EXPR, void_type_node,
			       fold_build2 (GT_EXPR, size_type_node,
					    indexes[dim], upb)));

    /* Add this dimension's contribution to the offsets.  */
    tree index = fold_convert (sizetype,
			       fold_build2 (MINUS_EXPR, ssizetype,
					    upb, indexes[dim]));
    *to_offset = fold_build2 (PLUS_EXPR, sizetype,
			      *to_offset,
			      fold_build2 (MULT_EXPR, sizetype,
					   index,
					   a68_multiple_stride (to, size_int (dim))));
    *from_offset = fold_build2 (PLUS_EXPR, sizetype,
				*from_offset,
				fold_build2 (MULT_EXPR, sizetype,
					     index,
					     a68_multiple_stride (from, size_int (dim))));

    if (dim == num_dimensions - 1)
      {
	/* Most inner loop, copy one element.  */

	tree to_off = a68_lower_tmpvar ("to_offset%", sizetype, *to_offset);
	tree from_off = a68_lower_tmpvar ("from_offset%", sizetype, *from_offset);

	tree to_elem = fold_build2 (MEM_REF,
				    element_type,
				    fold_build2 (POINTER_PLUS_EXPR,
						 element_pointer_type,
						 to_elements,
						 to_off),
				    fold_convert (element_pointer_type,
						  integer_zero_node));
	tree from_elem = fold_build2 (MEM_REF,
				      element_type,
				      fold_build2 (POINTER_PLUS_EXPR,
						   element_pointer_type,
						   from_elements,
						   from_off),
				      fold_convert (element_pointer_type,
						    integer_zero_node));

	/* XXX
	   if may_overlap then modify only if dst_offset < src_offset */
	a68_add_stmt (fold_build2 (MODIFY_EXPR, element_type,
				   to_elem, from_elem));
      }
    else
      {
	a68_add_stmt (copy_multiple_dimension_elems (dim + 1, num_dimensions,
						     to, from,
						     to_elements, from_elements,
						     to_offset, from_offset,
						     indexes));
      }

    /* indexes[dim]++ */
    a68_add_stmt (fold_build2 (POSTINCREMENT_EXPR, ssizetype,
			       indexes[dim], ssize_int (1)));
  }
  tree loop_body = a68_pop_range ();

  return fold_build1 (LOOP_EXPR, void_type_node, loop_body);
}

/* Copy the elements of a given multiple (string) FROM to the multiple (string)
   TO.

   The dimensions and bounds of both multiples are supposed to match, and they
   are supposed to not be flat.

   XXX simple cases  with same strides may be done with a memcpy.
   XXX compile this into a support routine to reduce code size.  */

tree
a68_multiple_copy_elems (MOID_T *mode, tree to, tree from)
{
  gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (to))
	      && A68_ROW_TYPE_P (TREE_TYPE (from)));

  /* Deflex modes as needed and determine dimension.  */
  if (IS_FLEX (mode))
    mode = SUB (mode);
  int num_dimensions = (mode == M_STRING ? 1 : DIM (mode));

  a68_push_range (NULL);
  to = a68_lower_tmpvar ("to%", TREE_TYPE (to), to);
  from = a68_lower_tmpvar ("from%", TREE_TYPE (from), from);
  tree from_elements = a68_multiple_elements (from);
  tree element_pointer_type = TREE_TYPE (from_elements);
  from_elements = a68_lower_tmpvar ("from_elements%", element_pointer_type,
				    from_elements);
  tree to_elements = a68_lower_tmpvar ("to_elements%", element_pointer_type,
				       a68_multiple_elements (to));

  tree *indexes = (tree *) xmalloc (num_dimensions * sizeof (tree));
  tree to_offset = size_zero_node;
  tree from_offset = size_zero_node;
  a68_add_stmt (copy_multiple_dimension_elems (0 /* dim */, num_dimensions,
					       to, from,
					       to_elements, from_elements,
					       &to_offset, &from_offset,
					       indexes));
  free (indexes);
  return a68_pop_range ();
}

/* Given a rows type, return the number of dimensions.  */

tree
a68_rows_dim (tree exp)
{
  gcc_assert (A68_ROWS_TYPE_P (TREE_TYPE (exp)));

  /* dim% is the first field in the rows struct.  */
  tree dim_field = TYPE_FIELDS (TREE_TYPE (exp));
  return fold_build3 (COMPONENT_REF,
		      TREE_TYPE (dim_field),
		      exp,
		      dim_field,
		      NULL_TREE);
}

/* Given a multiple value, create a rows value reflecting the multiple's
   dimensions and triplets.  */

tree
a68_rows_value (tree multiple)
{
  tree rows_type = CTYPE (M_ROWS);
  tree dim_field = TYPE_FIELDS (rows_type);
  tree triplets_field = TREE_CHAIN (dim_field);

  tree dimensions = save_expr (a68_multiple_dimensions (multiple));
  tree triplets = fold_build1 (ADDR_EXPR, TREE_TYPE (triplets_field),
			       a68_multiple_triplets (multiple));
  return build_constructor_va (rows_type, 2,
			       dim_field, dimensions,
			       triplets_field, triplets);
}

/* Given a rows value and a dimension number, return the upper bound or the
   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)
{
  tree rows_type = TREE_TYPE (rows);
  tree triplet_type = a68_triplet_type ();
  tree triplet_pointer_type = build_pointer_type (triplet_type);
  tree triplet_lb_field = TYPE_FIELDS (triplet_type);
  tree triplet_ub_field = TREE_CHAIN (TYPE_FIELDS (triplet_type));
  tree triplets_field = TREE_CHAIN (TYPE_FIELDS (rows_type));
  tree triplets = fold_build3 (COMPONENT_REF, triplet_pointer_type,
			       rows, triplets_field, NULL_TREE);
  tree triplet_offset = fold_build2 (MULT_EXPR, sizetype,
				     dim,
				     size_in_bytes (triplet_type));
  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)
{
  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 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 (TRUTH_AND_EXPR, boolean_type_node,
				fold_build2 (GT_EXPR, boolean_type_node, dim, size_zero_node),
				fold_build2 (LE_EXPR, boolean_type_node, 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.

   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);
}

/* Emit a run-time error if the bounds of M1 and M2 are not the same.  Both
   multiples are assumed to have the same type and therefore feature the same
   number of dimensions.  */

tree
a68_multiple_bounds_check_equal (NODE_T *p, tree m1, tree m2)
{
  m1 = save_expr (m1);
  m2 = save_expr (m2);

  /* First determine the rank of the multiples and check they match.  */
  tree m1_dimensions = a68_multiple_dimensions (m1);
  tree m2_dimensions = a68_multiple_dimensions (m2);
  gcc_assert (TREE_CODE (m1_dimensions) == INTEGER_CST
	      && TREE_CODE (m2_dimensions) == INTEGER_CST);

  int dim1 = tree_to_shwi (m1_dimensions);
  int dim2 = tree_to_shwi (m2_dimensions);
  gcc_assert (dim1 == dim2);

  a68_push_range (NULL /* VOID */);

  /* For each dimension, check that bounds are the same in both multiples.  */
  int i;
  for (i = 0; i < dim1; ++i)
    {
      tree dim_tree = build_int_cst (ssizetype, i);
      tree dim_plus_one = fold_build2 (PLUS_EXPR, ssizetype,
				       dim_tree,
				       fold_convert (ssizetype, size_one_node));

      tree lb1 = save_expr (a68_multiple_lower_bound (m1, dim_tree));
      tree lb2 = save_expr (a68_multiple_lower_bound (m2, dim_tree));

      tree ub1 = save_expr (a68_multiple_upper_bound (m1, dim_tree));
      tree ub2 = save_expr (a68_multiple_upper_bound (m2, dim_tree));

      tree bounds_equal = fold_build2 (TRUTH_AND_EXPR,
				       boolean_type_node,
				       fold_build2 (EQ_EXPR, boolean_type_node,
						    lb1, lb2),
				       fold_build2 (EQ_EXPR, boolean_type_node,
						    ub1, ub2));

      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_ARRAYBOUNDSMISMATCH,
				     void_type_node, 7,
				     filename,
				     build_int_cst (unsigned_type_node, lineno),
				     dim_plus_one,
				     lb1, ub1, lb2, ub2);
      call = fold_build2 (COMPOUND_EXPR, boolean_type_node, call, boolean_false_node);

      tree check = fold_build2_loc (a68_get_node_location (p),
				    TRUTH_ORIF_EXPR, boolean_type_node,
				    bounds_equal,
				    call);
      a68_add_stmt (check);
    }

  return a68_pop_range ();
}

/* Allocate a multiple on the heap.

   M is the mode the multiple to allocate.
   DIM is the number of dimensions of the multiple.
   ELEMS is a pointer to the elements of the multiple.
   ELEMS_SIZE is the size in bytes of ELEMS.
   *LOWER_BOUND and *UPPER_BOUND are the bounds for the DIM dimensions.  */

tree
a68_row_malloc (tree type, int dim, tree elems, tree elems_size,
		tree *lower_bound, tree *upper_bound)
{
  tree ptr_to_type = build_pointer_type (type);

  a68_push_range (NULL);

  /* Allocate space for the descriptor.  */
  tree ptr_to_multiple = a68_lower_tmpvar ("ptr_to_multiple%", ptr_to_type,
					   a68_lower_malloc (type, size_in_bytes (type)));
  tree multiple = a68_row_value (type, dim,
				 elems, elems_size,
				 lower_bound, upper_bound);
  a68_add_stmt (fold_build2 (MODIFY_EXPR, void_type_node,
			     fold_build1 (INDIRECT_REF, type, ptr_to_multiple),
			     multiple));
  a68_add_stmt (ptr_to_multiple);
  tree res = a68_pop_range ();
  TREE_TYPE (res) = ptr_to_type;
  return res;
}