/* 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
. */
#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 *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 *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 *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;
}