gfc_mark_ss_chain_used (gfc_ss * ss, unsigned flags)
{
for (; ss != gfc_ss_terminator; ss = ss->next)
- ss->useflags = flags;
+ ss->info->useflags = flags;
}
static void gfc_free_ss (gfc_ss *);
case GFC_SS_SECTION:
for (n = 0; n < ss->dimen; n++)
{
- if (ss->data.info.subscript[ss->dim[n]])
- gfc_free_ss_chain (ss->data.info.subscript[ss->dim[n]]);
+ if (ss_info->data.array.subscript[ss->dim[n]])
+ gfc_free_ss_chain (ss_info->data.array.subscript[ss->dim[n]]);
}
break;
ss_info = gfc_get_ss_info ();
ss_info->type = type;
+ ss_info->expr = expr;
ss = gfc_get_ss ();
ss->info = ss_info;
ss->next = next;
- ss->expr = expr;
ss->dimen = dimen;
for (i = 0; i < ss->dimen; i++)
ss->dim[i] = i;
ss_info = gfc_get_ss_info ();
ss_info->type = GFC_SS_TEMP;
+ ss_info->string_length = string_length;
+ ss_info->data.temp.type = type;
ss = gfc_get_ss ();
ss->info = ss_info;
ss->next = gfc_ss_terminator;
- ss->string_length = string_length;
- ss->data.temp.type = type;
ss->dimen = dimen;
for (i = 0; i < ss->dimen; i++)
ss->dim[i] = i;
ss_info = gfc_get_ss_info ();
ss_info->type = GFC_SS_SCALAR;
+ ss_info->expr = expr;
ss = gfc_get_ss ();
ss->info = ss_info;
ss->next = next;
- ss->expr = expr;
return ss;
}
memset (from, 0, sizeof (from));
memset (to, 0, sizeof (to));
- info = &ss->data.info;
+ info = &ss->info->data.array;
gcc_assert (ss->dimen > 0);
gcc_assert (loop->dimen == ss->dimen);
tree tmp;
int i;
- tmp = gfc_build_constant_array_constructor (ss->expr, type);
+ tmp = gfc_build_constant_array_constructor (ss->info->expr, type);
- info = &ss->data.info;
+ info = &ss->info->data.array;
info->descriptor = tmp;
info->data = gfc_build_addr_expr (NULL_TREE, tmp);
bool dynamic;
bool old_first_len, old_typespec_chararray_ctor;
tree old_first_len_val;
+ gfc_ss_info *ss_info;
+ gfc_expr *expr;
/* Save the old values for nested checking. */
old_first_len = first_len;
old_first_len_val = first_len_val;
old_typespec_chararray_ctor = typespec_chararray_ctor;
+ ss_info = ss->info;
+ expr = ss_info->expr;
+
/* Do bounds-checking here and in gfc_trans_array_ctor_element only if no
typespec was given for the array constructor. */
- typespec_chararray_ctor = (ss->expr->ts.u.cl
- && ss->expr->ts.u.cl->length_from_typespec);
+ typespec_chararray_ctor = (expr->ts.u.cl
+ && expr->ts.u.cl->length_from_typespec);
if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
- && ss->expr->ts.type == BT_CHARACTER && !typespec_chararray_ctor)
+ && expr->ts.type == BT_CHARACTER && !typespec_chararray_ctor)
{
first_len_val = gfc_create_var (gfc_charlen_type_node, "len");
first_len = true;
gcc_assert (ss->dimen == loop->dimen);
- c = ss->expr->value.constructor;
- if (ss->expr->ts.type == BT_CHARACTER)
+ c = expr->value.constructor;
+ if (expr->ts.type == BT_CHARACTER)
{
bool const_string;
/* get_array_ctor_strlen walks the elements of the constructor, if a
typespec was given, we already know the string length and want the one
specified there. */
- if (typespec_chararray_ctor && ss->expr->ts.u.cl->length
- && ss->expr->ts.u.cl->length->expr_type != EXPR_CONSTANT)
+ if (typespec_chararray_ctor && expr->ts.u.cl->length
+ && expr->ts.u.cl->length->expr_type != EXPR_CONSTANT)
{
gfc_se length_se;
const_string = false;
gfc_init_se (&length_se, NULL);
- gfc_conv_expr_type (&length_se, ss->expr->ts.u.cl->length,
+ gfc_conv_expr_type (&length_se, expr->ts.u.cl->length,
gfc_charlen_type_node);
- ss->string_length = length_se.expr;
+ ss_info->string_length = length_se.expr;
gfc_add_block_to_block (&loop->pre, &length_se.pre);
gfc_add_block_to_block (&loop->post, &length_se.post);
}
else
const_string = get_array_ctor_strlen (&loop->pre, c,
- &ss->string_length);
+ &ss_info->string_length);
/* Complex character array constructors should have been taken care of
and not end up here. */
- gcc_assert (ss->string_length);
+ gcc_assert (ss_info->string_length);
- ss->expr->ts.u.cl->backend_decl = ss->string_length;
+ expr->ts.u.cl->backend_decl = ss_info->string_length;
- type = gfc_get_character_type_len (ss->expr->ts.kind, ss->string_length);
+ type = gfc_get_character_type_len (expr->ts.kind, ss_info->string_length);
if (const_string)
type = build_pointer_type (type);
}
else
- type = gfc_typenode_for_spec (&ss->expr->ts);
+ type = gfc_typenode_for_spec (&expr->ts);
/* See if the constructor determines the loop bounds. */
dynamic = false;
- if (ss->expr->shape && loop->dimen > 1 && loop->to[0] == NULL_TREE)
+ if (expr->shape && loop->dimen > 1 && loop->to[0] == NULL_TREE)
{
/* We have a multidimensional parameter. */
int n;
- for (n = 0; n < ss->expr->rank; n++)
+ for (n = 0; n < expr->rank; n++)
{
loop->from[n] = gfc_index_zero_node;
- loop->to[n] = gfc_conv_mpz_to_tree (ss->expr->shape [n],
+ loop->to[n] = gfc_conv_mpz_to_tree (expr->shape [n],
gfc_index_integer_kind);
loop->to[n] = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, ss,
type, NULL_TREE, dynamic, true, false, where);
- desc = ss->data.info.descriptor;
+ desc = ss_info->data.array.descriptor;
offset = gfc_index_zero_node;
offsetvar = gfc_create_var_np (gfc_array_index_type, "offset");
TREE_NO_WARNING (offsetvar) = 1;
int n;
int dim;
- info = &ss->data.info;
+ info = &ss->info->data.array;
for (n = 0; n < loop->dimen; n++)
{
&& info->subscript[dim]->info->type == GFC_SS_VECTOR);
gfc_init_se (&se, NULL);
- desc = info->subscript[dim]->data.info.descriptor;
+ desc = info->subscript[dim]->info->data.array.descriptor;
zero = gfc_rank_cst[0];
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
locus * where)
{
gfc_se se;
+ gfc_ss_info *ss_info;
+ gfc_array_info *info;
+ gfc_expr *expr;
int n;
/* TODO: This can generate bad code if there are ordering dependencies,
{
gcc_assert (ss);
- switch (ss->info->type)
+ ss_info = ss->info;
+ expr = ss_info->expr;
+ info = &ss_info->data.array;
+
+ switch (ss_info->type)
{
case GFC_SS_SCALAR:
/* Scalar expression. Evaluate this now. This includes elemental
dimension indices, but not array section bounds. */
gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, ss->expr);
+ gfc_conv_expr (&se, expr);
gfc_add_block_to_block (&loop->pre, &se.pre);
- if (ss->expr->ts.type != BT_CHARACTER)
+ if (expr->ts.type != BT_CHARACTER)
{
/* Move the evaluation of scalar expressions outside the
scalarization loop, except for WHERE assignments. */
else
gfc_add_block_to_block (&loop->post, &se.post);
- ss->data.scalar.expr = se.expr;
- ss->string_length = se.string_length;
+ ss_info->data.scalar.value = se.expr;
+ ss_info->string_length = se.string_length;
break;
case GFC_SS_REFERENCE:
/* Scalar argument to elemental procedure. Evaluate this
now. */
gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, ss->expr);
+ gfc_conv_expr (&se, expr);
gfc_add_block_to_block (&loop->pre, &se.pre);
gfc_add_block_to_block (&loop->post, &se.post);
- ss->data.scalar.expr = gfc_evaluate_now (se.expr, &loop->pre);
- ss->string_length = se.string_length;
+ ss_info->data.scalar.value = gfc_evaluate_now (se.expr, &loop->pre);
+ ss_info->string_length = se.string_length;
break;
case GFC_SS_SECTION:
/* Add the expressions for scalar and vector subscripts. */
for (n = 0; n < GFC_MAX_DIMENSIONS; n++)
- if (ss->data.info.subscript[n])
- gfc_add_loop_ss_code (loop, ss->data.info.subscript[n], true,
- where);
+ if (info->subscript[n])
+ gfc_add_loop_ss_code (loop, info->subscript[n], true, where);
set_vector_loop_bounds (loop, ss);
break;
case GFC_SS_VECTOR:
/* Get the vector's descriptor and store it in SS. */
gfc_init_se (&se, NULL);
- gfc_conv_expr_descriptor (&se, ss->expr, gfc_walk_expr (ss->expr));
+ gfc_conv_expr_descriptor (&se, expr, gfc_walk_expr (expr));
gfc_add_block_to_block (&loop->pre, &se.pre);
gfc_add_block_to_block (&loop->post, &se.post);
- ss->data.info.descriptor = se.expr;
+ info->descriptor = se.expr;
break;
case GFC_SS_INTRINSIC:
gfc_init_se (&se, NULL);
se.loop = loop;
se.ss = ss;
- gfc_conv_expr (&se, ss->expr);
+ gfc_conv_expr (&se, expr);
gfc_add_block_to_block (&loop->pre, &se.pre);
gfc_add_block_to_block (&loop->post, &se.post);
- ss->string_length = se.string_length;
+ ss_info->string_length = se.string_length;
break;
case GFC_SS_CONSTRUCTOR:
- if (ss->expr->ts.type == BT_CHARACTER
- && ss->string_length == NULL
- && ss->expr->ts.u.cl
- && ss->expr->ts.u.cl->length)
+ if (expr->ts.type == BT_CHARACTER
+ && ss_info->string_length == NULL
+ && expr->ts.u.cl
+ && expr->ts.u.cl->length)
{
gfc_init_se (&se, NULL);
- gfc_conv_expr_type (&se, ss->expr->ts.u.cl->length,
+ gfc_conv_expr_type (&se, expr->ts.u.cl->length,
gfc_charlen_type_node);
- ss->string_length = se.expr;
+ ss_info->string_length = se.expr;
gfc_add_block_to_block (&loop->pre, &se.pre);
gfc_add_block_to_block (&loop->post, &se.post);
}
gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base)
{
gfc_se se;
+ gfc_ss_info *ss_info;
+ gfc_array_info *info;
tree tmp;
+ ss_info = ss->info;
+ info = &ss_info->data.array;
+
/* Get the descriptor for the array to be scalarized. */
- gcc_assert (ss->expr->expr_type == EXPR_VARIABLE);
+ gcc_assert (ss_info->expr->expr_type == EXPR_VARIABLE);
gfc_init_se (&se, NULL);
se.descriptor_only = 1;
- gfc_conv_expr_lhs (&se, ss->expr);
+ gfc_conv_expr_lhs (&se, ss_info->expr);
gfc_add_block_to_block (block, &se.pre);
- ss->data.info.descriptor = se.expr;
- ss->string_length = se.string_length;
+ info->descriptor = se.expr;
+ ss_info->string_length = se.string_length;
if (base)
{
|| (TREE_CODE (tmp) == ADDR_EXPR
&& DECL_P (TREE_OPERAND (tmp, 0)))))
tmp = gfc_evaluate_now (tmp, block);
- ss->data.info.data = tmp;
+ info->data = tmp;
tmp = gfc_conv_array_offset (se.expr);
- ss->data.info.offset = gfc_evaluate_now (tmp, block);
+ info->offset = gfc_evaluate_now (tmp, block);
/* Make absolutely sure that the saved_offset is indeed saved
so that the variable is still accessible after the loops
are translated. */
- ss->data.info.saved_offset = ss->data.info.offset;
+ info->saved_offset = info->offset;
}
}
if (!(gfc_option.rtcheck & GFC_RTCHECK_BOUNDS))
return index;
- descriptor = ss->data.info.descriptor;
+ descriptor = ss->info->data.array.descriptor;
index = gfc_evaluate_now (index, &se->pre);
/* We find a name for the error message. */
- name = ss->expr->symtree->n.sym->name;
+ name = ss->info->expr->symtree->n.sym->name;
gcc_assert (name != NULL);
if (TREE_CODE (descriptor) == VAR_DECL)
tree desc;
tree data;
- info = &ss->data.info;
+ info = &ss->info->data.array;
/* Get the index into the array for this dimension. */
if (ar)
gcc_assert (info->subscript[dim]
&& info->subscript[dim]->info->type == GFC_SS_SCALAR);
/* We've already translated this value outside the loop. */
- index = info->subscript[dim]->data.scalar.expr;
+ index = info->subscript[dim]->info->data.scalar.value;
index = trans_array_bound_check (se, ss, index, dim, &ar->where,
ar->as->type != AS_ASSUMED_SIZE
gcc_assert (info && se->loop);
gcc_assert (info->subscript[dim]
&& info->subscript[dim]->info->type == GFC_SS_VECTOR);
- desc = info->subscript[dim]->data.info.descriptor;
+ desc = info->subscript[dim]->info->data.array.descriptor;
/* Get a zero-based index into the vector. */
index = fold_build2_loc (input_location, MINUS_EXPR,
Use the stride returned by the function call and stored in
the descriptor for the temporary. */
if (se->ss && se->ss->info->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)
+ && se->ss->info->expr
+ && se->ss->info->expr->symtree
+ && se->ss->info->expr->symtree->n.sym->result
+ && se->ss->info->expr->symtree->n.sym->result->attr.pointer)
stride = gfc_conv_descriptor_stride_get (info->descriptor,
gfc_rank_cst[dim]);
tree index;
tree tmp;
gfc_ss *ss;
+ gfc_expr *expr;
int n;
ss = se->ss;
- info = &ss->data.info;
+ expr = ss->info->expr;
+ info = &ss->info->data.array;
if (ar)
n = se->loop->order[0];
else
index = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
index, info->offset);
- if (se->ss->expr && is_subref_array (se->ss->expr))
- decl = se->ss->expr->symtree->n.sym->backend_decl;
+ if (expr && is_subref_array (expr))
+ decl = expr->symtree->n.sym->backend_decl;
- tmp = build_fold_indirect_ref_loc (input_location,
- info->data);
+ tmp = build_fold_indirect_ref_loc (input_location, info->data);
se->expr = gfc_build_array_ref (tmp, index, decl);
}
void
gfc_conv_tmp_array_ref (gfc_se * se)
{
- se->string_length = se->ss->string_length;
+ se->string_length = se->ss->info->string_length;
gfc_conv_scalarized_array_ref (se, NULL);
gfc_advance_se_ss_chain (se);
}
gfc_array_info *info;
tree stride, index;
- info = &ss->data.info;
+ info = &ss->info->data.array;
gfc_init_se (&se, NULL);
se.loop = loop;
stmtblock_t * pblock)
{
tree stride;
+ gfc_ss_info *ss_info;
gfc_array_info *info;
gfc_ss_type ss_type;
gfc_ss *ss;
for this dimension. */
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
{
- if ((ss->useflags & flag) == 0)
+ ss_info = ss->info;
+
+ if ((ss_info->useflags & flag) == 0)
continue;
- ss_type = ss->info->type;
+ ss_type = ss_info->type;
if (ss_type != GFC_SS_SECTION
&& ss_type != GFC_SS_FUNCTION
&& ss_type != GFC_SS_CONSTRUCTOR
&& ss_type != GFC_SS_COMPONENT)
continue;
- info = &ss->data.info;
+ info = &ss_info->data.array;
gcc_assert (dim < ss->dimen);
gcc_assert (ss->dimen == loop->dimen);
/* Clear all the used flags. */
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
- ss->useflags = 0;
+ ss->info->useflags = 0;
}
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
{
gfc_ss_type ss_type;
+ gfc_ss_info *ss_info;
- if ((ss->useflags & 2) == 0)
+ ss_info = ss->info;
+
+ if ((ss_info->useflags & 2) == 0)
continue;
- ss_type = ss->info->type;
+ ss_type = ss_info->type;
if (ss_type != GFC_SS_SECTION
&& ss_type != GFC_SS_FUNCTION
&& ss_type != GFC_SS_CONSTRUCTOR
&& ss_type != GFC_SS_COMPONENT)
continue;
- ss->data.info.offset = ss->data.info.saved_offset;
+ ss_info->data.array.offset = ss_info->data.array.saved_offset;
}
/* Restart all the inner loops we just finished. */
gcc_assert (ss->info->type == GFC_SS_SECTION);
- info = &ss->data.info;
+ info = &ss->info->data.array;
ar = &info->ref->u.ar;
if (ar->dimen_type[dim] == DIMEN_VECTOR)
/* As usual, lbound and ubound are exceptions!. */
case GFC_SS_INTRINSIC:
- switch (ss->expr->value.function.isym->id)
+ switch (ss->info->expr->value.function.isym->id)
{
case GFC_ISYM_LBOUND:
case GFC_ISYM_UBOUND:
/* Loop over all the SS in the chain. */
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
{
+ gfc_ss_info *ss_info;
gfc_array_info *info;
+ gfc_expr *expr;
- info = &ss->data.info;
+ ss_info = ss->info;
+ expr = ss_info->expr;
+ info = &ss_info->data.array;
- if (ss->expr && ss->expr->shape && !info->shape)
- info->shape = ss->expr->shape;
+ if (expr && expr->shape && !info->shape)
+ info->shape = expr->shape;
- switch (ss->info->type)
+ switch (ss_info->type)
{
case GFC_SS_SECTION:
/* Get the descriptor for the array. */
break;
case GFC_SS_INTRINSIC:
- switch (ss->expr->value.function.isym->id)
+ switch (expr->value.function.isym->id)
{
/* Fall through to supply start and stride. */
case GFC_ISYM_LBOUND:
{
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;
+ info->start[dim] = gfc_index_zero_node;
+ info->end[dim] = gfc_index_zero_node;
+ info->stride[dim] = gfc_index_one_node;
}
break;
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
{
stmtblock_t inner;
+ gfc_ss_info *ss_info;
+ gfc_expr *expr;
+ locus *expr_loc;
+ const char *expr_name;
- if (ss->info->type != GFC_SS_SECTION)
+ ss_info = ss->info;
+ if (ss_info->type != GFC_SS_SECTION)
continue;
/* Catch allocatable lhs in f2003. */
if (gfc_option.flag_realloc_lhs && ss->is_alloc_lhs)
continue;
+ expr = ss_info->expr;
+ expr_loc = &expr->where;
+ expr_name = expr->symtree->name;
+
gfc_start_block (&inner);
/* TODO: range checking for mapped dimensions. */
- info = &ss->data.info;
+ info = &ss_info->data.array;
/* This code only checks ranges. Elemental and vector
dimensions are checked later. */
tmp = fold_build2_loc (input_location, 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'", dim + 1, ss->expr->symtree->name);
+ "of array '%s'", dim + 1, expr_name);
gfc_trans_runtime_check (true, false, tmp, &inner,
- &ss->expr->where, msg);
+ expr_loc, msg);
free (msg);
- desc = ss->data.info.descriptor;
+ desc = info->descriptor;
/* This is the run-time equivalent of resolve.c's
check_dimension(). The logical is more readable there
non_zerosized, tmp2);
asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' "
"outside of expected range (%%ld:%%ld)",
- dim + 1, ss->expr->symtree->name);
+ dim + 1, expr_name);
gfc_trans_runtime_check (true, false, tmp, &inner,
- &ss->expr->where, msg,
+ expr_loc, msg,
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,
+ expr_loc, msg,
fold_convert (long_integer_type_node, info->start[dim]),
fold_convert (long_integer_type_node, lbound),
fold_convert (long_integer_type_node, ubound));
boolean_type_node, non_zerosized, tmp);
asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' "
"below lower bound of %%ld",
- dim + 1, ss->expr->symtree->name);
+ dim + 1, expr_name);
gfc_trans_runtime_check (true, false, tmp, &inner,
- &ss->expr->where, msg,
+ expr_loc, msg,
fold_convert (long_integer_type_node, info->start[dim]),
fold_convert (long_integer_type_node, lbound));
free (msg);
boolean_type_node, non_zerosized, tmp3);
asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' "
"outside of expected range (%%ld:%%ld)",
- dim + 1, ss->expr->symtree->name);
+ dim + 1, expr_name);
gfc_trans_runtime_check (true, false, tmp2, &inner,
- &ss->expr->where, msg,
+ expr_loc, msg,
fold_convert (long_integer_type_node, tmp),
fold_convert (long_integer_type_node, ubound),
fold_convert (long_integer_type_node, lbound));
gfc_trans_runtime_check (true, false, tmp3, &inner,
- &ss->expr->where, msg,
+ expr_loc, msg,
fold_convert (long_integer_type_node, tmp),
fold_convert (long_integer_type_node, ubound),
fold_convert (long_integer_type_node, lbound));
{
asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' "
"below lower bound of %%ld",
- dim + 1, ss->expr->symtree->name);
+ dim + 1, expr_name);
gfc_trans_runtime_check (true, false, tmp2, &inner,
- &ss->expr->where, msg,
+ expr_loc, msg,
fold_convert (long_integer_type_node, tmp),
fold_convert (long_integer_type_node, lbound));
free (msg);
boolean_type_node, tmp, size[n]);
asprintf (&msg, "Array bound mismatch for dimension %d "
"of array '%s' (%%ld/%%ld)",
- dim + 1, ss->expr->symtree->name);
+ dim + 1, expr_name);
gfc_trans_runtime_check (true, false, tmp3, &inner,
- &ss->expr->where, msg,
+ expr_loc, msg,
fold_convert (long_integer_type_node, tmp),
fold_convert (long_integer_type_node, size[n]));
/* For optional arguments, only check bounds if the argument is
present. */
- if (ss->expr->symtree->n.sym->attr.optional
- || ss->expr->symtree->n.sym->attr.not_always_present)
+ if (expr->symtree->n.sym->attr.optional
+ || expr->symtree->n.sym->attr.not_always_present)
tmp = build3_v (COND_EXPR,
- gfc_conv_expr_present (ss->expr->symtree->n.sym),
+ gfc_conv_expr_present (expr->symtree->n.sym),
tmp, build_empty_stmt (input_location));
gfc_add_expr_to_block (&block, tmp);
{
gfc_ref *lref;
gfc_ref *rref;
+ gfc_expr *lexpr, *rexpr;
gfc_symbol *lsym;
gfc_symbol *rsym;
bool lsym_pointer, lsym_target, rsym_pointer, rsym_target;
- lsym = lss->expr->symtree->n.sym;
- rsym = rss->expr->symtree->n.sym;
+ lexpr = lss->info->expr;
+ rexpr = rss->info->expr;
+
+ lsym = lexpr->symtree->n.sym;
+ rsym = rexpr->symtree->n.sym;
lsym_pointer = lsym->attr.pointer;
lsym_target = lsym->attr.target;
/* For derived types we must check all the component types. We can ignore
array references as these will have the same base type as the previous
component ref. */
- for (lref = lss->expr->ref; lref != lss->data.info.ref; lref = lref->next)
+ for (lref = lexpr->ref; lref != lss->info->data.array.ref; lref = lref->next)
{
if (lref->type != REF_COMPONENT)
continue;
return 1;
}
- for (rref = rss->expr->ref; rref != rss->data.info.ref;
+ for (rref = rexpr->ref; rref != rss->info->data.array.ref;
rref = rref->next)
{
if (rref->type != REF_COMPONENT)
lsym_pointer = lsym->attr.pointer;
lsym_target = lsym->attr.target;
- for (rref = rss->expr->ref; rref != rss->data.info.ref; rref = rref->next)
+ for (rref = rexpr->ref; rref != rss->info->data.array.ref; rref = rref->next)
{
if (rref->type != REF_COMPONENT)
break;
gfc_ss *ss;
gfc_ref *lref;
gfc_ref *rref;
+ gfc_expr *dest_expr;
+ gfc_expr *ss_expr;
int nDepend = 0;
int i, j;
loop->temp_ss = NULL;
+ dest_expr = dest->info->expr;
for (ss = rss; ss != gfc_ss_terminator; ss = ss->next)
{
if (ss->info->type != GFC_SS_SECTION)
continue;
- if (dest->expr->symtree->n.sym != ss->expr->symtree->n.sym)
+ ss_expr = ss->info->expr;
+
+ if (dest_expr->symtree->n.sym != ss_expr->symtree->n.sym)
{
if (gfc_could_be_alias (dest, ss)
- || gfc_are_equivalenced_arrays (dest->expr, ss->expr))
+ || gfc_are_equivalenced_arrays (dest_expr, ss_expr))
{
nDepend = 1;
break;
}
else
{
- lref = dest->expr->ref;
- rref = ss->expr->ref;
+ lref = dest_expr->ref;
+ rref = ss_expr->ref;
nDepend = gfc_dep_resolver (lref, rref, &loop->reverse[0]);
if (nDepend == 1)
{
- tree base_type = gfc_typenode_for_spec (&dest->expr->ts);
+ tree base_type = gfc_typenode_for_spec (&dest_expr->ts);
if (GFC_ARRAY_TYPE_P (base_type)
|| GFC_DESCRIPTOR_TYPE_P (base_type))
base_type = gfc_get_element_type (base_type);
- loop->temp_ss = gfc_get_temp_ss (base_type, dest->string_length,
+ loop->temp_ss = gfc_get_temp_ss (base_type, dest->info->string_length,
loop->dimen);
gfc_add_ss_to_loop (loop, loop->temp_ss);
}
|| ss_type == GFC_SS_REFERENCE)
continue;
- info = &ss->data.info;
+ info = &ss->info->data.array;
dim = ss->dim[n];
if (loopspec[n] != NULL)
{
- specinfo = &loopspec[n]->data.info;
+ specinfo = &loopspec[n]->info->data.array;
spec_dim = loopspec[n]->dim[n];
}
else
can be determined at compile time. Prefer not to otherwise,
since the general case involves realloc, and it's better to
avoid that overhead if possible. */
- base = ss->expr->value.constructor;
+ base = ss->info->expr->value.constructor;
dynamic[n] = gfc_get_array_constructor_size (&i, base);
if (!dynamic[n] || !loopspec[n])
loopspec[n] = ss;
that's bad news. */
gcc_assert (loopspec[n]);
- info = &loopspec[n]->data.info;
+ info = &loopspec[n]->info->data.array;
dim = loopspec[n]->dim[n];
/* Set the extents of this range. */
gcc_assert (tmp_ss_info->type == GFC_SS_TEMP);
/* Make absolutely sure that this is a complete type. */
- if (loop->temp_ss->string_length)
- loop->temp_ss->data.temp.type
+ if (tmp_ss_info->string_length)
+ tmp_ss_info->data.temp.type
= gfc_get_character_type_len_for_eltype
- (TREE_TYPE (loop->temp_ss->data.temp.type),
- loop->temp_ss->string_length);
+ (TREE_TYPE (tmp_ss_info->data.temp.type),
+ tmp_ss_info->string_length);
- tmp = loop->temp_ss->data.temp.type;
- memset (&loop->temp_ss->data.info, 0, sizeof (gfc_array_info));
+ tmp = tmp_ss_info->data.temp.type;
+ memset (&tmp_ss_info->data.array, 0, sizeof (gfc_array_info));
tmp_ss_info->type = GFC_SS_SECTION;
gcc_assert (tmp_ss->dimen != 0);
&& ss_type != GFC_SS_CONSTRUCTOR)
continue;
- info = &ss->data.info;
+ info = &ss->info->data.array;
for (n = 0; n < ss->dimen; n++)
{
gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
{
gfc_ss_type ss_type;
+ gfc_ss_info *ss_info;
gfc_loopinfo loop;
gfc_array_info *info;
int need_tmp;
tree offset;
int full;
bool subref_array_target = false;
- gfc_expr *arg;
+ gfc_expr *arg, *ss_expr;
gcc_assert (ss != NULL);
gcc_assert (ss != gfc_ss_terminator);
- ss_type = ss->info->type;
+ ss_info = ss->info;
+ ss_type = ss_info->type;
+ ss_expr = ss_info->expr;
/* Special case things we know we can pass easily. */
switch (expr->expr_type)
Otherwise we need to copy it into a temporary. */
gcc_assert (ss_type == GFC_SS_SECTION);
- gcc_assert (ss->expr == expr);
- info = &ss->data.info;
+ gcc_assert (ss_expr == expr);
+ info = &ss_info->data.array;
/* Get the descriptor for the array. */
gfc_conv_ss_descriptor (&se->pre, ss, 0);
if (se->direct_byref)
{
- gcc_assert (ss_type == GFC_SS_FUNCTION && ss->expr == expr);
+ gcc_assert (ss_type == GFC_SS_FUNCTION && ss_expr == expr);
/* For pointer assignments pass the descriptor directly. */
if (se->ss == NULL)
return;
}
- if (ss->expr != expr || ss_type != GFC_SS_FUNCTION)
+ if (ss_expr != expr || ss_type != GFC_SS_FUNCTION)
{
- if (ss->expr != expr)
+ if (ss_expr != expr)
/* Elemental function. */
gcc_assert ((expr->value.function.esym != NULL
&& expr->value.function.esym->attr.elemental)
else
{
/* Transformational function. */
- info = &ss->data.info;
+ info = &ss_info->data.array;
need_tmp = 0;
}
break;
&& gfc_constant_array_constructor_p (expr->value.constructor))
{
need_tmp = 0;
- info = &ss->data.info;
+ info = &ss_info->data.array;
}
else
{
: NULL),
loop.dimen);
- se->string_length = loop.temp_ss->string_length;
+ se->string_length = loop.temp_ss->info->string_length;
gcc_assert (loop.temp_ss->dimen == loop.dimen);
gfc_add_ss_to_loop (&loop, loop.temp_ss);
}
/* Finish the copying loops. */
gfc_trans_scalarizing_loops (&loop, &block);
- desc = loop.temp_ss->data.info.descriptor;
+ desc = loop.temp_ss->info->data.array.descriptor;
}
else if (expr->expr_type == EXPR_FUNCTION && !transposed_dims (ss))
{
desc = info->descriptor;
- se->string_length = ss->string_length;
+ se->string_length = ss_info->string_length;
}
else
{
{
gcc_assert (info->subscript[n]
&& info->subscript[n]->info->type == GFC_SS_SCALAR);
- start = info->subscript[n]->data.scalar.expr;
+ start = info->subscript[n]->info->data.scalar.value;
}
else
{
stmtblock_t fblock;
gfc_ss *rss;
gfc_ss *lss;
+ gfc_array_info *linfo;
tree realloc_expr;
tree alloc_expr;
tree size1;
/* Find the ss for the lhs. */
lss = loop->ss;
for (; lss && lss != gfc_ss_terminator; lss = lss->loop_chain)
- if (lss->expr && lss->expr->expr_type == EXPR_VARIABLE)
+ if (lss->info->expr && lss->info->expr->expr_type == EXPR_VARIABLE)
break;
if (lss == gfc_ss_terminator)
return NULL_TREE;
- expr1 = lss->expr;
+ expr1 = lss->info->expr;
}
/* Bail out if this is not a valid allocate on assignment. */
/* Find the ss for the lhs. */
lss = loop->ss;
for (; lss && lss != gfc_ss_terminator; lss = lss->loop_chain)
- if (lss->expr == expr1)
+ if (lss->info->expr == expr1)
break;
if (lss == gfc_ss_terminator)
return NULL_TREE;
+ linfo = &lss->info->data.array;
+
/* Find an ss for the rhs. For operator expressions, we see the
ss's for the operands. Any one of these will do. */
rss = loop->ss;
for (; rss && rss != gfc_ss_terminator; rss = rss->loop_chain)
- if (rss->expr != expr1 && rss != loop->temp_ss)
+ if (rss->info->expr != expr1 && rss != loop->temp_ss)
break;
if (expr2 && rss == gfc_ss_terminator)
/* Since the lhs is allocatable, this must be a descriptor type.
Get the data and array size. */
- desc = lss->data.info.descriptor;
+ desc = linfo->descriptor;
gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)));
array1 = gfc_conv_descriptor_data_get (desc);
/* Get the rhs size. Fix both sizes. */
if (expr2)
- desc2 = rss->data.info.descriptor;
+ desc2 = rss->info->data.array.descriptor;
else
desc2 = NULL_TREE;
size2 = gfc_index_one_node;
running offset. Use the saved_offset instead. */
tmp = gfc_conv_descriptor_offset (desc);
gfc_add_modify (&fblock, tmp, offset);
- if (lss->data.info.saved_offset
- && TREE_CODE (lss->data.info.saved_offset) == VAR_DECL)
- gfc_add_modify (&fblock, lss->data.info.saved_offset, tmp);
+ if (linfo->saved_offset
+ && TREE_CODE (linfo->saved_offset) == VAR_DECL)
+ gfc_add_modify (&fblock, linfo->saved_offset, tmp);
/* Now set the deltas for the lhs. */
for (n = 0; n < expr1->rank; n++)
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type, tmp,
loop->from[dim]);
- if (lss->data.info.delta[dim]
- && TREE_CODE (lss->data.info.delta[dim]) == VAR_DECL)
- gfc_add_modify (&fblock, lss->data.info.delta[dim], tmp);
+ if (linfo->delta[dim]
+ && TREE_CODE (linfo->delta[dim]) == VAR_DECL)
+ gfc_add_modify (&fblock, linfo->delta[dim], tmp);
}
/* Get the new lhs size in bytes. */
gfc_add_expr_to_block (&fblock, tmp);
/* Make sure that the scalarizer data pointer is updated. */
- if (lss->data.info.data
- && TREE_CODE (lss->data.info.data) == VAR_DECL)
+ if (linfo->data
+ && TREE_CODE (linfo->data) == VAR_DECL)
{
tmp = gfc_conv_descriptor_data_get (desc);
- gfc_add_modify (&fblock, lss->data.info.data, tmp);
+ gfc_add_modify (&fblock, linfo->data, tmp);
}
/* Add the exit label. */
case AR_FULL:
newss = gfc_get_array_ss (ss, expr, ar->as->rank, GFC_SS_SECTION);
- newss->data.info.ref = ref;
+ newss->info->data.array.ref = ref;
/* Make sure array is the same as array(:,:), this way
we don't need to special case all the time. */
case AR_SECTION:
newss = gfc_get_array_ss (ss, expr, 0, GFC_SS_SECTION);
- newss->data.info.ref = ref;
+ newss->info->data.array.ref = ref;
/* We add SS chains for all the subscripts in the section. */
for (n = 0; n < ar->dimen; n++)
gcc_assert (ar->start[n]);
indexss = gfc_get_scalar_ss (gfc_ss_terminator, ar->start[n]);
indexss->loop_chain = gfc_ss_terminator;
- newss->data.info.subscript[n] = indexss;
+ newss->info->data.array.subscript[n] = indexss;
break;
case DIMEN_RANGE:
indexss = gfc_get_array_ss (gfc_ss_terminator, ar->start[n],
1, GFC_SS_VECTOR);
indexss->loop_chain = gfc_ss_terminator;
- newss->data.info.subscript[n] = indexss;
+ newss->info->data.array.subscript[n] = indexss;
newss->dim[newss->dimen] = n;
newss->dimen++;
break;
/* 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);
+ || newss->info->data.array.ref->u.ar.as->corank > 0);
ss = newss;
break;
OSDN Git Service
