array_dim = info->dim[loop_dim];
for (n = 0; n < info->dimen; n++)
- if (n != loop_dim && info->dim[n] < array_dim)
+ if (info->dim[n] < array_dim)
array_ref_dim++;
return array_ref_dim;
}
+/* 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)
+{
+ gfc_se se;
+ gfc_ss_info *info;
+ tree stride, index;
+
+ info = &ss->data.info;
+
+ gfc_init_se (&se, NULL);
+ se.loop = loop;
+ se.expr = info->descriptor;
+ stride = gfc_conv_array_stride (info->descriptor, array_dim);
+ index = gfc_conv_array_index_offset (&se, info, array_dim, loop_dim, ar,
+ stride);
+ gfc_add_block_to_block (pblock, &se.pre);
+
+ info->offset = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type,
+ info->offset, index);
+ info->offset = gfc_evaluate_now (info->offset, pblock);
+}
+
+
/* Generate the code to be executed immediately before entering a
scalarization loop. */
gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
stmtblock_t * pblock)
{
- tree index;
tree stride;
gfc_ss_info *info;
gfc_ss *ss;
- gfc_se se;
+ gfc_array_ref *ar;
int i;
/* This code will be executed before entering the scalarization loop
info = &ss->data.info;
- if (dim >= info->dimen)
- continue;
+ gcc_assert (dim < info->dimen);
+ gcc_assert (info->dimen == loop->dimen);
- if (dim == info->dimen - 1)
- {
- /* For the outermost loop calculate the offset due to any
- elemental dimensions. It will have been initialized with the
- base offset of the array. */
- if (info->ref)
- {
- for (i = 0; i < info->ref->u.ar.dimen; i++)
- {
- if (info->ref->u.ar.dimen_type[i] != DIMEN_ELEMENT)
- continue;
+ if (info->ref)
+ ar = &info->ref->u.ar;
+ else
+ ar = NULL;
- gfc_init_se (&se, NULL);
- se.loop = loop;
- se.expr = info->descriptor;
- stride = gfc_conv_array_stride (info->descriptor, i);
- index = gfc_conv_array_index_offset (&se, info, i, -1,
- &info->ref->u.ar,
- stride);
- gfc_add_block_to_block (pblock, &se.pre);
-
- info->offset = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type,
- info->offset, index);
- info->offset = gfc_evaluate_now (info->offset, pblock);
- }
- }
+ if (dim == loop->dimen - 1)
+ i = 0;
+ else
+ i = dim + 1;
+
+ /* For the time being, there is no loop reordering. */
+ gcc_assert (i == loop->order[i]);
+ i = loop->order[i];
- i = loop->order[0];
- /* For the time being, the innermost loop is unconditionally on
- the first dimension of the scalarization loop. */
- gcc_assert (i == 0);
+ if (dim == loop->dimen - 1)
+ {
stride = gfc_conv_array_stride (info->descriptor, info->dim[i]);
/* Calculate the stride of the innermost loop. Hopefully this will
allow the backend optimizers to do their stuff more effectively.
*/
info->stride0 = gfc_evaluate_now (stride, pblock);
- }
- else
- {
- /* Add the offset for the previous loop dimension. */
- gfc_array_ref *ar;
+ /* For the outermost loop calculate the offset due to any
+ elemental dimensions. It will have been initialized with the
+ base offset of the array. */
if (info->ref)
{
- ar = &info->ref->u.ar;
- i = loop->order[dim + 1];
- }
- else
- {
- ar = NULL;
- i = dim + 1;
- }
+ for (i = 0; i < ar->dimen; i++)
+ {
+ if (ar->dimen_type[i] != DIMEN_ELEMENT)
+ continue;
- gfc_init_se (&se, NULL);
- se.loop = loop;
- se.expr = info->descriptor;
- stride = gfc_conv_array_stride (info->descriptor, info->dim[i]);
- index = gfc_conv_array_index_offset (&se, info, info->dim[i], i,
- ar, stride);
- gfc_add_block_to_block (pblock, &se.pre);
- info->offset = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type, info->offset,
- index);
- info->offset = gfc_evaluate_now (info->offset, pblock);
+ add_array_offset (pblock, loop, ss, ar, i, /* unused */ -1);
+ }
+ }
}
+ else
+ /* Add the offset for the previous loop dimension. */
+ add_array_offset (pblock, loop, ss, ar, info->dim[i], i);
/* Remember this offset for the second loop. */
if (dim == loop->temp_dim - 1)
case GFC_SS_FUNCTION:
for (n = 0; n < ss->data.info.dimen; n++)
{
- ss->data.info.start[n] = gfc_index_zero_node;
- ss->data.info.end[n] = gfc_index_zero_node;
- ss->data.info.stride[n] = gfc_index_one_node;
+ int dim = ss->data.info.dim[n];
+
+ ss->data.info.start[dim] = gfc_index_zero_node;
+ ss->data.info.end[dim] = gfc_index_zero_node;
+ ss->data.info.stride[dim] = gfc_index_one_node;
}
break;
gfc_rank_cst[dim], stride);
}
- for (n = ndim; n < ndim + codim; n++)
+ for (n = loop.dimen; n < loop.dimen + codim; n++)
{
from = loop.from[n];
to = loop.to[n];
gfc_conv_descriptor_lbound_set (&loop.pre, parm,
gfc_rank_cst[n], from);
- if (n < ndim + codim - 1)
+ if (n < loop.dimen + codim - 1)
gfc_conv_descriptor_ubound_set (&loop.pre, parm,
gfc_rank_cst[n], to);
}
gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr)
{
gfc_ref *ref;
- gfc_array_ref *ar;
- gfc_ss *newss;
- int n;
for (ref = expr->ref; ref; ref = ref->next)
if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT)
break;
+ return gfc_walk_array_ref (ss, expr, ref);
+}
+
+
+gfc_ss *
+gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref)
+{
+ gfc_array_ref *ar;
+ gfc_ss *newss;
+ int n;
+
for (; ref; ref = ref->next)
{
if (ref->type == REF_SUBSTRING)
switch (ar->type)
{
case AR_ELEMENT:
- for (n = ar->dimen + ar->codimen - 1; n >= 0; n--)
+ for (n = ar->dimen - 1; n >= 0; n--)
ss = gfc_get_scalar_ss (ss, ar->start[n]);
break;
gcc_unreachable ();
}
}
- /* We should have at least one non-elemental dimension. */
- gcc_assert (newss->data.info.dimen > 0);
+ /* We should have at least one non-elemental dimension,
+ unless we are creating a descriptor for a (scalar) coarray. */
+ gcc_assert (newss->data.info.dimen > 0
+ || newss->data.info.ref->u.ar.as->corank > 0);
ss = newss;
break;