https://gcc.gnu.org/g:3a34dc4c0f63c13976d827048591b54972f9c364
commit 3a34dc4c0f63c13976d827048591b54972f9c364
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Thu Apr 3 15:34:46 2025 +0200
Sauvegarde spacing compilation OK
Diff:
---
gcc/fortran/trans-array.cc | 399 +++++++++++++++-------------------------
gcc/fortran/trans-array.h | 3 +-
gcc/fortran/trans-decl.cc | 10 +-
gcc/fortran/trans-descriptor.cc | 317 +++++++++++++++++++------------
gcc/fortran/trans-descriptor.h | 5 +-
gcc/fortran/trans-expr.cc | 10 +-
gcc/fortran/trans-intrinsic.cc | 17 +-
gcc/fortran/trans-io.cc | 11 +-
gcc/fortran/trans-openmp.cc | 42 +++--
gcc/fortran/trans-types.cc | 61 ++++--
gcc/fortran/trans.cc | 111 +----------
gcc/fortran/trans.h | 27 +--
12 files changed, 472 insertions(+), 541 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index b33ba5730f24..8d48d8e05a95 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -932,7 +932,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t
* post, gfc_ss * ss,
gfc_loopinfo *loop;
gfc_ss *s;
gfc_array_info *info;
- tree from[GFC_MAX_DIMENSIONS], to[GFC_MAX_DIMENSIONS],
sm[GFC_MAX_DIMENSIONS];
+ tree from[GFC_MAX_DIMENSIONS], to[GFC_MAX_DIMENSIONS],
spacing[GFC_MAX_DIMENSIONS];
tree type;
tree desc;
tree tmp;
@@ -1149,7 +1149,9 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
info->descriptor = desc;
info->array_access = array_access;
- size = elemsize;
+ size = fold_build2_loc (input_location, EXACT_DIV_EXPR, gfc_array_index_type,
+ elemsize, build_int_cst (gfc_array_index_type,
+ TYPE_ALIGN_UNIT (eltype)));
/*
Fill in the bounds and stride. This is a packed array, so:
@@ -1193,7 +1195,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
{
for (n = 0; n < total_dim; n++)
{
- sm[n] = size;
+ spacing[n] = size;
tree extent = to[n];
if (!shift_bounds && !integer_zerop (from[n]))
@@ -1245,8 +1247,9 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
nelem, initial, dynamic,
dealloc);
- gfc_set_temporary_descriptor (pre, desc, class_expr, elemsize, data_ptr,
- from, to, sm, total_dim, !bounds_known,
+ gfc_set_temporary_descriptor (pre, desc, class_expr, elemsize,
+ GFC_TYPE_ARRAY_ALIGN (desc), data_ptr,
+ from, to, spacing, total_dim, !bounds_known,
rank_changer, shift_bounds);
while (ss->parent)
@@ -1393,7 +1396,7 @@ gfc_trans_array_ctor_element (stmtblock_t * pblock, tree
desc,
/* Store the value. */
tmp = build_fold_indirect_ref_loc (input_location,
gfc_conv_descriptor_data_get (desc));
- tmp = gfc_build_array_ref (tmp, offset, NULL);
+ tmp = gfc_build_array_ref (tmp, offset, NULL_TREE, NULL_TREE);
if (expr->expr_type == EXPR_FUNCTION && expr->ts.type == BT_DERIVED
&& expr->ts.u.derived->attr.alloc_comp)
@@ -1724,7 +1727,7 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock,
tmp = gfc_conv_descriptor_data_get (desc);
tmp = build_fold_indirect_ref_loc (input_location,
tmp);
- tmp = gfc_build_array_ref (tmp, *poffset, NULL);
+ tmp = gfc_build_array_ref (tmp, *poffset, NULL_TREE, NULL_TREE);
tmp = gfc_build_addr_expr (NULL_TREE, tmp);
init = gfc_build_addr_expr (NULL_TREE, init);
@@ -2830,7 +2833,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss,
bool subscript,
info->stride[dim] = gfc_index_one_node;
- tree spacing = gfc_conv_descriptor_sm_get (tmp, tree_dim);
+ tree spacing = gfc_conv_descriptor_spacing_get (tmp,
tree_dim);
spacing = gfc_evaluate_now (spacing, &outer_loop->pre);
info->spacing[dim] = spacing;
}
@@ -2988,7 +2991,6 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss,
int base)
&& !ss->is_alloc_lhs)
data = gfc_evaluate_now (data, block);
info->data = data;
- info->saved_data = data;
tmp = gfc_conv_array_offset (se.expr);
if (!ss->is_alloc_lhs)
@@ -2999,6 +3001,11 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss *
ss, int base)
so that the variable is still accessible after the loops
are translated. */
info->saved_offset = info->offset;
+
+ tmp = gfc_conv_array_align (se.expr);
+ if (!ss->is_alloc_lhs)
+ tmp = gfc_evaluate_now (tmp, block);
+ info->align = tmp;
}
}
@@ -3073,10 +3080,24 @@ gfc_conv_array_offset (tree descriptor)
}
+/* Return an expression for the base alignment of an array. */
+
+tree
+gfc_conv_array_align (tree descriptor)
+{
+ tree type = TREE_TYPE (descriptor);
+ tree tmp = GFC_TYPE_ARRAY_ALIGN (type);
+ if (tmp != NULL_TREE)
+ return tmp;
+
+ return gfc_conv_descriptor_align_get (descriptor);
+}
+
+
/* Get an expression for the array stride. */
tree
-gfc_conv_array_sm (tree descriptor, int dim)
+gfc_conv_array_spacing (tree descriptor, int dim)
{
tree tmp;
tree type;
@@ -3084,11 +3105,11 @@ gfc_conv_array_sm (tree descriptor, int dim)
type = TREE_TYPE (descriptor);
/* For descriptorless arrays use the array size. */
- tmp = GFC_TYPE_ARRAY_SM (type, dim);
+ tmp = GFC_TYPE_ARRAY_SPACING (type, dim);
if (tmp != NULL_TREE)
return tmp;
- tmp = gfc_conv_descriptor_sm_get (descriptor, gfc_rank_cst[dim]);
+ tmp = gfc_conv_descriptor_spacing_get (descriptor, gfc_rank_cst[dim]);
return tmp;
}
@@ -3466,38 +3487,14 @@ non_negative_strides_array_p (tree expr)
static tree
-build_array_ref (tree desc, tree offset, tree decl, tree vptr)
+build_array_ref (tree desc, tree offset)
{
tree tmp;
- tree type;
- tree cdesc;
-
- /* For class arrays the class declaration is stored in the saved
- descriptor. */
- if (INDIRECT_REF_P (desc)
- && DECL_LANG_SPECIFIC (TREE_OPERAND (desc, 0))
- && GFC_DECL_SAVED_DESCRIPTOR (TREE_OPERAND (desc, 0)))
- cdesc = gfc_class_data_get (GFC_DECL_SAVED_DESCRIPTOR (
- TREE_OPERAND (desc, 0)));
- else
- cdesc = desc;
-
- /* Class container types do not always have the GFC_CLASS_TYPE_P
- but the canonical type does. */
- if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (cdesc))
- && TREE_CODE (cdesc) == COMPONENT_REF)
- {
- type = TREE_TYPE (TREE_OPERAND (cdesc, 0));
- if (TYPE_CANONICAL (type)
- && GFC_CLASS_TYPE_P (TYPE_CANONICAL (type)))
- vptr = gfc_class_vptr_get (TREE_OPERAND (cdesc, 0));
- }
tmp = gfc_conv_array_data (desc);
tmp = build_fold_indirect_ref_loc (input_location, tmp);
- tmp = gfc_build_array_ref (tmp, offset, decl,
- non_negative_strides_array_p (desc),
- vptr);
+ tmp = gfc_build_array_ref (tmp, offset, non_negative_strides_array_p (desc),
+ gfc_index_one_node, gfc_conv_array_align (desc));
return tmp;
}
@@ -3513,7 +3510,6 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int
dim, int i,
gfc_array_info *info;
tree index;
tree data;
- tree tmp;
info = &ss->info->data.array;
@@ -3548,23 +3544,14 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int
dim, int i,
gfc_array_index_type,
se->loop->loopvar[i], se->loop->from[i]);
- /* Multiply the index by the stride. */
- tmp = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, index,
-
info->subscript[dim]->info->data.array.spacing[0]);
-
data = info->subscript[dim]->info->data.array.data;
- if (info->subscript[dim]->info->data.array.array_access)
- index = fold_convert_loc (input_location, gfc_array_index_type,
tmp);
- else
- {
- data = fold_build2_loc (input_location, POINTER_PLUS_EXPR,
- TREE_TYPE (data), data, tmp);
- index = gfc_index_zero_node;
- }
+ index = fold_convert_loc (input_location, gfc_array_index_type,
index);
+
/* Read the vector to get an index into info->descriptor. */
data = build_fold_indirect_ref_loc (input_location, data);
- index = gfc_build_array_ref (data, index, NULL);
+ index = gfc_build_array_ref (data, index,
+
info->subscript[dim]->info->data.array.spacing[0],
+
info->subscript[dim]->info->data.array.align);
index = gfc_evaluate_now (index, &se->pre);
index = fold_convert (gfc_array_index_type, index);
@@ -3621,75 +3608,36 @@ gfc_conv_scalarized_array_ref (gfc_se * se,
gfc_array_ref * ar,
bool tmp_array = false)
{
gfc_array_info *info;
- tree decl = NULL_TREE;
tree base;
gfc_ss *ss;
- gfc_expr *expr;
int n;
ss = se->ss;
- expr = ss->info->expr;
info = &ss->info->data.array;
if (ar)
n = se->loop->order[0];
else
n = 0;
- tree tmp = conv_array_index_offset (se, ss, ss->dim[n], n, ar,
- info->spacing[ss->dim[n]]);
- tree index, data;
- if (info->array_access)
- {
- index = tmp;
-
- /* Add the offset for this dimension to the stored offset for all other
- dimensions. */
- if (info->offset && !integer_zerop (info->offset))
- index = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type,
- index, info->offset);
-
- data = info->data;
- }
- else
- {
- tree offset = fold_convert (size_type_node, tmp);
+ tree index = conv_array_index_offset (se, ss, ss->dim[n], n, ar,
+ info->spacing[ss->dim[n]]);
- data = info->data;
- data = fold_build2_loc (input_location, POINTER_PLUS_EXPR, TREE_TYPE
(data),
- data, offset);
+ /* Add the offset for this dimension to the stored offset for all other
+ dimensions. */
+ if (info->offset && !integer_zerop (info->offset))
+ index = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+ index, info->offset);
- index = gfc_index_zero_node;
- }
-
- base = build_fold_indirect_ref_loc (input_location, data);
+ base = build_fold_indirect_ref_loc (input_location, info->data);
/* Use the vptr 'size' field to access the element of a class array. */
if (build_class_array_ref (se, base, index))
return;
- if (get_CFI_desc (NULL, expr, &decl, ar))
- decl = build_fold_indirect_ref_loc (input_location, decl);
-
- /* A pointer array component can be detected from its field decl. Fix
- the descriptor, mark the resulting variable decl and pass it to
- gfc_build_array_ref. */
- if (is_pointer_array (info->descriptor)
- || (expr && expr->ts.deferred && info->descriptor
- && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (info->descriptor))))
- {
- if (TREE_CODE (info->descriptor) == COMPONENT_REF)
- decl = info->descriptor;
- else if (INDIRECT_REF_P (info->descriptor))
- decl = TREE_OPERAND (info->descriptor, 0);
-
- if (decl == NULL_TREE)
- decl = info->descriptor;
- }
-
bool non_negative_stride = tmp_array
|| non_negative_strides_array_p (info->descriptor);
- se->expr = gfc_build_array_ref (base, index, decl,
- non_negative_stride);
+ se->expr = gfc_build_array_ref (base, index, non_negative_stride,
+ gfc_index_one_node, info->align);
}
@@ -3800,9 +3748,6 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar,
gfc_expr *expr,
cst_offset = offset = gfc_index_zero_node;
tmp = gfc_conv_array_offset (decl);
- if (use_array_ref)
- tmp = fold_build2_loc (input_location, EXACT_DIV_EXPR,
- gfc_array_index_type, tmp, elem_len);
add_to_offset (&cst_offset, &offset, tmp);
/* Calculate the offsets from all the dimensions. Make sure to associate
@@ -3870,11 +3815,8 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar,
gfc_expr *expr,
}
}
- /* Multiply the index by the sm. */
- tree tmp = gfc_conv_array_sm (decl, n);
- if (use_array_ref)
- tmp = fold_build2_loc (input_location, EXACT_DIV_EXPR,
- gfc_array_index_type, tmp, elem_len);
+ /* Multiply the index by the spacing. */
+ tree tmp = gfc_conv_array_spacing (decl, n);
tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
indexse.expr, tmp);
@@ -3887,61 +3829,8 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar,
gfc_expr *expr,
offset = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type, offset, cst_offset);
- /* A pointer array component can be detected from its field decl. Fix
- the descriptor, mark the resulting variable decl and pass it to
- build_array_ref. */
- decl = NULL_TREE;
- if (get_CFI_desc (sym, expr, &decl, ar))
- decl = build_fold_indirect_ref_loc (input_location, decl);
- if (!expr->ts.deferred && !sym->attr.codimension
- && is_pointer_array (se->expr))
- {
- if (TREE_CODE (se->expr) == COMPONENT_REF)
- decl = se->expr;
- else if (INDIRECT_REF_P (se->expr))
- decl = TREE_OPERAND (se->expr, 0);
- else
- decl = se->expr;
- }
- else if (expr->ts.deferred
- || (sym->ts.type == BT_CHARACTER
- && sym->attr.select_type_temporary))
- {
- if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se->expr)))
- {
- decl = se->expr;
- if (INDIRECT_REF_P (decl))
- decl = TREE_OPERAND (decl, 0);
- }
- else
- decl = sym->backend_decl;
- }
- else if (sym->ts.type == BT_CLASS)
- {
- if (UNLIMITED_POLY (sym))
- {
- gfc_expr *class_expr = gfc_find_and_cut_at_last_class_ref (expr);
- gfc_init_se (&tmpse, NULL);
- gfc_conv_expr (&tmpse, class_expr);
- if (!se->class_vptr)
- se->class_vptr = gfc_class_vptr_get (tmpse.expr);
- gfc_free_expr (class_expr);
- decl = tmpse.expr;
- }
- else
- decl = NULL_TREE;
- }
-
free (var_name);
- if (use_array_ref)
- se->expr = build_array_ref (se->expr, offset, decl, se->class_vptr);
- else
- {
- offset = fold_convert_loc (input_location, size_type_node, offset);
- tree ptr = fold_build2_loc (input_location, POINTER_PLUS_EXPR,
- TREE_TYPE (se->expr), se->expr, offset);
- se->expr = build_array_ref (ptr, gfc_array_index_type, decl, NULL_TREE);
- }
+ se->expr = build_array_ref (se->expr, offset);
}
@@ -4080,10 +3969,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim,
int flag,
/* Remember this offset for the second loop. */
if (dim == loop->temp_dim - 1 && loop->parent == NULL)
- {
- info->saved_offset = info->offset;
- info->saved_data = info->data;
- }
+ info->saved_offset = info->offset;
}
}
@@ -4313,7 +4199,6 @@ gfc_trans_scalarized_loop_boundary (gfc_loopinfo * loop,
stmtblock_t * body)
continue;
ss_info->data.array.offset = ss_info->data.array.saved_offset;
- ss_info->data.array.data = ss_info->data.array.saved_data;
}
/* Restart all the inner loops we just finished. */
@@ -4392,29 +4277,26 @@ conv_array_spacing (stmtblock_t * block, gfc_ss * ss,
int dim)
tree value = NULL_TREE;
- if (info->array_access)
+ value = gfc_conv_array_spacing (desc, dim);
+
+#if 0
+ if (GFC_ARRAY_TYPE_P (type)
+ && GFC_TYPE_ARRAY_SPACING (type, dim) != NULL_TREE)
+ value = GFC_TYPE_ARRAY_SPACING (type, dim);
+ else if (dim == 0)
+ value = gfc_index_one_node;
+ else
{
- tree type = TREE_TYPE (desc);
- if (GFC_ARRAY_TYPE_P (type)
- && GFC_TYPE_ARRAY_STRIDE (type, dim) != NULL_TREE)
- value = GFC_TYPE_ARRAY_STRIDE (type, dim);
- else if (dim == 0)
- value = gfc_index_one_node;
- else
- {
- if (info->spacing[dim - 1] == NULL_TREE)
- conv_array_spacing (block, ss, dim - 1);
+ if (info->spacing[dim - 1] == NULL_TREE)
+ conv_array_spacing (block, ss, dim - 1);
- tree previous_spacing = info->spacing[dim - 1];
- tree previous_extent = gfc_conv_array_extent (desc, dim - 1);
- value = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, previous_spacing,
- previous_extent);
- }
+ tree previous_spacing = info->spacing[dim - 1];
+ tree previous_extent = gfc_conv_array_extent (desc, dim - 1);
+ value = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, previous_spacing,
+ previous_extent);
}
- else
- value = gfc_conv_descriptor_sm_get (info->descriptor,
- gfc_rank_cst[dim]);
+#endif
if (save_value)
info->spacing[dim] = gfc_evaluate_now (value, block);
@@ -6323,7 +6205,7 @@ gfc_trans_array_cobounds (tree type, stmtblock_t * pblock,
/* Generate code to evaluate non-constant array bounds. Sets *poffset and
- returns the size (in elements) of the array. */
+ returns the size (in align units) of the array. */
tree
gfc_trans_array_bounds (tree type, gfc_symbol * sym, tree * poffset,
@@ -6331,7 +6213,6 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sym, tree
* poffset,
{
gfc_array_spec *as;
tree size;
- tree sm;
tree offset;
tree ubound;
tree lbound;
@@ -6342,14 +6223,11 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sym,
tree * poffset,
as = IS_CLASS_COARRAY_OR_ARRAY (sym) ? CLASS_DATA (sym)->as : sym->as;
- size = gfc_index_one_node;
+ tree eltype = gfc_get_element_type (type);
+
+ size = fold_build2_loc (input_location, EXACT_DIV_EXPR, gfc_array_index_type,
+ TYPE_SIZE_UNIT (eltype), GFC_TYPE_ARRAY_ALIGN (type));
offset = gfc_index_zero_node;
- sm = GFC_TYPE_ARRAY_SM (type, 0);
- if (sm && VAR_P (sm))
- {
- tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
- gfc_add_modify (pblock, sm, tmp);
- }
for (dim = 0; dim < as->rank; dim++)
{
/* Evaluate non-constant array bound expressions.
@@ -6382,37 +6260,34 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sym,
tree * poffset,
offset, tmp);
/* The size of this dimension, and the stride of the next. */
+ tree spacing;
if (dim + 1 < as->rank)
- sm = GFC_TYPE_ARRAY_SM (type, dim + 1);
+ spacing = GFC_TYPE_ARRAY_SPACING (type, dim + 1);
else
- sm = GFC_TYPE_ARRAY_SIZE (type);
+ spacing = GFC_TYPE_ARRAY_SIZE (type);
- if (ubound != NULL_TREE && !(sm && INTEGER_CST_P (sm)))
+ if (ubound != NULL_TREE && !(spacing && INTEGER_CST_P (spacing)))
{
- /* Calculate sm = size * (ubound + 1 - lbound). */
- tmp = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type,
- gfc_index_one_node, lbound);
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type, ubound, tmp);
+ /* Calculate spacing = size * (ubound + 1 - lbound). */
+ tmp = gfc_conv_array_extent_dim (lbound, ubound, nullptr);
tmp = fold_build2_loc (input_location, MULT_EXPR,
gfc_array_index_type, size, tmp);
- if (sm)
- gfc_add_modify (pblock, sm, tmp);
+ if (spacing)
+ gfc_add_modify (pblock, spacing, tmp);
else
- sm = gfc_evaluate_now (tmp, pblock);
+ spacing = gfc_evaluate_now (tmp, pblock);
/* Make sure that negative size arrays are translated
to being zero size. */
tmp = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
- sm, gfc_index_zero_node);
+ spacing, gfc_index_zero_node);
tmp = fold_build3_loc (input_location, COND_EXPR,
gfc_array_index_type, tmp,
- sm, gfc_index_zero_node);
- gfc_add_modify (pblock, sm, tmp);
+ spacing, gfc_index_zero_node);
+ gfc_add_modify (pblock, spacing, tmp);
}
- size = sm;
+ size = spacing;
}
gfc_trans_array_cobounds (type, pblock, sym);
@@ -6509,15 +6384,13 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol
* sym,
}
if (sym->attr.omp_allocate)
{
- /* The size is the number of elements in the array, so multiply by the
- size of an element to get the total size. */
- tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
- size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- size, fold_convert (gfc_array_index_type, tmp));
size = gfc_evaluate_now (size, &init);
tree omp_alloc = lookup_attribute ("omp allocate",
DECL_ATTRIBUTES (decl));
+ size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, size,
+ GFC_TYPE_ARRAY_ALIGN (type));
TREE_CHAIN (TREE_CHAIN (TREE_VALUE (omp_alloc)))
= build_tree_list (size, NULL_TREE);
space = NULL_TREE;
@@ -6532,12 +6405,9 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol *
sym,
}
else
{
- /* The size is the number of elements in the array, so multiply by the
- size of an element to get the total size. */
- tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
- size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- size, fold_convert (gfc_array_index_type, tmp));
-
+ size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, size,
+ GFC_TYPE_ARRAY_ALIGN (type));
/* Allocate memory to hold the data. */
tmp = gfc_call_malloc (&init, TREE_TYPE (decl), size);
gfc_add_modify (&init, decl, tmp);
@@ -6673,7 +6543,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree
tmpdesc,
tree dextent;
tree dumdesc;
tree tmp;
- tree stride2, sm;
+ tree stride2, spacing = NULL_TREE;
tree stmt_packed;
tree stmt_unpacked;
tree partial;
@@ -6734,7 +6604,9 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree
tmpdesc,
anything as we still don't know the array stride. */
partial = gfc_create_var (logical_type_node, "partial");
TREE_USED (partial) = 1;
- tmp = gfc_conv_descriptor_sm_get (dumdesc, gfc_rank_cst[0]);
+ tmp = gfc_conv_descriptor_spacing_get (dumdesc, gfc_rank_cst[0]);
+ tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ tmp, gfc_conv_descriptor_align_get (dumdesc));
tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, tmp,
gfc_conv_descriptor_span_get (dumdesc));
gfc_add_modify (&init, partial, tmp);
@@ -6747,23 +6619,27 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree
tmpdesc,
if (no_repack)
{
/* Set the first stride. */
- sm = gfc_conv_descriptor_sm_get (dumdesc, gfc_rank_cst[0]);
- tmp = gfc_evaluate_now (sm, &init);
- sm = GFC_TYPE_ARRAY_SM (type, 0);
- gfc_add_modify (&init, sm, tmp);
+ spacing = gfc_conv_descriptor_spacing_get (dumdesc, gfc_rank_cst[0]);
+ tmp = gfc_evaluate_now (spacing, &init);
+ spacing = GFC_TYPE_ARRAY_SPACING (type, 0);
+ gfc_add_modify (&init, spacing, tmp);
/* Allow the user to disable array repacking. */
stmt_unpacked = NULL_TREE;
}
else
{
- gcc_assert (GFC_TYPE_ARRAY_SM (type, 0) == GFC_TYPE_ARRAY_ELEM_LEN
(type));
/* A library call to repack the array if necessary. */
tmp = GFC_DECL_SAVED_DESCRIPTOR (tmpdesc);
stmt_unpacked = build_call_expr_loc (input_location,
gfor_fndecl_in_pack, 1, tmp);
- sm = GFC_TYPE_ARRAY_ELEM_LEN (type);
+ spacing = gfc_conv_descriptor_span_get (dumdesc);
+ spacing = fold_convert_loc (input_location, gfc_array_index_type,
+ spacing);
+ spacing = fold_build2_loc (input_location, EXACT_DIV_EXPR,
+ gfc_array_index_type, spacing,
+ GFC_TYPE_ARRAY_ALIGN (type));
if (warn_array_temporaries)
{
@@ -6794,6 +6670,10 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree
tmpdesc,
offset = gfc_index_zero_node;
size = gfc_index_one_node;
+ tree spacing_units = gfc_conv_descriptor_span_get (dumdesc);
+ spacing_units = fold_build2_loc (input_location, EXACT_DIV_EXPR,
+ gfc_array_index_type, spacing_units,
+ GFC_TYPE_ARRAY_ALIGN (TREE_TYPE (tmpdesc)));
/* Evaluate the bounds of the array. */
for (n = 0; n < as->rank; n++)
@@ -6863,42 +6743,59 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree
tmpdesc,
gfc_array_index_type, tmp, lbound);
gfc_add_modify (&init, ubound, tmp);
}
- /* The offset of this dimension. offset = offset - lbound * sm. */
+ /* The offset of this dimension. offset = offset - lbound * spacing. */
tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- lbound, sm);
+ lbound, spacing);
offset = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type, offset, tmp);
- /* The size of this dimension, and the sm of the next. */
+ /* The size of this dimension, and the spacing of the next. */
if (n + 1 < as->rank)
{
- sm = GFC_TYPE_ARRAY_SM (type, n + 1);
+ spacing = GFC_TYPE_ARRAY_SPACING (type, n + 1);
if (no_repack || partial != NULL_TREE)
stmt_unpacked =
- gfc_conv_descriptor_sm_get (dumdesc, gfc_rank_cst[n+1]);
+ gfc_conv_descriptor_spacing_get (dumdesc, gfc_rank_cst[n+1]);
- /* Figure out the sm if not a known constant. */
- if (!INTEGER_CST_P (sm))
+ /* Figure out the spacing if not a known constant. */
+ if (!INTEGER_CST_P (spacing))
{
if (no_repack)
stmt_packed = NULL_TREE;
else
{
- /* Calculate sm = size * (ubound + 1 - lbound). */
+ /* Calculate spacing = size * (ubound + 1 - lbound). */
size = fold_build2_loc (input_location, MULT_EXPR,
gfc_array_index_type, size, extent);
- stmt_packed = size;
+ spacing_units = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type,
+ spacing_units, extent);
+
+ stmt_packed = spacing_units;
}
- /* Assign the sm. */
+ /* Assign the spacing. */
if (stmt_packed != NULL_TREE && stmt_unpacked != NULL_TREE)
tmp = fold_build3_loc (input_location, COND_EXPR,
gfc_array_index_type, partial,
stmt_unpacked, stmt_packed);
else
tmp = (stmt_packed != NULL_TREE) ? stmt_packed : stmt_unpacked;
- gfc_add_modify (&init, sm, tmp);
+ gfc_add_modify (&init, spacing, tmp);
+ }
+ }
+ else
+ {
+ spacing = GFC_TYPE_ARRAY_SIZE (type);
+
+ if (spacing && !INTEGER_CST_P (spacing))
+ {
+ /* Calculate size = stride * (ubound + 1 - lbound). */
+ tmp = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type,
+ size, extent);
+ gfc_add_modify (&init, spacing, tmp);
}
}
}
@@ -7001,7 +6898,7 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm,
tree desc, tree offset,
return;
}
- tmp = build_array_ref (desc, offset, NULL, NULL);
+ tmp = build_array_ref (desc, offset);
/* Offset the data pointer for pointer assignments from arrays with
subreferences; e.g. my_integer => my_type(:)%integer_component. */
@@ -7034,7 +6931,7 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm,
tree desc, tree offset,
gfc_init_se (&start, NULL);
gfc_conv_expr_type (&start, ref->u.ss.start,
gfc_charlen_type_node);
gfc_add_block_to_block (block, &start.pre);
- tmp = gfc_build_array_ref (tmp, start.expr, NULL);
+ tmp = gfc_build_array_ref (tmp, start.expr, true);
break;
case REF_ARRAY:
@@ -7079,7 +6976,7 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm,
tree desc, tree offset,
}
/* Apply the index to obtain the array element. */
- tmp = gfc_build_array_ref (tmp, index, NULL);
+ tmp = gfc_build_array_ref (tmp, index, true);
break;
case REF_INQUIRY:
@@ -8955,13 +8852,13 @@ structure_alloc_comps (gfc_symbol * der_type, tree
decl, tree dest,
/* Build the body of the loop. */
gfc_init_block (&loopbody);
- vref = gfc_build_array_ref (var, index, NULL);
+ vref = gfc_build_array_ref (var, index, NULL_TREE, NULL_TREE);
if (purpose == COPY_ALLOC_COMP || purpose == COPY_ONLY_ALLOC_COMP)
{
tmp = build_fold_indirect_ref_loc (input_location,
gfc_conv_array_data (dest));
- dref = gfc_build_array_ref (tmp, index, NULL);
+ dref = gfc_build_array_ref (tmp, index, NULL_TREE, NULL_TREE);
tmp = structure_alloc_comps (der_type, vref, dref, rank,
COPY_ALLOC_COMP, caf_mode, args,
no_finalization);
@@ -10316,7 +10213,7 @@ update_reallocated_descriptor (stmtblock_t *block,
gfc_loopinfo *loop)
UPDATE_VALUE (info->end[dim],
gfc_conv_descriptor_ubound_get (desc, tree_dim));
UPDATE_VALUE (info->spacing[dim],
- gfc_conv_descriptor_sm_get (desc, tree_dim));
+ gfc_conv_descriptor_spacing_get (desc, tree_dim));
info->delta[dim] = gfc_evaluate_now (info->delta[dim], block);
}
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 709166f07551..d52c1a859459 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -160,8 +160,9 @@ void gfc_conv_array_parameter (gfc_se *, gfc_expr *, bool,
const gfc_symbol *,
/* These work with both descriptors and descriptorless arrays. */
tree gfc_conv_array_data (tree);
tree gfc_conv_array_offset (tree);
+tree gfc_conv_array_align (tree);
/* Return either an INT_CST or an expression for that part of the descriptor.
*/
-tree gfc_conv_array_sm (tree, int);
+tree gfc_conv_array_spacing (tree, int);
tree gfc_conv_array_lbound (tree, int);
tree gfc_conv_array_ubound (tree, int);
tree gfc_conv_array_extent (tree, int);
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 1e92b8c63925..b34cb15e34ca 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -1128,10 +1128,10 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym)
suppress_warning (GFC_TYPE_ARRAY_UBOUND (type, dim));
}
- if (GFC_TYPE_ARRAY_SM (type, dim) == NULL_TREE)
+ if (GFC_TYPE_ARRAY_SPACING (type, dim) == NULL_TREE)
{
- GFC_TYPE_ARRAY_SM (type, dim) = create_index_var ("sm", nest);
- suppress_warning (GFC_TYPE_ARRAY_SM (type, dim));
+ GFC_TYPE_ARRAY_SPACING (type, dim) = create_index_var ("spacing",
nest);
+ suppress_warning (GFC_TYPE_ARRAY_SPACING (type, dim));
}
}
for (dim = GFC_TYPE_ARRAY_RANK (type);
@@ -7597,7 +7597,9 @@ done:
tmp = gfc_conv_descriptor_extent_get (gfc_desc, idx);
gfc_add_modify (&loop_body, gfc_get_cfi_dim_extent (cfi, idx), tmp);
/* d->dim[n].sm = gfc->dim[i].stride * gfc->span); */
- tmp = gfc_conv_descriptor_sm_get (gfc_desc, idx);
+ tmp = gfc_conv_descriptor_spacing_get (gfc_desc, idx);
+ tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ tmp, gfc_conv_descriptor_align_get (gfc_desc));
gfc_add_modify (&loop_body, gfc_get_cfi_dim_sm (cfi, idx), tmp);
/* Generate loop. */
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index e5c1eb5b3835..1f35b6722998 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -106,7 +106,7 @@ static tree
gfc_get_cfi_dim_item (tree desc, tree idx, unsigned field_idx)
{
tree tmp = gfc_get_cfi_descriptor_field (desc, CFI_FIELD_DIM);
- tmp = gfc_build_array_ref (tmp, idx, NULL_TREE, true);
+ tmp = gfc_build_array_ref (tmp, idx, true);
tree field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp)), field_idx);
gcc_assert (field != NULL_TREE);
return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
@@ -165,10 +165,11 @@ gfc_get_cfi_dim_sm (tree desc, tree idx)
#define OFFSET_FIELD 1
#define DTYPE_FIELD 2
#define SPAN_FIELD 3
-#define DIMENSION_FIELD 4
-#define CAF_TOKEN_FIELD 5
+#define ALIGN_FIELD 4
+#define DIMENSION_FIELD 5
+#define CAF_TOKEN_FIELD 6
-#define SM_SUBFIELD 0
+#define SPACING_SUBFIELD 0
#define LBOUND_SUBFIELD 1
#define UBOUND_SUBFIELD 2
@@ -303,6 +304,27 @@ conv_span_set (stmtblock_t *block, tree desc, tree value)
gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
}
+tree
+get_align (tree desc)
+{
+ tree field = get_component (desc, ALIGN_FIELD);
+ gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
+ return field;
+}
+
+tree
+conv_align_get (tree desc)
+{
+ return non_lvalue_loc (input_location, get_align (desc));
+}
+
+void
+conv_align_set (stmtblock_t *block, tree desc, tree value)
+{
+ tree t = get_align (desc);
+ gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
+}
+
tree
get_rank (tree desc)
{
@@ -510,7 +532,7 @@ get_dimension (tree desc, tree dim)
tmp = get_dimensions (desc);
- return gfc_build_array_ref (tmp, dim, NULL_TREE, true);
+ return gfc_build_array_ref (tmp, dim, true);
}
tree
@@ -573,15 +595,15 @@ get_subfield (tree desc, tree dim, unsigned field_idx)
}
tree
-get_sm (tree desc, tree dim)
+get_spacing (tree desc, tree dim)
{
- tree field = get_subfield (desc, dim, SM_SUBFIELD);
+ tree field = get_subfield (desc, dim, SPACING_SUBFIELD);
gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
return field;
}
tree
-conv_sm_get (tree desc, tree dim)
+conv_spacing_get (tree desc, tree dim)
{
tree type = TREE_TYPE (desc);
gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
@@ -594,14 +616,14 @@ conv_sm_get (tree desc, tree dim)
|| GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT))
return conv_span_get (desc);
- return non_lvalue_loc (input_location, get_sm (desc, dim));
+ return non_lvalue_loc (input_location, get_spacing (desc, dim));
}
void
-conv_sm_set (stmtblock_t *block, tree desc, tree dim, tree value)
+conv_spacing_set (stmtblock_t *block, tree desc, tree dim, tree value)
{
location_t loc = input_location;
- tree t = get_sm (desc, dim);
+ tree t = get_spacing (desc, dim);
gfc_add_modify_loc (loc, block, t,
fold_convert_loc (loc, TREE_TYPE (t), value));
}
@@ -620,10 +642,14 @@ conv_stride_get (tree desc, tree dim)
|| GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT))
return gfc_index_one_node;
- tree sm = conv_sm_get (desc, dim);
- tree span = conv_span_get (desc);
+ tree spacing = conv_spacing_get (desc, dim);
+ tree align = conv_align_get (desc);
+ tree len = conv_elem_len_get (desc);
return fold_build2_loc (input_location, EXACT_DIV_EXPR, gfc_array_index_type,
- sm, span);
+ fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, spacing,
+ align),
+ len);
}
tree
@@ -747,6 +773,26 @@ gfc_conv_descriptor_span_set (stmtblock_t *block, tree
desc, tree value)
return gfc_descriptor::conv_span_set (block, desc, value);
}
+tree
+gfc_conv_descriptor_align_get (tree desc)
+{
+ return gfc_descriptor::conv_align_get (desc);
+}
+
+static void
+gfc_conv_descriptor_align_set (stmtblock_t *block, tree desc, tree value)
+{
+ return gfc_descriptor::conv_align_set (block, desc, value);
+}
+
+static void
+gfc_conv_descriptor_align_set (stmtblock_t *block, tree desc, int value)
+{
+ return gfc_conv_descriptor_align_set (block, desc,
+ build_int_cst (gfc_array_index_type,
+ value));
+}
+
tree
gfc_conv_descriptor_dimension_get (tree desc, tree dim)
{
@@ -864,16 +910,16 @@ gfc_conv_descriptor_token_set (stmtblock_t *block, tree
desc, tree value)
}
tree
-gfc_conv_descriptor_sm_get (tree desc, tree dim)
+gfc_conv_descriptor_spacing_get (tree desc, tree dim)
{
- return gfc_descriptor::conv_sm_get (desc, dim);
+ return gfc_descriptor::conv_spacing_get (desc, dim);
}
void
-gfc_conv_descriptor_sm_set (stmtblock_t *block, tree desc,
+gfc_conv_descriptor_spacing_set (stmtblock_t *block, tree desc,
tree dim, tree value)
{
- gfc_descriptor::conv_sm_set (block, desc, dim, value);
+ gfc_descriptor::conv_spacing_set (block, desc, dim, value);
}
tree
@@ -1958,8 +2004,8 @@ gfc_build_null_descriptor (tree type)
static void
set_bounds_update_offset (stmtblock_t *block, tree desc, int dim,
- tree lbound, tree ubound, tree sm, tree lbound_diff,
- tree *offset, tree *next_sm, bool sm_unchanged)
+ tree lbound, tree ubound, tree spacing, tree
lbound_diff,
+ tree *offset, tree *next_spacing, bool
spacing_unchanged)
{
/* Stabilize values in case the expressions depend on the existing bounds.
*/
lbound = fold_convert (gfc_array_index_type, lbound);
@@ -1968,8 +2014,8 @@ set_bounds_update_offset (stmtblock_t *block, tree desc,
int dim,
ubound = fold_convert (gfc_array_index_type, ubound);
ubound = gfc_evaluate_now (ubound, block);
- sm = fold_convert (gfc_array_index_type, sm);
- sm = gfc_evaluate_now (sm, block);
+ spacing = fold_convert (gfc_array_index_type, spacing);
+ spacing = gfc_evaluate_now (spacing, block);
lbound_diff = fold_convert (gfc_array_index_type, lbound_diff);
lbound_diff = gfc_evaluate_now (lbound_diff, block);
@@ -1978,39 +2024,38 @@ set_bounds_update_offset (stmtblock_t *block, tree
desc, int dim,
gfc_rank_cst[dim], lbound);
gfc_conv_descriptor_ubound_set (block, desc,
gfc_rank_cst[dim], ubound);
- if (!sm_unchanged)
- gfc_conv_descriptor_sm_set (block, desc,
- gfc_rank_cst[dim], sm);
+ if (!spacing_unchanged)
+ gfc_conv_descriptor_spacing_set (block, desc, gfc_rank_cst[dim], spacing);
- if (!offset && !next_sm)
+ if (!offset && !next_spacing)
return;
/* Update offset. */
if (!integer_zerop (lbound_diff))
{
tree tmp = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, lbound_diff, sm);
+ gfc_array_index_type, lbound_diff, spacing);
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type, *offset, tmp);
*offset = gfc_evaluate_now (tmp, block);
}
- if (!next_sm)
+ if (!next_spacing)
return;
/* Set sm for next dimension. */
tree tmp = gfc_conv_array_extent_dim (lbound, ubound, NULL);
- *next_sm = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, sm, tmp);
+ *next_spacing = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, spacing, tmp);
}
static void
set_descriptor_dimension (stmtblock_t *block, tree desc, int dim,
- tree lbound, tree ubound, tree sm, tree *offset,
+ tree lbound, tree ubound, tree spacing, tree *offset,
tree *next_sm)
{
- set_bounds_update_offset (block, desc, dim, lbound, ubound, sm, lbound,
+ set_bounds_update_offset (block, desc, dim, lbound, ubound, spacing, lbound,
offset, next_sm, false);
}
@@ -2027,7 +2072,7 @@ conv_shift_descriptor_lbound (stmtblock_t* block, tree
from_desc, tree to_desc,
tree lbound = gfc_conv_descriptor_lbound_get (from_desc, gfc_rank_cst[dim]);
tree ubound = gfc_conv_descriptor_ubound_get (from_desc, gfc_rank_cst[dim]);
- tree sm = gfc_conv_descriptor_sm_get (from_desc, gfc_rank_cst[dim]);
+ tree spacing = gfc_conv_descriptor_spacing_get (from_desc,
gfc_rank_cst[dim]);
tree diff;
if (zero_based)
@@ -2045,7 +2090,7 @@ conv_shift_descriptor_lbound (stmtblock_t* block, tree
from_desc, tree to_desc,
tree tmp1 = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
ubound, diff);
- set_bounds_update_offset (block, to_desc, dim, new_lbound, tmp1, sm, diff,
+ set_bounds_update_offset (block, to_desc, dim, new_lbound, tmp1, spacing,
diff,
offset, nullptr, from_desc == to_desc);
}
@@ -2391,6 +2436,9 @@ gfc_conv_remap_descriptor (stmtblock_t *block, tree dest,
tree src,
}
gfc_conv_descriptor_span_set (block, dest, span);
+ gfc_conv_descriptor_align_set (block, dest,
+ gfc_conv_descriptor_align_get (dest));
+
/* Copy offset but adjust it such that it would correspond
to a lbound of zero. */
tree offset;
@@ -2401,10 +2449,10 @@ gfc_conv_remap_descriptor (stmtblock_t *block, tree
dest, tree src,
tree offs = gfc_conv_descriptor_offset_get (src);
for (int dim = 0; dim < src_rank; ++dim)
{
- tree sm = gfc_conv_descriptor_sm_get (src, gfc_rank_cst[dim]);
+ tree spacing = gfc_conv_descriptor_spacing_get (src,
gfc_rank_cst[dim]);
tree lbound = gfc_conv_descriptor_lbound_get (src, gfc_rank_cst[dim]);
tmp = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, sm, lbound);
+ gfc_array_index_type, spacing, lbound);
offs = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type, offs, tmp);
}
@@ -2412,7 +2460,7 @@ gfc_conv_remap_descriptor (stmtblock_t *block, tree dest,
tree src,
}
/* Set the bounds as declared for the LHS and calculate strides as
well as another offset update accordingly. */
- tree sm = gfc_conv_descriptor_sm_get (src, gfc_rank_cst[0]);
+ tree spacing = gfc_conv_descriptor_spacing_get (src, gfc_rank_cst[0]);
int last_dim = dest_rank - 1;
for (int dim = 0; dim < dest_rank; ++dim)
{
@@ -2431,8 +2479,8 @@ gfc_conv_remap_descriptor (stmtblock_t *block, tree dest,
tree src,
gfc_add_block_to_block (block, &upper_se.pre);
set_descriptor_dimension (block, dest, dim, lower_se.expr, upper_se.expr,
- sm, &offset,
- dim < last_dim ? &sm : nullptr);
+ spacing, &offset,
+ dim < last_dim ? &spacing : nullptr);
}
gfc_conv_descriptor_offset_set (block, dest, offset);
}
@@ -2489,6 +2537,9 @@ gfc_copy_descriptor (stmtblock_t *block, tree dest, tree
src,
else
tmp2 = gfc_get_array_span (src, src_expr);
gfc_conv_descriptor_span_set (block, dest, tmp2);
+
+ gfc_conv_descriptor_align_set (block, dest,
+ gfc_conv_descriptor_align_get (src));
}
@@ -2498,10 +2549,13 @@ gfc_set_descriptor_with_shape (stmtblock_t *block, tree
desc,
locus *where)
{
/* Set the span field. */
- tree elem_len = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc)));
+ tree elem_type = gfc_get_element_type (TREE_TYPE (desc));
+ tree elem_len = TYPE_SIZE_UNIT (elem_type);
elem_len = fold_convert (gfc_array_index_type, elem_len);
gfc_conv_descriptor_span_set (block, desc, elem_len);
+ gfc_conv_descriptor_align_set (block, desc, TYPE_ALIGN_UNIT (elem_type));
+
/* Set data value, dtype, and offset. */
tree tmp = GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc));
gfc_conv_descriptor_data_set (block, desc, fold_convert (tmp, ptr));
@@ -2524,9 +2578,13 @@ gfc_set_descriptor_with_shape (stmtblock_t *block, tree
desc,
gfc_copy_loopinfo_to_se (&shapese, &loop);
shapese.ss = shape_ss;
- tree sm = gfc_create_var (gfc_array_index_type, "sm");
+ tree spacing = gfc_create_var (gfc_array_index_type, "spacing");
tree offset = gfc_create_var (gfc_array_index_type, "offset");
- gfc_add_modify (block, sm, elem_len);
+ tmp = fold_build2_loc (input_location, EXACT_DIV_EXPR,
+ gfc_array_index_type, elem_len,
+ build_int_cst (gfc_array_index_type,
+ TYPE_ALIGN_UNIT (elem_type)));
+ gfc_add_modify (block, spacing, tmp);
gfc_add_modify (block, offset, gfc_index_zero_node);
/* Loop body. */
@@ -2536,9 +2594,9 @@ gfc_set_descriptor_with_shape (stmtblock_t *block, tree
desc,
tree dim = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
loop.loopvar[0], loop.from[0]);
- /* Set bounds and sm. */
+ /* Set bounds and spacing. */
gfc_conv_descriptor_lbound_set (&body, desc, dim, gfc_index_one_node);
- gfc_conv_descriptor_sm_set (&body, desc, dim, sm);
+ gfc_conv_descriptor_spacing_set (&body, desc, dim, spacing);
gfc_conv_expr (&shapese, shape);
gfc_add_block_to_block (&body, &shapese.pre);
@@ -2548,11 +2606,11 @@ gfc_set_descriptor_with_shape (stmtblock_t *block, tree
desc,
/* Calculate offset. */
gfc_add_modify (&body, offset,
fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type, offset, sm));
- /* Update sm. */
- gfc_add_modify (&body, sm,
+ gfc_array_index_type, offset, spacing));
+ /* Update spacing. */
+ gfc_add_modify (&body, spacing,
fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, sm,
+ gfc_array_index_type, spacing,
fold_convert (gfc_array_index_type,
shapese.expr)));
/* Finish scalarization loop. */
@@ -2607,27 +2665,26 @@ gfc_copy_sequence_descriptor (stmtblock_t &block, tree
lhs_desc, tree rhs_desc,
gfc_conv_descriptor_lbound_set (&block, arr, gfc_index_zero_node,
gfc_index_zero_node);
tree size = gfc_conv_descriptor_size (rhs_desc, rhs_rank);
- tree span = gfc_conv_descriptor_span_get (rhs_desc);
+ tree spacing0 =
+ gfc_conv_descriptor_spacing_get (rhs_desc, gfc_index_zero_node);
size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- size, span);
+ size, spacing0);
gfc_conv_descriptor_ubound_set (&block, arr, gfc_index_zero_node, size);
- gfc_conv_descriptor_sm_set (
- &block, arr, gfc_index_zero_node,
- gfc_conv_descriptor_sm_get (rhs_desc, gfc_index_zero_node));
+ gfc_conv_descriptor_spacing_set ( &block, arr, gfc_index_zero_node,
spacing0);
for (int i = 1; i < lhs_rank; i++)
{
gfc_conv_descriptor_lbound_set (&block, arr, gfc_rank_cst[i],
gfc_index_zero_node);
gfc_conv_descriptor_ubound_set (&block, arr, gfc_rank_cst[i],
gfc_index_zero_node);
- gfc_conv_descriptor_sm_set (&block, arr, gfc_rank_cst[i], size);
+ gfc_conv_descriptor_spacing_set (&block, arr, gfc_rank_cst[i], size);
}
gfc_conv_descriptor_dtype_set (&block, arr,
gfc_conv_descriptor_dtype_get (rhs_desc));
tree rank_value = build_int_cst (signed_char_type_node, lhs_rank);
gfc_conv_descriptor_rank_set (&block, arr, rank_value);
- gfc_conv_descriptor_span_set (&block, arr,
- gfc_conv_descriptor_span_get (arr));
+ gfc_conv_descriptor_align_set (&block, arr,
+ gfc_conv_descriptor_align_get (rhs_desc));
gfc_conv_descriptor_offset_set (&block, arr, gfc_index_zero_node);
desc = arr;
}
@@ -2644,6 +2701,8 @@ gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block,
{
tree tmp = gfc_get_cfi_desc_base_addr (cfi);
gfc_conv_descriptor_data_set (unconditional_block, gfc, tmp);
+ gfc_conv_descriptor_align_set (unconditional_block, gfc,
+ GFC_TYPE_ARRAY_ALIGN (TREE_TYPE (gfc)));
if (init_static)
{
@@ -2782,6 +2841,9 @@ gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block,
}
gfc_conv_descriptor_span_set (conditional_block, gfc, tmp);
+ gfc_conv_descriptor_align_set (conditional_block, gfc,
+ TYPE_ALIGN (gfc_get_element_type (TREE_TYPE
(gfc))));
+
/* Calculate offset + set lbound, ubound and stride. */
gfc_conv_descriptor_offset_set (conditional_block, gfc, gfc_index_zero_node);
if (gfc_sym
@@ -2830,29 +2892,36 @@ gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block,
if (contiguous_gfc)
{
- /* gfc->dim[i].sm
- = idx == 0 ? cfi->elem_len : gfc->dim[i-1].stride *
cfi->dim[i-1].extent */
+ /* gfc->dim[i].spacing
+ = idx == 0 ? cfi->elem_len / gfc->align : gfc->dim[i-1].spacing *
cfi->dim[i-1].extent */
tree cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
idx, build_zero_cst (TREE_TYPE (idx)));
tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (idx),
idx, build_int_cst (TREE_TYPE (idx), 1));
tree tmp2 = gfc_get_cfi_dim_extent (cfi, tmp);
- tmp = gfc_conv_descriptor_sm_get (gfc, tmp);
+ tmp = gfc_conv_descriptor_spacing_get (gfc, tmp);
tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (tmp2),
tmp2, tmp);
+ tmp2 = fold_build2_loc (input_location, EXACT_DIV_EXPR,
gfc_array_index_type,
+ gfc_get_cfi_desc_elem_len (cfi),
+ fold_convert_loc (input_location,
gfc_array_index_type,
+ GFC_TYPE_ARRAY_ALIGN (gfc)));
tmp = build3_loc (input_location, COND_EXPR, gfc_array_index_type, cond,
- gfc_get_cfi_desc_elem_len (cfi), tmp);
+ tmp2, tmp);
}
else
{
- /* gfc->dim[i].stride = cfi->dim[i].sm / cfi>elem_len */
- tmp = gfc_get_cfi_dim_sm (cfi, idx);
+ /* gfc->dim[i].spacing = cfi->dim[i].sm / gfc->align */
+ tmp = fold_build2_loc (input_location, EXACT_DIV_EXPR,
+ gfc_array_index_type,
+ gfc_get_cfi_dim_sm (cfi, idx),
+ GFC_TYPE_ARRAY_ALIGN (TREE_TYPE (gfc)));
}
- gfc_conv_descriptor_sm_set (&loop_body, gfc, idx, tmp);
+ gfc_conv_descriptor_spacing_set (&loop_body, gfc, idx, tmp);
- /* gfc->offset -= gfc->dim[i].stride * gfc->dim[i].lbound. */
+ /* gfc->offset -= gfc->dim[i].spacing * gfc->dim[i].lbound. */
tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- gfc_conv_descriptor_sm_get (gfc, idx),
+ gfc_conv_descriptor_spacing_get (gfc, idx),
gfc_conv_descriptor_lbound_get (gfc, idx));
tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
gfc_conv_descriptor_offset_get (gfc), tmp);
@@ -2870,7 +2939,7 @@ void
gfc_get_descriptor_offsets_for_info (const_tree desc_type, tree *data_off,
tree *dtype_off, tree *span_off,
tree *dim_off, tree *dim_size,
- tree *sm_suboff, tree *lower_suboff,
+ tree *spacing_suboff, tree *lower_suboff,
tree *upper_suboff)
{
tree field;
@@ -2887,8 +2956,8 @@ gfc_get_descriptor_offsets_for_info (const_tree
desc_type, tree *data_off,
*dim_off = byte_position (field);
type = TREE_TYPE (TREE_TYPE (field));
*dim_size = TYPE_SIZE_UNIT (type);
- field = gfc_advance_chain (TYPE_FIELDS (type), SM_SUBFIELD);
- *sm_suboff = byte_position (field);
+ field = gfc_advance_chain (TYPE_FIELDS (type), SPACING_SUBFIELD);
+ *spacing_suboff = byte_position (field);
field = gfc_advance_chain (TYPE_FIELDS (type), LBOUND_SUBFIELD);
*lower_suboff = byte_position (field);
field = gfc_advance_chain (TYPE_FIELDS (type), UBOUND_SUBFIELD);
@@ -2910,10 +2979,10 @@ gfc_get_descriptor_offsets_for_info (const_tree
desc_type, tree *data_off,
void
gfc_set_temporary_descriptor (stmtblock_t *block, tree desc, tree class_src,
- tree elemsize, tree data_ptr,
+ tree elemsize, tree elem_align, tree data_ptr,
tree lbound[GFC_MAX_DIMENSIONS],
tree ubound[GFC_MAX_DIMENSIONS],
- tree sm[GFC_MAX_DIMENSIONS], int rank,
+ tree spacing[GFC_MAX_DIMENSIONS], int rank,
bool omit_bounds, bool rank_changer,
bool shift_bounds)
{
@@ -2949,12 +3018,14 @@ gfc_set_temporary_descriptor (stmtblock_t *block, tree
desc, tree class_src,
/* Store the stride and bound components in the descriptor. */
tree this_lbound = shift_bounds ? gfc_index_zero_node : lbound[n];
set_descriptor_dimension (block, desc, n, this_lbound, ubound[n],
- sm[n], &offset, nullptr);
+ spacing[n], &offset, nullptr);
}
}
gfc_conv_descriptor_span_set (block, desc, elemsize);
-
+
+ gfc_conv_descriptor_align_set (block, desc, elem_align);
+
gfc_conv_descriptor_data_set (block, desc, data_ptr);
/* The offset is zero because we create temporaries with a zero
@@ -3032,6 +3103,9 @@ gfc_set_descriptor (stmtblock_t *block, tree dest, tree
src, gfc_expr *src_expr,
if (tmp)
gfc_conv_descriptor_span_set (block, dest, tmp);
+ tree eltype = gfc_get_element_type (TREE_TYPE (dest));
+ gfc_conv_descriptor_align_set (block, dest, TYPE_ALIGN (eltype));
+
/* The following can be somewhat confusing. We have two
descriptors, a new one and the original array.
{dest, parmtype, dim} refer to the new one.
@@ -3065,7 +3139,7 @@ gfc_set_descriptor (stmtblock_t *block, tree dest, tree
src, gfc_expr *src_expr,
for (int n = 0; n < ndim; n++)
{
- tree sm = gfc_conv_array_sm (src, n);
+ tree spacing = gfc_conv_array_spacing (src, n);
/* Work out the 1st element in the section. */
tree start;
@@ -3080,14 +3154,14 @@ gfc_set_descriptor (stmtblock_t *block, tree dest, tree
src, gfc_expr *src_expr,
{
/* Evaluate and remember the start of the section. */
start = info->start[n];
- sm = gfc_evaluate_now (sm, block);
+ spacing = gfc_evaluate_now (spacing, block);
}
tmp = gfc_conv_array_lbound (src, n);
tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (tmp),
start, tmp);
tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (tmp),
- tmp, sm);
+ tmp, spacing);
offset = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (tmp),
offset, tmp);
@@ -3123,19 +3197,19 @@ gfc_set_descriptor (stmtblock_t *block, tree dest, tree
src, gfc_expr *src_expr,
gfc_conv_descriptor_ubound_set (block, dest,
gfc_rank_cst[dim], to);
- /* Multiply the sm by the section stride to get the
+ /* Multiply the spacing by the section stride to get the
total stride. */
- sm = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type,
- sm, info->stride[n]);
+ spacing = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type,
+ spacing, info->stride[n]);
tmp = fold_build2_loc (input_location, MULT_EXPR,
- TREE_TYPE (offset), sm, from);
+ TREE_TYPE (offset), spacing, from);
offset = fold_build2_loc (input_location, MINUS_EXPR,
TREE_TYPE (offset), offset, tmp);
- /* Store the new sm. */
- gfc_conv_descriptor_sm_set (block, dest, gfc_rank_cst[dim], sm);
+ /* Store the new spacing. */
+ gfc_conv_descriptor_spacing_set (block, dest, gfc_rank_cst[dim],
spacing);
}
for (int n = rank; n < rank + corank; n++)
@@ -3220,7 +3294,7 @@ gfc_descr_init_count (tree descriptor, int rank, int
corank, gfc_expr ** lower,
tree size;
tree offset;
tree stride;
- tree sm;
+ tree spacing;
tree cond;
gfc_expr *ubound;
gfc_se se;
@@ -3231,6 +3305,9 @@ gfc_descr_init_count (tree descriptor, int rank, int
corank, gfc_expr ** lower,
stride = gfc_index_one_node;
offset = gfc_index_zero_node;
+ gfc_conv_descriptor_align_set (descriptor_block, descriptor,
+ GFC_TYPE_ARRAY_ALIGN (type));
+
/* Set the dtype before the alloc, because registration of coarrays needs
it initialized. */
if (expr->ts.type == BT_CHARACTER
@@ -3276,8 +3353,11 @@ gfc_descr_init_count (tree descriptor, int rank, int
corank, gfc_expr ** lower,
gfc_conv_descriptor_dtype_set (pblock, descriptor, gfc_get_dtype (type));
tree empty_cond = logical_false_node;
- sm = gfc_conv_descriptor_elem_len_get (descriptor);
- sm = fold_convert_loc (input_location, gfc_array_index_type, sm);
+ spacing = gfc_conv_descriptor_elem_len_get (descriptor);
+ spacing = fold_convert_loc (input_location, gfc_array_index_type, spacing);
+ spacing = fold_build2_loc (input_location, EXACT_DIV_EXPR,
+ gfc_array_index_type, spacing,
+ GFC_TYPE_ARRAY_ALIGN (type));
for (n = 0; n < rank; n++)
{
@@ -3326,7 +3406,7 @@ gfc_descr_init_count (tree descriptor, int rank, int
corank, gfc_expr ** lower,
/* Work out the offset for this component. */
tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- se.expr, sm);
+ se.expr, spacing);
offset = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type, offset, tmp);
@@ -3365,9 +3445,9 @@ gfc_descr_init_count (tree descriptor, int rank, int
corank, gfc_expr ** lower,
gfc_rank_cst[n], se.expr);
conv_ubound = se.expr;
- /* Store the sm. */
- gfc_conv_descriptor_sm_set (descriptor_block, descriptor,
- gfc_rank_cst[n], sm);
+ /* Store the spacing. */
+ gfc_conv_descriptor_spacing_set (descriptor_block, descriptor,
+ gfc_rank_cst[n], spacing);
/* Calculate size and check whether extent is negative. */
size = gfc_conv_array_extent_dim (conv_lbound, conv_ubound,
@@ -3385,7 +3465,7 @@ gfc_descr_init_count (tree descriptor, int rank, int
corank, gfc_expr ** lower,
TYPE_MAX_VALUE
(gfc_array_index_type)),
size);
cond = gfc_unlikely (fold_build2_loc (input_location, LT_EXPR,
- logical_type_node, tmp, sm),
+ logical_type_node, tmp, spacing),
PRED_FORTRAN_OVERFLOW);
tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node,
cond,
integer_one_node, integer_zero_node);
@@ -3404,9 +3484,9 @@ gfc_descr_init_count (tree descriptor, int rank, int
corank, gfc_expr ** lower,
gfc_array_index_type, stride, size);
stride = gfc_evaluate_now (stride, pblock);
- sm = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, sm, size);
- sm = gfc_evaluate_now (sm, pblock);
+ spacing = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, spacing, size);
+ spacing = gfc_evaluate_now (spacing, pblock);
}
for (n = rank; n < rank + corank; n++)
@@ -3458,6 +3538,9 @@ gfc_descr_init_count (tree descriptor, int rank, int
corank, gfc_expr ** lower,
tmp = fold_convert (gfc_array_index_type, element_size);
gfc_conv_descriptor_span_set (descriptor_block, descriptor, tmp);
+ gfc_conv_descriptor_align_set (descriptor_block, descriptor,
+ TYPE_ALIGN (gfc_get_element_type (TREE_TYPE
(descriptor))));
+
return gfc_evaluate_now (stride, pblock);
}
@@ -3496,15 +3579,18 @@ gfc_set_contiguous_array (stmtblock_t *block, tree
desc, tree size,
tree data_ptr)
{
tree dtype_value = gfc_get_dtype_rank_type (1, TREE_TYPE (desc));
+ gfc_conv_descriptor_align_set (block, desc,
+ GFC_TYPE_ARRAY_ALIGN (TREE_TYPE (desc)));
gfc_conv_descriptor_dtype_set (block, desc, dtype_value);
gfc_conv_descriptor_lbound_set (block, desc,
gfc_index_zero_node,
gfc_index_one_node);
- gfc_conv_descriptor_sm_set (block, desc,
- gfc_index_zero_node,
- gfc_conv_descriptor_span_get (desc));
- gfc_conv_descriptor_ubound_set (block, desc,
- gfc_index_zero_node, size);
+ tree span = gfc_conv_descriptor_span_get (desc);
+ tree spacing = fold_build2_loc (input_location, EXACT_DIV_EXPR,
+ gfc_array_index_type, span,
+ GFC_TYPE_ARRAY_ALIGN (TREE_TYPE (desc)));
+ gfc_conv_descriptor_spacing_set (block, desc, gfc_index_zero_node, spacing);
+ gfc_conv_descriptor_ubound_set (block, desc, gfc_index_zero_node, size);
gfc_conv_descriptor_data_set (block, desc, data_ptr);
}
@@ -3583,7 +3669,7 @@ gfc_copy_descriptor (stmtblock_t *block, tree dst, tree
src, int rank)
{
dim = gfc_rank_cst[n];
tmp = gfc_conv_descriptor_lbound_get (src, dim);
- tmp2 = gfc_conv_descriptor_sm_get (src, dim);
+ tmp2 = gfc_conv_descriptor_spacing_get (src, dim);
tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (tmp),
tmp, tmp2);
offset = fold_build2_loc (input_location, MINUS_EXPR,
@@ -3603,7 +3689,7 @@ get_std_lbound (gfc_expr *expr, tree desc, int dim, bool
assumed_size)
{
tree lbound;
tree ubound;
- tree sm;
+ tree spacing;
tree cond, cond1, cond3, cond4;
tree tmp;
gfc_ref *ref;
@@ -3613,15 +3699,15 @@ get_std_lbound (gfc_expr *expr, tree desc, int dim,
bool assumed_size)
tmp = gfc_rank_cst[dim];
lbound = gfc_conv_descriptor_lbound_get (desc, tmp);
ubound = gfc_conv_descriptor_ubound_get (desc, tmp);
- sm = gfc_conv_descriptor_sm_get (desc, tmp);
+ spacing = gfc_conv_descriptor_spacing_get (desc, tmp);
cond1 = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
ubound, lbound);
cond3 = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
- sm, gfc_index_zero_node);
+ spacing, gfc_index_zero_node);
cond3 = fold_build2_loc (input_location, TRUTH_AND_EXPR,
logical_type_node, cond3, cond1);
cond4 = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
- sm, gfc_index_zero_node);
+ spacing, gfc_index_zero_node);
if (assumed_size)
cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
tmp, build_int_cst (gfc_array_index_type,
@@ -3697,7 +3783,9 @@ gfc_set_descriptor_for_assign_realloc (stmtblock_t
*block, gfc_loopinfo *loop,
to the corresponding element of LBOUND(expr)."
Reuse size1 to keep a dimension-by-dimension track of the
stride of the new array. */
- tree size1 = elemsize2;
+ tree size1 = fold_build2_loc (input_location, EXACT_DIV_EXPR,
+ gfc_array_index_type, elemsize2,
+ GFC_TYPE_ARRAY_ALIGN (TREE_TYPE (desc)));
tree offset = gfc_index_zero_node;
for (int n = 0; n < expr2->rank; n++)
@@ -3724,7 +3812,7 @@ gfc_set_descriptor_for_assign_realloc (stmtblock_t
*block, gfc_loopinfo *loop,
gfc_conv_descriptor_lbound_set (block, desc, gfc_rank_cst[n], lbound);
gfc_conv_descriptor_ubound_set (block, desc, gfc_rank_cst[n], ubound);
- gfc_conv_descriptor_sm_set (block, desc, gfc_rank_cst[n], size1);
+ gfc_conv_descriptor_spacing_set (block, desc, gfc_rank_cst[n], size1);
lbound = gfc_conv_descriptor_lbound_get (desc,
gfc_rank_cst[n]);
tree tmp2 = fold_build2_loc (input_location, MULT_EXPR,
@@ -3742,7 +3830,11 @@ gfc_set_descriptor_for_assign_realloc (stmtblock_t
*block, gfc_loopinfo *loop,
gfc_conv_descriptor_offset_set (block, desc, offset);
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
- gfc_conv_descriptor_span_set (block, desc, elemsize2);
+ {
+ gfc_conv_descriptor_span_set (block, desc, elemsize2);
+ gfc_conv_descriptor_align_set (block, desc,
+ GFC_TYPE_ARRAY_ALIGN (TREE_TYPE (desc)));
+ }
/* For deferred character length, the 'size' field of the dtype might
have changed so set the dtype. */
@@ -3822,9 +3914,13 @@ gfc_set_pdt_array_descriptor (stmtblock_t *block, tree
desc,
fields can then be filled from the values so obtained. */
gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)));
+ gfc_conv_descriptor_align_set (block, desc,
+ GFC_TYPE_ARRAY_ALIGN (TREE_TYPE (desc)));
gfc_conv_descriptor_dtype_set (block, desc,
gfc_get_dtype (TREE_TYPE (desc)));
tree size = gfc_conv_descriptor_elem_len_get (desc);
+ size = fold_build2_loc (input_location, EXACT_DIV_EXPR, gfc_array_index_type,
+ desc, GFC_TYPE_ARRAY_ALIGN (TREE_TYPE (desc)));
tree offset = gfc_index_zero_node;
for (int i = 0; i < as->rank; i++)
{
@@ -3844,17 +3940,12 @@ gfc_set_pdt_array_descriptor (stmtblock_t *block, tree
desc,
gfc_free_expr (e);
tree upper = tse.expr;
gfc_conv_descriptor_ubound_set (block, desc, gfc_rank_cst[i], upper);
- gfc_conv_descriptor_sm_set (block, desc, gfc_rank_cst[i], size);
size = gfc_evaluate_now (size, block);
+ gfc_conv_descriptor_spacing_set (block, desc, gfc_rank_cst[i], size);
offset = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type, offset, size);
offset = gfc_evaluate_now (offset, block);
- tree tmp = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type,
- upper, lower);
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type,
- tmp, gfc_index_one_node);
+ tree tmp = gfc_conv_array_extent_dim (lower, upper, nullptr);
size = fold_build2_loc (input_location, MULT_EXPR,
gfc_array_index_type, size, tmp);
}
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index b991d2a41895..5f1d7f3f17b9 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -41,6 +41,7 @@ void gfc_copy_descriptor (stmtblock_t *block, tree dest, tree
src,
tree gfc_conv_descriptor_data_get (tree);
tree gfc_conv_descriptor_offset_get (tree);
tree gfc_conv_descriptor_span_get (tree);
+tree gfc_conv_descriptor_align_get (tree);
tree gfc_conv_descriptor_dtype_get (tree);
tree gfc_conv_descriptor_rank_get (tree);
tree gfc_conv_descriptor_elem_len_get (tree);
@@ -54,7 +55,7 @@ tree gfc_conv_descriptor_stride_get (tree, tree);
tree gfc_conv_descriptor_lbound_get (tree, tree);
tree gfc_conv_descriptor_ubound_get (tree, tree);
tree gfc_conv_descriptor_extent_get (tree, tree);
-tree gfc_conv_descriptor_sm_get (tree, tree);
+tree gfc_conv_descriptor_spacing_get (tree, tree);
tree gfc_conv_descriptor_token_get (tree);
tree gfc_conv_descriptor_token_field (tree);
@@ -84,7 +85,7 @@ void gfc_conv_shift_descriptor (stmtblock_t*, tree, tree,
int, tree);
void gfc_conv_shift_descriptor_subarray (stmtblock_t*, tree, gfc_expr *,
gfc_expr *);
void gfc_conv_shift_descriptor (stmtblock_t *, tree, int, tree *, tree *);
-void gfc_set_temporary_descriptor (stmtblock_t *, tree, tree, tree, tree,
+void gfc_set_temporary_descriptor (stmtblock_t *, tree, tree, tree, tree, tree,
tree[GFC_MAX_DIMENSIONS],
tree[GFC_MAX_DIMENSIONS],
tree[GFC_MAX_DIMENSIONS], int, bool, bool,
bool);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index e49d447bb85e..acd6ee937d28 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -2785,7 +2785,7 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
/* For BIND(C), a BT_CHARACTER is not an ARRAY_TYPE. */
if (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE)
{
- tmp = gfc_build_array_ref (tmp, start.expr, NULL_TREE, true);
+ tmp = gfc_build_array_ref (tmp, start.expr, true);
se->expr = gfc_build_addr_expr (type, tmp);
}
}
@@ -4798,7 +4798,7 @@ gfc_set_interface_mapping_bounds (stmtblock_t * block,
tree type, tree desc)
for (n = 0; n < GFC_TYPE_ARRAY_RANK (type); n++)
{
dim = gfc_rank_cst[n];
- GFC_TYPE_ARRAY_SM (type, n) = gfc_conv_array_sm (desc, n);
+ GFC_TYPE_ARRAY_SPACING (type, n) = gfc_conv_array_spacing (desc, n);
if (GFC_TYPE_ARRAY_LBOUND (type, n) == NULL_TREE)
{
GFC_TYPE_ARRAY_LBOUND (type, n)
@@ -4820,7 +4820,7 @@ gfc_set_interface_mapping_bounds (stmtblock_t * block,
tree type, tree desc)
}
tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
GFC_TYPE_ARRAY_LBOUND (type, n),
- GFC_TYPE_ARRAY_SM (type, n));
+ GFC_TYPE_ARRAY_SPACING (type, n));
offset = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type, offset, tmp);
}
@@ -6245,7 +6245,9 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr
*e, gfc_symbol *fsym)
tmp = gfc_conv_descriptor_extent_get (gfc, idx);
gfc_add_modify (&loop_body, gfc_get_cfi_dim_extent (cfi, idx), tmp);
/* d->dim[n].sm = gfc->dim[i].stride * gfc->span); */
- tmp = gfc_conv_descriptor_sm_get (gfc, idx);
+ tmp = gfc_conv_descriptor_spacing_get (gfc, idx);
+ tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ tmp, gfc_conv_descriptor_align_get (gfc));
gfc_add_modify (&loop_body, gfc_get_cfi_dim_sm (cfi, idx), tmp);
/* Generate loop. */
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 7e0089161777..9b8874910cee 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -2347,19 +2347,21 @@ gfc_conv_is_contiguous_expr (gfc_se *se, gfc_expr *arg)
gfc_add_block_to_block (&se->post, &argse.post);
desc = gfc_evaluate_now (argse.expr, &se->pre);
- tree sm = gfc_conv_descriptor_sm_get (desc, gfc_rank_cst[0]);
+ tree spacing = gfc_conv_descriptor_spacing_get (desc, gfc_rank_cst[0]);
+ tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ spacing, gfc_conv_descriptor_align_get (desc));
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
- sm, gfc_conv_descriptor_span_get (desc));
+ tmp, gfc_conv_descriptor_span_get (desc));
for (i = 0; i < arg->rank - 1; i++)
{
extent = gfc_conv_descriptor_extent_get (desc, gfc_rank_cst[i]);
- tmp = gfc_conv_descriptor_sm_get (desc, gfc_rank_cst[i]);
+ tmp = gfc_conv_descriptor_spacing_get (desc, gfc_rank_cst[i]);
tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (tmp),
tmp, extent);
- sm = gfc_conv_descriptor_sm_get (desc, gfc_rank_cst[i+1]);
+ spacing = gfc_conv_descriptor_spacing_get (desc, gfc_rank_cst[i+1]);
tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
- sm, tmp);
+ spacing, tmp);
cond = fold_build2_loc (input_location, TRUTH_AND_EXPR,
boolean_type_node, cond, tmp);
}
@@ -5533,8 +5535,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
for (int i = 0; i < arrayexpr->rank; i++)
{
tree res_idx = build_int_cst (gfc_array_index_type, i);
- tree res_arr_ref = gfc_build_array_ref (result_var, res_idx,
- NULL_TREE, true);
+ tree res_arr_ref = gfc_build_array_ref (result_var, res_idx, true);
tree value = convert (type, pos[i]);
gfc_add_modify (&se->pre, res_arr_ref, value);
@@ -9003,7 +9004,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
}
else
tmp = gfc_rank_cst[arg1->expr->rank - 1];
- tmp = gfc_conv_descriptor_sm_get (arg1se.expr, tmp);
+ tmp = gfc_conv_descriptor_spacing_get (arg1se.expr, tmp);
if (arg2->expr->rank != 0)
nonzero_arraylen = fold_build2_loc (input_location, NE_EXPR,
logical_type_node, tmp,
diff --git a/gcc/fortran/trans-io.cc b/gcc/fortran/trans-io.cc
index 99df15dcd86b..52b011217e55 100644
--- a/gcc/fortran/trans-io.cc
+++ b/gcc/fortran/trans-io.cc
@@ -772,10 +772,13 @@ gfc_convert_array_to_string (gfc_se * se, gfc_expr * e)
else
{
gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
- tree sm = gfc_conv_array_sm (array, rank);
+ tree spacing = gfc_conv_array_spacing (array, rank);
tree tmp = gfc_conv_array_extent (array, rank);
full_size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, tmp, sm);
+ gfc_array_index_type, tmp, spacing);
+ full_size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, full_size,
+ GFC_TYPE_ARRAY_ALIGN (type));
}
gcc_assert (elts_count || full_size);
@@ -1652,7 +1655,7 @@ nml_get_addr_expr (gfc_symbol * sym, gfc_component * c,
tmp = gfc_build_addr_expr (NULL_TREE, tmp);
if (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE)
- tmp = gfc_build_array_ref (tmp, gfc_index_zero_node, NULL);
+ tmp = gfc_build_array_ref (tmp, gfc_index_zero_node, NULL_TREE,
NULL_TREE);
if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
tmp = build_fold_indirect_ref_loc (input_location,
@@ -1818,7 +1821,7 @@ transfer_namelist_element (stmtblock_t * block, const
char * var_name,
iocall[IOCALL_SET_NML_VAL_DIM], 5,
dt_parm_addr,
build_int_cst (gfc_int4_type_node, n_dim),
- gfc_conv_array_sm (decl, n_dim),
+ gfc_conv_array_spacing (decl, n_dim),
gfc_conv_array_lbound (decl, n_dim),
gfc_conv_array_ubound (decl, n_dim));
gfc_add_expr_to_block (block, tmp);
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index e6afb84c031d..96b23a4fde77 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -779,17 +779,18 @@ gfc_omp_clause_default_ctor (tree clause, tree decl, tree
outer)
gfc_add_modify (&cond_block, decl, outer);
tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
size = gfc_conv_descriptor_extent_get (decl, rank);
+ tree spacing;
if (GFC_TYPE_ARRAY_RANK (type) >= 1)
- size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, size,
- gfc_conv_descriptor_sm_get (decl, rank));
+ spacing = gfc_conv_descriptor_spacing_get (decl, rank);
else
{
tree esize = gfc_conv_descriptor_span_get (decl);
- esize = fold_convert_loc (input_location, gfc_array_index_type,
esize);
- size = fold_build2_loc (input_location, MULT_EXPR,
gfc_array_index_type,
- size, esize);
+ spacing = fold_convert_loc (input_location, gfc_array_index_type,
esize);
}
+ size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ size, spacing);
+ size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ size, gfc_conv_descriptor_align_get (decl));
size = unshare_expr (size);
size = gfc_evaluate_now (fold_convert (size_type_node, size),
&cond_block);
@@ -968,17 +969,16 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree
src)
{
tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
size = gfc_conv_descriptor_extent_get (dest, rank);
+ tree spacing;
if (GFC_TYPE_ARRAY_RANK (type) >= 1)
- size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, size,
- gfc_conv_descriptor_sm_get (dest, rank));
+ spacing = gfc_conv_descriptor_spacing_get (dest, rank);
else
{
tree esize = gfc_conv_descriptor_span_get (dest);
- esize = fold_convert_loc (input_location, gfc_array_index_type,
esize);
- size = fold_build2_loc (input_location, MULT_EXPR,
gfc_array_index_type,
- size, esize);
+ spacing = fold_convert_loc (input_location, gfc_array_index_type,
esize);
}
+ size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ size, spacing);
size = unshare_expr (size);
size = gfc_evaluate_now (fold_convert (size_type_node, size),
&cond_block);
@@ -1089,17 +1089,21 @@ gfc_omp_clause_assign_op (tree clause, tree dest, tree
src)
{
tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
size = gfc_conv_descriptor_extent_get (src, rank);
+ tree spacing;
if (GFC_TYPE_ARRAY_RANK (type) >= 1)
- size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, size,
- gfc_conv_descriptor_sm_get (src, rank));
+ {
+ spacing = gfc_conv_descriptor_spacing_get (src, rank);
+ spacing = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, spacing,
+ gfc_conv_descriptor_align_get (src));
+ }
else
{
tree esize = gfc_conv_descriptor_span_get (src);
- esize = fold_convert_loc (input_location, gfc_array_index_type,
esize);
- size = fold_build2_loc (input_location, MULT_EXPR,
gfc_array_index_type,
- size, esize);
+ spacing = fold_convert_loc (input_location, gfc_array_index_type,
esize);
}
+ size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ size, spacing);
size = unshare_expr (size);
size = gfc_evaluate_now (fold_convert (size_type_node, size),
&cond_block);
@@ -1869,7 +1873,7 @@ gfc_omp_firstprivatize_type_sizes (struct
gimplify_omp_ctx *ctx, tree type)
{
omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_LBOUND (type, r));
omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_UBOUND (type, r));
- omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_SM (type, r));
+ omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_SPACING (type, r));
}
omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_SIZE (type));
omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_OFFSET (type));
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index 72b7d715fe1b..648a09fc2a7d 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -1855,15 +1855,18 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec *
as, gfc_packed packed,
int known_offset;
mpz_t offset;
mpz_t stride;
- mpz_t sm;
+ mpz_t spacing;
mpz_t delta;
gfc_expr *expr;
mpz_init_set_ui (offset, 0);
mpz_init_set_ui (stride, 1);
wide_int elem_len = wi::to_wide (TYPE_SIZE_UNIT (etype));
- gcc_assert (wi::fits_shwi_p (elem_len));
- mpz_init_set_ui (sm, elem_len.to_shwi ());
+ wide_int align = wi::uhwi (TYPE_ALIGN_UNIT (etype),
+ TYPE_PRECISION (gfc_array_index_type));
+ wide_int aligned_len = wi::udiv_trunc (elem_len, align);
+ gcc_assert (wi::fits_shwi_p (aligned_len));
+ mpz_init_set_ui (spacing, aligned_len.to_shwi ());
mpz_init (delta);
/* We don't use build_array_type because this does not include
@@ -1881,12 +1884,12 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec *
as, gfc_packed packed,
known_offset = 1;
for (n = 0; n < as->rank; n++)
{
- /* Fill in the sm and bound components of the type. */
+ /* Fill in the spacing and bound components of the type. */
if (known_stride)
- tmp = gfc_conv_mpz_to_tree (sm, gfc_index_integer_kind);
+ tmp = gfc_conv_mpz_to_tree (spacing, gfc_index_integer_kind);
else
tmp = NULL_TREE;
- GFC_TYPE_ARRAY_SM (type, n) = tmp;
+ GFC_TYPE_ARRAY_SPACING (type, n) = tmp;
expr = as->lower[n];
if (expr && expr->expr_type == EXPR_CONSTANT)
@@ -1904,7 +1907,7 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec *
as, gfc_packed packed,
if (known_stride)
{
/* Calculate the offset. */
- mpz_mul (delta, sm, as->lower[n]->value.integer);
+ mpz_mul (delta, spacing, as->lower[n]->value.integer);
mpz_sub (offset, offset, delta);
}
else
@@ -1930,7 +1933,7 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec *
as, gfc_packed packed,
as->lower[n]->value.integer);
mpz_add_ui (delta, delta, 1);
mpz_mul (stride, stride, delta);
- mpz_mul (sm, sm, delta);
+ mpz_mul (spacing, spacing, delta);
}
/* Only the first stride is known for partial packed arrays. */
@@ -1976,6 +1979,9 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec *
as, gfc_packed packed,
if (packed != PACKED_NO)
GFC_TYPE_ARRAY_ELEM_LEN (type) = TYPE_SIZE_UNIT (etype);
+ wide_int index_one = wi::one (TYPE_PRECISION (gfc_array_index_type));
+ GFC_TYPE_ARRAY_ALIGN (type) = wide_int_to_tree (gfc_array_index_type,
+ wi::lshift (index_one,
align));
GFC_TYPE_ARRAY_RANK (type) = as->rank;
GFC_TYPE_ARRAY_CORANK (type) = as->corank;
GFC_TYPE_ARRAY_DTYPE (type) = NULL_TREE;
@@ -2055,7 +2061,7 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec *
as, gfc_packed packed,
array_type_done:
mpz_clear (offset);
mpz_clear (stride);
- mpz_clear (sm);
+ mpz_clear (spacing);
mpz_clear (delta);
return type;
@@ -2119,6 +2125,12 @@ gfc_get_array_descriptor_base (int dimen, int codimen,
bool restricted)
gfc_array_index_type, &chain);
suppress_warning (decl);
+ /* Add the span component. */
+ decl = gfc_add_field_to_struct_1 (fat_type,
+ get_identifier ("align"),
+ gfc_array_index_type, &chain);
+ suppress_warning (decl);
+
/* Build the array type for the stride and bound components. */
if (dimen + codimen > 0)
{
@@ -2205,27 +2217,36 @@ gfc_get_array_type_bounds (tree etype, int dimen, int
codimen, tree * lbound,
GFC_DESCRIPTOR_TYPE_P (fat_type) = 1;
TYPE_LANG_SPECIFIC (fat_type) = ggc_cleared_alloc<struct lang_type> ();
+ int index_precision = TYPE_PRECISION (gfc_array_index_type);
+ wide_int align = wi::uhwi (TYPE_ALIGN_UNIT (etype), index_precision);
+ wide_int index_one = wi::one (index_precision);
+ GFC_TYPE_ARRAY_ALIGN (fat_type) = wide_int_to_tree (gfc_array_index_type,
+ wi::lshift (index_one,
align));
GFC_TYPE_ARRAY_RANK (fat_type) = dimen;
GFC_TYPE_ARRAY_CORANK (fat_type) = codimen;
GFC_TYPE_ARRAY_DTYPE (fat_type) = NULL_TREE;
GFC_TYPE_ARRAY_AKIND (fat_type) = akind;
/* Build an array descriptor record type. */
- tree sm;
+ tree spacing;
if (packed != 0)
{
stride = gfc_index_one_node;
- sm = TYPE_SIZE_UNIT (etype);
+ spacing = TYPE_SIZE_UNIT (etype);
+ spacing = fold_build2_loc (input_location, EXACT_DIV_EXPR,
+ gfc_array_index_type, spacing,
+ build_int_cst (gfc_array_index_type,
+ TYPE_ALIGN_UNIT (etype)));
}
else
{
stride = NULL_TREE;
- sm = NULL_TREE;
+ spacing = NULL_TREE;
}
for (n = 0; n < dimen + codimen; n++)
{
if (n < dimen)
- GFC_TYPE_ARRAY_SM (fat_type, n) = sm;
+ GFC_TYPE_ARRAY_SPACING (fat_type, n) = spacing;
if (lbound)
lower = lbound[n];
@@ -2260,15 +2281,15 @@ gfc_get_array_type_bounds (tree etype, int dimen, int
codimen, tree * lbound,
tmp = gfc_conv_array_extent_dim (lower, upper, nullptr);
stride = fold_build2_loc (input_location, MULT_EXPR,
gfc_array_index_type, tmp, stride);
- sm = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, tmp, sm);
+ spacing = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, tmp, spacing);
/* Check the folding worked. */
gcc_assert (INTEGER_CST_P (stride));
}
else
{
stride = NULL_TREE;
- sm = NULL_TREE;
+ spacing = NULL_TREE;
}
}
GFC_TYPE_ARRAY_SIZE (fat_type) = stride;
@@ -3847,7 +3868,7 @@ gfc_get_array_descr_info (const_tree type, struct
array_descr_info *info)
bool indirect = false;
tree etype, ptype, t, base_decl;
tree data_off, span_off, dim_off, dtype_off, dim_size;
- tree lower_suboff, upper_suboff, sm_suboff;
+ tree lower_suboff, upper_suboff, spacing_suboff;
tree dtype, field, rank_off;
if (! GFC_DESCRIPTOR_TYPE_P (type))
@@ -3902,7 +3923,7 @@ gfc_get_array_descr_info (const_tree type, struct
array_descr_info *info)
base_decl = build1 (INDIRECT_REF, ptype, base_decl);
gfc_get_descriptor_offsets_for_info (type, &data_off, &dtype_off, &span_off,
- &dim_off, &dim_size, &sm_suboff,
+ &dim_off, &dim_size, &spacing_suboff,
&lower_suboff, &upper_suboff);
t = base_decl;
@@ -3974,8 +3995,10 @@ gfc_get_array_descr_info (const_tree type, struct
array_descr_info *info)
}
t = fold_build_pointer_plus (base_decl,
size_binop (PLUS_EXPR,
- dim_off, sm_suboff));
+ dim_off, spacing_suboff));
t = build1 (INDIRECT_REF, gfc_array_index_type, t);
+ t = build2 (MULT_EXPR, gfc_array_index_type, t,
+ GFC_TYPE_ARRAY_ALIGN (type));
info->dimen[dim].stride = t;
if (dim + 1 < rank)
dim_off = size_binop (PLUS_EXPR, dim_off, dim_size);
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index b4ba84964175..7120824b8195 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -387,81 +387,6 @@ gfc_build_addr_expr (tree type, tree t)
}
-static tree
-get_array_span (tree type, tree decl)
-{
- tree span;
-
- /* Component references are guaranteed to have a reliable value for
- 'span'. Likewise indirect references since they emerge from the
- conversion of a CFI descriptor or the hidden dummy descriptor. */
- if (TREE_CODE (decl) == COMPONENT_REF
- && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
- return gfc_conv_descriptor_span_get (decl);
- else if (INDIRECT_REF_P (decl)
- && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
- return gfc_conv_descriptor_span_get (decl);
-
- /* Return the span for deferred character length array references. */
- if (type
- && (TREE_CODE (type) == ARRAY_TYPE || TREE_CODE (type) == INTEGER_TYPE)
- && TYPE_STRING_FLAG (type))
- {
- if (TREE_CODE (decl) == PARM_DECL)
- decl = build_fold_indirect_ref_loc (input_location, decl);
- if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
- span = gfc_conv_descriptor_span_get (decl);
- else
- span = gfc_get_character_len_in_bytes (type);
- span = (span && !integer_zerop (span))
- ? (fold_convert (gfc_array_index_type, span)) : (NULL_TREE);
- }
- /* Likewise for class array or pointer array references. */
- else if (TREE_CODE (decl) == FIELD_DECL
- || VAR_OR_FUNCTION_DECL_P (decl)
- || TREE_CODE (decl) == PARM_DECL)
- {
- if (GFC_DECL_CLASS (decl))
- {
- /* When a temporary is in place for the class array, then the
- original class' declaration is stored in the saved
- descriptor. */
- if (DECL_LANG_SPECIFIC (decl) && GFC_DECL_SAVED_DESCRIPTOR (decl))
- decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
- else
- {
- /* Allow for dummy arguments and other good things. */
- if (POINTER_TYPE_P (TREE_TYPE (decl)))
- decl = build_fold_indirect_ref_loc (input_location, decl);
-
- /* Check if '_data' is an array descriptor. If it is not,
- the array must be one of the components of the class
- object, so return a null span. */
- if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (
- gfc_class_data_get (decl))))
- return NULL_TREE;
- }
- span = gfc_class_vtab_size_get (decl);
- /* For unlimited polymorphic entities then _len component needs
- to be multiplied with the size. */
- span = gfc_resize_class_size_with_len (NULL, decl, span);
- }
- else if (GFC_DECL_PTR_ARRAY_P (decl))
- {
- if (TREE_CODE (decl) == PARM_DECL)
- decl = build_fold_indirect_ref_loc (input_location, decl);
- span = gfc_conv_descriptor_span_get (decl);
- }
- else
- span = NULL_TREE;
- }
- else
- span = NULL_TREE;
-
- return span;
-}
-
-
tree
gfc_build_spanned_array_ref (tree base, tree offset, tree span)
{
@@ -487,11 +412,10 @@ gfc_build_spanned_array_ref (tree base, tree offset, tree
span)
have to play it safe and use pointer arithmetic. */
tree
-gfc_build_array_ref (tree base, tree offset, tree decl,
- bool non_negative_offset, tree vptr)
+gfc_build_array_ref (tree base, tree offset, bool non_negative_offset,
+ tree spacing, tree align)
{
tree type = TREE_TYPE (base);
- tree span = NULL_TREE;
if (GFC_ARRAY_TYPE_P (type) && GFC_TYPE_ARRAY_RANK (type) == 0)
{
@@ -503,7 +427,6 @@ gfc_build_array_ref (tree base, tree offset, tree decl,
/* Scalar coarray, there is nothing to do. */
if (TREE_CODE (type) != ARRAY_TYPE)
{
- gcc_assert (decl == NULL_TREE);
gcc_assert (integer_zerop (offset));
return base;
}
@@ -516,28 +439,9 @@ gfc_build_array_ref (tree base, tree offset, tree decl,
/* Strip NON_LVALUE_EXPR nodes. */
STRIP_TYPE_NOPS (offset);
- /* If decl or vptr are non-null, pointer arithmetic for the array reference
- is likely. Generate the 'span' for the array reference. */
- if (vptr)
- {
- span = gfc_vptr_size_get (vptr);
-
- /* Check if this is an unlimited polymorphic object carrying a character
- payload. In this case, the 'len' field is non-zero. */
- if (decl && GFC_CLASS_TYPE_P (TREE_TYPE (decl)))
- span = gfc_resize_class_size_with_len (NULL, decl, span);
- }
- else if (decl)
- span = get_array_span (type, decl);
-
- /* If a non-null span has been generated reference the element with
- pointer arithmetic. */
- if (span != NULL_TREE)
- return gfc_build_spanned_array_ref (base, offset, span);
- /* Else use a straightforward array reference if possible. */
- else if (non_negative_offset)
+ if (non_negative_offset)
return build4_loc (input_location, ARRAY_REF, type, base, offset,
- NULL_TREE, NULL_TREE);
+ NULL_TREE, spacing);
/* Otherwise use pointer arithmetic. */
else
{
@@ -554,12 +458,13 @@ gfc_build_array_ref (tree base, tree offset, tree decl,
fold_convert (gfc_array_index_type, min))
: fold_convert (gfc_array_index_type, offset);
- tree elt_size = fold_convert (gfc_array_index_type,
- TYPE_SIZE_UNIT (type));
+ tree offset_align = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type,
+ zero_based_index, spacing);
tree offset_bytes = fold_build2_loc (input_location, MULT_EXPR,
gfc_array_index_type,
- zero_based_index, elt_size);
+ offset_align, align);
tree base_addr = gfc_build_addr_expr (pvoid_type_node, base);
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 3e985bdb9127..e254f9f1dc60 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -196,12 +196,11 @@ typedef struct gfc_array_info
tree descriptor;
/* holds the pointer to the data array. */
tree data;
- /* Original data pointer without additional offset. */
- tree saved_data;
/* To move some of the array index calculation out of the innermost loop. */
tree offset;
/* Original offset. */
tree saved_offset;
+ tree align;
/* Holds the SS for a subscript. Indexed by actual dimension. */
struct gfc_ss *subscript[GFC_MAX_DIMENSIONS];
@@ -214,9 +213,8 @@ typedef struct gfc_array_info
references. */
tree stride[GFC_MAX_DIMENSIONS];
/* The spacing in memory of elements of consecutive indexes, for each
- dimension. This is the intrinsic spacing of the array given by its stride
- multiplier (sm). In units whose size is given by the element type if
- array_access is true, otherwise in bytes. */
+ dimension. This is the intrinsic spacing of the array. In alignment-sized
+ units. */
tree spacing[GFC_MAX_DIMENSIONS];
tree delta[GFC_MAX_DIMENSIONS];
@@ -649,9 +647,8 @@ tree gfc_get_extern_function_decl (gfc_symbol *,
tree gfc_build_addr_expr (tree, tree);
/* Build an ARRAY_REF. */
-tree gfc_build_array_ref (tree, tree, tree,
- bool non_negative_offset = false,
- tree vptr = NULL_TREE);
+tree gfc_build_array_ref (tree, tree, bool non_negative_offset = false,
+ tree spacing = NULL_TREE, tree align = NULL_TREE);
/* Build an array ref using pointer arithmetic. */
tree gfc_build_spanned_array_ref (tree base, tree offset, tree span);
@@ -1038,8 +1035,9 @@ struct GTY(()) lang_type {
enum gfc_array_kind akind;
tree lbound[GFC_MAX_DIMENSIONS];
tree ubound[GFC_MAX_DIMENSIONS];
- tree sm[GFC_MAX_DIMENSIONS];
+ tree spacing[GFC_MAX_DIMENSIONS];
tree elem_len;
+ tree align;
tree size;
tree offset;
tree dtype;
@@ -1111,8 +1109,8 @@ struct GTY(()) lang_decl {
(TYPE_LANG_SPECIFIC(node)->lbound[dim])
#define GFC_TYPE_ARRAY_UBOUND(node, dim) \
(TYPE_LANG_SPECIFIC(node)->ubound[dim])
-#define GFC_TYPE_ARRAY_SM(node, dim) \
- (TYPE_LANG_SPECIFIC(node)->sm[dim])
+#define GFC_TYPE_ARRAY_SPACING(node, dim) \
+ (TYPE_LANG_SPECIFIC(node)->spacing[dim])
#define GFC_TYPE_ARRAY_EXTENT(node, dim) \
(fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, \
fold_build2_loc (input_location, MINUS_EXPR, \
@@ -1120,13 +1118,16 @@ struct GTY(()) lang_decl {
GFC_TYPE_ARRAY_UBOUND((node), (dim)), \
GFC_TYPE_ARRAY_LBOUND((node), (dim))), \
gfc_index_one_node))
+#if 0
#define GFC_TYPE_ARRAY_STRIDE(node, dim) \
(fold_build2_loc (input_location, EXACT_DIV_EXPR, gfc_array_index_type, \
- GFC_TYPE_ARRAY_SM((node), (dim)), \
- GFC_TYPE_ARRAY_ELEM_LEN((node))))
+ GFC_TYPE_ARRAY_SPACING((node), (dim)), \
+ GFC_TYPE_ARRAY_ALIGN((node))))
+#endif
#define GFC_TYPE_ARRAY_ELEM_LEN(node) (TYPE_LANG_SPECIFIC(node)->elem_len)
#define GFC_TYPE_ARRAY_RANK(node) (TYPE_LANG_SPECIFIC(node)->rank)
#define GFC_TYPE_ARRAY_CORANK(node) (TYPE_LANG_SPECIFIC(node)->corank)
+#define GFC_TYPE_ARRAY_ALIGN(node) (TYPE_LANG_SPECIFIC(node)->align)
#define GFC_TYPE_ARRAY_CAF_TOKEN(node) (TYPE_LANG_SPECIFIC(node)->caf_token)
#define GFC_TYPE_ARRAY_CAF_OFFSET(node) (TYPE_LANG_SPECIFIC(node)->caf_offset)
#define GFC_TYPE_ARRAY_SIZE(node) (TYPE_LANG_SPECIFIC(node)->size)
