https://gcc.gnu.org/g:bbffd5e2f96f55874352161d29b93f9065b80845
commit bbffd5e2f96f55874352161d29b93f9065b80845
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Tue Apr 8 10:21:36 2025 +0200
Sauvegarde compil' OK
Diff:
---
gcc/fortran/trans-array.cc | 309 ++++++++++++--------------------
gcc/fortran/trans-decl.cc | 196 +++++++++++---------
gcc/fortran/trans-descriptor.cc | 157 +++++-----------
gcc/fortran/trans-descriptor.h | 6 +-
gcc/fortran/trans-expr.cc | 9 +-
gcc/fortran/trans-intrinsic.cc | 20 +--
gcc/fortran/trans-io.cc | 8 +-
gcc/fortran/trans-openmp.cc | 25 +--
gcc/fortran/trans-types.cc | 174 ++++++------------
gcc/fortran/trans.cc | 85 +++++----
gcc/fortran/trans.h | 25 ++-
libgfortran/caf/single.c | 2 -
libgfortran/generated/reshape_c10.c | 5 +-
libgfortran/generated/reshape_c16.c | 5 +-
libgfortran/generated/reshape_c17.c | 5 +-
libgfortran/generated/reshape_c4.c | 5 +-
libgfortran/generated/reshape_c8.c | 5 +-
libgfortran/generated/reshape_i16.c | 5 +-
libgfortran/generated/reshape_i4.c | 5 +-
libgfortran/generated/reshape_i8.c | 5 +-
libgfortran/generated/reshape_r10.c | 5 +-
libgfortran/generated/reshape_r16.c | 5 +-
libgfortran/generated/reshape_r17.c | 5 +-
libgfortran/generated/reshape_r4.c | 5 +-
libgfortran/generated/reshape_r8.c | 5 +-
libgfortran/intrinsics/cshift0.c | 1 -
libgfortran/intrinsics/eoshift0.c | 1 -
libgfortran/intrinsics/eoshift2.c | 3 +-
libgfortran/intrinsics/move_alloc.c | 1 -
libgfortran/intrinsics/pack_generic.c | 2 -
libgfortran/intrinsics/spread_generic.c | 7 +-
libgfortran/intrinsics/unpack_generic.c | 2 +-
libgfortran/libgfortran.h | 11 +-
libgfortran/m4/reshape.m4 | 3 +-
34 files changed, 467 insertions(+), 645 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index fa7afc938e58..4c8136ba6a1d 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -964,10 +964,6 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
if (class_expr == NULL_TREE && GFC_CLASS_TYPE_P (eltype))
class_expr = get_class_info_from_ss (pre, ss, &eltype, &fcn_ss);
- bool array_access = class_expr == NULL_TREE
- && eltype != NULL_TREE
- && !GFC_CLASS_TYPE_P (eltype);
-
/* If the dynamic type is not available, use the declared type. */
if (eltype && GFC_CLASS_TYPE_P (eltype))
eltype = gfc_get_element_type (TREE_TYPE (TYPE_FIELDS (eltype)));
@@ -1148,10 +1144,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
}
info->descriptor = desc;
- info->array_access = array_access;
- 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)));
+ size = elemsize;
+ nelem = gfc_index_one_node;
/*
Fill in the bounds and stride. This is a packed array, so:
@@ -1217,9 +1211,14 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR,
logical_type_node, or_expr, cond);
+ extent = gfc_evaluate_now (extent, pre);
+
size = fold_build2_loc (input_location, MULT_EXPR,
gfc_array_index_type, size, extent);
size = gfc_evaluate_now (size, pre);
+
+ nelem = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, nelem, extent);
}
}
@@ -1228,27 +1227,24 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
/* Get the size of the array. */
if (size && !callee_alloc)
{
+ or_expr = gfc_evaluate_now (or_expr, pre);
+
/* If or_expr is true, then the extent in at least one
dimension is zero and the size is set to zero. */
size = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type,
or_expr, gfc_index_zero_node, size);
- nelem = size;
- size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- size, elemsize);
+ nelem = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type,
+ or_expr, gfc_index_zero_node, nelem);
}
else
- {
- nelem = size;
- size = NULL_TREE;
- }
+ size = NULL_TREE;
tree data_ptr = gfc_trans_allocate_array_storage (pre, post, info, size,
nelem, initial, dynamic,
dealloc);
gfc_set_temporary_descriptor (pre, desc, class_expr, elemsize,
- GFC_TYPE_ARRAY_ALIGN (TREE_TYPE (desc)),
data_ptr, from, to, spacing, total_dim,
!bounds_known, rank_changer, shift_bounds);
@@ -2183,35 +2179,6 @@ gfc_build_constant_array_constructor (gfc_expr * expr,
tree type)
}
-static bool
-array_access_safe_p (gfc_expr *expr)
-{
- if (expr->ts.type == BT_CLASS)
- return false;
-
- if (gfc_is_simply_contiguous (expr, false, true))
- return true;
-
- symbol_attribute attr = gfc_expr_attr (expr);
- if (attr.pointer)
- return false;
-
- if (expr->expr_type == EXPR_VARIABLE
- && attr.dummy)
- {
- gfc_symbol *sym = expr->symtree->n.sym;
-
- gfc_array_spec *as = sym->as;
- if (as
- && !(as->type == AS_EXPLICIT
- || as->type == AS_ASSUMED_SIZE))
- return false;
- }
-
- return true;
-}
-
-
/* Translate a constant EXPR_ARRAY array constructor for the scalarizer.
This mostly initializes the scalarizer state info structure with the
appropriate values to directly use the array created by the function
@@ -2229,7 +2196,6 @@ trans_constant_array_constructor (gfc_ss * ss, tree type)
info = &ss->info->data.array;
info->descriptor = tmp;
- info->array_access = array_access_safe_p (ss->info->expr);
info->data = gfc_build_addr_expr (NULL_TREE, tmp);
info->offset = gfc_index_zero_node;
@@ -2956,7 +2922,6 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss,
int base)
else
info->descriptor = gfc_evaluate_now (se.expr, block);
}
- info->array_access = array_access_safe_p (ss_info->expr);
ss_info->string_length = se.string_length;
ss_info->class_container = se.class_container;
@@ -2996,16 +2961,6 @@ 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_offset = info->offset;
-
- tmp = gfc_conv_array_align (se.expr);
- if (!ss->is_alloc_lhs)
- tmp = gfc_evaluate_now (tmp, block);
- info->align = tmp;
}
}
@@ -3080,20 +3035,6 @@ 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
@@ -3437,7 +3378,7 @@ build_class_array_ref (gfc_se *se, tree base, tree index)
/* 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 (TREE_TYPE (index), 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);
@@ -3463,7 +3404,11 @@ non_negative_strides_array_p (tree expr)
gfc_array_kind array_kind = GFC_TYPE_ARRAY_AKIND (type);
if (array_kind == GFC_ARRAY_ALLOCATABLE
- || array_kind == GFC_ARRAY_ASSUMED_SHAPE_CONT)
+ || array_kind == GFC_ARRAY_ASSUMED_SHAPE_CONT
+ || array_kind == GFC_ARRAY_ASSUMED_RANK_CONT
+ || array_kind == GFC_ARRAY_ASSUMED_RANK_ALLOCATABLE
+ || array_kind == GFC_ARRAY_ASSUMED_RANK_POINTER_CONT
+ || array_kind == GFC_ARRAY_POINTER_CONT)
return true;
}
@@ -3493,8 +3438,8 @@ build_array_ref (tree desc, tree offset)
tmp = gfc_conv_array_data (desc);
tmp = build_fold_indirect_ref_loc (input_location, tmp);
- tmp = gfc_build_array_ref (tmp, offset, non_negative_strides_array_p (desc),
- gfc_index_one_node, gfc_conv_array_align (desc));
+
+ tmp = gfc_build_array_ref (tmp, offset, non_negative_strides_array_p (desc));
return tmp;
}
@@ -3504,13 +3449,14 @@ build_array_ref (tree desc, tree offset)
DIM is the array dimension, I is the loop dimension. */
static tree
-conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i,
- gfc_array_ref * ar, tree spacing)
+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 data;
+ tree offset;
info = &ss->info->data.array;
@@ -3540,20 +3486,18 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int
dim, int i,
gcc_assert (info->subscript[dim]
&& info->subscript[dim]->info->type == GFC_SS_VECTOR);
- /* Get a zero-based index into the vector. */
- index = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type,
- se->loop->loopvar[i], se->loop->from[i]);
+ offset = fold_build1_loc (input_location, NEGATE_EXPR,
+ gfc_array_index_type, se->loop->from[i]);
descriptor = info->subscript[dim]->info->data.array.descriptor;
- index = fold_convert_loc (input_location, gfc_array_index_type,
index);
+ 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,
- gfc_conv_array_spacing (descriptor, 0),
- gfc_conv_array_align (descriptor));
+ index = gfc_build_array_ref (data, index, false, offset,
+ gfc_conv_array_spacing (descriptor, 0));
index = gfc_evaluate_now (index, &se->pre);
index = fold_convert (gfc_array_index_type, index);
@@ -3569,10 +3513,6 @@ conv_array_index_offset (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,
@@ -3594,12 +3534,7 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int
dim, int i,
gfc_array_index_type, index, info->delta[dim]);
}
- /* Multiply by the spacing. */
- if (spacing != NULL && !integer_onep (spacing))
- return fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- index, spacing);
- else
- return index;
+ return index;
}
@@ -3621,14 +3556,7 @@ gfc_conv_scalarized_array_ref (gfc_se * se,
gfc_array_ref * ar,
else
n = 0;
- tree index = conv_array_index_offset (se, ss, ss->dim[n], n, ar,
- info->spacing[ss->dim[n]]);
-
- /* 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);
+ tree index = conv_array_index (se, ss, ss->dim[n], n, ar);
base = build_fold_indirect_ref_loc (input_location, info->data);
@@ -3639,8 +3567,7 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref
* ar,
bool non_negative_stride = tmp_array
|| non_negative_strides_array_p (info->descriptor);
se->expr = gfc_build_array_ref (base, index, non_negative_stride,
- tmp_array ? NULL_TREE : gfc_index_one_node,
- tmp_array ? NULL_TREE : info->align);
+ info->offset, info->spacing[ss->dim[0]]);
}
@@ -3654,23 +3581,6 @@ gfc_conv_tmp_array_ref (gfc_se * se)
gfc_advance_se_ss_chain (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
@@ -3683,7 +3593,6 @@ 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;
@@ -3740,18 +3649,8 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar,
gfc_expr *expr,
&& ar->as->type != AS_DEFERRED)
decl = sym->backend_decl;
- bool use_array_ref = array_access_safe_p (expr);
- tree elem_len = NULL_TREE;
- if (use_array_ref)
- {
- elem_len = gfc_get_array_span (decl, expr);
- elem_len = fold_convert_loc (input_location, gfc_array_index_type,
- elem_len);
- }
-
- cst_offset = offset = gfc_index_zero_node;
- tmp = gfc_conv_array_offset (decl);
- add_to_offset (&cst_offset, &offset, tmp);
+ tree array = gfc_conv_array_data (decl);
+ array = build_fold_indirect_ref_loc (input_location, array);
/* Calculate the offsets from all the dimensions. Make sure to associate
the final offset so that we form a chain of loop invariant summands. */
@@ -3762,6 +3661,8 @@ 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. */
@@ -3772,7 +3673,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar,
gfc_expr *expr,
indexse.expr = save_expr (indexse.expr);
/* Lower bound. */
- tmp = gfc_conv_array_lbound (decl, n);
+ tmp = lbound;
if (sym->attr.temporary)
{
gfc_init_se (&tmpse, se);
@@ -3818,31 +3719,27 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar,
gfc_expr *expr,
}
}
- /* 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);
+ tree spacing = gfc_conv_array_spacing (decl, n);
- /* And add it to the total. */
- add_to_offset (&cst_offset, &offset, tmp);
+ gcc_assert (GFC_ARRAY_TYPE_P (TREE_TYPE (array)));
+ tmp = gfc_build_array_ref (array, indexse.expr,
+ non_negative_strides_array_p (decl),
+ lbound, spacing);
+ array = tmp;
}
- if (!integer_zerop (cst_offset))
- offset = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type, offset, cst_offset);
-
free (var_name);
- se->expr = build_array_ref (se->expr, offset);
+ se->expr = array;
}
/* Add the offset corresponding to array's ARRAY_DIM dimension and loop's
LOOP_DIM dimension (if any) to array's offset. */
-static void
-add_array_offset (stmtblock_t *pblock, gfc_loopinfo *loop, gfc_ss *ss,
- gfc_array_ref *ar, int array_dim, int loop_dim)
+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)
{
gfc_se se;
gfc_array_info *info;
@@ -3852,28 +3749,45 @@ add_array_offset (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_offset (&se, ss, array_dim, loop_dim, ar,
- info->spacing[array_dim]);
+ tree tmp = conv_array_index (&se, ss, array_dim, loop_dim, ar);
+
gfc_add_block_to_block (pblock, &se.pre);
- if (info->array_access)
- {
- tree index = fold_convert_loc (input_location, gfc_array_index_type,
tmp);
+ tree index = fold_convert_loc (input_location, gfc_array_index_type, tmp);
- info->offset = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type,
- info->offset, index);
- info->offset = gfc_evaluate_now (info->offset, pblock);
- }
+ tree elt_type = NULL_TREE;
+ if (!array_type_domains || array_type_domains->is_empty ())
+ elt_type = TREE_TYPE (array);
else
{
- tree offset = fold_convert_loc (input_location, size_type_node, tmp);
+ tree desc_type = TREE_TYPE (info->descriptor);
+ tree core_type = TREE_TYPE (GFC_TYPE_ARRAY_DATAPTR_TYPE (desc_type));
- info->data = fold_build2_loc (input_location, POINTER_PLUS_EXPR,
- TREE_TYPE (info->data),
- info->data, offset);
- info->data = gfc_evaluate_now (info->data, pblock);
+ unsigned j;
+ tree *dom_p;
+ FOR_EACH_VEC_ELT (*array_type_domains, j, dom_p)
+ {
+ gcc_assert (GFC_ARRAY_TYPE_P (core_type)
+ && TYPE_DOMAIN (core_type) == *dom_p);
+ core_type = TREE_TYPE (core_type);
+ }
+
+ core_type = TREE_TYPE (core_type);
+
+ tree elt_type = core_type;
+
+ FOR_EACH_VEC_ELT_REVERSE (*array_type_domains, j, dom_p)
+ elt_type = build_array_type (elt_type, *dom_p);
}
+
+ 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 gfc_build_array_ref (elt_type, array, index,
+ non_negative_stride, info->lbound[array_dim],
+ info->spacing[array_dim]);
}
@@ -3939,18 +3853,28 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim,
int flag,
{
gcc_assert (0 == ploop->order[0]);
- /* For the outermost loop calculate the offset due to any
- elemental dimensions. It will have been initialized with the
- base offset of the array. */
+ info->spacing0 = gfc_conv_array_spacing (info->descriptor, 0);
+ info->spacing0 = gfc_evaluate_now (info->spacing0, &loop->pre);
+
if (info->ref)
{
- for (int i = 0; i < ar->dimen; i++)
+ 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)
- continue;
+ if (ar->dimen_type[i] == DIMEN_ELEMENT)
+ array = add_array_index (pblock, ploop, ss, array, ar,
+ pss->dim[i], i, &domains);
+ else
+ domains.safe_push (TYPE_DOMAIN (array_type));
- add_array_offset (pblock, loop, ss, ar, i, /* unused */ -1);
+ array_type = TREE_TYPE (array_type);
}
+
+ info->data = gfc_build_addr_expr (NULL_TREE, array);
}
}
else
@@ -3966,13 +3890,18 @@ 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. */
- add_array_offset (pblock, ploop, ss, ar, pss->dim[i], i);
+ array = add_array_index (pblock, ploop, ss, array, ar, pss->dim[i], i,
+ nullptr);
+
+ info->data = gfc_build_addr_expr (NULL_TREE, array);
}
/* 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;
}
}
@@ -4201,7 +4130,7 @@ gfc_trans_scalarized_loop_boundary (gfc_loopinfo * loop,
stmtblock_t * body)
&& ss_type != GFC_SS_COMPONENT)
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. */
@@ -4233,7 +4162,7 @@ evaluate_bound (stmtblock_t *block, tree *bounds,
gfc_expr ** values,
tree desc, int dim, bool lbound, bool deferred, bool save_value)
{
gfc_se se;
- gfc_expr * input_val = values[dim];
+ gfc_expr * input_val = values ? values[dim] : nullptr;
tree *output = &bounds[dim];
if (input_val)
@@ -4350,6 +4279,8 @@ gfc_conv_section_startstride (stmtblock_t * block, gfc_ss
* ss, int dim)
evaluate_bound (block, info->end, ar->end, desc, dim, false,
ar->as->type == AS_DEFERRED, save_value);
+ evaluate_bound (block, info->lbound, nullptr, desc, dim, true,
+ ar->as->type == AS_DEFERRED, save_value);
/* Calculate the stride. */
if (stride == NULL)
@@ -4637,7 +4568,6 @@ done:
gfc_add_block_to_block (&outer_loop->post, &se.post);
info->descriptor = se.expr;
- info->array_access = true;
info->data = gfc_conv_array_data (info->descriptor);
info->data = gfc_evaluate_now (info->data, &outer_loop->pre);
@@ -6229,10 +6159,11 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sym,
tree * poffset,
tree eltype = gfc_get_element_type (type);
tree elem_len = fold_convert_loc (input_location, gfc_array_index_type,
TYPE_SIZE_UNIT (eltype));
-
- size = fold_build2_loc (input_location, EXACT_DIV_EXPR, gfc_array_index_type,
- elem_len, GFC_TYPE_ARRAY_ALIGN (type));
+ size = elem_len;
offset = gfc_index_zero_node;
+ tree spacing = GFC_TYPE_ARRAY_SPACING (type, 0);
+ if (spacing && VAR_P (spacing))
+ gfc_add_modify (pblock, spacing, elem_len);
for (dim = 0; dim < as->rank; dim++)
{
/* Evaluate non-constant array bound expressions.
@@ -6393,9 +6324,6 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol *
sym,
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;
@@ -6410,9 +6338,6 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol *
sym,
}
else
{
- 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);
@@ -6610,8 +6535,6 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree
tmpdesc,
partial = gfc_create_var (logical_type_node, "partial");
TREE_USED (partial) = 1;
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);
@@ -6645,9 +6568,6 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree
tmpdesc,
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)
{
@@ -6679,9 +6599,6 @@ 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++)
@@ -10211,7 +10128,7 @@ update_reallocated_descriptor (stmtblock_t *block,
gfc_loopinfo *loop)
while (0)
UPDATE_VALUE (info->offset, gfc_conv_descriptor_offset_get (desc));
- info->saved_offset = info->offset;
+ info->saved_data = info->data;
for (int i = 0; i < s->dimen; i++)
{
int dim = s->dim[i];
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index b34cb15e34ca..378e5c164505 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -1028,6 +1028,79 @@ create_index_var (const char * pfx, int nest)
}
+static tree
+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_variant_type_copy (type);
+ TREE_TYPE (new_type) = elt_type;
+ TYPE_DOMAIN (new_type) = build_variant_type_copy (TYPE_DOMAIN (type));
+ TYPE_MIN_VALUE (TYPE_DOMAIN (new_type)) = current_lbound;
+ TYPE_MAX_VALUE (TYPE_DOMAIN (new_type)) = current_ubound;
+ type = new_type;
+ }
+
+ if (current_lbound != NULL_TREE)
+ {
+ GFC_TYPE_ARRAY_LBOUND (root_type, dim) = current_lbound;
+ if (current_lbound
+ && VAR_P (current_lbound)
+ && DECL_ARTIFICIAL (current_lbound)
+ && DECL_IGNORED_P (current_lbound))
+ {
+ if (DECL_NAME (current_lbound)
+ && strstr (IDENTIFIER_POINTER (DECL_NAME (current_lbound)),
+ "lbound") != 0)
+ DECL_NAMELESS (current_lbound) = 1;
+ }
+ }
+ if (current_ubound != NULL_TREE)
+ {
+ GFC_TYPE_ARRAY_UBOUND (type, dim) = current_ubound;
+ if (current_ubound
+ && VAR_P (current_ubound)
+ && DECL_ARTIFICIAL (current_ubound)
+ && DECL_IGNORED_P (current_ubound))
+ {
+ if (DECL_NAME (current_ubound)
+ && strstr (IDENTIFIER_POINTER (DECL_NAME (current_ubound)),
+ "ubound") != 0)
+ DECL_NAMELESS (current_ubound) = 1;
+ }
+ }
+ tree current_spacing = spacing[dim];
+ if (current_spacing != NULL_TREE)
+ {
+ GFC_TYPE_ARRAY_SPACING (type, dim) = current_spacing;
+ if (current_spacing
+ && VAR_P (current_spacing)
+ && DECL_ARTIFICIAL (current_spacing)
+ && DECL_IGNORED_P (current_spacing))
+ {
+ if (DECL_NAME (current_spacing)
+ && strstr (IDENTIFIER_POINTER (DECL_NAME (current_spacing)),
+ "spacing") != 0)
+ DECL_NAMELESS (current_spacing) = 1;
+ }
+ }
+
+ return type;
+}
+
/* Create variables to hold all the non-constant bits of info for a
descriptorless array. Remember these in the lang-specific part of the
type. */
@@ -1035,6 +1108,9 @@ create_index_var (const char * pfx, int nest)
static void
gfc_build_qualified_array (tree decl, gfc_symbol * sym)
{
+ tree lbound[GFC_MAX_DIMENSIONS];
+ tree ubound[GFC_MAX_DIMENSIONS];
+ tree spacing[GFC_MAX_DIMENSIONS];
tree type;
int dim;
int nest;
@@ -1116,24 +1192,48 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym)
{
if (GFC_TYPE_ARRAY_LBOUND (type, dim) == NULL_TREE)
{
- GFC_TYPE_ARRAY_LBOUND (type, dim) = create_index_var ("lbound", nest);
- suppress_warning (GFC_TYPE_ARRAY_LBOUND (type, dim));
+ lbound[dim] = create_index_var ("lbound", nest);
+ suppress_warning (lbound[dim]);
}
+ else
+ lbound[dim] = NULL_TREE;
+
/* Don't try to use the unknown bound for assumed shape arrays. */
if (GFC_TYPE_ARRAY_UBOUND (type, dim) == NULL_TREE
&& (as->type != AS_ASSUMED_SIZE
|| dim < GFC_TYPE_ARRAY_RANK (type) - 1))
{
- GFC_TYPE_ARRAY_UBOUND (type, dim) = create_index_var ("ubound", nest);
- suppress_warning (GFC_TYPE_ARRAY_UBOUND (type, dim));
+ ubound[dim] = create_index_var ("ubound", nest);
+ suppress_warning (ubound[dim]);
}
+ else
+ ubound[dim] = NULL_TREE;
if (GFC_TYPE_ARRAY_SPACING (type, dim) == NULL_TREE)
{
- GFC_TYPE_ARRAY_SPACING (type, dim) = create_index_var ("spacing",
nest);
- suppress_warning (GFC_TYPE_ARRAY_SPACING (type, dim));
+ spacing[dim] = create_index_var ("spacing", nest);
+ suppress_warning (spacing[dim]);
}
+ else
+ spacing[dim] = NULL_TREE;
+ }
+
+ if (POINTER_TYPE_P (type))
+ {
+ gcc_assert (GFC_ARRAY_TYPE_P (TREE_TYPE (type))
+ && TYPE_LANG_SPECIFIC (TREE_TYPE (type))
+ == TYPE_LANG_SPECIFIC (type));
+ type = TREE_TYPE (type);
}
+
+ tree new_type = update_type_bounds (type, lbound, ubound, spacing, type,
+ as->rank - 1);
+ if (POINTER_TYPE_P (TREE_TYPE (decl)))
+ TREE_TYPE (TREE_TYPE (decl)) = new_type;
+ else
+ TREE_TYPE (decl) = new_type;
+ type = new_type;
+
for (dim = GFC_TYPE_ARRAY_RANK (type);
dim < GFC_TYPE_ARRAY_RANK (type) + GFC_TYPE_ARRAY_CORANK (type); dim++)
{
@@ -1168,86 +1268,6 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym)
GFC_TYPE_ARRAY_SIZE (type) = create_index_var ("size", nest);
suppress_warning (GFC_TYPE_ARRAY_SIZE (type));
}
-
- if (POINTER_TYPE_P (type))
- {
- gcc_assert (GFC_ARRAY_TYPE_P (TREE_TYPE (type)));
- gcc_assert (TYPE_LANG_SPECIFIC (type)
- == TYPE_LANG_SPECIFIC (TREE_TYPE (type)));
- type = TREE_TYPE (type);
- }
-
- if (! COMPLETE_TYPE_P (type) && GFC_TYPE_ARRAY_SIZE (type))
- {
- tree size, range;
-
- size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
- GFC_TYPE_ARRAY_SIZE (type), gfc_index_one_node);
- range = build_range_type (gfc_array_index_type, gfc_index_zero_node,
- size);
- TYPE_DOMAIN (type) = range;
- layout_type (type);
- }
-
- if (TYPE_NAME (type) != NULL_TREE && as->rank > 0
- && GFC_TYPE_ARRAY_UBOUND (type, as->rank - 1) != NULL_TREE
- && VAR_P (GFC_TYPE_ARRAY_UBOUND (type, as->rank - 1)))
- {
- tree gtype = DECL_ORIGINAL_TYPE (TYPE_NAME (type));
-
- for (dim = 0; dim < as->rank - 1; dim++)
- {
- gcc_assert (TREE_CODE (gtype) == ARRAY_TYPE);
- gtype = TREE_TYPE (gtype);
- }
- gcc_assert (TREE_CODE (gtype) == ARRAY_TYPE);
- if (TYPE_MAX_VALUE (TYPE_DOMAIN (gtype)) == NULL)
- TYPE_NAME (type) = NULL_TREE;
- }
-
- if (TYPE_NAME (type) == NULL_TREE)
- {
- tree gtype = TREE_TYPE (type), rtype, type_decl;
-
- for (dim = as->rank - 1; dim >= 0; dim--)
- {
- tree lbound, ubound;
- lbound = GFC_TYPE_ARRAY_LBOUND (type, dim);
- ubound = GFC_TYPE_ARRAY_UBOUND (type, dim);
- rtype = build_range_type (gfc_array_index_type, lbound, ubound);
- gtype = build_array_type (gtype, rtype);
- /* Ensure the bound variables aren't optimized out at -O0.
- For -O1 and above they often will be optimized out, but
- can be tracked by VTA. Also set DECL_NAMELESS, so that
- the artificial lbound.N or ubound.N DECL_NAME doesn't
- end up in debug info. */
- if (lbound
- && VAR_P (lbound)
- && DECL_ARTIFICIAL (lbound)
- && DECL_IGNORED_P (lbound))
- {
- if (DECL_NAME (lbound)
- && strstr (IDENTIFIER_POINTER (DECL_NAME (lbound)),
- "lbound") != 0)
- DECL_NAMELESS (lbound) = 1;
- DECL_IGNORED_P (lbound) = 0;
- }
- if (ubound
- && VAR_P (ubound)
- && DECL_ARTIFICIAL (ubound)
- && DECL_IGNORED_P (ubound))
- {
- if (DECL_NAME (ubound)
- && strstr (IDENTIFIER_POINTER (DECL_NAME (ubound)),
- "ubound") != 0)
- DECL_NAMELESS (ubound) = 1;
- DECL_IGNORED_P (ubound) = 0;
- }
- }
- TYPE_NAME (type) = type_decl = build_decl (input_location,
- TYPE_DECL, NULL, gtype);
- DECL_ORIGINAL_TYPE (type_decl) = gtype;
- }
}
@@ -7596,10 +7616,8 @@ done:
/* cfi->dim[i].extent = gfc->dim[i].ubound - gfc->dim[i].lbound + 1. */
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); */
+ /* d->dim[n].sm = gfc->dim[i].spacing */
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 b1516e640625..66a1019207ad 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -29,6 +29,7 @@ along with GCC; see the file COPYING3. If not see
#include "gimplify.h"
#include "trans-descriptor.h"
#include "trans-array.h"
+#include "stor-layout.h"
tree
@@ -304,27 +305,6 @@ 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)
{
@@ -614,9 +594,7 @@ conv_spacing_get (tree desc, tree dim)
|| GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_ALLOCATABLE
|| GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_POINTER_CONT
|| GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT))
- return fold_build2_loc (input_location, EXACT_DIV_EXPR,
- gfc_array_index_type, conv_span_get (desc),
- GFC_TYPE_ARRAY_ALIGN (TREE_TYPE (desc)));
+ return conv_span_get (desc);
return non_lvalue_loc (input_location, get_spacing (desc, dim));
}
@@ -645,13 +623,9 @@ conv_stride_get (tree desc, tree dim)
return gfc_index_one_node;
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,
- fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, spacing,
- align),
- len);
+ spacing, len);
}
tree
@@ -775,26 +749,6 @@ 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)
{
@@ -1003,6 +957,40 @@ 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 (!INTEGER_CST_P (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 (!INTEGER_CST_P (lower))
+ {
+ tree root = build0 (PLACEHOLDER_EXPR, desc_type);
+ tree dim = build_int_cst (integer_type_node, i);
+ upper = gfc_descriptor::get_ubound (root, dim);
+ }
+
+ tree idx_type = build_range_type (gfc_array_index_type, lower, upper);
+
+ type = build_array_type (type, idx_type);
+ layout_type (type);
+ }
+
+ return type;
+}
+
+
static bt
get_type_info (const bt &type)
{
@@ -2438,9 +2426,6 @@ 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;
@@ -2539,9 +2524,6 @@ 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));
}
@@ -2556,8 +2538,6 @@ gfc_set_descriptor_with_shape (stmtblock_t *block, tree
desc,
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));
@@ -2582,11 +2562,7 @@ gfc_set_descriptor_with_shape (stmtblock_t *block, tree
desc,
tree spacing = gfc_create_var (gfc_array_index_type, "spacing");
tree offset = gfc_create_var (gfc_array_index_type, "offset");
- 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, spacing, elem_len);
gfc_add_modify (block, offset, gfc_index_zero_node);
/* Loop body. */
@@ -2685,8 +2661,6 @@ gfc_copy_sequence_descriptor (stmtblock_t &block, tree
lhs_desc, tree rhs_desc,
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_align_set (&block, arr,
- gfc_conv_descriptor_align_get (rhs_desc));
gfc_conv_descriptor_offset_set (&block, arr, gfc_index_zero_node);
desc = arr;
}
@@ -2703,8 +2677,6 @@ 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)
{
@@ -2843,9 +2815,6 @@ 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
@@ -2904,20 +2873,13 @@ gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block,
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,
- tmp2, tmp);
+ gfc_get_cfi_desc_elem_len (cfi), tmp);
}
else
{
- /* 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->dim[i].spacing = cfi->dim[i].sm */
+ tmp = gfc_get_cfi_dim_sm (cfi, idx);
}
gfc_conv_descriptor_spacing_set (&loop_body, gfc, idx, tmp);
@@ -2981,7 +2943,7 @@ 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 elem_align, tree data_ptr,
+ tree elemsize, tree data_ptr,
tree lbound[GFC_MAX_DIMENSIONS],
tree ubound[GFC_MAX_DIMENSIONS],
tree spacing[GFC_MAX_DIMENSIONS], int rank,
@@ -3026,8 +2988,6 @@ gfc_set_temporary_descriptor (stmtblock_t *block, tree
desc, tree class_src,
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
@@ -3105,9 +3065,6 @@ 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_UNIT (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.
@@ -3307,9 +3264,6 @@ 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
@@ -3357,9 +3311,6 @@ gfc_descr_init_count (tree descriptor, int rank, int
corank, gfc_expr ** lower,
tree empty_cond = logical_false_node;
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++)
{
@@ -3540,9 +3491,6 @@ 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_UNIT(gfc_get_element_type
(TREE_TYPE (descriptor))));
-
return gfc_evaluate_now (stride, pblock);
}
@@ -3581,17 +3529,12 @@ 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);
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_spacing_set (block, desc, gfc_index_zero_node, span);
gfc_conv_descriptor_ubound_set (block, desc, gfc_index_zero_node, size);
gfc_conv_descriptor_data_set (block, desc, data_ptr);
}
@@ -3785,9 +3728,7 @@ 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 = fold_build2_loc (input_location, EXACT_DIV_EXPR,
- gfc_array_index_type, elemsize2,
- GFC_TYPE_ARRAY_ALIGN (TREE_TYPE (desc)));
+ tree size1 = elemsize2;
tree offset = gfc_index_zero_node;
for (int n = 0; n < expr2->rank; n++)
@@ -3832,11 +3773,7 @@ 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_align_set (block, desc,
- GFC_TYPE_ARRAY_ALIGN (TREE_TYPE (desc)));
- }
+ gfc_conv_descriptor_span_set (block, desc, elemsize2);
/* For deferred character length, the 'size' field of the dtype might
have changed so set the dtype. */
@@ -3916,13 +3853,9 @@ 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++)
{
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 5f1d7f3f17b9..5cdf324cf8e3 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -41,14 +41,13 @@ 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);
tree gfc_conv_descriptor_version_get (tree);
tree gfc_conv_descriptor_attribute_get (tree);
tree gfc_conv_descriptor_type_get (tree);
-tree gfc_conv_descriptor_dimension_get (tree);
+tree gfc_conv_descriptor_dimension_get (tree, tree);
tree gfc_conv_descriptor_dimensions_get (tree);
tree gfc_conv_descriptor_dimensions_get (tree, tree);
tree gfc_conv_descriptor_stride_get (tree, tree);
@@ -79,13 +78,14 @@ tree gfc_get_cfi_dim_extent (tree, tree);
tree gfc_get_cfi_dim_sm (tree, tree);
/* Shift lower bound of descriptor, updating ubound and offset. */
+tree gfc_build_desc_array_type (tree, tree, int, tree *, tree *);
void gfc_conv_shift_descriptor (stmtblock_t*, tree, const gfc_array_ref &);
void gfc_conv_shift_descriptor (stmtblock_t*, tree, int);
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, tree,
+void gfc_set_temporary_descriptor (stmtblock_t *, 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 0da3bf971a27..37fdda7e0cdd 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -1628,10 +1628,11 @@ gfc_copy_class_to_class (tree from, tree to, tree
nelems, bool unlimited)
{
tmp = gfc_conv_array_data (to);
tmp = build_fold_indirect_ref_loc (input_location, tmp);
+ tree ptr_type = GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (to_data));
+ tree len = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (ptr_type)));
to_ref = gfc_build_addr_expr (NULL_TREE,
- gfc_build_array_ref (tmp, index, false,
-
GFC_TYPE_ARRAY_SPACING (to, 0),
-
GFC_TYPE_ARRAY_ALIGN (to)));
+ gfc_build_array_ref (tmp, index, true,
+ NULL_TREE, len));
}
vec_safe_push (args, to_ref);
@@ -6200,8 +6201,6 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr
*e, gfc_symbol *fsym)
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_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 ca61dcda5ff4..475fa096ea4b 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -2155,8 +2155,7 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[rank+corank-1]);
tmp = gfc_build_array_ref (subdesc, gfc_rank_cst[corank-1], false,
- GFC_TYPE_ARRAY_SPACING (subse.expr, 0),
- GFC_TYPE_ARRAY_ALIGN (subse.expr));
+ NULL_TREE, GFC_TYPE_ARRAY_SPACING (subse.expr, 0));
invalid_bound = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
fold_convert (gfc_array_index_type, tmp),
lbound);
@@ -2166,8 +2165,8 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[codim]);
ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[codim]);
tmp = gfc_build_array_ref (subdesc, gfc_rank_cst[codim-rank], false,
- GFC_TYPE_ARRAY_SPACING (subse.expr, 0),
- GFC_TYPE_ARRAY_ALIGN (subse.expr));
+ NULL_TREE,
+ GFC_TYPE_ARRAY_SPACING (subse.expr, 0));
cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
fold_convert (gfc_array_index_type, tmp),
lbound);
@@ -2187,9 +2186,8 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
/* coindex = sub(corank) - lcobound(n). */
coindex = fold_convert (gfc_array_index_type,
gfc_build_array_ref (subdesc, gfc_rank_cst[corank-1],
- false,
- GFC_TYPE_ARRAY_SPACING
(subse.expr, 0),
- GFC_TYPE_ARRAY_ALIGN
(subse.expr)));
+ false, NULL_TREE,
+ GFC_TYPE_ARRAY_SPACING
(subse.expr, 0)));
lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[rank+corank-1]);
coindex = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
fold_convert (gfc_array_index_type, coindex),
@@ -2208,8 +2206,8 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
/* coindex += sub(codim). */
tmp = gfc_build_array_ref (subdesc, gfc_rank_cst[codim-rank], false,
- GFC_TYPE_ARRAY_SPACING (subse.expr, 0),
- GFC_TYPE_ARRAY_ALIGN (subse.expr));
+ NULL_TREE,
+ GFC_TYPE_ARRAY_SPACING (subse.expr, 0));
coindex = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type, coindex,
fold_convert (gfc_array_index_type, tmp));
@@ -2356,10 +2354,8 @@ gfc_conv_is_contiguous_expr (gfc_se *se, gfc_expr *arg)
desc = gfc_evaluate_now (argse.expr, &se->pre);
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,
- tmp, gfc_conv_descriptor_span_get (desc));
+ spacing, gfc_conv_descriptor_span_get (desc));
for (i = 0; i < arg->rank - 1; i++)
{
diff --git a/gcc/fortran/trans-io.cc b/gcc/fortran/trans-io.cc
index 44e65d9e01d2..147aff5f7118 100644
--- a/gcc/fortran/trans-io.cc
+++ b/gcc/fortran/trans-io.cc
@@ -776,9 +776,6 @@ gfc_convert_array_to_string (gfc_se * se, gfc_expr * e)
tree tmp = gfc_conv_array_extent (array, rank);
full_size = fold_build2_loc (input_location, MULT_EXPR,
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);
@@ -1655,9 +1652,8 @@ 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, false,
- GFC_TYPE_ARRAY_SPACING (tmp, 0),
- GFC_TYPE_ARRAY_ALIGN (tmp));
+ tmp = gfc_build_array_ref (tmp, gfc_index_zero_node, false,
+ NULL_TREE, GFC_TYPE_ARRAY_SPACING (tmp, 0));
if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
tmp = build_fold_indirect_ref_loc (input_location,
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 4e27816c1f5a..01d9263fb838 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -593,17 +593,15 @@ gfc_walk_alloc_comps (tree decl, tree dest, tree var,
gfc_init_block (&tmpblock);
tem = gfc_conv_array_data (decl);
tree declvar = build_fold_indirect_ref_loc (input_location, tem);
- tree declvref = gfc_build_array_ref (declvar, index, false,
- GFC_TYPE_ARRAY_SPACING (declvar, 0),
- GFC_TYPE_ARRAY_ALIGN (declvar));
+ tree declvref = gfc_build_array_ref (declvar, index, false, NULL_TREE,
+ GFC_TYPE_ARRAY_SPACING (declvar, 0));
tree destvar, destvref = NULL_TREE;
if (dest)
{
tem = gfc_conv_array_data (dest);
destvar = build_fold_indirect_ref_loc (input_location, tem);
- destvref = gfc_build_array_ref (destvar, index, false,
- GFC_TYPE_ARRAY_SPACING (declvar, 0),
- GFC_TYPE_ARRAY_ALIGN (declvar));
+ destvref = gfc_build_array_ref (destvar, index, false, NULL_TREE,
+ GFC_TYPE_ARRAY_SPACING (declvar, 0));
}
gfc_add_expr_to_block (&tmpblock,
gfc_walk_alloc_comps (declvref, destvref,
@@ -793,8 +791,6 @@ gfc_omp_clause_default_ctor (tree clause, tree decl, tree
outer)
}
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);
@@ -1097,9 +1093,6 @@ gfc_omp_clause_assign_op (tree clause, tree dest, tree
src)
if (GFC_TYPE_ARRAY_RANK (type) >= 1)
{
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
{
@@ -1236,12 +1229,10 @@ gfc_omp_linear_clause_add_loop (stmtblock_t *block,
tree dest, tree src,
gfc_init_block (&tmpblock);
if (TREE_CODE (TREE_TYPE (dest)) == ARRAY_TYPE)
{
- desta = gfc_build_array_ref (dest, index, false,
- GFC_TYPE_ARRAY_SPACING (dest, 0),
- GFC_TYPE_ARRAY_ALIGN (dest));
- srca = gfc_build_array_ref (src, index, false,
- GFC_TYPE_ARRAY_SPACING (src, 0),
- GFC_TYPE_ARRAY_ALIGN (src));
+ desta = gfc_build_array_ref (dest, index, false, NULL_TREE,
+ GFC_TYPE_ARRAY_SPACING (dest, 0));
+ srca = gfc_build_array_ref (src, index, false, NULL_TREE,
+ GFC_TYPE_ARRAY_SPACING (src, 0));
}
else
{
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index f30be9293fe0..69021347d9fa 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -39,6 +39,7 @@ along with GCC; see the file COPYING3. If not see
#include "dwarf2out.h" /* For struct array_descr_info. */
#include "attribs.h"
#include "alias.h"
+#include "trans-descriptor.h"
#if (GFC_MAX_DIMENSIONS < 10)
@@ -1840,6 +1841,23 @@ 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 = build_range_type (gfc_array_index_type, lbound[i],
ubound[i]);
+ 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. */
@@ -1847,54 +1865,41 @@ tree
gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed,
bool restricted)
{
- tree range;
+ tree lbound[GFC_MAX_DIMENSIONS];
+ tree ubound[GFC_MAX_DIMENSIONS];
+ tree spacing[GFC_MAX_DIMENSIONS];
tree type;
tree tmp;
int n;
- int known_offset;
mpz_t offset;
mpz_t stride;
- mpz_t spacing;
+ mpz_t spc;
mpz_t delta;
gfc_expr *expr;
mpz_init_set_ui (offset, 0);
mpz_init_set_ui (stride, 1);
- mpz_init (spacing);
- wide_int align = wi::uhwi (TYPE_ALIGN_UNIT (etype),
- TYPE_PRECISION (gfc_array_index_type));
+ mpz_init (spc);
bool known_spacing = INTEGER_CST_P (TYPE_SIZE_UNIT (etype));
if (known_spacing)
{
wide_int elem_len = wi::to_wide (TYPE_SIZE_UNIT (etype));
- wide_int len_align = wi::udiv_trunc (elem_len, align);
- gcc_assert (wi::fits_uhwi_p (len_align));
- mpz_set_ui (spacing, len_align.to_uhwi ());
+ gcc_assert (wi::fits_uhwi_p (elem_len));
+ mpz_set_ui (spc, elem_len.to_uhwi ());
}
mpz_init (delta);
- /* 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)
- 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> ();
-
bool known_stride = (packed != PACKED_NO);
- known_offset = 1;
+ bool known_offset = true;
for (n = 0; n < as->rank; n++)
{
/* Fill in the spacing and bound components of the type. */
if (known_spacing)
- tmp = gfc_conv_mpz_to_tree (spacing, gfc_index_integer_kind);
+ tmp = gfc_conv_mpz_to_tree (spc, gfc_index_integer_kind);
else
tmp = NULL_TREE;
- GFC_TYPE_ARRAY_SPACING (type, n) = tmp;
+ spacing[n] = tmp;
expr = as->lower[n];
if (expr && expr->expr_type == EXPR_CONSTANT)
@@ -1908,16 +1913,16 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec *
as, gfc_packed packed,
known_spacing = false;
tmp = NULL_TREE;
}
- GFC_TYPE_ARRAY_LBOUND (type, n) = tmp;
+ lbound[n] = tmp;
if (known_spacing)
{
/* Calculate the offset. */
- mpz_mul (delta, spacing, as->lower[n]->value.integer);
+ mpz_mul (delta, spc, as->lower[n]->value.integer);
mpz_sub (offset, offset, delta);
}
else
- known_offset = 0;
+ known_offset = false;
expr = as->upper[n];
if (expr && expr->expr_type == EXPR_CONSTANT)
@@ -1931,7 +1936,7 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec *
as, gfc_packed packed,
known_stride = false;
known_spacing = false;
}
- GFC_TYPE_ARRAY_UBOUND (type, n) = tmp;
+ ubound[n] = tmp;
if (known_spacing || known_stride)
{
@@ -1942,16 +1947,28 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec *
as, gfc_packed packed,
if (known_stride)
mpz_mul (stride, stride, delta);
if (known_spacing)
- mpz_mul (spacing, spacing, delta);
+ mpz_mul (spc, spc, delta);
}
/* Only the first stride is known for partial packed arrays. */
if (packed == PACKED_NO || packed == PACKED_PARTIAL)
{
- known_stride = 0;
- known_spacing = 0;
+ known_stride = false;
+ known_spacing = false;
}
}
+
+ type = build_nested_array_types (etype, lbound, ubound, as->rank);
+
+ GFC_ARRAY_TYPE_P (type) = 1;
+ TYPE_LANG_SPECIFIC (type) = ggc_cleared_alloc<struct lang_type> ();
+
+ for (n = 0; n < as->rank; n++)
+ {
+ GFC_TYPE_ARRAY_SPACING (type, n) = spacing[n];
+ GFC_TYPE_ARRAY_LBOUND (type, n) = lbound[n];
+ GFC_TYPE_ARRAY_UBOUND (type, n) = ubound[n];
+ }
for (n = as->rank; n < as->rank + as->corank; n++)
{
expr = as->lower[n];
@@ -1991,74 +2008,18 @@ 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, align);
GFC_TYPE_ARRAY_RANK (type) = as->rank;
GFC_TYPE_ARRAY_CORANK (type) = as->corank;
GFC_TYPE_ARRAY_DTYPE (type) = NULL_TREE;
- range = build_range_type (gfc_array_index_type, gfc_index_zero_node,
- NULL_TREE);
- /* TODO: use main type if it is unbounded. */
- GFC_TYPE_ARRAY_DATAPTR_TYPE (type) =
- build_pointer_type (build_array_type (etype, range));
+ GFC_TYPE_ARRAY_DATAPTR_TYPE (type) = build_pointer_type (type);
if (restricted)
GFC_TYPE_ARRAY_DATAPTR_TYPE (type) =
build_qualified_type (GFC_TYPE_ARRAY_DATAPTR_TYPE (type),
TYPE_QUAL_RESTRICT);
- if (as->rank == 0)
- {
- if (packed != PACKED_STATIC || flag_coarray == GFC_FCOARRAY_LIB)
- {
- type = build_pointer_type (type);
-
- if (restricted)
- type = build_qualified_type (type, TYPE_QUAL_RESTRICT);
-
- GFC_ARRAY_TYPE_P (type) = 1;
- TYPE_LANG_SPECIFIC (type) = TYPE_LANG_SPECIFIC (TREE_TYPE (type));
- }
-
- goto array_type_done;
- }
-
- if (known_stride)
- {
- mpz_sub_ui (stride, stride, 1);
- range = gfc_conv_mpz_to_tree (stride, gfc_index_integer_kind);
- }
- else
- range = NULL_TREE;
-
- range = build_range_type (gfc_array_index_type, gfc_index_zero_node, range);
- TYPE_DOMAIN (type) = range;
-
- build_pointer_type (etype);
- TREE_TYPE (type) = etype;
-
- layout_type (type);
-
- /* Represent packed arrays as multi-dimensional if they have rank >
- 1 and with proper bounds, instead of flat arrays. This makes for
- better debug info. */
- if (known_offset)
- {
- tree gtype = etype, rtype, type_decl;
-
- for (n = as->rank - 1; n >= 0; n--)
- {
- rtype = build_range_type (gfc_array_index_type,
- GFC_TYPE_ARRAY_LBOUND (type, n),
- GFC_TYPE_ARRAY_UBOUND (type, n));
- gtype = build_array_type (gtype, rtype);
- }
- TYPE_NAME (type) = type_decl = build_decl (input_location,
- TYPE_DECL, NULL, gtype);
- DECL_ORIGINAL_TYPE (type_decl) = gtype;
- }
-
- if (packed != PACKED_STATIC || !known_stride
- || (as->corank && flag_coarray == GFC_FCOARRAY_LIB))
+ if (packed != PACKED_STATIC
+ || (!known_stride && as->rank != 0)
+ || ((as->corank || as->rank == 0) && flag_coarray == GFC_FCOARRAY_LIB))
{
/* For dummy arrays and automatic (heap allocated) arrays we
want a pointer to the array. */
@@ -2069,10 +2030,9 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec *
as, gfc_packed packed,
TYPE_LANG_SPECIFIC (type) = TYPE_LANG_SPECIFIC (TREE_TYPE (type));
}
-array_type_done:
mpz_clear (offset);
mpz_clear (stride);
- mpz_clear (spacing);
+ mpz_clear (spc);
mpz_clear (delta);
return type;
@@ -2136,12 +2096,6 @@ 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)
{
@@ -2185,7 +2139,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, rtype;
+ tree fat_type, base_type, arraytype, lower, upper, stride, tmp;
const char *type_name;
int n;
@@ -2228,11 +2182,6 @@ 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,
- align);
GFC_TYPE_ARRAY_RANK (fat_type) = dimen;
GFC_TYPE_ARRAY_CORANK (fat_type) = codimen;
GFC_TYPE_ARRAY_DTYPE (fat_type) = NULL_TREE;
@@ -2244,11 +2193,6 @@ gfc_get_array_type_bounds (tree etype, int dimen, int
codimen, tree * lbound,
{
stride = gfc_index_one_node;
spacing = TYPE_SIZE_UNIT (etype);
- if (spacing != NULL_TREE)
- 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
{
@@ -2324,15 +2268,7 @@ gfc_get_array_type_bounds (tree etype, int dimen, int
codimen, tree * lbound,
return fat_type;
}
- /* 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 = gfc_build_desc_array_type (fat_type, etype, dimen, lbound,
ubound);
arraytype = build_pointer_type (arraytype);
if (restricted)
arraytype = build_qualified_type (arraytype, TYPE_QUAL_RESTRICT);
@@ -4014,8 +3950,6 @@ gfc_get_array_descr_info (const_tree type, struct
array_descr_info *info)
size_binop (PLUS_EXPR,
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 7120824b8195..152e19f536ac 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -412,59 +412,49 @@ 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, bool non_negative_offset,
- tree spacing, tree align)
+gfc_build_array_ref (tree type, tree base, tree index, bool
non_negative_offset,
+ tree offset, tree spacing)
{
- tree type = TREE_TYPE (base);
-
- if (GFC_ARRAY_TYPE_P (type) && GFC_TYPE_ARRAY_RANK (type) == 0)
- {
- gcc_assert (GFC_TYPE_ARRAY_CORANK (type) > 0);
-
- return fold_convert (TYPE_MAIN_VARIANT (type), base);
- }
-
- /* Scalar coarray, there is nothing to do. */
- if (TREE_CODE (type) != ARRAY_TYPE)
- {
- gcc_assert (integer_zerop (offset));
- return base;
- }
-
- type = TREE_TYPE (type);
-
if (DECL_P (base))
TREE_ADDRESSABLE (base) = 1;
/* Strip NON_LVALUE_EXPR nodes. */
- STRIP_TYPE_NOPS (offset);
+ STRIP_TYPE_NOPS (index);
if (non_negative_offset)
- return build4_loc (input_location, ARRAY_REF, type, base, offset,
- NULL_TREE, spacing);
+ {
+ tree align = build_int_cst (gfc_array_index_type,
+ TYPE_ALIGN_UNIT (type));
+ tree elt_unit_cnt = fold_build2_loc (input_location, EXACT_DIV_EXPR,
+ gfc_array_index_type, spacing,
+ align);
+ tree min_val = fold_build1_loc (input_location, NEGATE_EXPR,
+ gfc_array_index_type, offset);
+ return build4_loc (input_location, ARRAY_REF, type, base, index,
+ min_val, elt_unit_cnt);
+ }
/* Otherwise use pointer arithmetic. */
else
{
gcc_assert (TREE_CODE (TREE_TYPE (base)) == ARRAY_TYPE);
tree min = NULL_TREE;
- if (TYPE_DOMAIN (TREE_TYPE (base))
- && !integer_zerop (TYPE_MIN_VALUE (TYPE_DOMAIN (TREE_TYPE (base)))))
+ if (offset != NULL_TREE)
+ min = fold_build1_loc (input_location, NEGATE_EXPR,
+ gfc_array_index_type, offset);
+ else if (TYPE_DOMAIN (TREE_TYPE (base)))
min = TYPE_MIN_VALUE (TYPE_DOMAIN (TREE_TYPE (base)));
tree zero_based_index
- = min ? fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type,
- fold_convert (gfc_array_index_type, offset),
- fold_convert (gfc_array_index_type, min))
- : fold_convert (gfc_array_index_type, offset);
-
- tree offset_align = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type,
- zero_based_index, spacing);
+ = min && !integer_zerop (min)
+ ? fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type,
+ fold_convert (gfc_array_index_type, index),
+ fold_convert (gfc_array_index_type, min))
+ : fold_convert (gfc_array_index_type, index);
tree offset_bytes = fold_build2_loc (input_location, MULT_EXPR,
gfc_array_index_type,
- offset_align, align);
+ zero_based_index, spacing);
tree base_addr = gfc_build_addr_expr (pvoid_type_node, base);
@@ -476,6 +466,31 @@ gfc_build_array_ref (tree base, tree offset, bool
non_negative_offset,
}
+tree
+gfc_build_array_ref (tree base, tree index, bool non_negative_offset,
+ tree offset, tree spacing)
+{
+ tree type = TREE_TYPE (base);
+
+ if (GFC_ARRAY_TYPE_P (type) && GFC_TYPE_ARRAY_RANK (type) == 0)
+ {
+ gcc_assert (GFC_TYPE_ARRAY_CORANK (type) > 0);
+
+ return fold_convert (TYPE_MAIN_VARIANT (type), base);
+ }
+
+ /* Scalar coarray, there is nothing to do. */
+ if (TREE_CODE (type) != ARRAY_TYPE)
+ {
+ gcc_assert (integer_zerop (index));
+ return base;
+ }
+
+ return gfc_build_array_ref (TREE_TYPE (type), index, non_negative_offset,
+ offset, spacing);
+}
+
+
/* Generate a call to print a runtime error possibly including multiple
arguments and a locus. */
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index e254f9f1dc60..72f9b82098e3 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -194,33 +194,31 @@ typedef struct gfc_array_info
gfc_ref *ref;
/* The descriptor of this array. */
tree descriptor;
- /* holds the pointer to the data array. */
+ /* holds the pointer to the array. */
tree data;
+ /* value of the pointer to the array before the beginning of the loops. */
+ 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;
+
+ tree spacing0;
+
/* Holds the SS for a subscript. Indexed by actual dimension. */
struct gfc_ss *subscript[GFC_MAX_DIMENSIONS];
/* stride, spacing and delta are used to access this inside a scalarization
loop.
start is used in the calculation of these. Indexed by scalarizer
dimension. */
+ tree lbound[GFC_MAX_DIMENSIONS];
tree start[GFC_MAX_DIMENSIONS];
tree end[GFC_MAX_DIMENSIONS];
/* The spacing of indexes, that may be specified by the strides of array
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. In alignment-sized
- units. */
+ dimension. This is the intrinsic spacing of the array. */
tree spacing[GFC_MAX_DIMENSIONS];
tree delta[GFC_MAX_DIMENSIONS];
-
- /* False: access with pointer arithmetics.
- True: access with array reference. */
- bool array_access;
}
gfc_array_info;
@@ -648,7 +646,9 @@ tree gfc_build_addr_expr (tree, tree);
/* Build an ARRAY_REF. */
tree gfc_build_array_ref (tree, tree, bool non_negative_offset = false,
- tree spacing = NULL_TREE, tree align = NULL_TREE);
+ tree offset = NULL_TREE, tree spacing = NULL_TREE);
+tree gfc_build_array_ref (tree, tree, tree, bool non_negative_offset = false,
+ tree offset = NULL_TREE, tree spacing = NULL_TREE);
/* Build an array ref using pointer arithmetic. */
tree gfc_build_spanned_array_ref (tree base, tree offset, tree span);
@@ -1122,12 +1122,11 @@ struct GTY(()) lang_decl {
#define GFC_TYPE_ARRAY_STRIDE(node, dim) \
(fold_build2_loc (input_location, EXACT_DIV_EXPR, gfc_array_index_type, \
GFC_TYPE_ARRAY_SPACING((node), (dim)), \
- GFC_TYPE_ARRAY_ALIGN((node))))
+ GFC_TYPE_ARRAY_ELEM_LEN((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)
diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index b2398a43a94d..2f05a4decadc 100644
--- a/libgfortran/caf/single.c
+++ b/libgfortran/caf/single.c
@@ -382,7 +382,6 @@ _gfortran_caf_failed_images (gfc_descriptor_t *array,
array->dim[0]._ubound = -1;
array->dim[0].spacing = 1;
array->offset = 0;
- array->align = local_kind;
}
@@ -405,7 +404,6 @@ _gfortran_caf_stopped_images (gfc_descriptor_t *array,
array->dim[0]._ubound = -1;
array->dim[0].spacing = 1;
array->offset = 0;
- array->align = local_kind;
}
diff --git a/libgfortran/generated/reshape_c10.c
b/libgfortran/generated/reshape_c10.c
index 0d928d3c3e36..4cdf2cfa3630 100644
--- a/libgfortran/generated/reshape_c10.c
+++ b/libgfortran/generated/reshape_c10.c
@@ -53,6 +53,7 @@ reshape_c10 (gfc_array_c10 * const restrict ret,
index_type rdim;
index_type rsize;
index_type rs;
+ index_type spacing;
index_type rex;
GFC_COMPLEX_10 *rptr;
/* s.* indicates the source array. */
@@ -100,13 +101,15 @@ reshape_c10 (gfc_array_c10 * const restrict ret,
index_type alloc_size;
rs = 1;
+ spacing = GFC_DESCRIPTOR_SIZE(source);
for (index_type n = 0; n < rdim; n++)
{
rex = shape_data[n];
- GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs);
+ GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, spacing);
rs *= rex;
+ spacing *= rex;
}
ret->offset = 0;
diff --git a/libgfortran/generated/reshape_c16.c
b/libgfortran/generated/reshape_c16.c
index db51e15add91..acd265d0a837 100644
--- a/libgfortran/generated/reshape_c16.c
+++ b/libgfortran/generated/reshape_c16.c
@@ -53,6 +53,7 @@ reshape_c16 (gfc_array_c16 * const restrict ret,
index_type rdim;
index_type rsize;
index_type rs;
+ index_type spacing;
index_type rex;
GFC_COMPLEX_16 *rptr;
/* s.* indicates the source array. */
@@ -100,13 +101,15 @@ reshape_c16 (gfc_array_c16 * const restrict ret,
index_type alloc_size;
rs = 1;
+ spacing = GFC_DESCRIPTOR_SIZE(source);
for (index_type n = 0; n < rdim; n++)
{
rex = shape_data[n];
- GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs);
+ GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, spacing);
rs *= rex;
+ spacing *= rex;
}
ret->offset = 0;
diff --git a/libgfortran/generated/reshape_c17.c
b/libgfortran/generated/reshape_c17.c
index 06693c825df9..f1543d355fa4 100644
--- a/libgfortran/generated/reshape_c17.c
+++ b/libgfortran/generated/reshape_c17.c
@@ -53,6 +53,7 @@ reshape_c17 (gfc_array_c17 * const restrict ret,
index_type rdim;
index_type rsize;
index_type rs;
+ index_type spacing;
index_type rex;
GFC_COMPLEX_17 *rptr;
/* s.* indicates the source array. */
@@ -100,13 +101,15 @@ reshape_c17 (gfc_array_c17 * const restrict ret,
index_type alloc_size;
rs = 1;
+ spacing = GFC_DESCRIPTOR_SIZE(source);
for (index_type n = 0; n < rdim; n++)
{
rex = shape_data[n];
- GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs);
+ GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, spacing);
rs *= rex;
+ spacing *= rex;
}
ret->offset = 0;
diff --git a/libgfortran/generated/reshape_c4.c
b/libgfortran/generated/reshape_c4.c
index fd66f80d172b..83a066f03fe6 100644
--- a/libgfortran/generated/reshape_c4.c
+++ b/libgfortran/generated/reshape_c4.c
@@ -53,6 +53,7 @@ reshape_c4 (gfc_array_c4 * const restrict ret,
index_type rdim;
index_type rsize;
index_type rs;
+ index_type spacing;
index_type rex;
GFC_COMPLEX_4 *rptr;
/* s.* indicates the source array. */
@@ -100,13 +101,15 @@ reshape_c4 (gfc_array_c4 * const restrict ret,
index_type alloc_size;
rs = 1;
+ spacing = GFC_DESCRIPTOR_SIZE(source);
for (index_type n = 0; n < rdim; n++)
{
rex = shape_data[n];
- GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs);
+ GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, spacing);
rs *= rex;
+ spacing *= rex;
}
ret->offset = 0;
diff --git a/libgfortran/generated/reshape_c8.c
b/libgfortran/generated/reshape_c8.c
index d1d2047459ea..f4f297160008 100644
--- a/libgfortran/generated/reshape_c8.c
+++ b/libgfortran/generated/reshape_c8.c
@@ -53,6 +53,7 @@ reshape_c8 (gfc_array_c8 * const restrict ret,
index_type rdim;
index_type rsize;
index_type rs;
+ index_type spacing;
index_type rex;
GFC_COMPLEX_8 *rptr;
/* s.* indicates the source array. */
@@ -100,13 +101,15 @@ reshape_c8 (gfc_array_c8 * const restrict ret,
index_type alloc_size;
rs = 1;
+ spacing = GFC_DESCRIPTOR_SIZE(source);
for (index_type n = 0; n < rdim; n++)
{
rex = shape_data[n];
- GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs);
+ GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, spacing);
rs *= rex;
+ spacing *= rex;
}
ret->offset = 0;
diff --git a/libgfortran/generated/reshape_i16.c
b/libgfortran/generated/reshape_i16.c
index cb12bc90698d..201f98e4cf91 100644
--- a/libgfortran/generated/reshape_i16.c
+++ b/libgfortran/generated/reshape_i16.c
@@ -53,6 +53,7 @@ reshape_16 (gfc_array_i16 * const restrict ret,
index_type rdim;
index_type rsize;
index_type rs;
+ index_type spacing;
index_type rex;
GFC_INTEGER_16 *rptr;
/* s.* indicates the source array. */
@@ -100,13 +101,15 @@ reshape_16 (gfc_array_i16 * const restrict ret,
index_type alloc_size;
rs = 1;
+ spacing = GFC_DESCRIPTOR_SIZE(source);
for (index_type n = 0; n < rdim; n++)
{
rex = shape_data[n];
- GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs);
+ GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, spacing);
rs *= rex;
+ spacing *= rex;
}
ret->offset = 0;
diff --git a/libgfortran/generated/reshape_i4.c
b/libgfortran/generated/reshape_i4.c
index 66cae896125d..33f2f750e40c 100644
--- a/libgfortran/generated/reshape_i4.c
+++ b/libgfortran/generated/reshape_i4.c
@@ -53,6 +53,7 @@ reshape_4 (gfc_array_i4 * const restrict ret,
index_type rdim;
index_type rsize;
index_type rs;
+ index_type spacing;
index_type rex;
GFC_INTEGER_4 *rptr;
/* s.* indicates the source array. */
@@ -100,13 +101,15 @@ reshape_4 (gfc_array_i4 * const restrict ret,
index_type alloc_size;
rs = 1;
+ spacing = GFC_DESCRIPTOR_SIZE(source);
for (index_type n = 0; n < rdim; n++)
{
rex = shape_data[n];
- GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs);
+ GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, spacing);
rs *= rex;
+ spacing *= rex;
}
ret->offset = 0;
diff --git a/libgfortran/generated/reshape_i8.c
b/libgfortran/generated/reshape_i8.c
index e3a928eea086..94448afc5046 100644
--- a/libgfortran/generated/reshape_i8.c
+++ b/libgfortran/generated/reshape_i8.c
@@ -53,6 +53,7 @@ reshape_8 (gfc_array_i8 * const restrict ret,
index_type rdim;
index_type rsize;
index_type rs;
+ index_type spacing;
index_type rex;
GFC_INTEGER_8 *rptr;
/* s.* indicates the source array. */
@@ -100,13 +101,15 @@ reshape_8 (gfc_array_i8 * const restrict ret,
index_type alloc_size;
rs = 1;
+ spacing = GFC_DESCRIPTOR_SIZE(source);
for (index_type n = 0; n < rdim; n++)
{
rex = shape_data[n];
- GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs);
+ GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, spacing);
rs *= rex;
+ spacing *= rex;
}
ret->offset = 0;
diff --git a/libgfortran/generated/reshape_r10.c
b/libgfortran/generated/reshape_r10.c
index fa640d8f7b6d..e3f70782dc4e 100644
--- a/libgfortran/generated/reshape_r10.c
+++ b/libgfortran/generated/reshape_r10.c
@@ -53,6 +53,7 @@ reshape_r10 (gfc_array_r10 * const restrict ret,
index_type rdim;
index_type rsize;
index_type rs;
+ index_type spacing;
index_type rex;
GFC_REAL_10 *rptr;
/* s.* indicates the source array. */
@@ -100,13 +101,15 @@ reshape_r10 (gfc_array_r10 * const restrict ret,
index_type alloc_size;
rs = 1;
+ spacing = GFC_DESCRIPTOR_SIZE(source);
for (index_type n = 0; n < rdim; n++)
{
rex = shape_data[n];
- GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs);
+ GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, spacing);
rs *= rex;
+ spacing *= rex;
}
ret->offset = 0;
diff --git a/libgfortran/generated/reshape_r16.c
b/libgfortran/generated/reshape_r16.c
index 266feb71f051..5d88a74cfbed 100644
--- a/libgfortran/generated/reshape_r16.c
+++ b/libgfortran/generated/reshape_r16.c
@@ -53,6 +53,7 @@ reshape_r16 (gfc_array_r16 * const restrict ret,
index_type rdim;
index_type rsize;
index_type rs;
+ index_type spacing;
index_type rex;
GFC_REAL_16 *rptr;
/* s.* indicates the source array. */
@@ -100,13 +101,15 @@ reshape_r16 (gfc_array_r16 * const restrict ret,
index_type alloc_size;
rs = 1;
+ spacing = GFC_DESCRIPTOR_SIZE(source);
for (index_type n = 0; n < rdim; n++)
{
rex = shape_data[n];
- GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs);
+ GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, spacing);
rs *= rex;
+ spacing *= rex;
}
ret->offset = 0;
diff --git a/libgfortran/generated/reshape_r17.c
b/libgfortran/generated/reshape_r17.c
index ac8017f29af9..3c6ef2f9634a 100644
--- a/libgfortran/generated/reshape_r17.c
+++ b/libgfortran/generated/reshape_r17.c
@@ -53,6 +53,7 @@ reshape_r17 (gfc_array_r17 * const restrict ret,
index_type rdim;
index_type rsize;
index_type rs;
+ index_type spacing;
index_type rex;
GFC_REAL_17 *rptr;
/* s.* indicates the source array. */
@@ -100,13 +101,15 @@ reshape_r17 (gfc_array_r17 * const restrict ret,
index_type alloc_size;
rs = 1;
+ spacing = GFC_DESCRIPTOR_SIZE(source);
for (index_type n = 0; n < rdim; n++)
{
rex = shape_data[n];
- GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs);
+ GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, spacing);
rs *= rex;
+ spacing *= rex;
}
ret->offset = 0;
diff --git a/libgfortran/generated/reshape_r4.c
b/libgfortran/generated/reshape_r4.c
index ade896a2c226..beefcc300887 100644
--- a/libgfortran/generated/reshape_r4.c
+++ b/libgfortran/generated/reshape_r4.c
@@ -53,6 +53,7 @@ reshape_r4 (gfc_array_r4 * const restrict ret,
index_type rdim;
index_type rsize;
index_type rs;
+ index_type spacing;
index_type rex;
GFC_REAL_4 *rptr;
/* s.* indicates the source array. */
@@ -100,13 +101,15 @@ reshape_r4 (gfc_array_r4 * const restrict ret,
index_type alloc_size;
rs = 1;
+ spacing = GFC_DESCRIPTOR_SIZE(source);
for (index_type n = 0; n < rdim; n++)
{
rex = shape_data[n];
- GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs);
+ GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, spacing);
rs *= rex;
+ spacing *= rex;
}
ret->offset = 0;
diff --git a/libgfortran/generated/reshape_r8.c
b/libgfortran/generated/reshape_r8.c
index 7301276a7e2b..0c09de675166 100644
--- a/libgfortran/generated/reshape_r8.c
+++ b/libgfortran/generated/reshape_r8.c
@@ -53,6 +53,7 @@ reshape_r8 (gfc_array_r8 * const restrict ret,
index_type rdim;
index_type rsize;
index_type rs;
+ index_type spacing;
index_type rex;
GFC_REAL_8 *rptr;
/* s.* indicates the source array. */
@@ -100,13 +101,15 @@ reshape_r8 (gfc_array_r8 * const restrict ret,
index_type alloc_size;
rs = 1;
+ spacing = GFC_DESCRIPTOR_SIZE(source);
for (index_type n = 0; n < rdim; n++)
{
rex = shape_data[n];
- GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs);
+ GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, spacing);
rs *= rex;
+ spacing *= rex;
}
ret->offset = 0;
diff --git a/libgfortran/intrinsics/cshift0.c b/libgfortran/intrinsics/cshift0.c
index 9d146390fbfa..044a9642a705 100644
--- a/libgfortran/intrinsics/cshift0.c
+++ b/libgfortran/intrinsics/cshift0.c
@@ -62,7 +62,6 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array,
ret->offset = 0;
GFC_DTYPE_COPY(ret,array);
- ret->align = array->align;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
{
diff --git a/libgfortran/intrinsics/eoshift0.c
b/libgfortran/intrinsics/eoshift0.c
index 7f11af25a1c8..161d04fae8d1 100644
--- a/libgfortran/intrinsics/eoshift0.c
+++ b/libgfortran/intrinsics/eoshift0.c
@@ -67,7 +67,6 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array,
ret->offset = 0;
GFC_DTYPE_COPY(ret,array);
- ret->align = array->align;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
{
diff --git a/libgfortran/intrinsics/eoshift2.c
b/libgfortran/intrinsics/eoshift2.c
index 4a9e763d07b6..ce27134f0687 100644
--- a/libgfortran/intrinsics/eoshift2.c
+++ b/libgfortran/intrinsics/eoshift2.c
@@ -73,7 +73,6 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array,
ret->offset = 0;
GFC_DTYPE_COPY(ret,array);
- ret->align = array->align;
/* xmallocarray allocates a single byte for zero size. */
ret->base_addr = xmallocarray (arraysize, size);
@@ -85,7 +84,7 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array,
ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;
if (i == 0)
- sp = GFC_DESCRIPTOR_SIZE(ret) / ret->align;
+ sp = GFC_DESCRIPTOR_SIZE(ret);
else
sp = GFC_DESCRIPTOR_EXTENT(ret,i-1)
* GFC_DESCRIPTOR_SPACING(ret,i-1);
diff --git a/libgfortran/intrinsics/move_alloc.c
b/libgfortran/intrinsics/move_alloc.c
index ad9062a15656..c515b9bae8c3 100644
--- a/libgfortran/intrinsics/move_alloc.c
+++ b/libgfortran/intrinsics/move_alloc.c
@@ -46,7 +46,6 @@ move_alloc (gfc_array_char * from, gfc_array_char * to)
}
to->offset = from->offset;
- to->align = from->align;
GFC_DTYPE_COPY(to,from);
to->base_addr = from->base_addr;
from->base_addr = NULL;
diff --git a/libgfortran/intrinsics/pack_generic.c
b/libgfortran/intrinsics/pack_generic.c
index 3d6e5623342d..3de2a9f453b2 100644
--- a/libgfortran/intrinsics/pack_generic.c
+++ b/libgfortran/intrinsics/pack_generic.c
@@ -162,7 +162,6 @@ pack_internal (gfc_array_char *ret, const gfc_array_char
*array,
GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1);
ret->offset = 0;
- ret->align = array->align;
/* xmallocarray allocates a single byte for zero size. */
ret->base_addr = xmallocarray (total, size);
@@ -539,7 +538,6 @@ pack_s_internal (gfc_array_char *ret, const gfc_array_char
*array,
GFC_DIMENSION_SET(ret->dim[0],0,total-1,1);
ret->offset = 0;
- ret->align = array->align;
ret->base_addr = xmallocarray (total, size);
diff --git a/libgfortran/intrinsics/spread_generic.c
b/libgfortran/intrinsics/spread_generic.c
index fb4fd7093516..c537e5947bf8 100644
--- a/libgfortran/intrinsics/spread_generic.c
+++ b/libgfortran/intrinsics/spread_generic.c
@@ -78,7 +78,7 @@ spread_internal (gfc_array_char *ret, const gfc_array_char
*source,
dim = 0;
rs = 1;
- spacing = size / source->align;
+ spacing = size;
for (n = 0; n < rrank; n++)
{
stride = rs;
@@ -105,7 +105,6 @@ spread_internal (gfc_array_char *ret, const gfc_array_char
*source,
GFC_DIMENSION_SET(ret->dim[n], 0, ub, spacing);
}
ret->offset = 0;
- ret->align = source->align;
ret->base_addr = xmallocarray (rs, size);
if (rs <= 0)
@@ -253,9 +252,7 @@ spread_internal_scalar (gfc_array_char *ret, const char
*source,
{
ret->base_addr = xmallocarray (ncopies, size);
ret->offset = 0;
- ret->align = source->align;
- GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1,
- size / source->align);
+ GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, size);
}
else
{
diff --git a/libgfortran/intrinsics/unpack_generic.c
b/libgfortran/intrinsics/unpack_generic.c
index 81692cab09e2..ab747acf4c27 100644
--- a/libgfortran/intrinsics/unpack_generic.c
+++ b/libgfortran/intrinsics/unpack_generic.c
@@ -112,7 +112,7 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char
*vector,
return array descriptor. */
dim = GFC_DESCRIPTOR_RANK (mask);
rs = 1;
- spacing = size / vector->align;
+ spacing = size;
for (n = 0; n < dim; n++)
{
count[n] = 0;
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index daa11b9ebc74..4ef6edb36189 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -389,7 +389,6 @@ struct {\
size_t offset;\
dtype_type dtype;\
index_type span;\
- index_type align; \
descriptor_dimension dim[];\
}
@@ -464,21 +463,19 @@ typedef GFC_FULL_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS,
GFC_INTEGER_4) gfc_full_a
#define GFC_DESCRIPTOR_DATA(desc) ((desc)->base_addr)
#define GFC_DESCRIPTOR_DTYPE(desc) ((desc)->dtype)
#define GFC_DESCRIPTOR_SPAN(desc) ((desc)->span)
-#define GFC_DESCRIPTOR_ALIGN(desc) ((desc)->align)
-#define GFC_DIMENSION_SET(dim,lb,ub,sp) \
+#define GFC_DESCRIPTOR_DIMENSION_SET(desc,i,lb,ub,sp) \
do \
{ \
- (dim).lower_bound = lb; \
- (dim)._ubound = ub; \
- (dim).spacing = sp; \
+ (desc)->dim[i].lower_bound = lb; \
+ (desc)->dim[i]._ubound = ub; \
+ (desc)->dim[i].spacing = sp; \
} while (0)
#define GFC_DESCRIPTOR_LBOUND(desc,i) ((desc)->dim[i].lower_bound)
#define GFC_DESCRIPTOR_UBOUND(desc,i) ((desc)->dim[i]._ubound)
#define GFC_DESCRIPTOR_SPACING(desc,i) ((desc)->dim[i].spacing)
-#define GFC_DESCRIPTOR_SM(desc,i) (GFC_DESCRIPTOR_SPACING(desc,i) *
GFC_DESCRIPTOR_ALIGN(desc))
#define GFC_DESCRIPTOR_EXTENT(desc,i) (GFC_DESCRIPTOR_UBOUND(desc,i) +
(GFC_DESCRIPTOR_LBOUND(desc,i) - 1))
#define GFC_DESCRIPTOR_STRIDE(desc,i) (GFC_DESCRIPTOR_SM(desc,i) /
GFC_DESCRIPTOR_SIZE(desc))
diff --git a/libgfortran/m4/reshape.m4 b/libgfortran/m4/reshape.m4
index dec5ed254483..ea81148ab9dd 100644
--- a/libgfortran/m4/reshape.m4
+++ b/libgfortran/m4/reshape.m4
@@ -105,7 +105,7 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret,
index_type alloc_size;
rs = 1;
- spacing = GFC_DESCRIPTOR_SIZE(source) / source->align;
+ spacing = GFC_DESCRIPTOR_SIZE(source);
for (index_type n = 0; n < rdim; n++)
{
rex = shape_data[n];
@@ -116,7 +116,6 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret,
spacing *= rex;
}
ret->offset = 0;
- ret->align = source->align;
if (unlikely (rs < 1))
alloc_size = 0;
