https://gcc.gnu.org/g:22ce751b60bba098a6e0c2a75cd4d1e882eaa51a
commit 22ce751b60bba098a6e0c2a75cd4d1e882eaa51a
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Mon Apr 14 13:52:49 2025 +0200
Retour en arrière délinearisation tableaux compil' OK.
Diff:
---
gcc/fortran/trans-array.cc | 353 +++++++++++++---------------------------
gcc/fortran/trans-decl.cc | 35 +---
gcc/fortran/trans-descriptor.cc | 33 ----
gcc/fortran/trans-types.cc | 60 +++----
libgfortran/caf/single.c | 4 +-
5 files changed, 136 insertions(+), 349 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index fa84f007bee5..41d0a612edf5 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -2169,43 +2169,6 @@ gfc_build_constant_array_constructor (gfc_expr * expr,
tree type)
gfc_free_expr (as.upper[i]);
}
- if (expr->shape && expr->rank > 1)
- {
- vec<constructor_elt, va_gc> *vsrc = v;
-
- for (int r = 0; r < expr->rank - 1; r++)
- {
- vec<constructor_elt, va_gc> *vdest = nullptr;
- unsigned sidx = 0;
-
- tree type = tmptype;
- for (int j = expr->rank - 1; j > r; j--)
- {
- gcc_assert (TREE_CODE (type) == ARRAY_TYPE);
- type = TREE_TYPE (type);
- }
-
- int len = (int) mpz_get_si (expr->shape[r]);
-
- while (sidx != vec_safe_length (vsrc))
- {
- vec<constructor_elt, va_gc> *vtmp = nullptr;
-
- for (int i = 0; i < len; i++)
- {
- append_constructor (vtmp, (*vsrc)[sidx].value);
- sidx++;
- }
-
- append_constructor (vdest, build_constructor (type, vtmp));
- }
-
- vsrc = vdest;
- }
-
- v = vsrc;
- }
-
init = build_constructor (tmptype, v);
TREE_CONSTANT (init) = 1;
@@ -3007,6 +2970,11 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss *
ss, int base)
if (!ss->is_alloc_lhs)
tmp = gfc_evaluate_now (tmp, block);
info->offset = tmp;
+
+ /* Make absolutely sure that the saved_offset is indeed saved
+ so that the variable is still accessible after the loops
+ are translated. */
+ info->saved_data = info->data;
}
}
@@ -3359,82 +3327,6 @@ array_bound_check_elemental (gfc_se * se, gfc_ss * ss,
gfc_expr * expr)
}
-/* Build a scalarized array reference using the vptr 'size'. */
-
-static bool
-build_class_array_ref (gfc_se *se, tree base, tree index)
-{
- tree size;
- tree decl = NULL_TREE;
- tree tmp;
- gfc_expr *expr = se->ss->info->expr;
- gfc_expr *class_expr;
- gfc_typespec *ts;
- gfc_symbol *sym;
-
- tmp = !VAR_P (base) ? gfc_get_class_from_expr (base) : NULL_TREE;
-
- if (tmp != NULL_TREE)
- decl = tmp;
- else
- {
- /* The base expression does not contain a class component, either
- because it is a temporary array or array descriptor. Class
- array functions are correctly resolved above. */
- if (!expr
- || (expr->ts.type != BT_CLASS
- && !gfc_is_class_array_ref (expr, NULL)))
- return false;
-
- /* Obtain the expression for the class entity or component that is
- followed by an array reference, which is not an element, so that
- the span of the array can be obtained. */
- class_expr = gfc_find_and_cut_at_last_class_ref (expr, false, &ts);
-
- if (!ts)
- return false;
-
- sym = (!class_expr && expr) ? expr->symtree->n.sym : NULL;
- if (sym && sym->attr.function
- && sym == sym->result
- && sym->backend_decl == current_function_decl)
- /* The temporary is the data field of the class data component
- of the current function. */
- decl = gfc_get_fake_result_decl (sym, 0);
- else if (sym)
- {
- if (decl == NULL_TREE)
- decl = expr->symtree->n.sym->backend_decl;
- /* For class arrays the tree containing the class is stored in
- GFC_DECL_SAVED_DESCRIPTOR of the sym's backend_decl.
- For all others it's sym's backend_decl directly. */
- if (DECL_LANG_SPECIFIC (decl) && GFC_DECL_SAVED_DESCRIPTOR (decl))
- decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
- }
- else
- decl = gfc_get_class_from_gfc_expr (class_expr);
-
- if (POINTER_TYPE_P (TREE_TYPE (decl)))
- decl = build_fold_indirect_ref_loc (input_location, decl);
-
- if (!GFC_CLASS_TYPE_P (TREE_TYPE (decl)))
- return false;
- }
-
- se->class_vptr = gfc_evaluate_now (gfc_class_vptr_get (decl), &se->pre);
-
- size = gfc_class_vtab_size_get (decl);
- /* For unlimited polymorphic entities then _len component needs to be
- multiplied with the size. */
- size = gfc_resize_class_size_with_len (&se->pre, decl, size);
- size = fold_convert (gfc_array_index_type, size);
-
- /* Return the element in the se expression. */
- se->expr = gfc_build_spanned_array_ref (base, index, size);
- return true;
-}
-
-
/* Indicates that the tree EXPR is a reference to an array that can’t
have any negative stride. */
@@ -3480,49 +3372,16 @@ non_negative_strides_array_p (tree expr)
}
-static tree
-build_array_ref (tree array, tree index,
- bool non_negative_stride, tree lbound, tree spacing,
- const vec<tree> * array_type_domains)
-{
- tree elt_type = NULL_TREE;
- if (!array_type_domains || array_type_domains->is_empty ())
- elt_type = TREE_TYPE (TREE_TYPE (array));
- else
- {
- tree core_type = TREE_TYPE (array);
-
- unsigned j;
- tree *dom_p;
- FOR_EACH_VEC_ELT (*array_type_domains, j, dom_p)
- {
- gcc_assert (TREE_CODE (core_type) == ARRAY_TYPE
- && TYPE_DOMAIN (core_type) == *dom_p);
- core_type = TREE_TYPE (core_type);
- }
-
- elt_type = TREE_TYPE (core_type);
-
- FOR_EACH_VEC_ELT_REVERSE (*array_type_domains, j, dom_p)
- elt_type = gfc_build_incomplete_array_type (elt_type, *dom_p);
- }
-
- return gfc_build_array_ref (elt_type, array, index, non_negative_stride,
- lbound, spacing);
-}
-
-
/* Return the offset for an index. Performs bound checking for elemental
dimensions. Single element references are processed separately.
DIM is the array dimension, I is the loop dimension. */
static tree
-conv_array_index (gfc_se * se, gfc_ss * ss, int dim, int i,
- gfc_array_ref * ar)
+conv_array_index (gfc_se * se, gfc_ss * ss, int dim, int i, gfc_array_ref * ar)
{
gfc_array_info *info;
tree index;
- tree descriptor;
+ tree desc;
tree data;
info = &ss->info->data.array;
@@ -3553,16 +3412,19 @@ conv_array_index (gfc_se * se, gfc_ss * ss, int dim,
int i,
gcc_assert (info->subscript[dim]
&& info->subscript[dim]->info->type == GFC_SS_VECTOR);
- descriptor = info->subscript[dim]->info->data.array.descriptor;
+ desc = info->subscript[dim]->info->data.array.descriptor;
+
+ /* Get a zero-based index into the vector. */
index = fold_convert_loc (input_location, gfc_array_index_type,
se->loop->loopvar[i]);
/* Read the vector to get an index into info->descriptor. */
data = build_fold_indirect_ref_loc (input_location,
- gfc_conv_array_data (descriptor));
- index = gfc_build_array_ref (data, index, false,
- gfc_conv_array_lbound (descriptor, 0),
- gfc_conv_array_spacing (descriptor, 0));
+ gfc_conv_array_data (desc));
+ index = gfc_build_array_ref (data, index,
+ non_negative_strides_array_p (desc),
+ gfc_conv_array_lbound (desc, 0),
+ gfc_conv_array_spacing (desc, 0));
index = gfc_evaluate_now (index, &se->pre);
index = fold_convert (gfc_array_index_type, index);
@@ -3578,6 +3440,10 @@ conv_array_index (gfc_se * se, gfc_ss * ss, int dim, int
i,
/* Multiply the loop variable by the stride and delta. */
index = se->loop->loopvar[i];
+ if (!integer_onep (info->stride[dim]))
+ index = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, index,
+ info->stride[dim]);
if (!integer_zerop (info->delta[dim]))
index = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type, index,
@@ -3598,24 +3464,55 @@ conv_array_index (gfc_se * se, gfc_ss * ss, int dim,
int i,
index = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type, index, info->delta[dim]);
}
-
+
return index;
}
+static tree
+build_ptr_array_ref (tree data, tree offset)
+{
+ tree ptr = data;
+ gcc_assert (TREE_CODE (TREE_TYPE (ptr)) == POINTER_TYPE);
+ if (TREE_CODE (TREE_TYPE (TREE_TYPE (ptr))) == ARRAY_TYPE)
+ {
+ tree elt_type = TREE_TYPE (TREE_TYPE (TREE_TYPE (ptr)));
+ ptr = fold_convert_loc (input_location,
+ build_pointer_type (elt_type), ptr);
+ }
+
+ tree tmp = fold_build_pointer_plus_loc (input_location, ptr, offset);
+ return build_fold_indirect_ref_loc (input_location, tmp);
+}
+
+
+tree
+build_array_ref_dim (gfc_ss *ss, tree index, tree spacing, bool tmp_array =
false)
+{
+ gfc_array_info *info = &ss->info->data.array;
+
+ tree base = build_fold_indirect_ref_loc (input_location, info->data);
+
+ gfc_ss_type ss_type = ss->info->type;
+ bool non_negative_stride = ss_type == GFC_SS_FUNCTION
+ || ss_type == GFC_SS_CONSTRUCTOR
+ || ss_type == GFC_SS_INTRINSIC
+ || tmp_array
+ || non_negative_strides_array_p (info->descriptor);
+ return gfc_build_array_ref (base, index, non_negative_stride,
+ NULL_TREE, spacing);
+}
+
+
/* Build a scalarized reference to an array. */
static void
-gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar,
- bool tmp_array = false)
+gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar, bool tmp_array
= false)
{
- gfc_array_info *info;
- tree base;
gfc_ss *ss;
int n;
ss = se->ss;
- info = &ss->info->data.array;
if (ar)
n = se->loop->order[0];
else
@@ -3623,17 +3520,9 @@ gfc_conv_scalarized_array_ref (gfc_se * se,
gfc_array_ref * ar,
tree index = conv_array_index (se, ss, ss->dim[n], n, ar);
- 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;
-
- bool non_negative_stride = tmp_array
- || non_negative_strides_array_p (info->descriptor);
- se->expr = gfc_build_array_ref (base, index, non_negative_stride,
- info->lbound[ss->dim[0]],
- info->spacing[ss->dim[0]]);
+ se->expr = build_array_ref_dim (ss, index,
+ ss->info->data.array.spacing0,
+ tmp_array);
}
@@ -3648,6 +3537,24 @@ gfc_conv_tmp_array_ref (gfc_se * se)
}
+/* Add T to the offset pair *OFFSET, *CST_OFFSET. */
+
+static void
+add_to_offset (tree *cst_offset, tree *offset, tree t)
+{
+ if (TREE_CODE (t) == INTEGER_CST)
+ *cst_offset = int_const_binop (PLUS_EXPR, *cst_offset, t);
+ else
+ {
+ if (!integer_zerop (*offset))
+ *offset = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type, *offset, t);
+ else
+ *offset = t;
+ }
+}
+
+
/* Build an array reference. se->expr already holds the array descriptor.
This should be either a variable, indirect variable reference or component
reference. For arrays which do not have a descriptor, se->expr will be
@@ -3659,6 +3566,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar,
gfc_expr *expr,
locus * where)
{
int n;
+ tree offset, cst_offset;
tree tmp;
tree decl = NULL_TREE;
gfc_se indexse;
@@ -3715,8 +3623,8 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar,
gfc_expr *expr,
&& ar->as->type != AS_DEFERRED)
decl = sym->backend_decl;
- tree ptr = gfc_conv_array_data (decl);
- tree array = build_fold_indirect_ref_loc (input_location, ptr);
+ cst_offset = offset = gfc_index_zero_node;
+ add_to_offset (&cst_offset, &offset, gfc_conv_array_offset (decl));
/* Calculate the offsets from all the dimensions. Make sure to associate
the final offset so that we form a chain of loop invariant summands. */
@@ -3727,8 +3635,6 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar,
gfc_expr *expr,
gfc_conv_expr_type (&indexse, ar->start[n], gfc_array_index_type);
gfc_add_block_to_block (&se->pre, &indexse.pre);
- tree lbound = gfc_conv_array_lbound (decl, n);
-
if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) && ! expr->no_bounds_check)
{
/* Check array bounds. */
@@ -3739,7 +3645,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar,
gfc_expr *expr,
indexse.expr = save_expr (indexse.expr);
/* Lower bound. */
- tmp = lbound;
+ tmp = gfc_conv_array_lbound (decl, n);
if (sym->attr.temporary)
{
gfc_init_se (&tmpse, se);
@@ -3785,26 +3691,31 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar,
gfc_expr *expr,
}
}
+ /* Multiply the index by the stride. */
tree spacing = gfc_conv_array_spacing (decl, n);
-
- tmp = gfc_build_array_ref (array, indexse.expr,
- non_negative_strides_array_p (decl),
- lbound, spacing);
- array = tmp;
+ tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ indexse.expr, spacing);
+
+ /* And add it to the total. */
+ add_to_offset (&cst_offset, &offset, tmp);
}
free (var_name);
- se->expr = array;
+
+ if (!integer_zerop (cst_offset))
+ offset = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type, offset, cst_offset);
+
+ se->expr = build_ptr_array_ref (gfc_conv_array_data (decl), offset);
}
/* Add the offset corresponding to array's ARRAY_DIM dimension and loop's
LOOP_DIM dimension (if any) to array's offset. */
-static tree
-add_array_index (stmtblock_t *pblock, gfc_loopinfo *loop, gfc_ss *ss,
- tree array, gfc_array_ref *ar, int array_dim, int loop_dim,
- const vec<tree> * array_type_domains)
+static void
+add_array_offset (stmtblock_t *pblock, gfc_loopinfo *loop, gfc_ss *ss,
+ gfc_array_ref *ar, int array_dim, int loop_dim)
{
gfc_se se;
gfc_array_info *info;
@@ -3814,20 +3725,13 @@ add_array_index (stmtblock_t *pblock, gfc_loopinfo
*loop, gfc_ss *ss,
gfc_init_se (&se, NULL);
se.loop = loop;
se.expr = info->descriptor;
- tree tmp = conv_array_index (&se, ss, array_dim, loop_dim, ar);
+ tree index = conv_array_index (&se, ss, array_dim, loop_dim, ar);
gfc_add_block_to_block (pblock, &se.pre);
- tree index = fold_convert_loc (input_location, gfc_array_index_type, tmp);
-
- gfc_ss_type ss_type = ss->info->type;
- bool non_negative_stride = ss_type == GFC_SS_FUNCTION
- || ss_type == GFC_SS_CONSTRUCTOR
- || ss_type == GFC_SS_INTRINSIC
- || non_negative_strides_array_p (info->descriptor);
- return build_array_ref (array, index, non_negative_stride,
- info->lbound[array_dim], info->spacing[array_dim],
- array_type_domains);
+ tree tmp = build_array_ref_dim (ss, index, info->spacing[array_dim]);
+ tmp = gfc_build_addr_expr (NULL_TREE, tmp);
+ info->data = gfc_evaluate_now (tmp, pblock);
}
@@ -3894,27 +3798,20 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim,
int flag,
gcc_assert (0 == ploop->order[0]);
info->spacing0 = gfc_conv_array_spacing (info->descriptor, 0);
+ /* Calculate the spacing of the innermost loop. Hopefully this will
+ allow the backend optimizers to do their stuff more effectively.
+ */
info->spacing0 = gfc_evaluate_now (info->spacing0, pblock);
if (info->ref)
{
- auto_vec<tree> domains;
-
- tree array = build_fold_indirect_ref_loc (input_location,
info->data);
- tree array_type = TREE_TYPE (array);
-
for (int i = ar->dimen - 1; i >= 0; i--)
{
- if (ar->dimen_type[i] == DIMEN_ELEMENT)
- array = add_array_index (pblock, ploop, ss, array, ar,
- i, -1 /* unused */, &domains);
- else
- domains.safe_push (TYPE_DOMAIN (array_type));
+ if (ar->dimen_type[i] != DIMEN_ELEMENT)
+ continue;
- array_type = TREE_TYPE (array_type);
+ add_array_offset (pblock, ploop, ss, ar, i, -1 /* unused */);
}
-
- info->data = gfc_build_addr_expr (NULL_TREE, array);
}
}
else
@@ -3930,13 +3827,8 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim,
int flag,
gcc_assert (i == ploop->order[i]);
i = ploop->order[i];
- tree array = build_fold_indirect_ref_loc (input_location,
- info->data);
/* Add the offset for the previous loop dimension. */
- array = add_array_index (pblock, ploop, ss, array, ar, pss->dim[i], i,
- nullptr);
-
- info->data = gfc_build_addr_expr (NULL_TREE, array);
+ add_array_offset (pblock, ploop, ss, ar, pss->dim[i], i);
}
/* Remember this offset for the second loop. */
@@ -4336,20 +4228,6 @@ gfc_conv_section_startstride (stmtblock_t * block,
gfc_ss * ss, int dim)
}
-static void
-conv_evaluate_lbound (stmtblock_t * block, gfc_ss * ss, int dim)
-{
- gcc_assert (ss->info->type == GFC_SS_SECTION);
-
- gfc_array_info *info = &ss->info->data.array;
- gfc_array_ref *ar = &info->ref->u.ar;
- tree desc = info->descriptor;
-
- evaluate_bound (block, info->lbound, nullptr, desc, dim, true,
- ar->as->type == AS_DEFERRED, !ss->is_alloc_lhs);
-}
-
-
/* Generate in INNER the bounds checking code along the dimension DIM for
the array associated with SS_INFO. */
@@ -4601,16 +4479,12 @@ done:
{
gfc_conv_section_startstride (&outer_loop->pre, ss, ss->dim[n]);
conv_array_spacing (&outer_loop->pre, ss, ss->dim[n]);
- conv_evaluate_lbound (&outer_loop->pre, ss, ss->dim[n]);
}
if (loop->parent == nullptr)
for (n = 0; n < GFC_MAX_DIMENSIONS; n++)
if (info->subscript[n]
&& info->subscript[n]->info->type == GFC_SS_SCALAR)
- {
- conv_array_spacing (&outer_loop->pre, ss, n);
- conv_evaluate_lbound (&outer_loop->pre, ss, n);
- }
+ conv_array_spacing (&outer_loop->pre, ss, n);
break;
case GFC_SS_INTRINSIC:
@@ -6205,7 +6079,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 align units) of the array. */
+ returns the size (in bytes) of the array. */
tree
gfc_trans_array_bounds (tree type, gfc_symbol * sym, tree * poffset,
@@ -6886,13 +6760,8 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm,
tree desc,
tree tmp = gfc_conv_array_data (desc);
tree array = build_fold_indirect_ref_loc (input_location, tmp);
- for (int i = GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc)) - 1; i >= 0; i--)
- {
- array = build_array_ref (array, gfc_index_zero_node,
- non_negative_strides, gfc_index_zero_node,
- gfc_conv_array_spacing (desc, i), nullptr);
- }
- tmp = array;
+ tmp = gfc_build_array_ref (array, gfc_index_zero_node, non_negative_strides,
+ gfc_index_zero_node, NULL_TREE);
/* Offset the data pointer for pointer assignments from arrays with
subreferences; e.g. my_integer => my_type(:)%integer_component. */
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 39886b66ec09..b154cb3161c2 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -1033,39 +1033,7 @@ update_type_bounds (tree type, tree
lbound[GFC_MAX_DIMENSIONS],
tree ubound[GFC_MAX_DIMENSIONS],
tree spacing[GFC_MAX_DIMENSIONS], tree root_type, int dim)
{
- tree elt_type;
- if (dim == 0)
- elt_type = TREE_TYPE (type);
- else
- elt_type = update_type_bounds (TREE_TYPE (type), lbound, ubound, spacing,
- root_type, dim - 1);
-
tree current_lbound = lbound[dim];
- tree current_ubound = ubound[dim];
- if (current_lbound != NULL_TREE
- || current_ubound != NULL_TREE
- || elt_type != TREE_TYPE (type))
- {
- tree new_type = build_distinct_type_copy (type);
- TREE_TYPE (new_type) = elt_type;
- TYPE_DOMAIN (new_type) = build_distinct_type_copy (TYPE_DOMAIN (type));
-
- tree new_lbound = current_lbound;
- if (new_lbound == NULL_TREE)
- new_lbound = TYPE_MIN_VALUE (TYPE_DOMAIN (type));
- TYPE_MIN_VALUE (TYPE_DOMAIN (new_type)) = new_lbound;
-
- tree new_ubound = current_ubound;
- if (new_ubound == NULL_TREE)
- new_ubound = TYPE_MAX_VALUE (TYPE_DOMAIN (type));
- TYPE_MAX_VALUE (TYPE_DOMAIN (new_type)) = new_ubound;
-
- layout_type (TYPE_DOMAIN (new_type));
- layout_type (new_type);
-
- type = new_type;
- }
-
if (current_lbound != NULL_TREE)
{
GFC_TYPE_ARRAY_LBOUND (root_type, dim) = current_lbound;
@@ -1080,6 +1048,8 @@ update_type_bounds (tree type, tree
lbound[GFC_MAX_DIMENSIONS],
DECL_NAMELESS (current_lbound) = 1;
}
}
+
+ tree current_ubound = ubound[dim];
if (current_ubound != NULL_TREE)
{
GFC_TYPE_ARRAY_UBOUND (root_type, dim) = current_ubound;
@@ -1094,6 +1064,7 @@ update_type_bounds (tree type, tree
lbound[GFC_MAX_DIMENSIONS],
DECL_NAMELESS (current_ubound) = 1;
}
}
+
tree current_spacing = spacing[dim];
if (current_spacing != NULL_TREE)
{
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 190311675198..3ae5a2a2dea3 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -956,39 +956,6 @@ gfc_conv_descriptor_stride_get (tree desc, tree dim)
}
-tree
-gfc_build_desc_array_type (tree desc_type, tree etype, int dimen, tree *
lbound,
- tree * ubound)
-{
- tree type = etype;
-
- for (int i = 0; i < dimen; i++)
- {
- tree lower = lbound[i];
- if (!lower)
- {
- tree root = build0 (PLACEHOLDER_EXPR, desc_type);
- tree dim = build_int_cst (integer_type_node, i);
- lower = gfc_descriptor::get_lbound (root, dim);
- }
-
- tree upper = ubound[i];
- if (!upper)
- {
- tree root = build0 (PLACEHOLDER_EXPR, desc_type);
- tree dim = build_int_cst (integer_type_node, i);
- upper = gfc_descriptor::get_ubound (root, dim);
- }
-
- tree index_type = build_range_type (gfc_array_index_type, lower, upper);
-
- type = gfc_build_incomplete_array_type (type, index_type);
- }
-
- return type;
-}
-
-
static bt
get_type_info (const bt &type)
{
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index 2eed2f010819..c8d56ec55999 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -1445,14 +1445,8 @@ gfc_get_element_type (tree type)
}
else
{
- int rank = GFC_TYPE_ARRAY_RANK (type);
- for (int i = 0; i < rank; i++)
- {
- gcc_assert (TREE_CODE (type) == ARRAY_TYPE);
- type = TREE_TYPE (type);
- }
-
- element = type;
+ gcc_assert (TREE_CODE (type) == ARRAY_TYPE);
+ element = TREE_TYPE (type);
}
}
else
@@ -1465,14 +1459,7 @@ gfc_get_element_type (tree type)
/* For arrays, which are not scalar coarrays. */
if (TREE_CODE (element) == ARRAY_TYPE && !TYPE_STRING_FLAG (element))
- {
- int rank = GFC_TYPE_ARRAY_RANK (type);
- for (int i = 0; i < rank; i++)
- {
- gcc_assert (TREE_CODE (element) == ARRAY_TYPE);
- element = TREE_TYPE (element);
- }
- }
+ element = TREE_TYPE (element);
}
return element;
@@ -1854,27 +1841,6 @@ gfc_get_dtype (tree type, int * rank)
}
-static tree
-build_nested_array_types (tree etype, tree lbound[GFC_MAX_DIMENSIONS],
- tree ubound[GFC_MAX_DIMENSIONS], int rank)
-{
- tree type = etype;
-
- for (int i = 0; i < rank; i++)
- {
- tree idx_type;
- if (lbound[i])
- idx_type = build_range_type (gfc_array_index_type, lbound[i],
ubound[i]);
- else
- idx_type = gfc_array_index_type;
- type = build_array_type (type, idx_type);
- layout_type (type);
- }
-
- return build_variant_type_copy (type);
-}
-
-
/* Build an array type for use without a descriptor, packed according
to the value of PACKED. */
@@ -1975,7 +1941,13 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec *
as, gfc_packed packed,
}
}
- type = build_nested_array_types (etype, lbound, ubound, as->rank);
+ /* We don't use build_array_type because this does not include
+ lang-specific information (i.e. the bounds of the array) when checking
+ for duplicates. */
+ if (as->rank != 0)
+ type = make_node (ARRAY_TYPE);
+ else
+ type = build_variant_type_copy (etype);
GFC_ARRAY_TYPE_P (type) = 1;
TYPE_LANG_SPECIFIC (type) = ggc_cleared_alloc<struct lang_type> ();
@@ -2156,7 +2128,7 @@ gfc_get_array_type_bounds (tree etype, int dimen, int
codimen, tree * lbound,
enum gfc_array_kind akind, bool restricted)
{
char name[8 + 2*GFC_RANK_DIGITS + 1 + GFC_MAX_SYMBOL_LEN];
- tree fat_type, base_type, arraytype, lower, upper, stride, tmp;
+ tree fat_type, base_type, arraytype, lower, upper, stride, tmp, rtype;
const char *type_name;
int n;
@@ -2286,7 +2258,15 @@ gfc_get_array_type_bounds (tree etype, int dimen, int
codimen, tree * lbound,
return fat_type;
}
- arraytype = gfc_build_desc_array_type (fat_type, etype, dimen, lbound,
ubound);
+ /* We define data as an array with the correct size if possible.
+ Much better than doing pointer arithmetic. */
+ if (stride)
+ rtype = build_range_type (gfc_array_index_type, gfc_index_zero_node,
+ int_const_binop (MINUS_EXPR, stride,
+ build_int_cst (TREE_TYPE
(stride), 1)));
+ else
+ rtype = gfc_array_range_type;
+ arraytype = build_array_type (etype, rtype);
arraytype = build_pointer_type (arraytype);
if (restricted)
arraytype = build_qualified_type (arraytype, TYPE_QUAL_RESTRICT);
diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index 2f05a4decadc..455ffad5743c 100644
--- a/libgfortran/caf/single.c
+++ b/libgfortran/caf/single.c
@@ -380,7 +380,7 @@ _gfortran_caf_failed_images (gfc_descriptor_t *array,
indicate an empty array. */
array->dim[0].lower_bound = 0;
array->dim[0]._ubound = -1;
- array->dim[0].spacing = 1;
+ array->dim[0].spacing = local_kind;
array->offset = 0;
}
@@ -402,7 +402,7 @@ _gfortran_caf_stopped_images (gfc_descriptor_t *array,
indicate an empty array. */
array->dim[0].lower_bound = 0;
array->dim[0]._ubound = -1;
- array->dim[0].spacing = 1;
+ array->dim[0].spacing = local_kind;
array->offset = 0;
}
