This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[Patch, fortran] [20..30/66] inline sum and product: Update core structs.
- From: Mikael Morin <mikael dot morin at sfr dot fr>
- To: gfortran <fortran at gcc dot gnu dot org> , GCC patches <gcc-patches at gcc dot gnu dot org>
- Date: Fri, 28 Oct 2011 01:30:31 +0200 (CEST)
- Subject: [Patch, fortran] [20..30/66] inline sum and product: Update core structs.
- References: <20111027232818.18581.901@gimli.local>
These patches introduce the new scalarizer structures. As explained earlier,
the dim and dimen field are now part of the main gfc_ss structure.
All the common fields (type, expr, shape, string length, union data and all its
content) are moved to a new external structure gfc_ss_info to which a pointer
is kept in the main gfc_ss structure. The former gfc_ss_info is renamed to
gfc_array_info as it is only used for non-scalar case. The shape field is moved
to gfc_array_info as it is not used in non-array cases.
This is explained in the schema below (though I'm not sure it makes it more understandable).
struct gfc_ss struct gfc_ss
{ {
---- new -------> struct gfc_ss_info *
{
---- new ---------> int refcount;
gfc_ss_type type; -------------+ +-> gfc_ss_type type;
gfc_expr *expr; -------------+-- moved ----+-> gfc_expr *expr;
mpz_t *shape; ----- moved ----|------+ |
tree string_length; -------------+ | +-> tree string_length;
union ----------------------+ | +-> union
{ | {
struct | struct
{ | {
tree expr; ------------ renamed --------------> tree value;
} | }
scalar; | scalar;
|
struct | struct
{ | {
int dimen; ---------+ | int dimen;
tree type; | | tree type;
} | | }
temp; |- merged --+ | temp;
| | |
struct gfc_ss_info --|- renamed -|---|----------> struct gfc_array_info
{ | | | {
| | +-----------> mpz_t *shape;
int dimen; ---------+ |
gfc_ref *ref; | gfc_ref *ref;
tree descriptor; + moved + tree descriptor;
tree data; | | tree data;
tree offset; | | tree offset;
tree saved_offset; | | tree saved_offset;
tree stride0; | | tree stride0;
gfc_ss *subscript[]; | | gfc_ss *subscript[];
| |
tree start[]; | | tree start[];
tree end[]; | | tree end[];
tree stride[]; | | tree stride[];
tree delta[]; | | tree delta[];
| |
int dim[]; --------------------+ |
} info; ---------- renamed ---|------> } array;
} | }
data; | data;
|
+-----------------|----> unsigned useflags:2;
+-----------------|----> unsigned where:1;
| | }
moved |
| +--> int dimen;
| +--> int dim[];
|
gfc_ss *loop_chain; | gfc_ss *loop_chain;
gfc_ss *next; | gfc_ss *next;
|
unsigned useflags:2; ----+
unsigned where:1; ----+
unsigned is_alloc_lhs:1; unsigned is_alloc_lhs:1;
} }
gfc_ss; gfc_ss;
The follow-up messages are the step-by-step patches to change the structures
by moving fields one by one. This is for those prefering more straightforward
patches (like me).
For the masoch^W^W those who prefer one single patch the combined patch is
attached to this mail.
Patch 20: Rename gfc_ss_info to gfc_array_info.
Patch 21: Move {dim,dimen} from gfc_array_info to gfc_ss.
Patch 22: Move shape from gfc_ss to gfc_array_info.
Patch 23: Move type from gfc_ss to a new gfc_ss_info.
Patch 24: Move expr from gfc_ss to gfc_ss_info.
Patch 25: Move string_length from gfc_ss to gfc_ss_info.
Patch 26: Move scalar struct from gfc_ss to gfc_ss_info.
Patch 27: Move temp struct from gfc_ss to gfc_ss_info.
Patch 28: Move info struct from gfc_ss to gfc_ss_info.
Patch 29: Move useflags from gfc_ss to gfc_ss_info.
Patch 30: Move where from gfc_ss to gfc_ss_info.
diff --git a/trans-array.c b/trans-array.c
index dc4dccd..045c426 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -463,7 +463,7 @@ void
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 *);
@@ -486,20 +486,30 @@ gfc_free_ss_chain (gfc_ss * ss)
}
+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_info->data.array.subscript[ss->dim[n]])
+ gfc_free_ss_chain (ss_info->data.array.subscript[ss->dim[n]]);
}
break;
@@ -507,6 +517,7 @@ gfc_free_ss (gfc_ss * ss)
break;
}
+ free_ss_info (ss_info);
free (ss);
}
@@ -517,17 +528,19 @@ gfc_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;
}
@@ -539,13 +552,20 @@ gfc_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;
}
@@ -557,11 +577,15 @@ gfc_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;
}
@@ -642,7 +666,7 @@ gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping * mapping,
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)
@@ -685,7 +709,7 @@ gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping * mapping,
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;
@@ -810,15 +834,12 @@ static int
get_array_ref_dim (gfc_ss *ss, int loop_dim)
{
int n, array_dim, array_ref_dim;
- gfc_ss_info *info;
-
- info = &ss->data.info;
array_ref_dim = 0;
- array_dim = info->dim[loop_dim];
+ array_dim = ss->dim[loop_dim];
- for (n = 0; n < info->dimen; n++)
- if (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;
@@ -845,7 +866,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
tree eltype, tree initial, bool dynamic,
bool dealloc, bool callee_alloc, locus * where)
{
- gfc_ss_info *info;
+ gfc_array_info *info;
tree from[GFC_MAX_DIMENSIONS], to[GFC_MAX_DIMENSIONS];
tree type;
tree desc;
@@ -859,10 +880,10 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
memset (from, 0, sizeof (from));
memset (to, 0, sizeof (to));
- info = &ss->data.info;
+ info = &ss->info->data.array;
- gcc_assert (info->dimen > 0);
- gcc_assert (loop->dimen == info->dimen);
+ 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);
@@ -870,7 +891,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
/* 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])
@@ -899,7 +920,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
/* 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;
@@ -937,7 +958,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
for (n = 0; n < loop->dimen; n++)
{
- dim = info->dim[n];
+ dim = ss->dim[n];
if (size == NULL_TREE)
{
@@ -1003,8 +1024,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
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;
}
@@ -1857,19 +1878,19 @@ gfc_build_constant_array_constructor (gfc_expr * expr, tree type)
static void
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 = &ss->info->data.array;
info->descriptor = tmp;
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;
@@ -1932,75 +1953,80 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
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,
@@ -2047,7 +2073,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
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;
@@ -2099,7 +2125,7 @@ finish:
static void
set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss)
{
- gfc_ss_info *info;
+ gfc_array_info *info;
gfc_se se;
tree tmp;
tree desc;
@@ -2107,11 +2133,11 @@ set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss)
int n;
int dim;
- info = &ss->data.info;
+ info = &ss->info->data.array;
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)
{
@@ -2120,10 +2146,10 @@ set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss)
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;
+ 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,
@@ -2145,6 +2171,9 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
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,
@@ -2155,50 +2184,53 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
{
gcc_assert (ss);
- switch (ss->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. */
if (subscript)
se.expr = convert(gfc_array_index_type, se.expr);
- if (!ss->where)
+ if (!ss_info->where)
se.expr = gfc_evaluate_now (se.expr, &loop->pre);
gfc_add_block_to_block (&loop->pre, &se.post);
}
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;
@@ -2206,10 +2238,10 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
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:
@@ -2222,22 +2254,22 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
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);
}
@@ -2263,16 +2295,21 @@ static void
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)
{
@@ -2286,15 +2323,15 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int 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;
}
}
@@ -2447,12 +2484,12 @@ trans_array_bound_check (gfc_se * se, gfc_ss *ss, tree index, int n,
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)
@@ -2516,12 +2553,12 @@ static tree
conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i,
gfc_array_ref * ar, tree stride)
{
- gfc_ss_info *info;
+ gfc_array_info *info;
tree index;
tree desc;
tree data;
- info = &ss->data.info;
+ info = &ss->info->data.array;
/* Get the index into the array for this dimension. */
if (ar)
@@ -2535,9 +2572,9 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i,
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 = trans_array_bound_check (se, ss, index, dim, &ar->where,
ar->as->type != AS_ASSUMED_SIZE
@@ -2547,8 +2584,8 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i,
case DIMEN_VECTOR:
gcc_assert (info && se->loop);
gcc_assert (info->subscript[dim]
- && info->subscript[dim]->type == GFC_SS_VECTOR);
- desc = info->subscript[dim]->data.info.descriptor;
+ && info->subscript[dim]->info->type == GFC_SS_VECTOR);
+ desc = info->subscript[dim]->info->data.array.descriptor;
/* Get a zero-based index into the vector. */
index = fold_build2_loc (input_location, MINUS_EXPR,
@@ -2602,11 +2639,11 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int 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)
+ 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]);
@@ -2629,31 +2666,33 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i,
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->info->data.array;
if (ar)
n = se->loop->order[0];
else
n = 0;
- index = conv_array_index_offset (se, se->ss, 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);
}
@@ -2663,7 +2702,7 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar)
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);
}
@@ -2827,10 +2866,10 @@ add_array_offset (stmtblock_t *pblock, gfc_loopinfo *loop, gfc_ss *ss,
gfc_array_ref *ar, int array_dim, int loop_dim)
{
gfc_se se;
- gfc_ss_info *info;
+ gfc_array_info *info;
tree stride, index;
- info = &ss->data.info;
+ info = &ss->info->data.array;
gfc_init_se (&se, NULL);
se.loop = loop;
@@ -2854,7 +2893,9 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
stmtblock_t * pblock)
{
tree stride;
- gfc_ss_info *info;
+ gfc_ss_info *ss_info;
+ gfc_array_info *info;
+ gfc_ss_type ss_type;
gfc_ss *ss;
gfc_array_ref *ar;
int i;
@@ -2863,18 +2904,22 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
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;
- 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;
+ info = &ss_info->data.array;
- gcc_assert (dim < info->dimen);
- gcc_assert (info->dimen == loop->dimen);
+ gcc_assert (dim < ss->dimen);
+ gcc_assert (ss->dimen == loop->dimen);
if (info->ref)
ar = &info->ref->u.ar;
@@ -2892,7 +2937,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
if (dim == loop->dimen - 1)
{
- 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.
@@ -2915,7 +2960,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
}
else
/* Add the offset for the previous loop dimension. */
- add_array_offset (pblock, loop, ss, ar, info->dim[i], i);
+ add_array_offset (pblock, loop, ss, ar, ss->dim[i], i);
/* Remember this offset for the second loop. */
if (dim == loop->temp_dim - 1)
@@ -3103,7 +3148,7 @@ gfc_trans_scalarizing_loops (gfc_loopinfo * loop, stmtblock_t * body)
/* Clear all the used flags. */
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
- ss->useflags = 0;
+ ss->info->useflags = 0;
}
@@ -3135,15 +3180,22 @@ gfc_trans_scalarized_loop_boundary (gfc_loopinfo * loop, stmtblock_t * body)
/* Restore the initial offsets. */
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
{
- if ((ss->useflags & 2) == 0)
+ gfc_ss_type ss_type;
+ gfc_ss_info *ss_info;
+
+ ss_info = ss->info;
+
+ if ((ss_info->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;
+ ss_info->data.array.offset = ss_info->data.array.saved_offset;
}
/* Restart all the inner loops we just finished. */
@@ -3205,12 +3257,12 @@ gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int dim)
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;
+ info = &ss->info->data.array;
ar = &info->ref->u.ar;
if (ar->dimen_type[dim] == DIMEN_VECTOR)
@@ -3265,25 +3317,25 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
/* 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:
@@ -3303,21 +3355,29 @@ done:
/* 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_info->data.array;
- switch (ss->type)
+ if (expr && expr->shape && !info->shape)
+ info->shape = expr->shape;
+
+ 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:
@@ -3333,13 +3393,13 @@ done:
case GFC_SS_CONSTRUCTOR:
case GFC_SS_FUNCTION:
- for (n = 0; n < ss->data.info.dimen; n++)
+ for (n = 0; n < ss->dimen; n++)
{
- int dim = ss->data.info.dim[n];
+ 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;
@@ -3356,7 +3416,7 @@ done:
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;
@@ -3368,18 +3428,27 @@ done:
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. */
- info = &ss->data.info;
+ info = &ss_info->data.array;
/* This code only checks ranges. Elemental and vector
dimensions are checked later. */
@@ -3387,7 +3456,7 @@ done:
{
bool check_upper;
- dim = info->dim[n];
+ dim = ss->dim[n];
if (info->ref->u.ar.dimen_type[dim] != DIMEN_RANGE)
continue;
@@ -3401,12 +3470,12 @@ done:
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
@@ -3460,14 +3529,14 @@ done:
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));
@@ -3482,9 +3551,9 @@ done:
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);
@@ -3514,14 +3583,14 @@ done:
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));
@@ -3531,9 +3600,9 @@ done:
{
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);
@@ -3560,10 +3629,10 @@ done:
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]));
@@ -3577,10 +3646,10 @@ done:
/* 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);
@@ -3633,12 +3702,16 @@ gfc_could_be_alias (gfc_ss * lss, gfc_ss * rss)
{
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;
@@ -3656,7 +3729,7 @@ gfc_could_be_alias (gfc_ss * lss, gfc_ss * rss)
/* 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;
@@ -3676,7 +3749,7 @@ gfc_could_be_alias (gfc_ss * lss, gfc_ss * rss)
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)
@@ -3711,7 +3784,7 @@ gfc_could_be_alias (gfc_ss * lss, gfc_ss * rss)
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;
@@ -3747,20 +3820,25 @@ gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest,
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;
@@ -3768,18 +3846,18 @@ gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest,
}
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. */
@@ -3828,11 +3906,11 @@ temporary:
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);
}
@@ -3851,9 +3929,9 @@ void
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];
@@ -3871,19 +3949,19 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
{
gfc_ss_type ss_type;
- 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];
+ info = &ss->info->data.array;
+ dim = ss->dim[n];
if (loopspec[n] != NULL)
{
- specinfo = &loopspec[n]->data.info;
- spec_dim = specinfo->dim[n];
+ specinfo = &loopspec[n]->info->data.array;
+ spec_dim = loopspec[n]->dim[n];
}
else
{
@@ -3892,19 +3970,19 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
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.
@@ -3916,7 +3994,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
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;
@@ -3925,7 +4003,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
/* 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;
@@ -3936,7 +4014,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
if (loopspec[n] && ss->is_alloc_lhs)
continue;
- if (ss->type != GFC_SS_SECTION)
+ if (ss_type != GFC_SS_SECTION)
continue;
if (!loopspec[n])
@@ -3948,7 +4026,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
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])
@@ -3970,11 +4048,11 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
that's bad news. */
gcc_assert (loopspec[n]);
- info = &loopspec[n]->data.info;
- dim = info->dim[n];
+ info = &loopspec[n]->info->data.array;
+ 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]))
{
@@ -3994,7 +4072,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
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
@@ -4047,30 +4125,30 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
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 (&tmp_ss_info->data.array, 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, tmp, NULL_TREE,
+ tmp_ss, tmp, NULL_TREE,
false, true, false, where);
}
@@ -4087,19 +4165,22 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * 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;
+ info = &ss->info->data.array;
- 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. */
@@ -5657,16 +5738,15 @@ get_array_charlen (gfc_expr *expr, gfc_se *se)
}
}
+
/* Helper function to check dimensions. */
static bool
transposed_dims (gfc_ss *ss)
{
- gfc_ss_info *info;
int n;
- info = &ss->data.info;
- for (n = 0; n < info->dimen; n++)
- if (info->dim[n] != n)
+ for (n = 0; n < ss->dimen; n++)
+ if (ss->dim[n] != n)
return true;
return false;
}
@@ -5703,8 +5783,10 @@ transposed_dims (gfc_ss *ss)
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;
@@ -5714,11 +5796,15 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
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)
{
@@ -5726,9 +5812,9 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
/* 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);
- info = &ss->data.info;
+ gcc_assert (ss_type == GFC_SS_SECTION);
+ gcc_assert (ss_expr == expr);
+ info = &ss_info->data.array;
/* Get the descriptor for the array. */
gfc_conv_ss_descriptor (&se->pre, ss, 0);
@@ -5805,7 +5891,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
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)
@@ -5817,16 +5903,16 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
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
@@ -5838,19 +5924,19 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
else
{
/* Transformational function. */
- info = &ss->data.info;
+ info = &ss_info->data.array;
need_tmp = 0;
}
break;
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))
{
need_tmp = 0;
- info = &ss->data.info;
+ info = &ss_info->data.array;
}
else
{
@@ -5898,8 +5984,8 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
: 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);
}
@@ -5950,12 +6036,12 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * 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
{
@@ -5972,7 +6058,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
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)
{
@@ -6056,8 +6142,8 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
&& 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
{
@@ -6087,7 +6173,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
/* 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. */
@@ -7143,6 +7229,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
stmtblock_t fblock;
gfc_ss *rss;
gfc_ss *lss;
+ gfc_array_info *linfo;
tree realloc_expr;
tree alloc_expr;
tree size1;
@@ -7173,11 +7260,11 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
/* 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. */
@@ -7188,17 +7275,19 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
/* 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)
@@ -7208,7 +7297,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
/* 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);
@@ -7278,7 +7367,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
/* 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;
@@ -7368,21 +7457,21 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
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 = 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]);
- 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. */
@@ -7446,11 +7535,11 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
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. */
@@ -7640,7 +7729,7 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref)
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. */
@@ -7658,7 +7747,7 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref)
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++)
@@ -7672,14 +7761,14 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref)
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:
/* 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:
@@ -7688,9 +7777,9 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref)
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->data.info.dim[newss->data.info.dimen] = n;
- newss->data.info.dimen++;
+ newss->info->data.array.subscript[n] = indexss;
+ newss->dim[newss->dimen] = n;
+ newss->dimen++;
break;
default:
@@ -7700,8 +7789,8 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref)
}
/* We should have at least one non-elemental dimension,
unless we are creating a descriptor for a (scalar) coarray. */
- gcc_assert (newss->data.info.dimen > 0
- || newss->data.info.ref->u.ar.as->corank > 0);
+ gcc_assert (newss->dimen > 0
+ || newss->info->data.array.ref->u.ar.as->corank > 0);
ss = newss;
break;
@@ -7812,7 +7901,7 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
/* 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;
diff --git a/trans-const.c b/trans-const.c
index 5fbe765..fa820ef 100644
--- a/trans-const.c
+++ b/trans-const.c
@@ -358,6 +358,8 @@ gfc_conv_constant_to_tree (gfc_expr * expr)
void
gfc_conv_constant (gfc_se * se, gfc_expr * expr)
{
+ gfc_ss *ss;
+
/* We may be receiving an expression for C_NULL_PTR or C_NULL_FUNPTR. If
so, the expr_type will not yet be an EXPR_CONSTANT. We need to make
it so here. */
@@ -380,14 +382,18 @@ gfc_conv_constant (gfc_se * se, gfc_expr * expr)
return;
}
- if (se->ss != NULL)
+ ss = se->ss;
+ if (ss != NULL)
{
- gcc_assert (se->ss != gfc_ss_terminator);
- gcc_assert (se->ss->type == GFC_SS_SCALAR);
- gcc_assert (se->ss->expr == expr);
+ gfc_ss_info *ss_info;
+
+ ss_info = ss->info;
+ gcc_assert (ss != gfc_ss_terminator);
+ gcc_assert (ss_info->type == GFC_SS_SCALAR);
+ gcc_assert (ss_info->expr == expr);
- se->expr = se->ss->data.scalar.expr;
- se->string_length = se->ss->string_length;
+ se->expr = ss_info->data.scalar.value;
+ se->string_length = ss_info->string_length;
gfc_advance_se_ss_chain (se);
return;
}
diff --git a/trans-expr.c b/trans-expr.c
index b2c1739..01d4ca3 100644
--- a/trans-expr.c
+++ b/trans-expr.c
@@ -613,6 +613,7 @@ conv_parent_component_references (gfc_se * se, gfc_ref * ref)
static void
gfc_conv_variable (gfc_se * se, gfc_expr * expr)
{
+ gfc_ss *ss;
gfc_ref *ref;
gfc_symbol *sym;
tree parent_decl = NULL_TREE;
@@ -622,16 +623,19 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
bool entry_master;
sym = expr->symtree->n.sym;
- if (se->ss != NULL)
+ ss = se->ss;
+ if (ss != NULL)
{
+ gfc_ss_info *ss_info = ss->info;
+
/* Check that something hasn't gone horribly wrong. */
- gcc_assert (se->ss != gfc_ss_terminator);
- gcc_assert (se->ss->expr == expr);
+ gcc_assert (ss != gfc_ss_terminator);
+ gcc_assert (ss_info->expr == expr);
/* A scalarized term. We already know the descriptor. */
- se->expr = se->ss->data.info.descriptor;
- se->string_length = se->ss->string_length;
- for (ref = se->ss->data.info.ref; ref; ref = ref->next)
+ se->expr = ss_info->data.array.descriptor;
+ se->string_length = ss_info->string_length;
+ for (ref = ss_info->data.array.ref; ref; ref = ref->next)
if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT)
break;
}
@@ -2359,7 +2363,7 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77,
gfc_ss *rss;
gfc_loopinfo loop;
gfc_loopinfo loop2;
- gfc_ss_info *info;
+ gfc_array_info *info;
tree offset;
tree tmp_index;
tree tmp;
@@ -2400,7 +2404,7 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77,
: NULL),
loop.dimen);
- parmse->string_length = loop.temp_ss->string_length;
+ parmse->string_length = loop.temp_ss->info->string_length;
/* Associate the SS with the loop. */
gfc_add_ss_to_loop (&loop, loop.temp_ss);
@@ -2409,7 +2413,7 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77,
gfc_conv_loop_setup (&loop, &expr->where);
/* Pass the temporary descriptor back to the caller. */
- info = &loop.temp_ss->data.info;
+ info = &loop.temp_ss->info->data.array;
parmse->expr = info->descriptor;
/* Setup the gfc_se structures. */
@@ -2488,8 +2492,8 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77,
dimensions, so this is very simple. The offset is only computed
outside the innermost loop, so the overall transfer could be
optimized further. */
- info = &rse.ss->data.info;
- dimen = info->dimen;
+ info = &rse.ss->info->data.array;
+ dimen = rse.ss->dimen;
tmp_index = gfc_index_zero_node;
for (n = dimen - 1; n > 0; n--)
@@ -2854,7 +2858,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
tree fntype;
gfc_se parmse;
gfc_ss *argss;
- gfc_ss_info *info;
+ gfc_array_info *info;
int byref;
int parm_kind;
tree type;
@@ -2893,8 +2897,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
{
if (!sym->attr.elemental)
{
- gcc_assert (se->ss->type == GFC_SS_FUNCTION);
- if (se->ss->useflags)
+ gcc_assert (se->ss->info->type == GFC_SS_FUNCTION);
+ if (se->ss->info->useflags)
{
gcc_assert ((!comp && gfc_return_by_reference (sym)
&& sym->result->attr.dimension)
@@ -2906,7 +2910,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
return 0;
}
}
- info = &se->ss->data.info;
+ info = &se->ss->info->data.array;
}
else
info = NULL;
@@ -2979,7 +2983,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
gfc_init_se (&parmse, se);
gfc_conv_derived_to_class (&parmse, e, fsym->ts);
}
- else if (se->ss && se->ss->useflags)
+ else if (se->ss && se->ss->info->useflags)
{
/* An elemental function inside a scalarized loop. */
gfc_init_se (&parmse, se);
@@ -3582,7 +3586,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
/* Set the type of the array. */
tmp = gfc_typenode_for_spec (&comp->ts);
- gcc_assert (info->dimen == se->loop->dimen);
+ gcc_assert (se->ss->dimen == se->loop->dimen);
/* Evaluate the bounds of the result, if known. */
gfc_set_loop_bounds_from_array_spec (&mapping, se, comp->as);
@@ -3604,8 +3608,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
callee_alloc = comp->attr.allocatable || comp->attr.pointer;
gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, se->ss,
tmp, NULL_TREE, false,
- !comp->attr.pointer,
- callee_alloc, &se->ss->expr->where);
+ !comp->attr.pointer, callee_alloc,
+ &se->ss->info->expr->where);
/* Pass the temporary as the first argument. */
result = info->descriptor;
@@ -3618,7 +3622,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
/* Set the type of the array. */
tmp = gfc_typenode_for_spec (&ts);
- gcc_assert (info->dimen == se->loop->dimen);
+ gcc_assert (se->ss->dimen == se->loop->dimen);
/* Evaluate the bounds of the result, if known. */
gfc_set_loop_bounds_from_array_spec (&mapping, se, sym->result->as);
@@ -3640,8 +3644,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
callee_alloc = sym->attr.allocatable || sym->attr.pointer;
gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, se->ss,
tmp, NULL_TREE, false,
- !sym->attr.pointer,
- callee_alloc, &se->ss->expr->where);
+ !sym->attr.pointer, callee_alloc,
+ &se->ss->info->expr->where);
/* Pass the temporary as the first argument. */
result = info->descriptor;
@@ -4239,8 +4243,11 @@ is_zero_initializer_p (gfc_expr * expr)
static void
gfc_conv_array_constructor_expr (gfc_se * se, gfc_expr * expr)
{
- gcc_assert (se->ss != NULL && se->ss != gfc_ss_terminator);
- gcc_assert (se->ss->expr == expr && se->ss->type == GFC_SS_CONSTRUCTOR);
+ gfc_ss *ss;
+
+ ss = se->ss;
+ gcc_assert (ss != NULL && ss != gfc_ss_terminator);
+ gcc_assert (ss->info->expr == expr && ss->info->type == GFC_SS_CONSTRUCTOR);
gfc_conv_tmp_array_ref (se);
}
@@ -4344,6 +4351,7 @@ gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr)
gfc_se lse;
gfc_ss *rss;
gfc_ss *lss;
+ gfc_array_info *lss_array;
stmtblock_t body;
stmtblock_t block;
gfc_loopinfo loop;
@@ -4367,19 +4375,20 @@ gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr)
/* Create a SS for the destination. */
lss = gfc_get_array_ss (gfc_ss_terminator, NULL, cm->as->rank,
GFC_SS_COMPONENT);
- lss->shape = gfc_get_shape (cm->as->rank);
- lss->data.info.descriptor = dest;
- lss->data.info.data = gfc_conv_array_data (dest);
- lss->data.info.offset = gfc_conv_array_offset (dest);
+ lss_array = &lss->info->data.array;
+ lss_array->shape = gfc_get_shape (cm->as->rank);
+ lss_array->descriptor = dest;
+ lss_array->data = gfc_conv_array_data (dest);
+ lss_array->offset = gfc_conv_array_offset (dest);
for (n = 0; n < cm->as->rank; n++)
{
- lss->data.info.start[n] = gfc_conv_array_lbound (dest, n);
- lss->data.info.stride[n] = gfc_index_one_node;
+ lss_array->start[n] = gfc_conv_array_lbound (dest, n);
+ lss_array->stride[n] = gfc_index_one_node;
- mpz_init (lss->shape[n]);
- mpz_sub (lss->shape[n], cm->as->upper[n]->value.integer,
+ mpz_init (lss_array->shape[n]);
+ mpz_sub (lss_array->shape[n], cm->as->upper[n]->value.integer,
cm->as->lower[n]->value.integer);
- mpz_add_ui (lss->shape[n], lss->shape[n], 1);
+ mpz_add_ui (lss_array->shape[n], lss_array->shape[n], 1);
}
/* Associate the SS with the loop. */
@@ -4422,8 +4431,8 @@ gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr)
gfc_add_block_to_block (&block, &loop.pre);
gfc_add_block_to_block (&block, &loop.post);
- gcc_assert (lss->shape != NULL);
- gfc_free_shape (&lss->shape, cm->as->rank);
+ gcc_assert (lss_array->shape != NULL);
+ gfc_free_shape (&lss_array->shape, cm->as->rank);
gfc_cleanup_loop (&loop);
return gfc_finish_block (&block);
@@ -4819,15 +4828,22 @@ gfc_conv_substring_expr (gfc_se * se, gfc_expr * expr)
void
gfc_conv_expr (gfc_se * se, gfc_expr * expr)
{
- if (se->ss && se->ss->expr == expr
- && (se->ss->type == GFC_SS_SCALAR || se->ss->type == GFC_SS_REFERENCE))
+ gfc_ss *ss;
+
+ ss = se->ss;
+ if (ss && ss->info->expr == expr
+ && (ss->info->type == GFC_SS_SCALAR
+ || ss->info->type == GFC_SS_REFERENCE))
{
+ gfc_ss_info *ss_info;
+
+ ss_info = ss->info;
/* Substitute a scalar expression evaluated outside the scalarization
loop. */
- se->expr = se->ss->data.scalar.expr;
- if (se->ss->type == GFC_SS_REFERENCE)
+ se->expr = ss_info->data.scalar.value;
+ if (ss_info->type == GFC_SS_REFERENCE)
se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
- se->string_length = se->ss->string_length;
+ se->string_length = ss_info->string_length;
gfc_advance_se_ss_chain (se);
return;
}
@@ -4944,10 +4960,12 @@ gfc_conv_expr_type (gfc_se * se, gfc_expr * expr, tree type)
void
gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr)
{
+ gfc_ss *ss;
tree var;
- if (se->ss && se->ss->expr == expr
- && se->ss->type == GFC_SS_REFERENCE)
+ ss = se->ss;
+ if (ss && ss->info->expr == expr
+ && ss->info->type == GFC_SS_REFERENCE)
{
/* Returns a reference to the scalar evaluated outside the loop
for this case. */
@@ -6152,7 +6170,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
/* Find a non-scalar SS from the lhs. */
while (lss_section != gfc_ss_terminator
- && lss_section->type != GFC_SS_SECTION)
+ && lss_section->info->type != GFC_SS_SECTION)
lss_section = lss_section->next;
gcc_assert (lss_section != gfc_ss_terminator);
diff --git a/trans-intrinsic.c b/trans-intrinsic.c
index 95161f8..fcc59d7 100644
--- a/trans-intrinsic.c
+++ b/trans-intrinsic.c
@@ -1004,7 +1004,7 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
gcc_assert (!expr->value.function.actual->next->expr);
gcc_assert (corank > 0);
gcc_assert (se->loop->dimen == 1);
- gcc_assert (se->ss->expr == expr);
+ gcc_assert (se->ss->info->expr == expr);
dim_arg = se->loop->loopvar[0];
dim_arg = fold_build2_loc (input_location, PLUS_EXPR,
@@ -1321,7 +1321,7 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper)
/* Create an implicit second parameter from the loop variable. */
gcc_assert (!arg2->expr);
gcc_assert (se->loop->dimen == 1);
- gcc_assert (se->ss->expr == expr);
+ gcc_assert (se->ss->info->expr == expr);
gfc_advance_se_ss_chain (se);
bound = se->loop->loopvar[0];
bound = fold_build2_loc (input_location, MINUS_EXPR,
@@ -1515,7 +1515,7 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
gcc_assert (!arg2->expr);
gcc_assert (corank > 0);
gcc_assert (se->loop->dimen == 1);
- gcc_assert (se->ss->expr == expr);
+ gcc_assert (se->ss->info->expr == expr);
bound = se->loop->loopvar[0];
bound = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
@@ -2323,7 +2323,7 @@ gfc_conv_intrinsic_funcall (gfc_se * se, gfc_expr * expr)
gfc_symbol *sym;
VEC(tree,gc) *append_args;
- gcc_assert (!se->ss || se->ss->expr == expr);
+ gcc_assert (!se->ss || se->ss->info->expr == expr);
if (se->ss)
gcc_assert (expr->rank > 0);
@@ -5269,14 +5269,14 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr)
gfc_actual_arglist *arg;
gfc_se argse;
gfc_ss *ss;
- gfc_ss_info *info;
+ gfc_array_info *info;
stmtblock_t block;
int n;
bool scalar_mold;
info = NULL;
if (se->loop)
- info = &se->ss->data.info;
+ info = &se->ss->info->data.array;
/* Convert SOURCE. The output from this stage is:-
source_bytes = length of the source in bytes
@@ -6634,7 +6634,7 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
break;
case GFC_ISYM_TRANSFER:
- if (se->ss && se->ss->useflags)
+ if (se->ss && se->ss->info->useflags)
/* Access the previously obtained result. */
gfc_conv_tmp_array_ref (se);
else
@@ -6753,19 +6753,17 @@ walk_inline_intrinsic_transpose (gfc_ss *ss, gfc_expr *expr)
for (tmp_ss = arg_ss; ; tmp_ss = tmp_ss->next)
{
- if (tmp_ss->type != GFC_SS_SCALAR
- && tmp_ss->type != GFC_SS_REFERENCE)
+ if (tmp_ss->info->type != GFC_SS_SCALAR
+ && tmp_ss->info->type != GFC_SS_REFERENCE)
{
int tmp_dim;
- gfc_ss_info *info;
- info = &tmp_ss->data.info;
- gcc_assert (info->dimen == 2);
+ gcc_assert (tmp_ss->dimen == 2);
/* We just invert dimensions. */
- tmp_dim = info->dim[0];
- info->dim[0] = info->dim[1];
- info->dim[1] = tmp_dim;
+ tmp_dim = tmp_ss->dim[0];
+ tmp_ss->dim[0] = tmp_ss->dim[1];
+ tmp_ss->dim[1] = tmp_dim;
}
/* Stop when tmp_ss points to the last valid element of the chain... */
@@ -6802,7 +6800,7 @@ walk_inline_intrinsic_function (gfc_ss * ss, gfc_expr * expr)
void
gfc_add_intrinsic_ss_code (gfc_loopinfo * loop ATTRIBUTE_UNUSED, gfc_ss * ss)
{
- switch (ss->expr->value.function.isym->id)
+ switch (ss->info->expr->value.function.isym->id)
{
case GFC_ISYM_UBOUND:
case GFC_ISYM_LBOUND:
diff --git a/trans-io.c b/trans-io.c
index bbf5a02..12dfcf8 100644
--- a/trans-io.c
+++ b/trans-io.c
@@ -1937,6 +1937,7 @@ transfer_array_component (tree expr, gfc_component * cm, locus * where)
int n;
gfc_ss *ss;
gfc_se se;
+ gfc_array_info *ss_array;
gfc_start_block (&block);
gfc_init_se (&se, NULL);
@@ -1948,19 +1949,20 @@ transfer_array_component (tree expr, gfc_component * cm, locus * where)
ss = gfc_get_array_ss (gfc_ss_terminator, NULL, cm->as->rank,
GFC_SS_COMPONENT);
- ss->shape = gfc_get_shape (cm->as->rank);
- ss->data.info.descriptor = expr;
- ss->data.info.data = gfc_conv_array_data (expr);
- ss->data.info.offset = gfc_conv_array_offset (expr);
+ ss_array = &ss->info->data.array;
+ ss_array->shape = gfc_get_shape (cm->as->rank);
+ ss_array->descriptor = expr;
+ ss_array->data = gfc_conv_array_data (expr);
+ ss_array->offset = gfc_conv_array_offset (expr);
for (n = 0; n < cm->as->rank; n++)
{
- ss->data.info.start[n] = gfc_conv_array_lbound (expr, n);
- ss->data.info.stride[n] = gfc_index_one_node;
+ ss_array->start[n] = gfc_conv_array_lbound (expr, n);
+ ss_array->stride[n] = gfc_index_one_node;
- mpz_init (ss->shape[n]);
- mpz_sub (ss->shape[n], cm->as->upper[n]->value.integer,
+ mpz_init (ss_array->shape[n]);
+ mpz_sub (ss_array->shape[n], cm->as->upper[n]->value.integer,
cm->as->lower[n]->value.integer);
- mpz_add_ui (ss->shape[n], ss->shape[n], 1);
+ mpz_add_ui (ss_array->shape[n], ss_array->shape[n], 1);
}
/* Once we got ss, we use scalarizer to create the loop. */
@@ -1995,8 +1997,8 @@ transfer_array_component (tree expr, gfc_component * cm, locus * where)
gfc_add_block_to_block (&block, &loop.pre);
gfc_add_block_to_block (&block, &loop.post);
- gcc_assert (ss->shape != NULL);
- gfc_free_shape (&ss->shape, cm->as->rank);
+ gcc_assert (ss_array->shape != NULL);
+ gfc_free_shape (&ss_array->shape, cm->as->rank);
gfc_cleanup_loop (&loop);
return gfc_finish_block (&block);
diff --git a/trans-stmt.c b/trans-stmt.c
index c7ae360..86a56e8 100644
--- a/trans-stmt.c
+++ b/trans-stmt.c
@@ -193,7 +193,7 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
gfc_loopinfo tmp_loop;
gfc_se parmse;
gfc_ss *ss;
- gfc_ss_info *info;
+ gfc_array_info *info;
gfc_symbol *fsym;
gfc_ref *ref;
int n;
@@ -220,9 +220,9 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
info = NULL;
for (ss = loopse->ss; ss && ss != gfc_ss_terminator; ss = ss->next)
{
- if (ss->expr != e)
+ if (ss->info->expr != e)
continue;
- info = &ss->data.info;
+ info = &ss->info->data.array;
break;
}
@@ -241,8 +241,8 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
/* Make a local loopinfo for the temporary creation, so that
none of the other ss->info's have to be renormalized. */
gfc_init_loopinfo (&tmp_loop);
- tmp_loop.dimen = info->dimen;
- for (n = 0; n < info->dimen; n++)
+ tmp_loop.dimen = ss->dimen;
+ for (n = 0; n < ss->dimen; n++)
{
tmp_loop.to[n] = loopse->loop->to[n];
tmp_loop.from[n] = loopse->loop->from[n];
@@ -320,7 +320,7 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
/* Calculate the offset for the temporary. */
offset = gfc_index_zero_node;
- for (n = 0; n < info->dimen; n++)
+ for (n = 0; n < ss->dimen; n++)
{
tmp = gfc_conv_descriptor_stride_get (info->descriptor,
gfc_rank_cst[n]);
@@ -3306,7 +3306,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
gfc_ss *lss, *rss;
gfc_se lse;
gfc_se rse;
- gfc_ss_info *info;
+ gfc_array_info *info;
gfc_loopinfo loop;
tree desc;
tree parm;
@@ -3388,7 +3388,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
gfc_conv_loop_setup (&loop, &expr2->where);
- info = &rss->data.info;
+ info = &rss->info->data.array;
desc = info->descriptor;
/* Make a new descriptor. */
@@ -4048,7 +4048,7 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2,
/* Find a non-scalar SS from the lhs. */
while (lss_section != gfc_ss_terminator
- && lss_section->type != GFC_SS_SECTION)
+ && lss_section->info->type != GFC_SS_SECTION)
lss_section = lss_section->next;
gcc_assert (lss_section != gfc_ss_terminator);
@@ -4062,7 +4062,7 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2,
{
/* The rhs is scalar. Add a ss for the expression. */
rss = gfc_get_scalar_ss (gfc_ss_terminator, expr2);
- rss->where = 1;
+ rss->info->where = 1;
}
/* Associate the SS with the loop. */
@@ -4501,7 +4501,7 @@ gfc_trans_where_3 (gfc_code * cblock, gfc_code * eblock)
if (tsss == gfc_ss_terminator)
{
tsss = gfc_get_scalar_ss (gfc_ss_terminator, tsrc);
- tsss->where = 1;
+ tsss->info->where = 1;
}
gfc_add_ss_to_loop (&loop, tdss);
gfc_add_ss_to_loop (&loop, tsss);
@@ -4516,7 +4516,7 @@ gfc_trans_where_3 (gfc_code * cblock, gfc_code * eblock)
if (esss == gfc_ss_terminator)
{
esss = gfc_get_scalar_ss (gfc_ss_terminator, esrc);
- esss->where = 1;
+ esss->info->where = 1;
}
gfc_add_ss_to_loop (&loop, edss);
gfc_add_ss_to_loop (&loop, esss);
diff --git a/trans.h b/trans.h
index 535c207..c35b1ae 100644
--- a/trans.h
+++ b/trans.h
@@ -108,17 +108,13 @@ typedef enum
gfc_coarray_type;
-/* Scalarization State chain. Created by walking an expression tree before
- creating the scalarization loops. Then passed as part of a gfc_se structure
- to translate the expression inside the loop. Note that these chains are
- terminated by gfc_se_terminator, not NULL. A NULL pointer in a gfc_se
- indicates to gfc_conv_* that this is a scalar expression.
- Note that some member arrays correspond to scalarizer rank and others
- are the variable rank. */
+/* The array-specific scalarization informations. The array members of
+ this struct are indexed by actual array index, and thus can be sparse. */
-typedef struct gfc_ss_info
+typedef struct gfc_array_info
{
- int dimen;
+ mpz_t *shape;
+
/* The ref that holds information on this section. */
gfc_ref *ref;
/* The descriptor of this array. */
@@ -139,12 +135,8 @@ typedef struct gfc_ss_info
tree end[GFC_MAX_DIMENSIONS];
tree stride[GFC_MAX_DIMENSIONS];
tree delta[GFC_MAX_DIMENSIONS];
-
- /* Translation from loop dimensions to actual dimensions.
- actual_dim = dim[loop_dim] */
- int dim[GFC_MAX_DIMENSIONS];
}
-gfc_ss_info;
+gfc_array_info;
typedef enum
{
@@ -190,47 +182,70 @@ typedef enum
}
gfc_ss_type;
-/* SS structures can only belong to a single loopinfo. They must be added
- otherwise they will not get freed. */
-typedef struct gfc_ss
+
+typedef struct gfc_ss_info
{
gfc_ss_type type;
gfc_expr *expr;
- mpz_t *shape;
tree string_length;
+
union
{
/* If type is GFC_SS_SCALAR or GFC_SS_REFERENCE. */
struct
{
- tree expr;
+ tree value;
}
scalar;
/* GFC_SS_TEMP. */
struct
{
- /* The rank of the temporary. May be less than the rank of the
- assigned expression. */
- int dimen;
tree type;
}
temp;
+
/* All other types. */
- gfc_ss_info info;
+ gfc_array_info array;
}
data;
+ /* This is used by assignments requiring temporaries. The bits specify which
+ loops the terms appear in. This will be 1 for the RHS expressions,
+ 2 for the LHS expressions, and 3(=1|2) for the temporary. */
+ unsigned useflags:2;
+
+ /* Suppresses precalculation of scalars in WHERE assignments. */
+ unsigned where:1;
+}
+gfc_ss_info;
+
+#define gfc_get_ss_info() XCNEW (gfc_ss_info)
+
+
+/* Scalarization State chain. Created by walking an expression tree before
+ creating the scalarization loops. Then passed as part of a gfc_se structure
+ to translate the expression inside the loop. Note that these chains are
+ terminated by gfc_ss_terminator, not NULL. A NULL pointer in a gfc_se
+ indicates to gfc_conv_* that this is a scalar expression.
+ SS structures can only belong to a single loopinfo. They must be added
+ otherwise they will not get freed. */
+
+typedef struct gfc_ss
+{
+ gfc_ss_info *info;
+
+ int dimen;
+ /* Translation from loop dimensions to actual array dimensions.
+ actual_dim = dim[loop_dim] */
+ int dim[GFC_MAX_DIMENSIONS];
+
/* All the SS in a loop and linked through loop_chain. The SS for an
expression are linked by the next pointer. */
struct gfc_ss *loop_chain;
struct gfc_ss *next;
- /* This is used by assignments requiring temporaries. The bits specify which
- loops the terms appear in. This will be 1 for the RHS expressions,
- 2 for the LHS expressions, and 3(=1|2) for the temporary. The bit
- 'where' suppresses precalculation of scalars in WHERE assignments. */
- unsigned useflags:2, where:1, is_alloc_lhs:1;
+ unsigned is_alloc_lhs:1;
}
gfc_ss;
#define gfc_get_ss() XCNEW (gfc_ss)
- Follow-Ups:
- [Patch, fortran] [20/66] inline sum and product: Update core structs: Rename gfc_ss_info.
- [Patch, fortran] [21/66] inline sum and product: Update core structs: Move dim and dimen.
- [Patch, fortran] [22/66] inline sum and product: Update core structs: Move shape.
- [Patch, fortran] [23/66] inline sum and product: Update core structs: Move type.
- [Patch, fortran] [25/66] inline sum and product: Update core structs: Move string_length.
- [Patch, fortran] [26/66] inline sum and product: Update core structs: Move scalar struct.
- [Patch, fortran] [27/66] inline sum and product: Update core structs: Move temp struct.
- [Patch, fortran] [29/66] inline sum and product: Update core structs: Move useflags flag.
- [Patch, fortran] [24/66] inline sum and product: Update core structs: Move expr.
- [Patch, fortran] [28/66] inline sum and product: Update core structs: Move info struct.
- [Patch, fortran] [30/66] inline sum and product: Update core structs: Move where flag.