size = TREE_INT_CST_LOW (TYPE_SIZE_UNIT (type));
bound = build_int_cst (size_type_node, n * size);
tmp = build_call_expr_loc (input_location,
- built_in_decls[BUILT_IN_MEMCPY], 3,
- tmp, init, bound);
+ builtin_decl_explicit (BUILT_IN_MEMCPY),
+ 3, tmp, init, bound);
gfc_add_expr_to_block (&body, tmp);
*poffset = fold_build2_loc (input_location, PLUS_EXPR,
/* Temporary array or derived type component. */
gcc_assert (se->loop);
index = se->loop->loopvar[se->loop->order[i]];
+
+ /* Pointer functions can have stride[0] different from unity.
+ Use the stride returned by the function call and stored in
+ the descriptor for the temporary. */
+ if (se->ss && se->ss->type == GFC_SS_FUNCTION
+ && se->ss->expr
+ && se->ss->expr->symtree
+ && se->ss->expr->symtree->n.sym->result
+ && se->ss->expr->symtree->n.sym->result->attr.pointer)
+ stride = gfc_conv_descriptor_stride_get (info->descriptor,
+ gfc_rank_cst[dim]);
+
if (!integer_zerop (info->delta[dim]))
index = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type, index, info->delta[dim]);
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
if (dim >= info->dimen)
continue;
+ if (info->ref)
+ {
+ ar = &info->ref->u.ar;
+ i = loop->order[dim + 1];
+ }
+ else
+ {
+ ar = NULL;
+ i = dim + 1;
+ }
+
+
if (dim == info->dimen - 1)
{
+ 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);
+ 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);
+
/* 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++)
+ for (i = 0; i < ar->dimen; i++)
{
- if (info->ref->u.ar.dimen_type[i] != DIMEN_ELEMENT)
+ if (ar->dimen_type[i] != DIMEN_ELEMENT)
continue;
gfc_init_se (&se, NULL);
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);
+ ar, stride);
gfc_add_block_to_block (pblock, &se.pre);
info->offset = fold_build2_loc (input_location, PLUS_EXPR,
info->offset = gfc_evaluate_now (info->offset, pblock);
}
}
-
- 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);
- 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;
-
- if (info->ref)
- {
- ar = &info->ref->u.ar;
- i = loop->order[dim + 1];
- }
- else
- {
- ar = NULL;
- i = dim + 1;
- }
-
gfc_init_se (&se, NULL);
se.loop = loop;
se.expr = info->descriptor;
tree to;
tree base;
+ ndim = info->ref ? info->ref->u.ar.dimen : info->dimen;
+
if (se->want_coarray)
{
+ gfc_array_ref *ar = &info->ref->u.ar;
+
codim = gfc_get_corank (expr);
- for (n = ss->data.info.dimen; n < ss->data.info.dimen + codim - 1;
- n++)
+ for (n = 0; n < codim - 1; n++)
{
/* Make sure we are not lost somehow. */
- gcc_assert (info->ref->u.ar.dimen_type[n] == DIMEN_THIS_IMAGE);
+ gcc_assert (ar->dimen_type[n + ndim] == DIMEN_THIS_IMAGE);
- /* Make sure the call to gfc_conv_section_startstride won't
+ /* Make sure the call to gfc_conv_section_startstride won't
generate unnecessary code to calculate stride. */
- gcc_assert (info->ref->u.ar.stride[n] == NULL);
+ gcc_assert (ar->stride[n + ndim] == NULL);
- gfc_conv_section_startstride (&loop, ss, n);
- loop.from[n] = info->start[n];
- loop.to[n] = info->end[n];
+ gfc_conv_section_startstride (&loop, ss, n + ndim);
+ loop.from[n + loop.dimen] = info->start[n + ndim];
+ loop.to[n + loop.dimen] = info->end[n + ndim];
}
- gcc_assert (n == ss->data.info.dimen + codim - 1);
- evaluate_bound (&loop.pre, info->start, info->ref->u.ar.start,
- info->descriptor, n, true);
- loop.from[n] = info->start[n];
+ gcc_assert (n == codim - 1);
+ evaluate_bound (&loop.pre, info->start, ar->start,
+ info->descriptor, n + ndim, true);
+ loop.from[n + loop.dimen] = info->start[n + ndim];
}
else
codim = 0;
else
base = NULL_TREE;
- ndim = info->ref ? info->ref->u.ar.dimen : info->dimen;
for (n = 0; n < ndim; n++)
{
stride = gfc_conv_array_stride (desc, n);
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_add_expr_to_block (&block, tmp);
}
- tmp = built_in_decls[BUILT_IN_MEMCPY];
+ tmp = builtin_decl_explicit (BUILT_IN_MEMCPY);
tmp = build_call_expr_loc (input_location, tmp, 3,
dest, src, size);
}
/* We know the temporary and the value will be the same length,
so can use memcpy. */
- tmp = built_in_decls[BUILT_IN_MEMCPY];
+ tmp = builtin_decl_explicit (BUILT_IN_MEMCPY);
tmp = build_call_expr_loc (input_location,
tmp, 3, gfc_conv_descriptor_data_get (dest),
gfc_conv_descriptor_data_get (src), size);
in the array reference - (*desc.data)[<element>]. */
gfc_init_block (&realloc_block);
tmp = build_call_expr_loc (input_location,
- built_in_decls[BUILT_IN_REALLOC], 2,
+ builtin_decl_explicit (BUILT_IN_REALLOC), 2,
fold_convert (pvoid_type_node, array1),
size2);
gfc_conv_descriptor_data_set (&realloc_block,
/* Malloc expression. */
gfc_init_block (&alloc_block);
tmp = build_call_expr_loc (input_location,
- built_in_decls[BUILT_IN_MALLOC], 1,
- size2);
+ builtin_decl_explicit (BUILT_IN_MALLOC),
+ 1, size2);
gfc_conv_descriptor_data_set (&alloc_block,
desc, tmp);
tmp = gfc_conv_descriptor_dtype (desc);
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)
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;
OSDN Git Service
