switch (ss->type)
{
case GFC_SS_SECTION:
- for (n = 0; n < ss->data.info.dimen; n++)
+ for (n = 0; n < ss->dimen; n++)
{
- if (ss->data.info.subscript[ss->data.info.dim[n]])
- gfc_free_ss_chain (ss->data.info.subscript[ss->data.info.dim[n]]);
+ if (ss->data.info.subscript[ss->dim[n]])
+ gfc_free_ss_chain (ss->data.info.subscript[ss->dim[n]]);
}
break;
gfc_get_array_ss (gfc_ss *next, gfc_expr *expr, int dimen, gfc_ss_type type)
{
gfc_ss *ss;
- gfc_ss_info *info;
int i;
ss = gfc_get_ss ();
ss->next = next;
ss->type = type;
ss->expr = expr;
- info = &ss->data.info;
- info->dimen = dimen;
- info->codimen = 0;
- for (i = 0; i < info->dimen; i++)
- info->dim[i] = i;
+ ss->dimen = dimen;
+ for (i = 0; i < ss->dimen; i++)
+ ss->dim[i] = i;
return ss;
}
gfc_get_temp_ss (tree type, tree string_length, int dimen)
{
gfc_ss *ss;
+ int i;
ss = gfc_get_ss ();
ss->next = gfc_ss_terminator;
ss->type = GFC_SS_TEMP;
ss->string_length = string_length;
- ss->data.temp.dimen = dimen;
ss->data.temp.type = type;
+ ss->dimen = dimen;
+ for (i = 0; i < ss->dimen; i++)
+ ss->dim[i] = i;
return ss;
}
tree tmp;
if (as && as->type == AS_EXPLICIT)
- for (n = 0; n < se->loop->dimen + se->loop->codimen; n++)
+ for (n = 0; n < se->loop->dimen; n++)
{
- dim = se->ss->data.info.dim[n];
+ dim = se->ss->dim[n];
gcc_assert (dim < as->rank);
gcc_assert (se->loop->dimen == as->rank);
if (se->loop->to[n] == NULL_TREE)
gfc_add_block_to_block (&se->post, &tmpse.post);
lower = fold_convert (gfc_array_index_type, tmpse.expr);
- if (se->loop->codimen == 0
- || n < se->loop->dimen + se->loop->codimen - 1)
- {
- /* ...and the upper bound. */
- gfc_init_se (&tmpse, NULL);
- gfc_apply_interface_mapping (mapping, &tmpse, as->upper[dim]);
- gfc_add_block_to_block (&se->pre, &tmpse.pre);
- gfc_add_block_to_block (&se->post, &tmpse.post);
- upper = fold_convert (gfc_array_index_type, tmpse.expr);
-
- /* Set the upper bound of the loop to UPPER - LOWER. */
- tmp = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type, upper, lower);
- tmp = gfc_evaluate_now (tmp, &se->pre);
- se->loop->to[n] = tmp;
- }
+ /* ...and the upper bound. */
+ gfc_init_se (&tmpse, NULL);
+ gfc_apply_interface_mapping (mapping, &tmpse, as->upper[dim]);
+ gfc_add_block_to_block (&se->pre, &tmpse.pre);
+ gfc_add_block_to_block (&se->post, &tmpse.post);
+ upper = fold_convert (gfc_array_index_type, tmpse.expr);
+
+ /* Set the upper bound of the loop to UPPER - LOWER. */
+ tmp = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, upper, lower);
+ tmp = gfc_evaluate_now (tmp, &se->pre);
+ se->loop->to[n] = tmp;
}
}
}
static void
gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post,
- gfc_ss_info * info, tree size, tree nelem,
+ gfc_array_info * info, tree size, tree nelem,
tree initial, bool dynamic, bool dealloc)
{
tree tmp;
*/
static int
-get_array_ref_dim (gfc_ss_info *info, int loop_dim)
+get_array_ref_dim (gfc_ss *ss, int loop_dim)
{
int n, array_dim, array_ref_dim;
array_ref_dim = 0;
- array_dim = info->dim[loop_dim];
+ array_dim = ss->dim[loop_dim];
- for (n = 0; n < info->dimen; n++)
- if (n != loop_dim && info->dim[n] < array_dim)
+ for (n = 0; n < ss->dimen; n++)
+ if (ss->dim[n] < array_dim)
array_ref_dim++;
return array_ref_dim;
tree
gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
- gfc_loopinfo * loop, gfc_ss_info * info,
+ gfc_loopinfo * loop, gfc_ss * ss,
tree eltype, tree initial, bool dynamic,
bool dealloc, bool callee_alloc, locus * where)
{
+ gfc_array_info *info;
tree from[GFC_MAX_DIMENSIONS], to[GFC_MAX_DIMENSIONS];
tree type;
tree desc;
memset (from, 0, sizeof (from));
memset (to, 0, sizeof (to));
- gcc_assert (info->dimen > 0);
- gcc_assert (loop->dimen == info->dimen);
+ info = &ss->data.info;
+
+ gcc_assert (ss->dimen > 0);
+ gcc_assert (loop->dimen == ss->dimen);
if (gfc_option.warn_array_temp && where)
gfc_warning ("Creating array temporary at %L", where);
/* Set the lower bound to zero. */
for (n = 0; n < loop->dimen; n++)
{
- dim = info->dim[n];
+ dim = ss->dim[n];
/* Callee allocated arrays may not have a known bound yet. */
if (loop->to[n])
to the n'th dimension of the array. We need to reconstruct loop infos
in the right order before using it to set the descriptor
bounds. */
- tmp_dim = get_array_ref_dim (info, n);
+ tmp_dim = get_array_ref_dim (ss, n);
from[tmp_dim] = loop->from[n];
to[tmp_dim] = loop->to[n];
/* Initialize the descriptor. */
type =
- gfc_get_array_type_bounds (eltype, info->dimen, 0, from, to, 1,
+ gfc_get_array_type_bounds (eltype, ss->dimen, 0, from, to, 1,
GFC_ARRAY_UNKNOWN, true);
desc = gfc_create_var (type, "atmp");
GFC_DECL_PACKED_ARRAY (desc) = 1;
for (n = 0; n < loop->dimen; n++)
{
- dim = info->dim[n];
+ dim = ss->dim[n];
if (size == NULL_TREE)
{
size, tmp);
size = gfc_evaluate_now (size, pre);
}
- for (n = info->dimen; n < info->dimen + info->codimen; n++)
- {
- gfc_conv_descriptor_lbound_set (pre, desc, gfc_rank_cst[n],
- gfc_index_zero_node);
- if (n < info->dimen + info->codimen - 1)
- gfc_conv_descriptor_ubound_set (pre, desc, gfc_rank_cst[n], loop->to[n]);
- }
/* Get the size of the array. */
gfc_trans_allocate_array_storage (pre, post, info, size, nelem, initial,
dynamic, dealloc);
- if (info->dimen > loop->temp_dim)
- loop->temp_dim = info->dimen;
+ if (ss->dimen > loop->temp_dim)
+ loop->temp_dim = ss->dimen;
return size;
}
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,
gfc_build_constant_array_constructor. */
static void
-gfc_trans_constant_array_constructor (gfc_loopinfo * loop,
- gfc_ss * ss, tree type)
+trans_constant_array_constructor (gfc_ss * ss, tree type)
{
- gfc_ss_info *info;
+ gfc_array_info *info;
tree tmp;
int i;
info->data = gfc_build_addr_expr (NULL_TREE, tmp);
info->offset = gfc_index_zero_node;
- for (i = 0; i < info->dimen + info->codimen; i++)
+ for (i = 0; i < ss->dimen; i++)
{
info->delta[i] = gfc_index_zero_node;
info->start[i] = gfc_index_zero_node;
info->end[i] = gfc_index_zero_node;
info->stride[i] = gfc_index_one_node;
}
-
- if (info->dimen > loop->temp_dim)
- loop->temp_dim = info->dimen;
}
/* Helper routine of gfc_trans_array_constructor to determine if the
bounds of the loop specified by LOOP are constant and simple enough
- to use with gfc_trans_constant_array_constructor. Returns the
+ to use with trans_constant_array_constructor. Returns the
iteration count of the loop if suitable, and NULL_TREE otherwise. */
static tree
first_len = true;
}
- gcc_assert (ss->data.info.dimen == loop->dimen);
+ gcc_assert (ss->dimen == loop->dimen);
c = ss->expr->value.constructor;
if (ss->expr->ts.type == BT_CHARACTER)
tree size = constant_array_constructor_loop_size (loop);
if (size && compare_tree_int (size, nelem) == 0)
{
- gfc_trans_constant_array_constructor (loop, ss, type);
+ trans_constant_array_constructor (ss, type);
goto finish;
}
}
if (TREE_CODE (loop->to[0]) == VAR_DECL)
dynamic = true;
- gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, &ss->data.info,
+ gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, ss,
type, NULL_TREE, dynamic, true, false, where);
desc = ss->data.info.descriptor;
loop bounds. */
static void
-gfc_set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss_info * info)
+set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss)
{
+ gfc_array_info *info;
gfc_se se;
tree tmp;
tree desc;
int n;
int dim;
- for (n = 0; n < loop->dimen + loop->codimen; n++)
+ info = &ss->data.info;
+
+ for (n = 0; n < loop->dimen; n++)
{
- dim = info->dim[n];
+ dim = ss->dim[n];
if (info->ref->u.ar.dimen_type[dim] == DIMEN_VECTOR
&& loop->to[n] == NULL)
{
gfc_add_loop_ss_code (loop, ss->data.info.subscript[n], true,
where);
- gfc_set_vector_loop_bounds (loop, &ss->data.info);
+ set_vector_loop_bounds (loop, ss);
break;
case GFC_SS_VECTOR:
/* Generate code to perform an array index bound check. */
static tree
-gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n,
- locus * where, bool check_upper)
+trans_array_bound_check (gfc_se * se, gfc_ss *ss, tree index, int n,
+ locus * where, bool check_upper)
{
tree fault;
tree tmp_lo, tmp_up;
+ tree descriptor;
char *msg;
const char * name = NULL;
if (!(gfc_option.rtcheck & GFC_RTCHECK_BOUNDS))
return index;
+ descriptor = ss->data.info.descriptor;
+
index = gfc_evaluate_now (index, &se->pre);
/* We find a name for the error message. */
- if (se->ss)
- name = se->ss->expr->symtree->name;
-
- if (!name && se->loop && se->loop->ss && se->loop->ss->expr
- && se->loop->ss->expr->symtree)
- name = se->loop->ss->expr->symtree->name;
-
- if (!name && se->loop && se->loop->ss && se->loop->ss->loop_chain
- && se->loop->ss->loop_chain->expr
- && se->loop->ss->loop_chain->expr->symtree)
- name = se->loop->ss->loop_chain->expr->symtree->name;
-
- if (!name && se->loop && se->loop->ss && se->loop->ss->expr)
- {
- if (se->loop->ss->expr->expr_type == EXPR_FUNCTION
- && se->loop->ss->expr->value.function.name)
- name = se->loop->ss->expr->value.function.name;
- else
- if (se->loop->ss->type == GFC_SS_CONSTRUCTOR
- || se->loop->ss->type == GFC_SS_SCALAR)
- name = "unnamed constant";
- }
+ name = ss->expr->symtree->n.sym->name;
+ gcc_assert (name != NULL);
if (TREE_CODE (descriptor) == VAR_DECL)
name = IDENTIFIER_POINTER (DECL_NAME (descriptor));
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,
- gfc_array_ref * ar, tree stride)
+conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i,
+ gfc_array_ref * ar, tree stride)
{
+ gfc_array_info *info;
tree index;
tree desc;
tree data;
+ info = &ss->data.info;
+
/* Get the index into the array for this dimension. */
if (ar)
{
/* We've already translated this value outside the loop. */
index = info->subscript[dim]->data.scalar.expr;
- index = gfc_trans_array_bound_check (se, info->descriptor,
- index, dim, &ar->where,
- ar->as->type != AS_ASSUMED_SIZE
- || dim < ar->dimen - 1);
+ index = trans_array_bound_check (se, ss, index, dim, &ar->where,
+ ar->as->type != AS_ASSUMED_SIZE
+ || dim < ar->dimen - 1);
break;
case DIMEN_VECTOR:
index = fold_convert (gfc_array_index_type, index);
/* Do any bounds checking on the final info->descriptor index. */
- index = gfc_trans_array_bound_check (se, info->descriptor,
- index, dim, &ar->where,
- ar->as->type != AS_ASSUMED_SIZE
- || dim < ar->dimen - 1);
+ index = trans_array_bound_check (se, ss, index, dim, &ar->where,
+ ar->as->type != AS_ASSUMED_SIZE
+ || dim < ar->dimen - 1);
break;
case DIMEN_RANGE:
/* 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]);
static void
gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar)
{
- gfc_ss_info *info;
+ gfc_array_info *info;
tree decl = NULL_TREE;
tree index;
tree tmp;
+ gfc_ss *ss;
int n;
- info = &se->ss->data.info;
+ ss = se->ss;
+ info = &ss->data.info;
if (ar)
n = se->loop->order[0];
else
n = 0;
- index = gfc_conv_array_index_offset (se, info, info->dim[n], n, ar,
- info->stride0);
+ index = conv_array_index_offset (se, ss, ss->dim[n], n, ar, info->stride0);
/* Add the offset for this dimension to the stored offset for all other
dimensions. */
if (!integer_zerop (info->offset))
}
+/* 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_array_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 = conv_array_index_offset (&se, ss, 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_array_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 < ss->dimen);
+ gcc_assert (ss->dimen == loop->dimen);
+
+ if (info->ref)
+ ar = &info->ref->u.ar;
+ else
+ ar = NULL;
- if (dim == info->dimen - 1)
+ 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];
+
+ if (dim == loop->dimen - 1)
{
+ stride = gfc_conv_array_stride (info->descriptor, ss->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.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);
+ add_array_offset (pblock, loop, ss, ar, i, /* unused */ -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);
}
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;
- 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 the offset for the previous loop dimension. */
+ add_array_offset (pblock, loop, ss, ar, ss->dim[i], i);
/* Remember this offset for the second loop. */
if (dim == loop->temp_dim - 1)
gcc_assert (!loop->array_parameter);
- for (dim = loop->dimen + loop->codimen - 1; dim >= 0; dim--)
+ for (dim = loop->dimen - 1; dim >= 0; dim--)
{
n = loop->order[dim];
pblock = body;
/* Generate the loops. */
- for (dim = 0; dim < loop->dimen + loop->codimen; dim++)
+ for (dim = 0; dim < loop->dimen; dim++)
{
n = loop->order[dim];
gfc_trans_scalarized_loop_end (loop, n, pblock);
gfc_add_expr_to_block (&loop->pre, tmp);
/* Clear all the used flags. */
- for (ss = loop->ss; ss; ss = ss->loop_chain)
+ for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
ss->useflags = 0;
}
}
+/* Precalculate (either lower or upper) bound of an array section.
+ BLOCK: Block in which the (pre)calculation code will go.
+ BOUNDS[DIM]: Where the bound value will be stored once evaluated.
+ VALUES[DIM]: Specified bound (NULL <=> unspecified).
+ DESC: Array descriptor from which the bound will be picked if unspecified
+ (either lower or upper bound according to LBOUND). */
+
+static void
+evaluate_bound (stmtblock_t *block, tree *bounds, gfc_expr ** values,
+ tree desc, int dim, bool lbound)
+{
+ gfc_se se;
+ gfc_expr * input_val = values[dim];
+ tree *output = &bounds[dim];
+
+
+ if (input_val)
+ {
+ /* Specified section bound. */
+ gfc_init_se (&se, NULL);
+ gfc_conv_expr_type (&se, input_val, gfc_array_index_type);
+ gfc_add_block_to_block (block, &se.pre);
+ *output = se.expr;
+ }
+ else
+ {
+ /* No specific bound specified so use the bound of the array. */
+ *output = lbound ? gfc_conv_array_lbound (desc, dim) :
+ gfc_conv_array_ubound (desc, dim);
+ }
+ *output = gfc_evaluate_now (*output, block);
+}
+
+
/* Calculate the lower bound of an array section. */
static void
-gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int dim,
- bool coarray, bool coarray_last)
+gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int dim)
{
- gfc_expr *start;
- gfc_expr *end;
gfc_expr *stride = NULL;
tree desc;
gfc_se se;
- gfc_ss_info *info;
+ gfc_array_info *info;
+ gfc_array_ref *ar;
gcc_assert (ss->type == GFC_SS_SECTION);
info = &ss->data.info;
+ ar = &info->ref->u.ar;
- if (info->ref->u.ar.dimen_type[dim] == DIMEN_VECTOR)
+ if (ar->dimen_type[dim] == DIMEN_VECTOR)
{
/* We use a zero-based index to access the vector. */
info->start[dim] = gfc_index_zero_node;
info->end[dim] = NULL;
- if (!coarray)
- info->stride[dim] = gfc_index_one_node;
+ info->stride[dim] = gfc_index_one_node;
return;
}
- gcc_assert (info->ref->u.ar.dimen_type[dim] == DIMEN_RANGE);
+ gcc_assert (ar->dimen_type[dim] == DIMEN_RANGE
+ || ar->dimen_type[dim] == DIMEN_THIS_IMAGE);
desc = info->descriptor;
- start = info->ref->u.ar.start[dim];
- end = info->ref->u.ar.end[dim];
- if (!coarray)
- stride = info->ref->u.ar.stride[dim];
+ stride = ar->stride[dim];
/* Calculate the start of the range. For vector subscripts this will
be the range of the vector. */
- if (start)
- {
- /* Specified section start. */
- 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[dim] = se.expr;
- }
- else
- {
- /* No lower bound specified so use the bound of the array. */
- info->start[dim] = gfc_conv_array_lbound (desc, dim);
- }
- info->start[dim] = gfc_evaluate_now (info->start[dim], &loop->pre);
+ evaluate_bound (&loop->pre, info->start, ar->start, desc, dim, true);
/* Similarly calculate the end. Although this is not used in the
scalarizer, it is needed when checking bounds and where the end
is an expression with side-effects. */
- if (!coarray_last)
- {
- if (end)
- {
- /* Specified section start. */
- 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[dim] = se.expr;
- }
- else
- {
- /* No upper bound specified so use the bound of the array. */
- info->end[dim] = gfc_conv_array_ubound (desc, dim);
- }
- info->end[dim] = gfc_evaluate_now (info->end[dim], &loop->pre);
- }
+ evaluate_bound (&loop->pre, info->end, ar->end, desc, dim, false);
/* Calculate the stride. */
- if (!coarray && stride == NULL)
+ if (stride == NULL)
info->stride[dim] = gfc_index_one_node;
- else if (!coarray)
+ else
{
gfc_init_se (&se, NULL);
gfc_conv_expr_type (&se, stride, gfc_array_index_type);
loop->dimen = 0;
/* Determine the rank of the loop. */
- for (ss = loop->ss;
- ss != gfc_ss_terminator && loop->dimen == 0; ss = ss->loop_chain)
+ for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
{
switch (ss->type)
{
case GFC_SS_CONSTRUCTOR:
case GFC_SS_FUNCTION:
case GFC_SS_COMPONENT:
- loop->dimen = ss->data.info.dimen;
- loop->codimen = ss->data.info.codimen;
- break;
+ loop->dimen = ss->dimen;
+ goto done;
/* As usual, lbound and ubound are exceptions!. */
case GFC_SS_INTRINSIC:
{
case GFC_ISYM_LBOUND:
case GFC_ISYM_UBOUND:
- loop->dimen = ss->data.info.dimen;
- loop->codimen = 0;
- break;
-
case GFC_ISYM_LCOBOUND:
case GFC_ISYM_UCOBOUND:
case GFC_ISYM_THIS_IMAGE:
- loop->dimen = ss->data.info.dimen;
- loop->codimen = ss->data.info.codimen;
- break;
+ loop->dimen = ss->dimen;
+ goto done;
default:
break;
/* We should have determined the rank of the expression by now. If
not, that's bad news. */
- gcc_assert (loop->dimen + loop->codimen != 0);
+ gcc_unreachable ();
+done:
/* Loop over all the SS in the chain. */
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
{
/* Get the descriptor for the array. */
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, ss->data.info.dim[n],
- false, false);
- for (n = ss->data.info.dimen;
- n < ss->data.info.dimen + ss->data.info.codimen; n++)
- gfc_conv_section_startstride (loop, ss, ss->data.info.dim[n], true,
- n == ss->data.info.dimen
- + ss->data.info.codimen -1);
-
+ for (n = 0; n < ss->dimen; n++)
+ gfc_conv_section_startstride (loop, ss, ss->dim[n]);
break;
case GFC_SS_INTRINSIC:
case GFC_SS_CONSTRUCTOR:
case GFC_SS_FUNCTION:
- for (n = 0; n < ss->data.info.dimen; n++)
+ for (n = 0; n < ss->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->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;
tree end;
tree size[GFC_MAX_DIMENSIONS];
tree stride_pos, stride_neg, non_zerosized, tmp2, tmp3;
- gfc_ss_info *info;
+ gfc_array_info *info;
char *msg;
int dim;
{
bool check_upper;
- dim = info->dim[n];
+ dim = ss->dim[n];
if (info->ref->u.ar.dimen_type[dim] != DIMEN_RANGE)
continue;
if (nDepend == 1)
break;
- for (i = 0; i < dest->data.info.dimen; i++)
- for (j = 0; j < ss->data.info.dimen; j++)
+ for (i = 0; i < dest->dimen; i++)
+ for (j = 0; j < ss->dimen; j++)
if (i != j
- && dest->data.info.dim[i] == ss->data.info.dim[j])
+ && dest->dim[i] == ss->dim[j])
{
/* If we don't access array elements in the same order,
there is a dependency. */
base_type = gfc_get_element_type (base_type);
loop->temp_ss = gfc_get_temp_ss (base_type, dest->string_length,
loop->dimen);
- loop->temp_ss->data.temp.codimen = loop->codimen;
gfc_add_ss_to_loop (loop, loop->temp_ss);
}
else
gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
{
int n, dim, spec_dim;
- gfc_ss_info *info;
- gfc_ss_info *specinfo;
- gfc_ss *ss;
+ gfc_array_info *info;
+ gfc_array_info *specinfo;
+ gfc_ss *ss, *tmp_ss;
tree tmp;
gfc_ss *loopspec[GFC_MAX_DIMENSIONS];
bool dynamic[GFC_MAX_DIMENSIONS];
mpz_t i;
mpz_init (i);
- for (n = 0; n < loop->dimen + loop->codimen; n++)
+ for (n = 0; n < loop->dimen; n++)
{
loopspec[n] = NULL;
dynamic[n] = false;
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)
+ gfc_ss_type ss_type;
+
+ ss_type = ss->type;
+ if (ss_type == GFC_SS_SCALAR
+ || ss_type == GFC_SS_TEMP
+ || ss_type == GFC_SS_REFERENCE)
continue;
info = &ss->data.info;
- dim = info->dim[n];
+ dim = ss->dim[n];
if (loopspec[n] != NULL)
{
specinfo = &loopspec[n]->data.info;
- spec_dim = specinfo->dim[n];
+ spec_dim = loopspec[n]->dim[n];
}
else
{
gcc_assert (loopspec[n]);
info = &loopspec[n]->data.info;
- dim = info->dim[n];
+ dim = loopspec[n]->dim[n];
/* Set the extents of this range. */
cshape = loopspec[n]->shape;
- if (n < loop->dimen && cshape && INTEGER_CST_P (info->start[dim])
+ if (cshape && INTEGER_CST_P (info->start[dim])
&& INTEGER_CST_P (info->stride[dim]))
{
loop->from[n] = info->start[dim];
- mpz_set (i, cshape[get_array_ref_dim (info, n)]);
+ mpz_set (i, cshape[get_array_ref_dim (loopspec[n], n)]);
mpz_sub_ui (i, i, 1);
/* To = from + (size - 1) * stride. */
tmp = gfc_conv_mpz_to_tree (i, gfc_index_integer_kind);
allocating the temporary. */
gfc_add_loop_ss_code (loop, loop->ss, false, where);
+ tmp_ss = loop->temp_ss;
/* If we want a temporary then create it. */
- if (loop->temp_ss != NULL)
+ if (tmp_ss != NULL)
{
gcc_assert (loop->temp_ss->type == GFC_SS_TEMP);
loop->temp_ss->string_length);
tmp = loop->temp_ss->data.temp.type;
- n = loop->temp_ss->data.temp.dimen;
- memset (&loop->temp_ss->data.info, 0, sizeof (gfc_ss_info));
+ memset (&loop->temp_ss->data.info, 0, sizeof (gfc_array_info));
loop->temp_ss->type = GFC_SS_SECTION;
- loop->temp_ss->data.info.dimen = n;
- gcc_assert (loop->temp_ss->data.info.dimen != 0);
- for (n = 0; n < loop->temp_ss->data.info.dimen; n++)
- loop->temp_ss->data.info.dim[n] = n;
+ gcc_assert (tmp_ss->dimen != 0);
gfc_trans_create_temp_array (&loop->pre, &loop->post, loop,
- &loop->temp_ss->data.info, tmp, NULL_TREE,
+ tmp_ss, tmp, NULL_TREE,
false, true, false, where);
}
info = &ss->data.info;
- for (n = 0; n < info->dimen; n++)
+ for (n = 0; n < ss->dimen; n++)
{
/* If we are specifying the range the delta is already set. */
if (loopspec[n] != ss)
{
- dim = ss->data.info.dim[n];
+ dim = ss->dim[n];
/* Calculate the offset relative to the loop variable.
First multiply by the stride. */
}
}
+
/* Helper function to check dimensions. */
static bool
-dim_ok (gfc_ss_info *info)
+transposed_dims (gfc_ss *ss)
{
int n;
- for (n = 0; n < info->dimen; n++)
- if (info->dim[n] != n)
- return false;
- return true;
+
+ for (n = 0; n < ss->dimen; n++)
+ if (ss->dim[n] != n)
+ return true;
+ return false;
}
/* Convert an array for passing as an actual argument. Expressions and
gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
{
gfc_loopinfo loop;
- gfc_ss_info *info;
+ gfc_array_info *info;
int need_tmp;
int n;
tree tmp;
else
full = gfc_full_array_ref_p (info->ref, NULL);
- if (full && dim_ok (info))
+ if (full && !transposed_dims (ss))
{
if (se->direct_byref && !se->byref_noassign)
{
loop.dimen);
se->string_length = loop.temp_ss->string_length;
- gcc_assert (loop.temp_ss->data.temp.dimen == loop.dimen);
- loop.temp_ss->data.temp.codimen = loop.codimen;
+ gcc_assert (loop.temp_ss->dimen == loop.dimen);
gfc_add_ss_to_loop (&loop, loop.temp_ss);
}
desc = loop.temp_ss->data.info.descriptor;
}
- else if (expr->expr_type == EXPR_FUNCTION && dim_ok (info))
+ else if (expr->expr_type == EXPR_FUNCTION && !transposed_dims (ss))
{
desc = info->descriptor;
se->string_length = ss->string_length;
tree to;
tree base;
+ ndim = info->ref ? info->ref->u.ar.dimen : ss->dimen;
+
if (se->want_coarray)
- codim = gfc_get_corank (expr);
+ {
+ gfc_array_ref *ar = &info->ref->u.ar;
+
+ codim = gfc_get_corank (expr);
+ for (n = 0; n < codim - 1; n++)
+ {
+ /* Make sure we are not lost somehow. */
+ gcc_assert (ar->dimen_type[n + ndim] == DIMEN_THIS_IMAGE);
+
+ /* Make sure the call to gfc_conv_section_startstride won't
+ generate unnecessary code to calculate stride. */
+ gcc_assert (ar->stride[n + ndim] == NULL);
+
+ 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 == 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;
{
/* Otherwise make a new one. */
parmtype = gfc_get_element_type (TREE_TYPE (desc));
- parmtype = gfc_get_array_type_bounds (parmtype, loop.dimen,
- loop.codimen, loop.from,
- loop.to, 0,
+ parmtype = gfc_get_array_type_bounds (parmtype, loop.dimen, codim,
+ loop.from, loop.to, 0,
GFC_ARRAY_UNKNOWN, false);
parm = gfc_create_var (parmtype, "parm");
}
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);
/* look for the corresponding scalarizer dimension: dim. */
for (dim = 0; dim < ndim; dim++)
- if (info->dim[dim] == n)
+ if (ss->dim[dim] == n)
break;
/* loop exited early: the DIM being looked for has been found. */
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);
for (n = 0; n < expr1->rank; n++)
{
tmp = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[n]);
- dim = lss->data.info.dim[n];
+ dim = lss->dim[n];
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type, tmp,
loop->from[dim]);
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)
ar = &ref->u.ar;
- if (ar->as->rank == 0 && ref->next != NULL)
- {
- /* Scalar coarray. */
- continue;
- }
-
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;
/* Make sure array is the same as array(:,:), this way
we don't need to special case all the time. */
ar->dimen = ar->as->rank;
- ar->codimen = 0;
for (n = 0; n < ar->dimen; n++)
{
ar->dimen_type[n] = DIMEN_RANGE;
gcc_assert (ar->end[n] == NULL);
gcc_assert (ar->stride[n] == NULL);
}
- for (n = ar->dimen; n < ar->dimen + ar->as->corank; n++)
- {
- newss->data.info.dim[n] = n;
- ar->dimen_type[n] = DIMEN_RANGE;
-
- gcc_assert (ar->start[n] == NULL);
- gcc_assert (ar->end[n] == NULL);
- }
ss = newss;
break;
newss->data.info.ref = ref;
/* We add SS chains for all the subscripts in the section. */
- for (n = 0; n < ar->dimen + ar->codimen; n++)
+ for (n = 0; n < ar->dimen; n++)
{
gfc_ss *indexss;
switch (ar->dimen_type[n])
{
- case DIMEN_THIS_IMAGE:
- continue;
case DIMEN_ELEMENT:
/* Add SS for elemental (scalar) subscripts. */
gcc_assert (ar->start[n]);
case DIMEN_RANGE:
/* We don't add anything for sections, just remember this
dimension for later. */
- newss->data.info.dim[newss->data.info.dimen
- + newss->data.info.codimen] = n;
- if (n < ar->dimen)
- newss->data.info.dimen++;
+ newss->dim[newss->dimen] = n;
+ newss->dimen++;
break;
case DIMEN_VECTOR:
1, GFC_SS_VECTOR);
indexss->loop_chain = gfc_ss_terminator;
newss->data.info.subscript[n] = indexss;
- newss->data.info.dim[newss->data.info.dimen
- + newss->data.info.codimen] = n;
- if (n < ar->dimen)
- newss->data.info.dimen++;
+ newss->dim[newss->dimen] = n;
+ newss->dimen++;
break;
default:
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->dimen > 0
+ || newss->data.info.ref->u.ar.as->corank > 0);
ss = newss;
break;
OSDN Git Service
