}
+static void
+free_ss_info (gfc_ss_info *ss_info)
+{
+ free (ss_info);
+}
+
+
/* Free a SS. */
static void
gfc_free_ss (gfc_ss * ss)
{
+ gfc_ss_info *ss_info;
int n;
- switch (ss->type)
+ ss_info = ss->info;
+
+ switch (ss_info->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;
break;
}
+ free_ss_info (ss_info);
free (ss);
}
gfc_get_array_ss (gfc_ss *next, gfc_expr *expr, int dimen, gfc_ss_type type)
{
gfc_ss *ss;
- gfc_ss_info *info;
+ gfc_ss_info *ss_info;
int i;
+ 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->type = type;
- ss->expr = expr;
- info = &ss->data.info;
- info->dimen = dimen;
- 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;
+ gfc_ss_info *ss_info;
+ int 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->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;
}
gfc_get_scalar_ss (gfc_ss *next, gfc_expr *expr)
{
gfc_ss *ss;
+ gfc_ss_info *ss_info;
+
+ 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->type = GFC_SS_SCALAR;
- ss->expr = expr;
return ss;
}
if (as && as->type == AS_EXPLICIT)
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)
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)
{
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;
}
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;
- tmp = gfc_build_constant_array_constructor (ss->expr, type);
+ tmp = gfc_build_constant_array_constructor (ss->info->expr, type);
info = &ss->data.info;
info->data = gfc_build_addr_expr (NULL_TREE, tmp);
info->offset = gfc_index_zero_node;
- for (i = 0; i < info->dimen; 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
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->data.info.dimen == loop->dimen);
+ 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,
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;
+ 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)
{
difference between the vector's upper and lower bounds. */
gcc_assert (loop->from[n] == gfc_index_zero_node);
gcc_assert (info->subscript[dim]
- && info->subscript[dim]->type == GFC_SS_VECTOR);
+ && info->subscript[dim]->info->type == GFC_SS_VECTOR);
gfc_init_se (&se, NULL);
desc = info->subscript[dim]->data.info.descriptor;
locus * where)
{
gfc_se se;
+ gfc_ss_info *ss_info;
+ gfc_expr *expr;
int n;
/* TODO: This can generate bad code if there are ordering dependencies,
{
gcc_assert (ss);
- switch (ss->type)
+ ss_info = ss->info;
+ expr = ss_info->expr;
+
+ 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:
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:
/* 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;
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;
tree tmp;
+ ss_info = ss->info;
+
/* 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;
+ ss_info->string_length = se.string_length;
if (base)
{
/* 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->info->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)
{
case DIMEN_ELEMENT:
/* Elemental dimension. */
gcc_assert (info->subscript[dim]
- && info->subscript[dim]->type == GFC_SS_SCALAR);
+ && 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 = 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:
gcc_assert (info && se->loop);
gcc_assert (info->subscript[dim]
- && info->subscript[dim]->type == GFC_SS_VECTOR);
+ && info->subscript[dim]->info->type == GFC_SS_VECTOR);
desc = info->subscript[dim]->data.info.descriptor;
/* Get a zero-based index into the 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:
/* 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)
+ if (se->ss && se->ss->info->type == GFC_SS_FUNCTION
+ && 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]);
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;
+ gfc_expr *expr;
int n;
- info = &se->ss->data.info;
+ ss = se->ss;
+ expr = ss->info->expr;
+ 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))
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);
}
}
+/* 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_type ss_type;
gfc_ss *ss;
- gfc_se se;
gfc_array_ref *ar;
int i;
if ((ss->useflags & flag) == 0)
continue;
- if (ss->type != GFC_SS_SECTION
- && ss->type != GFC_SS_FUNCTION && ss->type != GFC_SS_CONSTRUCTOR
- && ss->type != GFC_SS_COMPONENT)
+ 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;
- if (dim >= info->dimen)
- continue;
+ gcc_assert (dim < ss->dimen);
+ gcc_assert (ss->dimen == loop->dimen);
if (info->ref)
- {
- ar = &info->ref->u.ar;
- i = loop->order[dim + 1];
- }
+ ar = &info->ref->u.ar;
else
- {
- ar = NULL;
- i = dim + 1;
- }
+ ar = NULL;
+ if (dim == loop->dimen - 1)
+ i = 0;
+ else
+ i = dim + 1;
- if (dim == info->dimen - 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)
{
- 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]);
+ 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.
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,
- 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. */
- 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)
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;
}
/* Restore the initial offsets. */
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
{
+ gfc_ss_type ss_type;
+
if ((ss->useflags & 2) == 0)
continue;
- if (ss->type != GFC_SS_SECTION
- && ss->type != GFC_SS_FUNCTION && ss->type != GFC_SS_CONSTRUCTOR
- && ss->type != GFC_SS_COMPONENT)
+ 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;
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);
+ gcc_assert (ss->info->type == GFC_SS_SECTION);
info = &ss->data.info;
ar = &info->ref->u.ar;
/* Determine the rank of the loop. */
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
{
- switch (ss->type)
+ switch (ss->info->type)
{
case GFC_SS_SECTION:
case GFC_SS_CONSTRUCTOR:
case GFC_SS_FUNCTION:
case GFC_SS_COMPONENT:
- loop->dimen = ss->data.info.dimen;
+ loop->dimen = ss->dimen;
goto done;
/* 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:
case GFC_ISYM_LCOBOUND:
case GFC_ISYM_UCOBOUND:
case GFC_ISYM_THIS_IMAGE:
- loop->dimen = ss->data.info.dimen;
+ loop->dimen = ss->dimen;
goto done;
default:
/* Loop over all the SS in the chain. */
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
{
- if (ss->expr && ss->expr->shape && !ss->shape)
- ss->shape = ss->expr->shape;
+ gfc_ss_info *ss_info;
+ gfc_array_info *info;
+ gfc_expr *expr;
+
+ ss_info = ss->info;
+ expr = ss_info->expr;
+ info = &ss->data.info;
+
+ if (expr && expr->shape && !info->shape)
+ info->shape = expr->shape;
- switch (ss->type)
+ switch (ss_info->type)
{
case GFC_SS_SECTION:
/* 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]);
+ for (n = 0; n < ss->dimen; n++)
+ gfc_conv_section_startstride (loop, ss, ss->dim[n]);
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:
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;
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->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. */
{
bool check_upper;
- dim = info->dim[n];
+ dim = ss->dim[n];
if (info->ref->u.ar.dimen_type[dim] != DIMEN_RANGE)
continue;
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;
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->data.info.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->data.info.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->data.info.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->type != GFC_SS_SECTION)
+ 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)
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. */
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);
}
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];
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->info->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
{
spec_dim = 0;
}
- if (ss->shape)
+ if (info->shape)
{
- gcc_assert (ss->shape[dim]);
+ gcc_assert (info->shape[dim]);
/* The frontend has worked out the size for us. */
if (!loopspec[n]
- || !loopspec[n]->shape
+ || !specinfo->shape
|| !integer_zerop (specinfo->start[spec_dim]))
/* Prefer zero-based descriptors if possible. */
loopspec[n] = ss;
continue;
}
- if (ss->type == GFC_SS_CONSTRUCTOR)
+ if (ss_type == GFC_SS_CONSTRUCTOR)
{
gfc_constructor_base base;
/* An unknown size constructor will always be rank one.
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;
/* TODO: Pick the best bound if we have a choice between a
function and something else. */
- if (ss->type == GFC_SS_FUNCTION)
+ if (ss_type == GFC_SS_FUNCTION)
{
loopspec[n] = ss;
continue;
if (loopspec[n] && ss->is_alloc_lhs)
continue;
- if (ss->type != GFC_SS_SECTION)
+ if (ss_type != GFC_SS_SECTION)
continue;
if (!loopspec[n])
known lower bound
known upper bound
*/
- else if ((loopspec[n]->type == GFC_SS_CONSTRUCTOR && dynamic[n])
+ else if ((loopspec[n]->info->type == GFC_SS_CONSTRUCTOR && dynamic[n])
|| n >= loop->dimen)
loopspec[n] = ss;
else if (integer_onep (info->stride[dim])
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;
+ cshape = info->shape;
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);
else
{
loop->from[n] = info->start[dim];
- switch (loopspec[n]->type)
+ switch (loopspec[n]->info->type)
{
case GFC_SS_CONSTRUCTOR:
/* The upper bound is calculated when we expand the
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);
+ gfc_ss_info *tmp_ss_info;
+
+ tmp_ss_info = tmp_ss->info;
+ 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;
- n = loop->temp_ss->data.temp.dimen;
- memset (&loop->temp_ss->data.info, 0, sizeof (gfc_ss_info));
- loop->temp_ss->type = GFC_SS_SECTION;
- loop->temp_ss->data.info.dimen = n;
+ tmp = tmp_ss_info->data.temp.type;
+ memset (&loop->temp_ss->data.info, 0, sizeof (gfc_array_info));
+ tmp_ss_info->type = GFC_SS_SECTION;
- 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);
}
/* Calculate the translation from loop variables to array indices. */
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
{
- if (ss->type != GFC_SS_SECTION && ss->type != GFC_SS_COMPONENT
- && ss->type != GFC_SS_CONSTRUCTOR)
+ gfc_ss_type ss_type;
+ ss_type = ss->info->type;
+ if (ss_type != GFC_SS_SECTION
+ && ss_type != GFC_SS_COMPONENT
+ && ss_type != GFC_SS_CONSTRUCTOR)
continue;
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
void
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_ss_info *info;
+ gfc_array_info *info;
int need_tmp;
int n;
tree 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_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)
{
/* If we have a linear array section, we can pass it directly.
Otherwise we need to copy it into a temporary. */
- gcc_assert (ss->type == GFC_SS_SECTION);
- gcc_assert (ss->expr == expr);
+ gcc_assert (ss_type == GFC_SS_SECTION);
+ gcc_assert (ss_expr == expr);
info = &ss->data.info;
/* Get the descriptor for the array. */
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)
{
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)
|| (expr->value.function.isym != NULL
&& expr->value.function.isym->elemental));
else
- gcc_assert (ss->type == GFC_SS_INTRINSIC);
+ gcc_assert (ss_type == GFC_SS_INTRINSIC);
need_tmp = 1;
if (expr->ts.type == BT_CHARACTER
case EXPR_ARRAY:
/* Constant array constructors don't need a temporary. */
- if (ss->type == GFC_SS_CONSTRUCTOR
+ if (ss_type == GFC_SS_CONSTRUCTOR
&& expr->ts.type != BT_CHARACTER
&& gfc_constant_array_constructor_p (expr->value.constructor))
{
: NULL),
loop.dimen);
- se->string_length = loop.temp_ss->string_length;
- gcc_assert (loop.temp_ss->data.temp.dimen == loop.dimen);
+ 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);
}
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;
+ se->string_length = ss_info->string_length;
}
else
{
tree to;
tree base;
- ndim = info->ref ? info->ref->u.ar.dimen : info->dimen;
+ ndim = info->ref ? info->ref->u.ar.dimen : ss->dimen;
if (se->want_coarray)
{
&& info->ref->u.ar.dimen_type[n] == DIMEN_ELEMENT)
{
gcc_assert (info->subscript[n]
- && info->subscript[n]->type == GFC_SS_SCALAR);
- start = info->subscript[n]->data.scalar.expr;
+ && info->subscript[n]->info->type == GFC_SS_SCALAR);
+ start = info->subscript[n]->info->data.scalar.value;
}
else
{
/* 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. */
/* 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)
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)
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]);
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;
case DIMEN_RANGE:
/* We don't add anything for sections, just remember this
dimension for later. */
- newss->data.info.dim[newss->data.info.dimen] = n;
- 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] = n;
- newss->data.info.dimen++;
+ newss->dim[newss->dimen] = n;
+ newss->dimen++;
break;
default:
}
/* 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
+ gcc_assert (newss->dimen > 0
|| newss->data.info.ref->u.ar.as->corank > 0);
ss = newss;
break;
/* Scalar argument. */
gcc_assert (type == GFC_SS_SCALAR || type == GFC_SS_REFERENCE);
newss = gfc_get_scalar_ss (head, arg->expr);
- newss->type = type;
+ newss->info->type = type;
}
else
scalar = 0;
OSDN Git Service
