@@ -434,10 +434,10 @@ gfc_free_ss (gfc_ss * ss)
switch (ss->type)
{
case GFC_SS_SECTION:
- for (n = 0; n < GFC_MAX_DIMENSIONS; n++)
+ for (n = 0; n < ss->data.info.dimen; n++)
{
- if (ss->data.info.subscript[n])
- gfc_free_ss_chain (ss->data.info.subscript[n]);
+ if (ss->data.info.subscript[ss->data.info.dim[n]])
+ gfc_free_ss_chain (ss->data.info.subscript[ss->data.info.dim[n]]);
}
break;
@@ -762,25 +762,28 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
for (n = 0; n < info->dimen; n++)
{
+ dim = info->dim[n];
+
if (size == NULL_TREE)
{
/* For a callee allocated array express the loop bounds in terms
of the descriptor fields. */
- tmp =
- fold_build2 (MINUS_EXPR, gfc_array_index_type,
- gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[n]),
- gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[n]));
+ tmp = fold_build2 (
+ MINUS_EXPR, gfc_array_index_type,
+ gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]),
+ gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]));
loop->to[n] = tmp;
continue;
}
/* Store the stride and bound components in the descriptor. */
- gfc_conv_descriptor_stride_set (pre, desc, gfc_rank_cst[n], size);
+ gfc_conv_descriptor_stride_set (pre, desc, gfc_rank_cst[dim], size);
- gfc_conv_descriptor_lbound_set (pre, desc, gfc_rank_cst[n],
+ gfc_conv_descriptor_lbound_set (pre, desc, gfc_rank_cst[dim],
gfc_index_zero_node);
- gfc_conv_descriptor_ubound_set (pre, desc, gfc_rank_cst[n], loop->to[n]);
+ gfc_conv_descriptor_ubound_set (pre, desc, gfc_rank_cst[dim],
+ loop->to[n]);
tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
loop->to[n], gfc_index_one_node);
@@ -2387,7 +2390,8 @@ gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n,
/* Return the offset for an index. Performs bound checking for elemental
- dimensions. Single element references are processed separately. */
+ dimensions. Single element references are processed separately.
+ DIM is the array dimension, I is the loop dimension. */
static tree
gfc_conv_array_index_offset (gfc_se * se, gfc_ss_info * info, int dim, int i,
@@ -2448,14 +2452,14 @@ gfc_conv_array_index_offset (gfc_se * se, gfc_ss_info * info, int dim, int i,
/* Scalarized dimension. */
gcc_assert (info && se->loop);
- /* Multiply the loop variable by the stride and delta. */
+ /* Multiply the loop variable by the stride and delta. */
index = se->loop->loopvar[i];
- if (!integer_onep (info->stride[i]))
+ if (!integer_onep (info->stride[dim]))
index = fold_build2 (MULT_EXPR, gfc_array_index_type, index,
- info->stride[i]);
- if (!integer_zerop (info->delta[i]))
+ info->stride[dim]);
+ if (!integer_zerop (info->delta[dim]))
index = fold_build2 (PLUS_EXPR, gfc_array_index_type, index,
- info->delta[i]);
+ info->delta[dim]);
break;
default:
@@ -2467,9 +2471,9 @@ gfc_conv_array_index_offset (gfc_se * se, gfc_ss_info * info, int dim, int i,
/* Temporary array or derived type component. */
gcc_assert (se->loop);
index = se->loop->loopvar[se->loop->order[i]];
- if (!integer_zerop (info->delta[i]))
+ if (!integer_zerop (info->delta[dim]))
index = fold_build2 (PLUS_EXPR, gfc_array_index_type,
- index, info->delta[i]);
+ index, info->delta[dim]);
}
/* Multiply by the stride. */
@@ -2967,7 +2971,7 @@ gfc_trans_scalarized_loop_boundary (gfc_loopinfo * loop, stmtblock_t * body)
/* Calculate the lower bound of an array section. */
static void
-gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int n)
+gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int dim)
{
gfc_expr *start;
gfc_expr *end;
@@ -2975,19 +2979,17 @@ gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int n)
tree desc;
gfc_se se;
gfc_ss_info *info;
- int dim;
gcc_assert (ss->type == GFC_SS_SECTION);
info = &ss->data.info;
- dim = info->dim[n];
if (info->ref->u.ar.dimen_type[dim] == DIMEN_VECTOR)
{
/* We use a zero-based index to access the vector. */
- info->start[n] = gfc_index_zero_node;
- info->stride[n] = gfc_index_one_node;
- info->end[n] = NULL;
+ info->start[dim] = gfc_index_zero_node;
+ info->stride[dim] = gfc_index_one_node;
+ info->end[dim] = NULL;
return;
}
@@ -3005,14 +3007,14 @@ gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int n)
gfc_init_se (&se, NULL);
gfc_conv_expr_type (&se, start, gfc_array_index_type);
gfc_add_block_to_block (&loop->pre, &se.pre);
- info->start[n] = se.expr;
+ info->start[dim] = se.expr;
}
else
{
/* No lower bound specified so use the bound of the array. */
- info->start[n] = gfc_conv_array_lbound (desc, dim);
+ info->start[dim] = gfc_conv_array_lbound (desc, dim);
}
- info->start[n] = gfc_evaluate_now (info->start[n], &loop->pre);
+ info->start[dim] = gfc_evaluate_now (info->start[dim], &loop->pre);
/* Similarly calculate the end. Although this is not used in the
scalarizer, it is needed when checking bounds and where the end
@@ -3023,24 +3025,24 @@ gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int n)
gfc_init_se (&se, NULL);
gfc_conv_expr_type (&se, end, gfc_array_index_type);
gfc_add_block_to_block (&loop->pre, &se.pre);
- info->end[n] = se.expr;
+ info->end[dim] = se.expr;
}
else
{
/* No upper bound specified so use the bound of the array. */
- info->end[n] = gfc_conv_array_ubound (desc, dim);
+ info->end[dim] = gfc_conv_array_ubound (desc, dim);
}
- info->end[n] = gfc_evaluate_now (info->end[n], &loop->pre);
+ info->end[dim] = gfc_evaluate_now (info->end[dim], &loop->pre);
/* Calculate the stride. */
if (stride == NULL)
- info->stride[n] = gfc_index_one_node;
+ info->stride[dim] = gfc_index_one_node;
else
{
gfc_init_se (&se, NULL);
gfc_conv_expr_type (&se, stride, gfc_array_index_type);
gfc_add_block_to_block (&loop->pre, &se.pre);
- info->stride[n] = gfc_evaluate_now (se.expr, &loop->pre);
+ info->stride[dim] = gfc_evaluate_now (se.expr, &loop->pre);
}
}
@@ -3105,7 +3107,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
gfc_conv_ss_descriptor (&loop->pre, ss, !loop->array_parameter);
for (n = 0; n < ss->data.info.dimen; n++)
- gfc_conv_section_startstride (loop, ss, n);
+ gfc_conv_section_startstride (loop, ss, ss->data.info.dim[n]);
break;
case GFC_SS_INTRINSIC:
@@ -3180,11 +3182,10 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
check_upper = true;
/* Zero stride is not allowed. */
- tmp = fold_build2 (EQ_EXPR, boolean_type_node, info->stride[n],
+ tmp = fold_build2 (EQ_EXPR, boolean_type_node, info->stride[dim],
gfc_index_zero_node);
asprintf (&msg, "Zero stride is not allowed, for dimension %d "
- "of array '%s'", info->dim[n]+1,
- ss->expr->symtree->name);
+ "of array '%s'", dim + 1, ss->expr->symtree->name);
gfc_trans_runtime_check (true, false, tmp, &inner,
&ss->expr->where, msg);
gfc_free (msg);
@@ -3192,27 +3193,27 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
desc = ss->data.info.descriptor;
/* This is the run-time equivalent of resolve.c's
- check_dimension(). The logical is more readable there
- than it is here, with all the trees. */
+ check_dimension(). The logical is more readable there
+ than it is here, with all the trees. */
lbound = gfc_conv_array_lbound (desc, dim);
- end = info->end[n];
+ end = info->end[dim];
if (check_upper)
ubound = gfc_conv_array_ubound (desc, dim);
else
ubound = NULL;
/* non_zerosized is true when the selected range is not
- empty. */
+ empty. */
stride_pos = fold_build2 (GT_EXPR, boolean_type_node,
- info->stride[n], gfc_index_zero_node);
- tmp = fold_build2 (LE_EXPR, boolean_type_node, info->start[n],
+ info->stride[dim], gfc_index_zero_node);
+ tmp = fold_build2 (LE_EXPR, boolean_type_node, info->start[dim],
end);
stride_pos = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
stride_pos, tmp);
stride_neg = fold_build2 (LT_EXPR, boolean_type_node,
- info->stride[n], gfc_index_zero_node);
- tmp = fold_build2 (GE_EXPR, boolean_type_node, info->start[n],
+ info->stride[dim], gfc_index_zero_node);
+ tmp = fold_build2 (GE_EXPR, boolean_type_node, info->start[dim],
end);
stride_neg = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
stride_neg, tmp);
@@ -3226,24 +3227,24 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
if (check_upper)
{
tmp = fold_build2 (LT_EXPR, boolean_type_node,
- info->start[n], lbound);
+ info->start[dim], lbound);
tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
non_zerosized, tmp);
tmp2 = fold_build2 (GT_EXPR, boolean_type_node,
- info->start[n], ubound);
+ info->start[dim], ubound);
tmp2 = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
non_zerosized, tmp2);
asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' "
"outside of expected range (%%ld:%%ld)",
- info->dim[n]+1, ss->expr->symtree->name);
+ dim + 1, ss->expr->symtree->name);
gfc_trans_runtime_check (true, false, tmp, &inner,
&ss->expr->where, msg,
- fold_convert (long_integer_type_node, info->start[n]),
+ fold_convert (long_integer_type_node, info->start[dim]),
fold_convert (long_integer_type_node, lbound),
fold_convert (long_integer_type_node, ubound));
gfc_trans_runtime_check (true, false, tmp2, &inner,
&ss->expr->where, msg,
- fold_convert (long_integer_type_node, info->start[n]),
+ fold_convert (long_integer_type_node, info->start[dim]),
fold_convert (long_integer_type_node, lbound),
fold_convert (long_integer_type_node, ubound));
gfc_free (msg);
@@ -3251,15 +3252,15 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
else
{
tmp = fold_build2 (LT_EXPR, boolean_type_node,
- info->start[n], lbound);
+ info->start[dim], lbound);
tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
non_zerosized, tmp);
asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' "
"below lower bound of %%ld",
- info->dim[n]+1, ss->expr->symtree->name);
+ dim + 1, ss->expr->symtree->name);
gfc_trans_runtime_check (true, false, tmp, &inner,
&ss->expr->where, msg,
- fold_convert (long_integer_type_node, info->start[n]),
+ fold_convert (long_integer_type_node, info->start[dim]),
fold_convert (long_integer_type_node, lbound));
gfc_free (msg);
}
@@ -3269,9 +3270,9 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
and check it against both lower and upper bounds. */
tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, end,
- info->start[n]);
+ info->start[dim]);
tmp = fold_build2 (TRUNC_MOD_EXPR, gfc_array_index_type, tmp,
- info->stride[n]);
+ info->stride[dim]);
tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, end,
tmp);
tmp2 = fold_build2 (LT_EXPR, boolean_type_node, tmp, lbound);
@@ -3284,7 +3285,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
non_zerosized, tmp3);
asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' "
"outside of expected range (%%ld:%%ld)",
- info->dim[n]+1, ss->expr->symtree->name);
+ dim + 1, ss->expr->symtree->name);
gfc_trans_runtime_check (true, false, tmp2, &inner,
&ss->expr->where, msg,
fold_convert (long_integer_type_node, tmp),
@@ -3301,7 +3302,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
{
asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' "
"below lower bound of %%ld",
- info->dim[n]+1, ss->expr->symtree->name);
+ dim + 1, ss->expr->symtree->name);
gfc_trans_runtime_check (true, false, tmp2, &inner,
&ss->expr->where, msg,
fold_convert (long_integer_type_node, tmp),
@@ -3311,21 +3312,21 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
/* Check the section sizes match. */
tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, end,
- info->start[n]);
+ info->start[dim]);
tmp = fold_build2 (FLOOR_DIV_EXPR, gfc_array_index_type, tmp,
- info->stride[n]);
+ info->stride[dim]);
tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
gfc_index_one_node, tmp);
tmp = fold_build2 (MAX_EXPR, gfc_array_index_type, tmp,
build_int_cst (gfc_array_index_type, 0));
/* We remember the size of the first section, and check all the
- others against this. */
+ others against this. */
if (size[n])
{
tmp3 = fold_build2 (NE_EXPR, boolean_type_node, tmp, size[n]);
asprintf (&msg, "Array bound mismatch for dimension %d "
"of array '%s' (%%ld/%%ld)",
- info->dim[n]+1, ss->expr->symtree->name);
+ dim + 1, ss->expr->symtree->name);
gfc_trans_runtime_check (true, false, tmp3, &inner,
&ss->expr->where, msg,
@@ -3517,7 +3518,7 @@ gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest,
void
gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
{
- int n;
+ int n, dim, spec_dim;
gfc_ss_info *info;
gfc_ss_info *specinfo;
gfc_ss *ss;
@@ -3533,14 +3534,34 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
loopspec[n] = NULL;
dynamic[n] = false;
/* We use one SS term, and use that to determine the bounds of the
- loop for this dimension. We try to pick the simplest term. */
+ loop for this dimension. We try to pick the simplest term. */
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
{
+ if (ss->type == GFC_SS_SCALAR || ss->type == GFC_SS_REFERENCE)
+ continue;
+
+ info = &ss->data.info;
+ dim = info->dim[n];
+
+ if (loopspec[n] != NULL)
+ {
+ specinfo = &loopspec[n]->data.info;
+ spec_dim = specinfo->dim[n];
+ }
+ else
+ {
+ /* Silence unitialized warnings. */
+ specinfo = NULL;
+ spec_dim = 0;
+ }
+
if (ss->shape)
{
+ gcc_assert (ss->shape[dim]);
/* The frontend has worked out the size for us. */
- if (!loopspec[n] || !loopspec[n]->shape
- || !integer_zerop (loopspec[n]->data.info.start[n]))
+ if (!loopspec[n]
+ || !loopspec[n]->shape
+ || !integer_zerop (specinfo->start[spec_dim]))
/* Prefer zero-based descriptors if possible. */
loopspec[n] = ss;
continue;
@@ -3567,22 +3588,16 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
/* TODO: Pick the best bound if we have a choice between a
function and something else. */
- if (ss->type == GFC_SS_FUNCTION)
- {
- loopspec[n] = ss;
- continue;
- }
+ if (ss->type == GFC_SS_FUNCTION)
+ {
+ loopspec[n] = ss;
+ continue;
+ }
if (ss->type != GFC_SS_SECTION)
continue;
- if (loopspec[n])
- specinfo = &loopspec[n]->data.info;
- else
- specinfo = NULL;
- info = &ss->data.info;
-
- if (!specinfo)
+ if (!loopspec[n])
loopspec[n] = ss;
/* Criteria for choosing a loop specifier (most important first):
doesn't need realloc
@@ -3593,14 +3608,14 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
*/
else if (loopspec[n]->type == GFC_SS_CONSTRUCTOR && dynamic[n])
loopspec[n] = ss;
- else if (integer_onep (info->stride[n])
- && !integer_onep (specinfo->stride[n]))
+ else if (integer_onep (info->stride[dim])
+ && !integer_onep (specinfo->stride[spec_dim]))
loopspec[n] = ss;
- else if (INTEGER_CST_P (info->stride[n])
- && !INTEGER_CST_P (specinfo->stride[n]))
+ else if (INTEGER_CST_P (info->stride[dim])
+ && !INTEGER_CST_P (specinfo->stride[spec_dim]))
loopspec[n] = ss;
- else if (INTEGER_CST_P (info->start[n])
- && !INTEGER_CST_P (specinfo->start[n]))
+ else if (INTEGER_CST_P (info->start[dim])
+ && !INTEGER_CST_P (specinfo->start[spec_dim]))
loopspec[n] = ss;
/* We don't work out the upper bound.
else if (INTEGER_CST_P (info->finish[n])
@@ -3613,26 +3628,27 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
gcc_assert (loopspec[n]);
info = &loopspec[n]->data.info;
+ dim = info->dim[n];
/* Set the extents of this range. */
cshape = loopspec[n]->shape;
- if (cshape && INTEGER_CST_P (info->start[n])
- && INTEGER_CST_P (info->stride[n]))
+ if (cshape && INTEGER_CST_P (info->start[dim])
+ && INTEGER_CST_P (info->stride[dim]))
{
- loop->from[n] = info->start[n];
+ loop->from[n] = info->start[dim];
mpz_set (i, cshape[n]);
mpz_sub_ui (i, i, 1);
/* To = from + (size - 1) * stride. */
tmp = gfc_conv_mpz_to_tree (i, gfc_index_integer_kind);
- if (!integer_onep (info->stride[n]))
+ if (!integer_onep (info->stride[dim]))
tmp = fold_build2 (MULT_EXPR, gfc_array_index_type,
- tmp, info->stride[n]);
+ tmp, info->stride[dim]);
loop->to[n] = fold_build2 (PLUS_EXPR, gfc_array_index_type,
loop->from[n], tmp);
}
else
{
- loop->from[n] = info->start[n];
+ loop->from[n] = info->start[dim];
switch (loopspec[n]->type)
{
case GFC_SS_CONSTRUCTOR:
@@ -3644,7 +3660,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
case GFC_SS_SECTION:
/* Use the end expression if it exists and is not constant,
so that it is only evaluated once. */
- loop->to[n] = info->end[n];
+ loop->to[n] = info->end[dim];
break;
case GFC_SS_FUNCTION:
@@ -3658,12 +3674,12 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
}
/* Transform everything so we have a simple incrementing variable. */
- if (integer_onep (info->stride[n]))
- info->delta[n] = gfc_index_zero_node;
+ if (integer_onep (info->stride[dim]))
+ info->delta[dim] = gfc_index_zero_node;
else
{
/* Set the delta for this section. */
- info->delta[n] = gfc_evaluate_now (loop->from[n], &loop->pre);
+ info->delta[dim] = gfc_evaluate_now (loop->from[n], &loop->pre);
/* Number of iterations is (end - start + step) / step.
with start = 0, this simplifies to
last = end / step;
@@ -3671,7 +3687,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
loop->to[n], loop->from[n]);
tmp = fold_build2 (FLOOR_DIV_EXPR, gfc_array_index_type,
- tmp, info->stride[n]);
+ tmp, info->stride[dim]);
tmp = fold_build2 (MAX_EXPR, gfc_array_index_type, tmp,
build_int_cst (gfc_array_index_type, -1));
loop->to[n] = gfc_evaluate_now (tmp, &loop->pre);
@@ -3732,18 +3748,20 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
/* If we are specifying the range the delta is already set. */
if (loopspec[n] != ss)
{
+ dim = ss->data.info.dim[n];
+
/* Calculate the offset relative to the loop variable.
- First multiply by the stride. */
+ First multiply by the stride. */
tmp = loop->from[n];
- if (!integer_onep (info->stride[n]))
+ if (!integer_onep (info->stride[dim]))
tmp = fold_build2 (MULT_EXPR, gfc_array_index_type,
- tmp, info->stride[n]);
+ tmp, info->stride[dim]);
/* Then subtract this from our starting value. */
tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
- info->start[n], tmp);
+ info->start[dim], tmp);
- info->delta[n] = gfc_evaluate_now (tmp, &loop->pre);
+ info->delta[dim] = gfc_evaluate_now (tmp, &loop->pre);
}
}
}
@@ -5307,7 +5325,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
gcc_assert (info->dim[dim] == n);
/* Evaluate and remember the start of the section. */
- start = info->start[dim];
+ start = info->start[n];
stride = gfc_evaluate_now (stride, &loop.pre);
}
@@ -5354,11 +5372,11 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
/* Multiply the stride by the section stride to get the
total stride. */
stride = fold_build2 (MULT_EXPR, gfc_array_index_type,
- stride, info->stride[dim]);
+ stride, info->stride[n]);
if (se->direct_byref
- && info->ref
- && info->ref->u.ar.type != AR_FULL)
+ && info->ref
+ && info->ref->u.ar.type != AR_FULL)
{
base = fold_build2 (MINUS_EXPR, TREE_TYPE (base),
base, stride);
@@ -114,8 +114,8 @@ typedef struct gfc_ss_info
tree stride[GFC_MAX_DIMENSIONS];
tree delta[GFC_MAX_DIMENSIONS];
- /* Translation from scalarizer dimensions to actual dimensions.
- actual = dim[scalarizer] */
+ /* Translation from loop dimensions to actual dimensions.
+ actual_dim = dim[loop_dim] */
int dim[GFC_MAX_DIMENSIONS];
}
gfc_ss_info;