* [Patch, fortran] [06/66] inline sum and product: Prepare gfc_trans_preloop_setup
2011-10-27 23:36 ` [Patch, fortran] [01..06/66] inline sum and product: Prepare gfc_trans_preloop_setup Mikael Morin
2011-10-27 23:30 ` [Patch, fortran] [01/66] " Mikael Morin
@ 2011-10-27 23:30 ` Mikael Morin
2011-10-30 9:52 ` Paul Richard Thomas
2011-10-27 23:31 ` [Patch, fortran] [03/66] " Mikael Morin
` (3 subsequent siblings)
5 siblings, 1 reply; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:30 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 0 bytes --]
[-- Attachment #2: pr43829-6.CL --]
[-- Type: text/plain, Size: 160 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (gfc_trans_preloop_setup): Move common code...
(add_array_offset): ...into that new function.
[-- Attachment #3: pr43829-6.patch --]
[-- Type: text/x-diff, Size: 2861 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 476978e..f615e4e 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -2830,6 +2830,34 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
}
+/* 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_ss_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 = gfc_conv_array_index_offset (&se, info, 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. */
@@ -2837,11 +2865,9 @@ static void
gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
stmtblock_t * pblock)
{
- tree index;
tree stride;
gfc_ss_info *info;
gfc_ss *ss;
- gfc_se se;
gfc_array_ref *ar;
int i;
@@ -2896,36 +2922,13 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
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, info->dim[i], i);
/* Remember this offset for the second loop. */
if (dim == loop->temp_dim - 1)
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [01/66] inline sum and product: Prepare gfc_trans_preloop_setup
2011-10-27 23:36 ` [Patch, fortran] [01..06/66] inline sum and product: Prepare gfc_trans_preloop_setup Mikael Morin
@ 2011-10-27 23:30 ` Mikael Morin
2011-10-27 23:30 ` [Patch, fortran] [06/66] " Mikael Morin
` (4 subsequent siblings)
5 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:30 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 0 bytes --]
[-- Attachment #2: pr43829-1.CL --]
[-- Type: text/plain, Size: 174 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (gfc_trans_preloop_setup): Move array reference
initialisation earlier. Factor subsequent array references.
[-- Attachment #3: pr43829-1.patch --]
[-- Type: text/x-diff, Size: 2003 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 3472804..4b21476 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -2842,6 +2842,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
gfc_ss_info *info;
gfc_ss *ss;
gfc_se se;
+ gfc_array_ref *ar;
int i;
/* This code will be executed before entering the scalarization loop
@@ -2861,6 +2862,18 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
if (dim >= info->dimen)
continue;
+ if (info->ref)
+ {
+ ar = &info->ref->u.ar;
+ i = loop->order[dim + 1];
+ }
+ else
+ {
+ ar = NULL;
+ i = dim + 1;
+ }
+
+
if (dim == info->dimen - 1)
{
/* For the outermost loop calculate the offset due to any
@@ -2868,9 +2881,9 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
base offset of the array. */
if (info->ref)
{
- for (i = 0; i < info->ref->u.ar.dimen; i++)
+ for (i = 0; i < ar->dimen; i++)
{
- if (info->ref->u.ar.dimen_type[i] != DIMEN_ELEMENT)
+ if (ar->dimen_type[i] != DIMEN_ELEMENT)
continue;
gfc_init_se (&se, NULL);
@@ -2878,8 +2891,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
se.expr = info->descriptor;
stride = gfc_conv_array_stride (info->descriptor, i);
index = gfc_conv_array_index_offset (&se, info, i, -1,
- &info->ref->u.ar,
- stride);
+ ar, stride);
gfc_add_block_to_block (pblock, &se.pre);
info->offset = fold_build2_loc (input_location, PLUS_EXPR,
@@ -2903,19 +2915,6 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
else
{
/* Add the offset for the previous loop dimension. */
- gfc_array_ref *ar;
-
- if (info->ref)
- {
- ar = &info->ref->u.ar;
- i = loop->order[dim + 1];
- }
- else
- {
- ar = NULL;
- i = dim + 1;
- }
-
gfc_init_se (&se, NULL);
se.loop = loop;
se.expr = info->descriptor;
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [03/66] inline sum and product: Prepare gfc_trans_preloop_setup
2011-10-27 23:36 ` [Patch, fortran] [01..06/66] inline sum and product: Prepare gfc_trans_preloop_setup Mikael Morin
2011-10-27 23:30 ` [Patch, fortran] [01/66] " Mikael Morin
2011-10-27 23:30 ` [Patch, fortran] [06/66] " Mikael Morin
@ 2011-10-27 23:31 ` Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [05/66] " Mikael Morin
` (2 subsequent siblings)
5 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:31 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 0 bytes --]
[-- Attachment #2: pr43829-3.CL --]
[-- Type: text/plain, Size: 127 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (gfc_trans_preloop_setup): Factor loop index
initialization.
[-- Attachment #3: pr43829-3.patch --]
[-- Type: text/x-diff, Size: 589 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 91359e9..e3134f5 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -2863,16 +2863,15 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
continue;
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;
+
+ i = dim + 1;
+ /* For the time being, there is no loop reordering. */
+ gcc_assert (i == loop->order[i]);
+ i = loop->order[i];
if (dim == info->dimen - 1)
{
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [10/66] inline sum and product: Preliminary cleanups: Use array's instead of loop's dimensions.
2011-10-27 23:35 ` [Patch, fortran] [07..12/66] inline sum and product: Preliminary cleanups Mikael Morin
2011-10-27 23:31 ` [Patch, fortran] [07/66] inline sum and product: Preliminary cleanups: Useless coarray code removal Mikael Morin
@ 2011-10-27 23:31 ` Mikael Morin
2011-10-27 23:32 ` [Patch, fortran] [08/66] inline sum and product: Preliminary cleanups: Remove redundant condition Mikael Morin
` (3 subsequent siblings)
5 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:31 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 0 bytes --]
[-- Attachment #2: pr43829-10.CL --]
[-- Type: text/plain, Size: 164 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (gfc_conv_ss_startstride): Access array bounds along
array dimensions instead of loop dimensions.
[-- Attachment #3: pr43829-10.patch --]
[-- Type: text/x-diff, Size: 613 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 8359af2..f4d8a85 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -3347,9 +3347,11 @@ done:
case GFC_SS_FUNCTION:
for (n = 0; n < ss->data.info.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->data.info.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;
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [14/66] inline sum and product: Interfaces changes: gfc_trans_array_bound_check, gfc_conv_array_index_offset
2011-10-28 0:02 ` [Patch, fortran] [13..19/66] inline sum and product: Interfaces changes Mikael Morin
@ 2011-10-27 23:31 ` Mikael Morin
2011-10-27 23:32 ` [Patch, fortran] [17/66] inline sum and product: Interfaces changes: gfc_set_vector_loop_bounds Mikael Morin
` (5 subsequent siblings)
6 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:31 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 331 bytes --]
The next patch is going to need array expression (available through gf_ss)
instead of just the array descriptor in gfc_trans_array_bound_check. This makes
the gfc_ss struct available as argument.
This requires an update of gfc_conv_array_index_offset too.
Both functions are static, they lose their gfc_ prefix along the way.
OK?
[-- Attachment #2: pr43829-14.CL --]
[-- Type: text/plain, Size: 520 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (gfc_trans_array_bound_check,
trans_array_bound_check): Rename the former to the latter.
Replace descriptor argument with ss argument. Get descriptor from ss.
(gfc_conv_array_index_offset, conv_array_index_offset): Rename the
former to the latter. Update call to trans_array_bound_check.
Replace info argument with ss argument. Get info from ss.
(gfc_conv_scalarized_array_ref): Update call to conv_array_index_offset.
(add_array_offset): Ditto
[-- Attachment #3: pr43829-14.patch --]
[-- Type: text/x-diff, Size: 3374 bytes --]
diff --git a/trans-array.c b/trans-array.c
index c39fc9e..45bf683 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -2426,17 +2426,20 @@ gfc_conv_array_ubound (tree descriptor, int dim)
/* 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. */
@@ -2521,13 +2524,16 @@ gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n,
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_ss_info *info;
tree index;
tree desc;
tree data;
+ info = &ss->data.info;
+
/* Get the index into the array for this dimension. */
if (ar)
{
@@ -2544,10 +2550,9 @@ gfc_conv_array_index_offset (gfc_se * se, gfc_ss_info * info, int dim, int i,
/* We've already translated this value outside the loop. */
index = info->subscript[dim]->data.scalar.expr;
- index = gfc_trans_array_bound_check (se, info->descriptor,
- index, dim, &ar->where,
- ar->as->type != AS_ASSUMED_SIZE
- || dim < ar->dimen - 1);
+ index = trans_array_bound_check (se, ss, index, dim, &ar->where,
+ ar->as->type != AS_ASSUMED_SIZE
+ || dim < ar->dimen - 1);
break;
case DIMEN_VECTOR:
@@ -2574,10 +2579,9 @@ gfc_conv_array_index_offset (gfc_se * se, gfc_ss_info * info, int dim, int i,
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:
@@ -2648,7 +2652,7 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar)
else
n = 0;
- index = gfc_conv_array_index_offset (se, info, info->dim[n], n, ar,
+ index = conv_array_index_offset (se, se->ss, info->dim[n], n, ar,
info->stride0);
/* Add the offset for this dimension to the stored offset for all other
dimensions. */
@@ -2843,8 +2847,7 @@ add_array_offset (stmtblock_t *pblock, gfc_loopinfo *loop, gfc_ss *ss,
se.loop = loop;
se.expr = info->descriptor;
stride = gfc_conv_array_stride (info->descriptor, array_dim);
- index = gfc_conv_array_index_offset (&se, info, array_dim, loop_dim, ar,
- stride);
+ 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,
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [07/66] inline sum and product: Preliminary cleanups: Useless coarray code removal.
2011-10-27 23:35 ` [Patch, fortran] [07..12/66] inline sum and product: Preliminary cleanups Mikael Morin
@ 2011-10-27 23:31 ` Mikael Morin
2011-10-27 23:31 ` [Patch, fortran] [10/66] inline sum and product: Preliminary cleanups: Use array's instead of loop's dimensions Mikael Morin
` (4 subsequent siblings)
5 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:31 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 295 bytes --]
This is a followup to my recent coarray/scalarizer changes, especially that one
cleaning-up gfc_walk_variable_expr/gfc_walk_array_ref:
http://gcc.gnu.org/ml/fortran/2011-09/msg00072.html
Scalar coarrays are not handled as AR_ELEMENT in the scalarizer.
Thus, no need to handle coarrays here.
OK?
[-- Attachment #2: pr43829-7.CL --]
[-- Type: text/plain, Size: 112 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (gfc_walk_array_ref): Skip coarray dimensions.
[-- Attachment #3: pr43829-7.patch --]
[-- Type: text/x-diff, Size: 406 bytes --]
diff --git a/trans-array.c b/trans-array.c
index f615e4e..83fa7b6 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -7637,7 +7637,7 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref)
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;
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [25/66] inline sum and product: Update core structs: Move string_length.
2011-10-27 23:32 ` [Patch, fortran] [20..30/66] inline sum and product: Update core structs Mikael Morin
2011-10-27 23:32 ` [Patch, fortran] [20/66] inline sum and product: Update core structs: Rename gfc_ss_info Mikael Morin
@ 2011-10-27 23:32 ` Mikael Morin
2011-10-27 23:32 ` [Patch, fortran] [29/66] inline sum and product: Update core structs: Move useflags flag Mikael Morin
` (8 subsequent siblings)
10 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:32 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 63 bytes --]
This moves string_length field from gfc_ss to gfc_ss_info.
OK?
[-- Attachment #2: pr43829-25.CL --]
[-- Type: text/plain, Size: 603 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans.h (struct gfc_ss, struct gfc_ss_info): Move field
string_length from the former struct to the latter.
* trans-array.c
(gfc_get_temp_ss, gfc_trans_array_constructor, gfc_add_loop_ss_code,
gfc_conv_ss_descriptor, gfc_conv_scalarized_array_ref,
gfc_conv_resolve_dependencies, gfc_conv_loop_setup,
gfc_conv_expr_descriptor): Update references to string_length and
factor common reference chains where possible.
* trans-const.c (gfc_conv_constant): Ditto.
* trans-expr.c (gfc_conv_variable, gfc_conv_subref_array_arg,
gfc_conv_expr): Ditto.
[-- Attachment #3: pr43829-25.patch --]
[-- Type: text/x-diff, Size: 8787 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 65f7ade..827d13d 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -557,11 +557,11 @@ gfc_get_temp_ss (tree type, tree string_length, int dimen)
ss_info = gfc_get_ss_info ();
ss_info->type = GFC_SS_TEMP;
+ ss_info->string_length = string_length;
ss = gfc_get_ss ();
ss->info = ss_info;
ss->next = gfc_ss_terminator;
- ss->string_length = string_length;
ss->data.temp.type = type;
ss->dimen = dimen;
for (i = 0; i < ss->dimen; i++)
@@ -1953,6 +1953,7 @@ 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. */
@@ -1960,7 +1961,8 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
old_first_len_val = first_len_val;
old_typespec_chararray_ctor = typespec_chararray_ctor;
- expr = ss->info->expr;
+ 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. */
@@ -1993,21 +1995,21 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
gfc_init_se (&length_se, NULL);
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);
- 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 (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);
}
@@ -2207,7 +2209,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
gfc_add_block_to_block (&loop->post, &se.post);
ss->data.scalar.expr = se.expr;
- ss->string_length = se.string_length;
+ ss_info->string_length = se.string_length;
break;
case GFC_SS_REFERENCE:
@@ -2219,7 +2221,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
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->string_length = se.string_length;
break;
case GFC_SS_SECTION:
@@ -2254,19 +2256,19 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
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 (expr->ts.type == BT_CHARACTER
- && ss->string_length == NULL
+ && ss_info->string_length == NULL
&& expr->ts.u.cl
&& expr->ts.u.cl->length)
{
gfc_init_se (&se, NULL);
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);
}
@@ -2304,7 +2306,7 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base)
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)
{
@@ -2697,7 +2699,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);
}
@@ -3899,7 +3901,7 @@ temporary:
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);
}
@@ -4124,11 +4126,11 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
gcc_assert (tmp_ss_info->type == GFC_SS_TEMP);
/* Make absolutely sure that this is a complete type. */
- if (loop->temp_ss->string_length)
+ if (tmp_ss_info->string_length)
loop->temp_ss->data.temp.type
= gfc_get_character_type_len_for_eltype
(TREE_TYPE (loop->temp_ss->data.temp.type),
- loop->temp_ss->string_length);
+ tmp_ss_info->string_length);
tmp = loop->temp_ss->data.temp.type;
memset (&loop->temp_ss->data.info, 0, sizeof (gfc_array_info));
@@ -5973,7 +5975,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
: NULL),
loop.dimen);
- se->string_length = loop.temp_ss->string_length;
+ se->string_length = loop.temp_ss->info->string_length;
gcc_assert (loop.temp_ss->dimen == loop.dimen);
gfc_add_ss_to_loop (&loop, loop.temp_ss);
}
@@ -6030,7 +6032,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
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
{
diff --git a/trans-const.c b/trans-const.c
index 0cf2719..35a5e68 100644
--- a/trans-const.c
+++ b/trans-const.c
@@ -393,7 +393,7 @@ gfc_conv_constant (gfc_se * se, gfc_expr * expr)
gcc_assert (ss_info->expr == expr);
se->expr = se->ss->data.scalar.expr;
- se->string_length = se->ss->string_length;
+ 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 2e620ad..87734f1 100644
--- a/trans-expr.c
+++ b/trans-expr.c
@@ -626,13 +626,15 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
ss = se->ss;
if (ss != NULL)
{
+ gfc_ss_info *ss_info = ss->info;
+
/* Check that something hasn't gone horribly wrong. */
gcc_assert (ss != gfc_ss_terminator);
- gcc_assert (ss->info->expr == expr);
+ 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;
+ se->string_length = ss_info->string_length;
for (ref = se->ss->data.info.ref; ref; ref = ref->next)
if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT)
break;
@@ -2402,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);
@@ -4833,12 +4835,15 @@ gfc_conv_expr (gfc_se * se, gfc_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 (ss->info->type == GFC_SS_REFERENCE)
+ 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;
}
diff --git a/trans.h b/trans.h
index 5922360..f1b109a 100644
--- a/trans.h
+++ b/trans.h
@@ -187,6 +187,7 @@ typedef struct gfc_ss_info
{
gfc_ss_type type;
gfc_expr *expr;
+ tree string_length;
}
gfc_ss_info;
@@ -205,7 +206,6 @@ typedef struct gfc_ss
{
gfc_ss_info *info;
- tree string_length;
union
{
/* If type is GFC_SS_SCALAR or GFC_SS_REFERENCE. */
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [12/66] inline sum and product: Preliminary cleanups: Stop loop before end marker.
2011-10-27 23:35 ` [Patch, fortran] [07..12/66] inline sum and product: Preliminary cleanups Mikael Morin
` (2 preceding siblings ...)
2011-10-27 23:32 ` [Patch, fortran] [08/66] inline sum and product: Preliminary cleanups: Remove redundant condition Mikael Morin
@ 2011-10-27 23:32 ` Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [09/66] inline sum and product: Preliminary cleanups: Assertify condition Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [11/66] inline sum and product: Preliminary cleanups: Skip temporary case Mikael Morin
5 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:32 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 257 bytes --]
We should not be writing to gfc_ss_terminator.
It is working without this patch because gfc_ss_terminator's next pointer is
NULL, so the loop stops just after it, and because we are writing zero to
gfc_ss_terminator, but it is already all zeros anyway.
OK?
[-- Attachment #2: pr43829-12.CL --]
[-- Type: text/plain, Size: 140 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (gfc_trans_scalarizing_loops): Stop loop before end
marker, not after it.
[-- Attachment #3: pr43829-12.patch --]
[-- Type: text/x-diff, Size: 432 bytes --]
diff --git a/trans-array.c b/trans-array.c
index cfbe909..f611302 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -3114,7 +3114,7 @@ gfc_trans_scalarizing_loops (gfc_loopinfo * loop, stmtblock_t * body)
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;
}
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [15/66] inline sum and product: Interfaces changes: obtain name more simply
2011-10-28 0:02 ` [Patch, fortran] [13..19/66] inline sum and product: Interfaces changes Mikael Morin
2011-10-27 23:31 ` [Patch, fortran] [14/66] inline sum and product: Interfaces changes: gfc_trans_array_bound_check, gfc_conv_array_index_offset Mikael Morin
2011-10-27 23:32 ` [Patch, fortran] [17/66] inline sum and product: Interfaces changes: gfc_set_vector_loop_bounds Mikael Morin
@ 2011-10-27 23:32 ` Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [13/66] inline sum and product: Interfaces changes: gfc_trans_array_constructor Mikael Morin
` (3 subsequent siblings)
6 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:32 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 132 bytes --]
This is a follow-up to the previous patch. It symplifies name obtention
so that later we can change structs with less pain. :-)
OK?
[-- Attachment #2: pr43829-15.CL --]
[-- Type: text/plain, Size: 126 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (gfc_trans_array_bound_check): Use ss argument
to get name.
[-- Attachment #3: pr43829-15.patch --]
[-- Type: text/x-diff, Size: 1277 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 45bf683..d8f5448 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -2443,28 +2443,8 @@ trans_array_bound_check (gfc_se * se, gfc_ss *ss, tree index, int n,
index = gfc_evaluate_now (index, &se->pre);
/* We find a name for the error message. */
- if (se->ss)
- name = se->ss->expr->symtree->name;
-
- if (!name && se->loop && se->loop->ss && se->loop->ss->expr
- && se->loop->ss->expr->symtree)
- name = se->loop->ss->expr->symtree->name;
-
- if (!name && se->loop && se->loop->ss && se->loop->ss->loop_chain
- && se->loop->ss->loop_chain->expr
- && se->loop->ss->loop_chain->expr->symtree)
- name = se->loop->ss->loop_chain->expr->symtree->name;
-
- if (!name && se->loop && se->loop->ss && se->loop->ss->expr)
- {
- if (se->loop->ss->expr->expr_type == EXPR_FUNCTION
- && se->loop->ss->expr->value.function.name)
- name = se->loop->ss->expr->value.function.name;
- else
- if (se->loop->ss->type == GFC_SS_CONSTRUCTOR
- || se->loop->ss->type == GFC_SS_SCALAR)
- name = "unnamed constant";
- }
+ name = ss->expr->symtree->n.sym->name;
+ gcc_assert (name != NULL);
if (TREE_CODE (descriptor) == VAR_DECL)
name = IDENTIFIER_POINTER (DECL_NAME (descriptor));
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [17/66] inline sum and product: Interfaces changes: gfc_set_vector_loop_bounds
2011-10-28 0:02 ` [Patch, fortran] [13..19/66] inline sum and product: Interfaces changes Mikael Morin
2011-10-27 23:31 ` [Patch, fortran] [14/66] inline sum and product: Interfaces changes: gfc_trans_array_bound_check, gfc_conv_array_index_offset Mikael Morin
@ 2011-10-27 23:32 ` Mikael Morin
2011-10-27 23:32 ` [Patch, fortran] [15/66] inline sum and product: Interfaces changes: obtain name more simply Mikael Morin
` (4 subsequent siblings)
6 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:32 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 151 bytes --]
Same as previous patch, gfc_set_vector_loop_bounds uses dimensions, and thus
needs a gfc_ss struct as argument.
gfc_ prefix removed along the way.
OK?
[-- Attachment #2: pr43829-17.CL --]
[-- Type: text/plain, Size: 267 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (gfc_set_vector_loop_bounds, set_vector_loop_bounds):
Rename the former to the latter. Change type and name of argument.
Get previous argument from the new one.
(gfc_add_loop_ss_code): Update call.
[-- Attachment #3: pr43829-17.patch --]
[-- Type: text/x-diff, Size: 900 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 0e7c1c1..6af4fd6 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -2094,8 +2094,9 @@ finish:
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_ss_info *info;
gfc_se se;
tree tmp;
tree desc;
@@ -2103,6 +2104,8 @@ gfc_set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss_info * info)
int n;
int dim;
+ info = &ss->data.info;
+
for (n = 0; n < loop->dimen; n++)
{
dim = info->dim[n];
@@ -2194,7 +2197,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
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:
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [20/66] inline sum and product: Update core structs: Rename gfc_ss_info.
2011-10-27 23:32 ` [Patch, fortran] [20..30/66] inline sum and product: Update core structs Mikael Morin
@ 2011-10-27 23:32 ` Mikael Morin
2011-10-27 23:32 ` [Patch, fortran] [25/66] inline sum and product: Update core structs: Move string_length Mikael Morin
` (9 subsequent siblings)
10 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:32 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 48 bytes --]
This renames gfc_ss_info to gfc_array_info.
OK?
[-- Attachment #2: pr43829-20.CL --]
[-- Type: text/plain, Size: 834 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans.h (struct gfc_ss_info, struct gfc_array_info):
Rename the former to the latter.
* trans-array.c (gfc_get_array_ss, gfc_trans_allocate_array_storage,
get_array_ref_dim, gfc_trans_create_temp_array,
gfc_trans_constant_array_constructor, gfc_set_vector_loop_bounds,
gfc_conv_array_index_offset, gfc_conv_scalarized_array_ref,
add_array_offset, gfc_trans_preloop_setup, gfc_conv_section_startstride,
gfc_conv_ss_startstride, gfc_conv_loop_setup, transposed_dims,
gfc_conv_expr_descriptor): Update all uses.
* trans-expr.c (gfc_conv_subref_array_arg, gfc_conv_procedure_call):
Ditto.
* trans-intrinsic.c (gfc_conv_intrinsic_transfer,
walk_inline_intrinsic_transpose): Ditto.
* trans-stmt.c (gfc_conv_elemental_dependencies,
gfc_trans_pointer_assign_need_temp): Ditto.
[-- Attachment #3: pr43829-20.patch --]
[-- Type: text/x-diff, Size: 7910 bytes --]
diff --git a/trans-array.c b/trans-array.c
index dc4dccd..2e1a8d4 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -517,7 +517,7 @@ 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_array_info *info;
int i;
ss = gfc_get_ss ();
@@ -685,7 +685,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,7 +810,7 @@ static int
get_array_ref_dim (gfc_ss *ss, int loop_dim)
{
int n, array_dim, array_ref_dim;
- gfc_ss_info *info;
+ gfc_array_info *info;
info = &ss->data.info;
@@ -845,7 +845,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;
@@ -1857,7 +1857,7 @@ 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;
@@ -2099,7 +2099,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;
@@ -2516,7 +2516,7 @@ 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;
@@ -2629,7 +2629,7 @@ 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;
@@ -2827,7 +2827,7 @@ 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;
@@ -2854,7 +2854,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
stmtblock_t * pblock)
{
tree stride;
- gfc_ss_info *info;
+ gfc_array_info *info;
gfc_ss *ss;
gfc_array_ref *ar;
int i;
@@ -3205,7 +3205,7 @@ 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);
@@ -3356,7 +3356,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;
@@ -3851,8 +3851,8 @@ void
gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
{
int n, dim, spec_dim;
- gfc_ss_info *info;
- gfc_ss_info *specinfo;
+ gfc_array_info *info;
+ gfc_array_info *specinfo;
gfc_ss *ss;
tree tmp;
gfc_ss *loopspec[GFC_MAX_DIMENSIONS];
@@ -4061,7 +4061,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
tmp = loop->temp_ss->data.temp.type;
n = loop->temp_ss->data.temp.dimen;
- memset (&loop->temp_ss->data.info, 0, sizeof (gfc_ss_info));
+ memset (&loop->temp_ss->data.info, 0, sizeof (gfc_array_info));
loop->temp_ss->type = GFC_SS_SECTION;
loop->temp_ss->data.info.dimen = n;
@@ -5661,7 +5661,7 @@ get_array_charlen (gfc_expr *expr, gfc_se *se)
static bool
transposed_dims (gfc_ss *ss)
{
- gfc_ss_info *info;
+ gfc_array_info *info;
int n;
info = &ss->data.info;
@@ -5704,7 +5704,7 @@ void
gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
{
gfc_loopinfo loop;
- gfc_ss_info *info;
+ gfc_array_info *info;
int need_tmp;
int n;
tree tmp;
diff --git a/trans-expr.c b/trans-expr.c
index b2c1739..636c0b0 100644
--- a/trans-expr.c
+++ b/trans-expr.c
@@ -2359,7 +2359,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;
@@ -2854,7 +2854,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;
diff --git a/trans-intrinsic.c b/trans-intrinsic.c
index 95161f8..47313e6 100644
--- a/trans-intrinsic.c
+++ b/trans-intrinsic.c
@@ -5269,7 +5269,7 @@ 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;
@@ -6757,7 +6757,7 @@ walk_inline_intrinsic_transpose (gfc_ss *ss, gfc_expr *expr)
&& tmp_ss->type != GFC_SS_REFERENCE)
{
int tmp_dim;
- gfc_ss_info *info;
+ gfc_array_info *info;
info = &tmp_ss->data.info;
gcc_assert (info->dimen == 2);
diff --git a/trans-stmt.c b/trans-stmt.c
index c7ae360..aa7591b 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;
@@ -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;
diff --git a/trans.h b/trans.h
index 535c207..6f9f6c8 100644
--- a/trans.h
+++ b/trans.h
@@ -108,15 +108,10 @@ 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;
/* The ref that holds information on this section. */
@@ -144,7 +139,7 @@ typedef struct gfc_ss_info
actual_dim = dim[loop_dim] */
int dim[GFC_MAX_DIMENSIONS];
}
-gfc_ss_info;
+gfc_array_info;
typedef enum
{
@@ -190,8 +185,15 @@ typedef enum
}
gfc_ss_type;
-/* SS structures can only belong to a single loopinfo. They must be added
+
+/* 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_type type;
@@ -217,7 +219,7 @@ typedef struct gfc_ss
}
temp;
/* All other types. */
- gfc_ss_info info;
+ gfc_array_info info;
}
data;
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [20..30/66] inline sum and product: Update core structs.
2011-10-27 23:43 [Patch, fortran] [00/66] PR fortran/43829 Inline sum and product (AKA scalarization of reductions) Mikael Morin
@ 2011-10-27 23:32 ` Mikael Morin
2011-10-27 23:32 ` [Patch, fortran] [20/66] inline sum and product: Update core structs: Rename gfc_ss_info Mikael Morin
` (10 more replies)
2011-10-27 23:35 ` [Patch, fortran] [07..12/66] inline sum and product: Preliminary cleanups Mikael Morin
` (7 subsequent siblings)
8 siblings, 11 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:32 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 5289 bytes --]
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.
[-- Attachment #2: pr43829-20..30.diff --]
[-- Type: text/x-diff, Size: 80302 bytes --]
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)
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [29/66] inline sum and product: Update core structs: Move useflags flag.
2011-10-27 23:32 ` [Patch, fortran] [20..30/66] inline sum and product: Update core structs Mikael Morin
2011-10-27 23:32 ` [Patch, fortran] [20/66] inline sum and product: Update core structs: Rename gfc_ss_info Mikael Morin
2011-10-27 23:32 ` [Patch, fortran] [25/66] inline sum and product: Update core structs: Move string_length Mikael Morin
@ 2011-10-27 23:32 ` Mikael Morin
2011-10-27 23:33 ` [Patch, fortran] [22/66] inline sum and product: Update core structs: Move shape Mikael Morin
` (7 subsequent siblings)
10 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:32 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 58 bytes --]
This moves useflags field from gfc_ss to gfc_ss_info.
OK?
[-- Attachment #2: pr43829-29.CL --]
[-- Type: text/plain, Size: 407 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans.h (struct gfc_ss, struct gfc_ss_info): Move field
gfc_ss::useflags into gfc_ss_info.
* trans-array.c (gfc_mark_ss_chain_used, gfc_trans_preloop_setup,
gfc_trans_scalarizing_loops, gfc_trans_scalarized_boundary):
Update reference chains.
* trans-expr.c (gfc_conv_procedure_call): Ditto.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Ditto.
[-- Attachment #3: pr43829-29.patch --]
[-- Type: text/x-diff, Size: 3411 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 78e1443..427bb7b 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 *);
@@ -2906,7 +2906,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
{
ss_info = ss->info;
- if ((ss->useflags & flag) == 0)
+ if ((ss_info->useflags & flag) == 0)
continue;
ss_type = ss_info->type;
@@ -3148,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;
}
@@ -3185,7 +3185,7 @@ gfc_trans_scalarized_loop_boundary (gfc_loopinfo * loop, stmtblock_t * body)
ss_info = ss->info;
- if ((ss->useflags & 2) == 0)
+ if ((ss_info->useflags & 2) == 0)
continue;
ss_type = ss_info->type;
diff --git a/trans-expr.c b/trans-expr.c
index b175b62..01d4ca3 100644
--- a/trans-expr.c
+++ b/trans-expr.c
@@ -2898,7 +2898,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
if (!sym->attr.elemental)
{
gcc_assert (se->ss->info->type == GFC_SS_FUNCTION);
- if (se->ss->useflags)
+ if (se->ss->info->useflags)
{
gcc_assert ((!comp && gfc_return_by_reference (sym)
&& sym->result->attr.dimension)
@@ -2983,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);
diff --git a/trans-intrinsic.c b/trans-intrinsic.c
index a3b7383..fcc59d7 100644
--- a/trans-intrinsic.c
+++ b/trans-intrinsic.c
@@ -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
diff --git a/trans.h b/trans.h
index e74da41..907c271 100644
--- a/trans.h
+++ b/trans.h
@@ -209,6 +209,11 @@ typedef struct gfc_ss_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;
}
gfc_ss_info;
@@ -237,11 +242,9 @@ typedef struct gfc_ss
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;
+ /* The bit 'where' suppresses precalculation of scalars in WHERE assignments.
+ */
+ unsigned where:1, is_alloc_lhs:1;
}
gfc_ss;
#define gfc_get_ss() XCNEW (gfc_ss)
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [08/66] inline sum and product: Preliminary cleanups: Remove redundant condition.
2011-10-27 23:35 ` [Patch, fortran] [07..12/66] inline sum and product: Preliminary cleanups Mikael Morin
2011-10-27 23:31 ` [Patch, fortran] [07/66] inline sum and product: Preliminary cleanups: Useless coarray code removal Mikael Morin
2011-10-27 23:31 ` [Patch, fortran] [10/66] inline sum and product: Preliminary cleanups: Use array's instead of loop's dimensions Mikael Morin
@ 2011-10-27 23:32 ` Mikael Morin
2011-10-27 23:32 ` [Patch, fortran] [12/66] inline sum and product: Preliminary cleanups: Stop loop before end marker Mikael Morin
` (2 subsequent siblings)
5 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:32 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 136 bytes --]
As the first line of context shows, if the first condition is false, the second
is false too. Thus, the first condition is useless.
OK?
[-- Attachment #2: pr43829-8.CL --]
[-- Type: text/plain, Size: 114 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (get_array_ref_dim): Remove redundant condition.
[-- Attachment #3: pr43829-8.patch --]
[-- Type: text/x-diff, Size: 398 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 83fa7b6..5500ec4 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -815,7 +815,7 @@ get_array_ref_dim (gfc_ss_info *info, int loop_dim)
array_dim = info->dim[loop_dim];
for (n = 0; n < info->dimen; n++)
- if (n != loop_dim && info->dim[n] < array_dim)
+ if (info->dim[n] < array_dim)
array_ref_dim++;
return array_ref_dim;
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [22/66] inline sum and product: Update core structs: Move shape.
2011-10-27 23:32 ` [Patch, fortran] [20..30/66] inline sum and product: Update core structs Mikael Morin
` (2 preceding siblings ...)
2011-10-27 23:32 ` [Patch, fortran] [29/66] inline sum and product: Update core structs: Move useflags flag Mikael Morin
@ 2011-10-27 23:33 ` Mikael Morin
2011-10-27 23:33 ` [Patch, fortran] [26/66] inline sum and product: Update core structs: Move scalar struct Mikael Morin
` (6 subsequent siblings)
10 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:33 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 58 bytes --]
This moves shape field from gfc_ss to gfc_array_info.
OK?
[-- Attachment #2: pr43829-22.CL --]
[-- Type: text/plain, Size: 401 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans.h (struct gfc_ss, struct gfc_array_info): Move shape field
from the former struct to the latter.
* trans-array.c (gfc_conv_ss_startstride, gfc_conv_loop_setup):
Update field references.
* trans-expr.c (gfc_trans_subarray_assign): Update field references
and factor common reference chains.
* trans-io.c (transfer_array_component): Ditto.
[-- Attachment #3: pr43829-22.patch --]
[-- Type: text/x-diff, Size: 5983 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 6ff60dc..277a49e 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -3302,8 +3302,12 @@ 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_array_info *info;
+
+ info = &ss->data.info;
+
+ if (ss->expr && ss->expr->shape && !info->shape)
+ info->shape = ss->expr->shape;
switch (ss->type)
{
@@ -3891,12 +3895,12 @@ 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;
@@ -3973,7 +3977,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
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]))
{
diff --git a/trans-expr.c b/trans-expr.c
index 84222f5..6bc336b 100644
--- a/trans-expr.c
+++ b/trans-expr.c
@@ -4344,6 +4344,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 +4368,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->data.info;
+ 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 +4424,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);
diff --git a/trans-io.c b/trans-io.c
index bbf5a02..a97691e 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->data.info;
+ 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.h b/trans.h
index 5acab12..daf2499 100644
--- a/trans.h
+++ b/trans.h
@@ -113,6 +113,8 @@ gfc_coarray_type;
typedef struct gfc_array_info
{
+ mpz_t *shape;
+
/* The ref that holds information on this section. */
gfc_ref *ref;
/* The descriptor of this array. */
@@ -193,7 +195,6 @@ typedef struct gfc_ss
{
gfc_ss_type type;
gfc_expr *expr;
- mpz_t *shape;
tree string_length;
union
{
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [23/66] inline sum and product: Update core structs: Move type.
2011-10-27 23:32 ` [Patch, fortran] [20..30/66] inline sum and product: Update core structs Mikael Morin
` (4 preceding siblings ...)
2011-10-27 23:33 ` [Patch, fortran] [26/66] inline sum and product: Update core structs: Move scalar struct Mikael Morin
@ 2011-10-27 23:33 ` Mikael Morin
2011-10-27 23:34 ` [Patch, fortran] [27/66] inline sum and product: Update core structs: Move temp struct Mikael Morin
` (4 subsequent siblings)
10 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:33 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 67 bytes --]
This moves type field from gfc_ss to a new gfc_ss_info struct.
OK?
[-- Attachment #2: pr43829-23.CL --]
[-- Type: text/plain, Size: 1245 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans.h (struct gfc_ss_info): New struct.
(gfc_get_ss_info): New macro.
(struct gfc_ss): Move type field to struct gfc_ss_info.
Add an info field of type gfc_ss_info.
* trans-array.c (free_ss_info): New function.
(gfc_free_ss): Call free_ss_info.
(gfc_get_array_ss, gfc_get_temp_ss, gfc_get_scalar_ss):
Allocate gfc_ss_info field.
(gfc_get_array_ss, gfc_get_temp_ss, gfc_get_scalar_ss,
gfc_set_vector_loop_bounds, gfc_add_loop_ss_code,
gfc_conv_array_index_offset, gfc_trans_preloop_setup,
gfc_trans_scalarized_loop_boundary, gfc_conv_section_startstride,
gfc_conv_ss_startstride, gfc_conv_resolve_dependencies,
gfc_conv_loop_setup, transposed_dims, gfc_conv_expr_descriptor,
gfc_walk_elemental_function_args): Update references to type.
* trans-const.c (gfc_conv_constant): Factor common reference chains
and update reference to type.
* trans-expr.c (gfc_conv_procedure_call, gfc_trans_assignment_1):
Update reference to type.
(gfc_conv_array_constructor_expr, gfc_conv_expr,
gfc_conv_expr_reference): Ditto. Factor common reference chains.
* trans-intrinsic.c (walk_inline_intrinsic_transpose): Update references
to type
* trans-stmt.c (gfc_trans_where_assign): Ditto.
[-- Attachment #3: pr43829-23.patch --]
[-- Type: text/x-diff, Size: 17605 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 277a49e..80dadf4 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -486,14 +486,24 @@ 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->dimen; n++)
@@ -507,6 +517,7 @@ gfc_free_ss (gfc_ss * ss)
break;
}
+ free_ss_info (ss_info);
free (ss);
}
@@ -517,11 +528,15 @@ gfc_ss *
gfc_get_array_ss (gfc_ss *next, gfc_expr *expr, int dimen, gfc_ss_type type)
{
gfc_ss *ss;
+ gfc_ss_info *ss_info;
int i;
+ ss_info = gfc_get_ss_info ();
+ ss_info->type = type;
+
ss = gfc_get_ss ();
+ ss->info = ss_info;
ss->next = next;
- ss->type = type;
ss->expr = expr;
ss->dimen = dimen;
for (i = 0; i < ss->dimen; i++)
@@ -537,11 +552,15 @@ 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 = 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.type = type;
ss->dimen = dimen;
@@ -558,10 +577,14 @@ 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 = gfc_get_ss ();
+ ss->info = ss_info;
ss->next = next;
- ss->type = GFC_SS_SCALAR;
ss->expr = expr;
return ss;
@@ -2118,7 +2141,7 @@ 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;
@@ -2153,7 +2176,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
{
gcc_assert (ss);
- switch (ss->type)
+ switch (ss->info->type)
{
case GFC_SS_SCALAR:
/* Scalar expression. Evaluate this now. This includes elemental
@@ -2533,7 +2556,7 @@ 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;
@@ -2545,7 +2568,7 @@ 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);
+ && info->subscript[dim]->info->type == GFC_SS_VECTOR);
desc = info->subscript[dim]->data.info.descriptor;
/* Get a zero-based index into the vector. */
@@ -2600,7 +2623,7 @@ 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
+ if (se->ss && se->ss->info->type == GFC_SS_FUNCTION
&& se->ss->expr
&& se->ss->expr->symtree
&& se->ss->expr->symtree->n.sym->result
@@ -2854,6 +2877,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
{
tree stride;
gfc_array_info *info;
+ gfc_ss_type ss_type;
gfc_ss *ss;
gfc_array_ref *ar;
int i;
@@ -2865,9 +2889,11 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
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;
@@ -3134,12 +3160,16 @@ 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)
{
+ 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;
@@ -3207,7 +3237,7 @@ gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int dim)
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;
@@ -3264,7 +3294,7 @@ 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:
@@ -3309,7 +3339,7 @@ done:
if (ss->expr && ss->expr->shape && !info->shape)
info->shape = ss->expr->shape;
- switch (ss->type)
+ switch (ss->info->type)
{
case GFC_SS_SECTION:
/* Get the descriptor for the array. */
@@ -3372,7 +3402,7 @@ done:
{
stmtblock_t inner;
- if (ss->type != GFC_SS_SECTION)
+ if (ss->info->type != GFC_SS_SECTION)
continue;
/* Catch allocatable lhs in f2003. */
@@ -3757,7 +3787,7 @@ gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest,
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)
@@ -3874,7 +3904,7 @@ 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)
@@ -3907,7 +3937,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
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.
@@ -3928,7 +3958,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;
@@ -3939,7 +3969,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])
@@ -3951,7 +3981,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])
@@ -3997,7 +4027,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
@@ -4054,7 +4084,10 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
/* If we want a temporary then create it. */
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)
@@ -4065,7 +4098,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
tmp = loop->temp_ss->data.temp.type;
memset (&loop->temp_ss->data.info, 0, sizeof (gfc_array_info));
- loop->temp_ss->type = GFC_SS_SECTION;
+ tmp_ss_info->type = GFC_SS_SECTION;
gcc_assert (tmp_ss->dimen != 0);
@@ -4087,9 +4120,12 @@ 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;
@@ -5702,6 +5738,7 @@ 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_loopinfo loop;
gfc_array_info *info;
int need_tmp;
@@ -5718,6 +5755,8 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
gcc_assert (ss != NULL);
gcc_assert (ss != gfc_ss_terminator);
+ ss_type = ss->info->type;
+
/* Special case things we know we can pass easily. */
switch (expr->expr_type)
{
@@ -5725,7 +5764,7 @@ 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_type == GFC_SS_SECTION);
gcc_assert (ss->expr == expr);
info = &ss->data.info;
@@ -5804,7 +5843,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)
@@ -5816,7 +5855,7 @@ 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)
/* Elemental function. */
@@ -5825,7 +5864,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
|| (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
@@ -5844,7 +5883,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
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))
{
@@ -6055,7 +6094,7 @@ 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);
+ && info->subscript[n]->info->type == GFC_SS_SCALAR);
start = info->subscript[n]->data.scalar.expr;
}
else
@@ -7811,7 +7850,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..84a8339 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,10 +382,11 @@ 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 (ss != gfc_ss_terminator);
+ gcc_assert (ss->info->type == GFC_SS_SCALAR);
gcc_assert (se->ss->expr == expr);
se->expr = se->ss->data.scalar.expr;
diff --git a/trans-expr.c b/trans-expr.c
index 6bc336b..5a94615 100644
--- a/trans-expr.c
+++ b/trans-expr.c
@@ -2893,7 +2893,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
{
if (!sym->attr.elemental)
{
- gcc_assert (se->ss->type == GFC_SS_FUNCTION);
+ gcc_assert (se->ss->info->type == GFC_SS_FUNCTION);
if (se->ss->useflags)
{
gcc_assert ((!comp && gfc_return_by_reference (sym)
@@ -4239,8 +4239,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->expr == expr && ss->info->type == GFC_SS_CONSTRUCTOR);
gfc_conv_tmp_array_ref (se);
}
@@ -4821,13 +4824,17 @@ 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->expr == expr
+ && (ss->info->type == GFC_SS_SCALAR
+ || ss->info->type == GFC_SS_REFERENCE))
{
/* Substitute a scalar expression evaluated outside the scalarization
loop. */
se->expr = se->ss->data.scalar.expr;
- if (se->ss->type == GFC_SS_REFERENCE)
+ if (ss->info->type == GFC_SS_REFERENCE)
se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
se->string_length = se->ss->string_length;
gfc_advance_se_ss_chain (se);
@@ -4946,10 +4953,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->expr == expr
+ && ss->info->type == GFC_SS_REFERENCE)
{
/* Returns a reference to the scalar evaluated outside the loop
for this case. */
@@ -6154,7 +6163,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 3f8d514..dff16dc 100644
--- a/trans-intrinsic.c
+++ b/trans-intrinsic.c
@@ -6753,8 +6753,8 @@ 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;
diff --git a/trans-stmt.c b/trans-stmt.c
index c66d6b5..c89419a 100644
--- a/trans-stmt.c
+++ b/trans-stmt.c
@@ -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);
diff --git a/trans.h b/trans.h
index daf2499..13d4c58 100644
--- a/trans.h
+++ b/trans.h
@@ -183,6 +183,15 @@ typedef enum
gfc_ss_type;
+typedef struct gfc_ss_info
+{
+ gfc_ss_type type;
+}
+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
@@ -193,7 +202,8 @@ gfc_ss_type;
typedef struct gfc_ss
{
- gfc_ss_type type;
+ gfc_ss_info *info;
+
gfc_expr *expr;
tree string_length;
union
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [26/66] inline sum and product: Update core structs: Move scalar struct.
2011-10-27 23:32 ` [Patch, fortran] [20..30/66] inline sum and product: Update core structs Mikael Morin
` (3 preceding siblings ...)
2011-10-27 23:33 ` [Patch, fortran] [22/66] inline sum and product: Update core structs: Move shape Mikael Morin
@ 2011-10-27 23:33 ` Mikael Morin
2011-10-27 23:33 ` [Patch, fortran] [23/66] inline sum and product: Update core structs: Move type Mikael Morin
` (5 subsequent siblings)
10 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:33 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 206 bytes --]
This moves data::scalar field from gfc_ss to gfc_ss_info.
The expr subfield is renamed to value, as it is not the expression really,
it is a reference to a variable containing the pre-calculated value.
OK?
[-- Attachment #2: pr43829-26.CL --]
[-- Type: text/plain, Size: 424 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans.h (struct gfc_ss, struct gfc_ss_info): Move member struct
gfc_ss::data::scalar into newly created union gfc_ss_info::data,
and rename subfield expr to value.
* trans-array.c (gfc_add_loop_ss_code, gfc_conv_array_index_offset,
gfc_conv_expr_descriptor): Update reference chains.
* trans-const.c (gfc_conv_constant): Ditto.
* trans-expr.c (gfc_conv_expr): Ditto.
[-- Attachment #3: pr43829-26.patch --]
[-- Type: text/x-diff, Size: 3223 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 827d13d..eef0f09 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -2208,7 +2208,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
else
gfc_add_block_to_block (&loop->post, &se.post);
- ss->data.scalar.expr = se.expr;
+ ss_info->data.scalar.value = se.expr;
ss_info->string_length = se.string_length;
break;
@@ -2220,7 +2220,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
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_info->data.scalar.value = gfc_evaluate_now (se.expr, &loop->pre);
ss_info->string_length = se.string_length;
break;
@@ -2571,7 +2571,7 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i,
gcc_assert (info->subscript[dim]
&& info->subscript[dim]->info->type == GFC_SS_SCALAR);
/* We've already translated this value outside the loop. */
- index = info->subscript[dim]->data.scalar.expr;
+ index = info->subscript[dim]->info->data.scalar.value;
index = trans_array_bound_check (se, ss, index, dim, &ar->where,
ar->as->type != AS_ASSUMED_SIZE
@@ -6134,7 +6134,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
{
gcc_assert (info->subscript[n]
&& info->subscript[n]->info->type == GFC_SS_SCALAR);
- start = info->subscript[n]->data.scalar.expr;
+ start = info->subscript[n]->info->data.scalar.value;
}
else
{
diff --git a/trans-const.c b/trans-const.c
index 35a5e68..fa820ef 100644
--- a/trans-const.c
+++ b/trans-const.c
@@ -392,7 +392,7 @@ gfc_conv_constant (gfc_se * se, gfc_expr * expr)
gcc_assert (ss_info->type == GFC_SS_SCALAR);
gcc_assert (ss_info->expr == expr);
- se->expr = se->ss->data.scalar.expr;
+ 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 87734f1..55853f1 100644
--- a/trans-expr.c
+++ b/trans-expr.c
@@ -4840,7 +4840,7 @@ gfc_conv_expr (gfc_se * se, gfc_expr * expr)
ss_info = ss->info;
/* Substitute a scalar expression evaluated outside the scalarization
loop. */
- se->expr = se->ss->data.scalar.expr;
+ 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 = ss_info->string_length;
diff --git a/trans.h b/trans.h
index f1b109a..567e5a3 100644
--- a/trans.h
+++ b/trans.h
@@ -188,6 +188,17 @@ typedef struct gfc_ss_info
gfc_ss_type type;
gfc_expr *expr;
tree string_length;
+
+ union
+ {
+ /* If type is GFC_SS_SCALAR or GFC_SS_REFERENCE. */
+ struct
+ {
+ tree value;
+ }
+ scalar;
+ }
+ data;
}
gfc_ss_info;
@@ -208,13 +219,6 @@ typedef struct gfc_ss
union
{
- /* If type is GFC_SS_SCALAR or GFC_SS_REFERENCE. */
- struct
- {
- tree expr;
- }
- scalar;
-
/* GFC_SS_TEMP. */
struct
{
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [32/66] inline sum and product: Update the scalarizer: clear specloop in gfc_trans_create_temp_arrays.
2011-10-27 23:35 ` [Patch, fortran] [31..53/66] inline sum and product: Update the scalarizer Mikael Morin
2011-10-27 23:34 ` [Patch, fortran] [31/66] inline sum and product: Update the scalarizer: Split gfc_conv_loop_setup Mikael Morin
@ 2011-10-27 23:34 ` Mikael Morin
2011-10-27 23:35 ` [Patch, fortran] [45/66] inline sum and product: Update the scalarizer: Update dimension mapping inversion functions Mikael Morin
` (10 subsequent siblings)
12 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:34 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 198 bytes --]
The code clearing specloop in gfc_conv_loop_setup would need some explanation.
This patch moves it to gfc_trans_create_temp_array (where the reason for
it are more clear) with a proper comment.
OK?
[-- Attachment #2: pr43829-32.CL --]
[-- Type: text/plain, Size: 179 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (gfc_conv_loop_setup, gfc_trans_create_temp_array):
Move specloop arrays clearing from the former to the latter.
[-- Attachment #3: pr43829-32.patch --]
[-- Type: text/x-diff, Size: 1166 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 302f937..545f2fb 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -902,6 +902,11 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
pre);
loop->from[n] = gfc_index_zero_node;
+ /* We have just changed the loop bounds, we must clear the
+ corresponding specloop, so that delta calculation is not skipped
+ later in set_delta. */
+ loop->specloop[n] = NULL;
+
/* We are constructing the temporary's descriptor based on the loop
dimensions. As the dimensions may be accessed in arbitrary order
(think of transpose) the size taken from the n'th loop may not map
@@ -4136,7 +4141,6 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
{
gfc_ss *tmp_ss;
tree tmp;
- int n;
set_loop_bounds (loop);
@@ -4172,9 +4176,6 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
false, true, false, where);
}
- for (n = 0; n < loop->temp_dim; n++)
- loop->specloop[loop->order[n]] = NULL;
-
/* For array parameters we don't have loop variables, so don't calculate the
translations. */
if (loop->array_parameter)
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [31/66] inline sum and product: Update the scalarizer: Split gfc_conv_loop_setup.
2011-10-27 23:35 ` [Patch, fortran] [31..53/66] inline sum and product: Update the scalarizer Mikael Morin
@ 2011-10-27 23:34 ` Mikael Morin
2011-10-27 23:34 ` [Patch, fortran] [32/66] inline sum and product: Update the scalarizer: clear specloop in gfc_trans_create_temp_arrays Mikael Morin
` (11 subsequent siblings)
12 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:34 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 557 bytes --]
Loop-centered functions will be called recursively to handle nested loops.
This is the case of gfc_conv_loop_setup. However, gfc_conv_loop_setup has
a tempoary handling part in the middle which doesn't need to be called
recursively. This patch moves the beginning and ending of gfc_conv_loop_setup
into functions of their own, so that they can be called recursively (later).
To share gfc_conv_loop_setup's loopspec local variable in the three functions,
we store it into gfc_loopinfo's specloop field (which existed, but was
completely unused before).
OK?
[-- Attachment #2: pr43829-31.CL --]
[-- Type: text/plain, Size: 423 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (set_loop_bounds): Separate the beginning of
gfc_conv_loop_setup into a function of its own.
(set_delta): Separate the end of gfc_conv_loop_setup into a function
of its own.
(gfc_conv_loop_setup): Call set_loop_bounds and set delta.
(set_loop_bounds, set_delta, gfc_conv_loop_setup): Make loopspec a
pointer to the specloop field from the loop struct.
[-- Attachment #3: pr43829-31.patch --]
[-- Type: text/x-diff, Size: 2875 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 045c426..302f937 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -3919,25 +3919,25 @@ temporary:
}
-/* Initialize the scalarization loop. Creates the loop variables. Determines
- the range of the loop variables. Creates a temporary if required.
- Calculates how to transform from loop variables to array indices for each
- expression. Also generates code for scalar expressions which have been
- moved outside the loop. */
+/* Browse through each array's information from the scalarizer and set the loop
+ bounds according to the "best" one (per dimension), i.e. the one which
+ provides the most information (constant bounds, shape, etc). */
-void
-gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
+static void
+set_loop_bounds (gfc_loopinfo *loop)
{
int n, dim, spec_dim;
gfc_array_info *info;
gfc_array_info *specinfo;
- gfc_ss *ss, *tmp_ss;
+ gfc_ss *ss;
tree tmp;
- gfc_ss *loopspec[GFC_MAX_DIMENSIONS];
+ gfc_ss **loopspec;
bool dynamic[GFC_MAX_DIMENSIONS];
mpz_t *cshape;
mpz_t i;
+ loopspec = loop->specloop;
+
mpz_init (i);
for (n = 0; n < loop->dimen; n++)
{
@@ -4119,6 +4119,26 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
loop->from[n] = gfc_index_zero_node;
}
}
+ mpz_clear (i);
+}
+
+
+static void set_delta (gfc_loopinfo *loop);
+
+
+/* Initialize the scalarization loop. Creates the loop variables. Determines
+ the range of the loop variables. Creates a temporary if required.
+ Also generates code for scalar expressions which have been
+ moved outside the loop. */
+
+void
+gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
+{
+ gfc_ss *tmp_ss;
+ tree tmp;
+ int n;
+
+ set_loop_bounds (loop);
/* Add all the scalar code that can be taken out of the loops.
This may include calculating the loop bounds, so do it before
@@ -4153,15 +4173,31 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
}
for (n = 0; n < loop->temp_dim; n++)
- loopspec[loop->order[n]] = NULL;
-
- mpz_clear (i);
+ loop->specloop[loop->order[n]] = NULL;
/* For array parameters we don't have loop variables, so don't calculate the
translations. */
if (loop->array_parameter)
return;
+ set_delta (loop);
+}
+
+
+/* Calculates how to transform from loop variables to array indices for each
+ array: once loop bounds are chosen, sets the difference (DELTA field) between
+ loop bounds and array reference bounds, for each array info. */
+
+static void
+set_delta (gfc_loopinfo *loop)
+{
+ gfc_ss *ss, **loopspec;
+ gfc_array_info *info;
+ tree tmp;
+ int n, dim;
+
+ loopspec = loop->specloop;
+
/* Calculate the translation from loop variables to array indices. */
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
{
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [27/66] inline sum and product: Update core structs: Move temp struct.
2011-10-27 23:32 ` [Patch, fortran] [20..30/66] inline sum and product: Update core structs Mikael Morin
` (5 preceding siblings ...)
2011-10-27 23:33 ` [Patch, fortran] [23/66] inline sum and product: Update core structs: Move type Mikael Morin
@ 2011-10-27 23:34 ` Mikael Morin
2011-10-27 23:35 ` [Patch, fortran] [24/66] inline sum and product: Update core structs: Move expr Mikael Morin
` (3 subsequent siblings)
10 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:34 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 60 bytes --]
This moves data::temp field from gfc_ss to gfc_ss_info.
OK?
[-- Attachment #2: pr43829-27.CL --]
[-- Type: text/plain, Size: 242 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans.h (struct gfc_ss, struct gfc_ss_info): Move member struct
gfc_ss::data::temp into gfc_ss_info::data.
* trans-array.c (gfc_get_temp_ss, gfc_conv_loop_setup): Update reference
chains.
[-- Attachment #3: pr43829-27.patch --]
[-- Type: text/x-diff, Size: 1624 bytes --]
diff --git a/trans-array.c b/trans-array.c
index eef0f09..173e52b 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -558,11 +558,11 @@ gfc_get_temp_ss (tree type, tree string_length, int dimen)
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->data.temp.type = type;
ss->dimen = dimen;
for (i = 0; i < ss->dimen; i++)
ss->dim[i] = i;
@@ -4127,12 +4127,12 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
/* Make absolutely sure that this is a complete type. */
if (tmp_ss_info->string_length)
- loop->temp_ss->data.temp.type
+ tmp_ss_info->data.temp.type
= gfc_get_character_type_len_for_eltype
- (TREE_TYPE (loop->temp_ss->data.temp.type),
+ (TREE_TYPE (tmp_ss_info->data.temp.type),
tmp_ss_info->string_length);
- tmp = loop->temp_ss->data.temp.type;
+ 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;
diff --git a/trans.h b/trans.h
index 567e5a3..60708e9 100644
--- a/trans.h
+++ b/trans.h
@@ -197,6 +197,13 @@ typedef struct gfc_ss_info
tree value;
}
scalar;
+
+ /* GFC_SS_TEMP. */
+ struct
+ {
+ tree type;
+ }
+ temp;
}
data;
}
@@ -219,12 +226,6 @@ typedef struct gfc_ss
union
{
- /* GFC_SS_TEMP. */
- struct
- {
- tree type;
- }
- temp;
/* All other types. */
gfc_array_info info;
}
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [31..53/66] inline sum and product: Update the scalarizer.
2011-10-27 23:43 [Patch, fortran] [00/66] PR fortran/43829 Inline sum and product (AKA scalarization of reductions) Mikael Morin
2011-10-27 23:32 ` [Patch, fortran] [20..30/66] inline sum and product: Update core structs Mikael Morin
2011-10-27 23:35 ` [Patch, fortran] [07..12/66] inline sum and product: Preliminary cleanups Mikael Morin
@ 2011-10-27 23:35 ` Mikael Morin
2011-10-27 23:34 ` [Patch, fortran] [31/66] inline sum and product: Update the scalarizer: Split gfc_conv_loop_setup Mikael Morin
` (12 more replies)
2011-10-27 23:36 ` [Patch, fortran] [62..66/66] inline sum and product: Inline sum Mikael Morin
` (5 subsequent siblings)
8 siblings, 13 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:35 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 3178 bytes --]
This part of the serie takes care of updating the scalarizer code once its
core structures have changed.
There are basically two kinds of changes:
- for functions working on loops mostly one needs to take care of more than
one loop. This is done by attaching a list of nested loops to every
gfc_loopinfo struct and calling these functions recursively on every element
of the list. (See patches 31 and 47..52).
- for functions working mostly on arrays, one needs to take care of arrays
slices scattered in more than one gfc_ss struct. This is done by adding
nested_ss and parent pointers to walk upwards (towards outer loops) or
downwards (towards inner loops) in the chain. Then the function can walk
the chain to have a view of the whole array. See below for the
gfc_trans_create_temp_array case. (See patches 40..44).
- Hybrid functions. Of course most functions are not trivial enough to work
on loops without looking at the arrays, or conversely working on a single
array without using the loop information. For those hybrid functions, a
combination of the above is used. A loop field is added to the gfc_ss structs
so that there is no ambiguity (it's easy to make mistakes) to which loop the
array slice belongs.
The case of gfc_trans_create_temp_array deserves a comment of its own.
For the expression
some_func(sum(a(:,:), 1))
the temporary created needs to be of rank 2 (i.e. it should be of the same size
as `a(1,:)', while for the expression
sum(some_other_func(), 1)
it should have the same size as the full result of `some_other_func()'.
This shows that in the first case we want the temporary to be of the size of the
outer loop only, while for the second it should be of the combined size of
the outer and the inner loop. Thus, we can't guess temporary size by walking
loops downwards (from the outer to the inner loop), we have to walk upwards
(this is patch 46, with preliminaries 33 and 45).
The same convention has been used in all the functions requiring the same kind
of walk: walk from inner to outer.
Another important thing in gfc_trans_create_temp_array is the handling of
dimensions. In every gfc_ss struct, we have with the DIM array a mapping from
loop dimension to array dimension, but as we are setting temporary bounds with
loop bounds, we need to reverse that information (get the loop bounds from the
array dimension). If one wants to handle multiple loops one has to consider
every corresponding DIM array.
See patch 45 for details.
Sorry, this part is a big mess.
Patch 31 : Split gfc_conv_loop_setup.
Patch 32 : Clear specloop in gfc_trans_create_temp_array.
Patch 33 : Move condition out of loop in gfc_trans_create_temp_array.
Patch 34 : gfc_ss_info reference counting.
Patch 35..39: New gfc_ss::loop field.
Patch 40..43: New gfc_ss::parent field.
Patch 44 : New gfc_ss::nested_ss field.
Patch 45 : Update get_array_ref_dim.
Patch 46 : Update gfc_trans_create_temp_array.
Patch 47..48: New gfc_loopinfo::nested_loop field.
Patch 49..51: New gfc_loopinfo::parent field.
Patch 52 : Add preliminary code in outermost loop.
Patch 53 : Update gfc_trans_preloop_setup.
[-- Attachment #2: pr43829-31..53.diff --]
[-- Type: text/x-diff, Size: 52124 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 045c426cab10dd934c92759f3ae4c6e29e1de99a..3c0c11038079cfcce3b47ce68f223869b30d93e4 100644
*** a/trans-array.c
--- b/trans-array.c
*************** gfc_free_ss_chain (gfc_ss * ss)
*** 489,494 ****
--- 489,499 ----
static void
free_ss_info (gfc_ss_info *ss_info)
{
+ ss_info->refcount--;
+ if (ss_info->refcount > 0)
+ return;
+
+ gcc_assert (ss_info->refcount == 0);
free (ss_info);
}
*************** gfc_get_array_ss (gfc_ss *next, gfc_expr
*** 532,537 ****
--- 537,543 ----
int i;
ss_info = gfc_get_ss_info ();
+ ss_info->refcount++;
ss_info->type = type;
ss_info->expr = expr;
*************** gfc_get_temp_ss (tree type, tree string_
*** 556,561 ****
--- 562,568 ----
int i;
ss_info = gfc_get_ss_info ();
+ ss_info->refcount++;
ss_info->type = GFC_SS_TEMP;
ss_info->string_length = string_length;
ss_info->data.temp.type = type;
*************** gfc_get_scalar_ss (gfc_ss *next, gfc_exp
*** 580,585 ****
--- 587,593 ----
gfc_ss_info *ss_info;
ss_info = gfc_get_ss_info ();
+ ss_info->refcount++;
ss_info->type = GFC_SS_SCALAR;
ss_info->expr = expr;
*************** gfc_get_scalar_ss (gfc_ss *next, gfc_exp
*** 596,601 ****
--- 604,610 ----
void
gfc_cleanup_loop (gfc_loopinfo * loop)
{
+ gfc_loopinfo *loop_next, **ploop;
gfc_ss *ss;
gfc_ss *next;
*************** gfc_cleanup_loop (gfc_loopinfo * loop)
*** 607,612 ****
--- 616,659 ----
gfc_free_ss (ss);
ss = next;
}
+
+ /* Remove reference to self in the parent loop. */
+ if (loop->parent)
+ for (ploop = &loop->parent->nested; *ploop; ploop = &(*ploop)->next)
+ if (*ploop == loop)
+ {
+ *ploop = loop->next;
+ break;
+ }
+
+ /* Free non-freed nested loops. */
+ for (loop = loop->nested; loop; loop = loop_next)
+ {
+ loop_next = loop->next;
+ gfc_cleanup_loop (loop);
+ free (loop);
+ }
+ }
+
+
+ static void
+ set_ss_loop (gfc_ss *ss, gfc_loopinfo *loop)
+ {
+ int n;
+
+ for (; ss != gfc_ss_terminator; ss = ss->next)
+ {
+ ss->loop = loop;
+
+ if (ss->info->type == GFC_SS_SCALAR
+ || ss->info->type == GFC_SS_REFERENCE
+ || ss->info->type == GFC_SS_TEMP)
+ continue;
+
+ for (n = 0; n < GFC_MAX_DIMENSIONS; n++)
+ if (ss->info->data.array.subscript[n] != NULL)
+ set_ss_loop (ss->info->data.array.subscript[n], loop);
+ }
}
*************** void
*** 616,628 ****
--- 663,698 ----
gfc_add_ss_to_loop (gfc_loopinfo * loop, gfc_ss * head)
{
gfc_ss *ss;
+ gfc_loopinfo *nested_loop;
if (head == gfc_ss_terminator)
return;
+ set_ss_loop (head, loop);
+
ss = head;
for (; ss && ss != gfc_ss_terminator; ss = ss->next)
{
+ if (ss->nested_ss)
+ {
+ nested_loop = ss->nested_ss->loop;
+
+ /* More than one ss can belong to the same loop. Hence, we add the
+ loop to the chain only if it is different from the previously
+ added one, to avoid duplicate nested loops. */
+ if (nested_loop != loop->nested)
+ {
+ gcc_assert (nested_loop->parent == NULL);
+ nested_loop->parent = loop;
+
+ gcc_assert (nested_loop->next == NULL);
+ nested_loop->next = loop->nested;
+ loop->nested = nested_loop;
+ }
+ else
+ gcc_assert (nested_loop->parent == loop);
+ }
+
if (ss->next == gfc_ss_terminator)
ss->loop_chain = loop->ss;
else
*************** void
*** 657,676 ****
gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping * mapping,
gfc_se * se, gfc_array_spec * as)
{
! int n, dim;
gfc_se tmpse;
tree lower;
tree upper;
tree tmp;
! if (as && as->type == AS_EXPLICIT)
! for (n = 0; n < se->loop->dimen; 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)
{
/* Evaluate the lower bound. */
gfc_init_se (&tmpse, NULL);
gfc_apply_interface_mapping (mapping, &tmpse, as->lower[dim]);
--- 727,757 ----
gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping * mapping,
gfc_se * se, gfc_array_spec * as)
{
! int n, dim, total_dim;
gfc_se tmpse;
+ gfc_ss *ss;
tree lower;
tree upper;
tree tmp;
! total_dim = 0;
!
! if (!as || as->type != AS_EXPLICIT)
! return;
!
! for (ss = se->ss; ss; ss = ss->parent)
{
! total_dim += ss->loop->dimen;
! for (n = 0; n < ss->loop->dimen; n++)
{
+ /* The bound is known, nothing to do. */
+ if (ss->loop->to[n] != NULL_TREE)
+ continue;
+
+ dim = ss->dim[n];
+ gcc_assert (dim < as->rank);
+ gcc_assert (ss->loop->dimen <= as->rank);
+
/* Evaluate the lower bound. */
gfc_init_se (&tmpse, NULL);
gfc_apply_interface_mapping (mapping, &tmpse, as->lower[dim]);
*************** gfc_set_loop_bounds_from_array_spec (gfc
*** 689,697 ****
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type, upper, lower);
tmp = gfc_evaluate_now (tmp, &se->pre);
! se->loop->to[n] = tmp;
}
}
}
--- 770,780 ----
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type, upper, lower);
tmp = gfc_evaluate_now (tmp, &se->pre);
! ss->loop->to[n] = tmp;
}
}
+
+ gcc_assert (total_dim == as->rank);
}
*************** gfc_trans_allocate_array_storage (stmtbl
*** 824,843 ****
}
! /* Get the array reference dimension corresponding to the given loop dimension.
! It is different from the true array dimension given by the dim array in
! the case of a partial array reference
! It is different from the loop dimension in the case of a transposed array.
! */
static int
! get_array_ref_dim (gfc_ss *ss, int loop_dim)
{
! int n, array_dim, array_ref_dim;
array_ref_dim = 0;
- array_dim = ss->dim[loop_dim];
for (n = 0; n < ss->dimen; n++)
if (ss->dim[n] < array_dim)
array_ref_dim++;
--- 907,935 ----
}
! /* Get the scalarizer array dimension corresponding to actual array dimension
! given by ARRAY_DIM.
!
! For example, if SS represents the array ref a(1,:,:,1), it is a
! bidimensional scalarizer array, and the result would be 0 for ARRAY_DIM=1,
! and 1 for ARRAY_DIM=2.
! If SS represents transpose(a(:,1,1,:)), it is again a bidimensional
! scalarizer array, and the result would be 1 for ARRAY_DIM=0 and 0 for
! ARRAY_DIM=3.
! If SS represents sum(a(:,:,:,1), dim=1), it is a 2+1-dimensional scalarizer
! array. If called on the inner ss, the result would be respectively 0,1,2 for
! ARRAY_DIM=0,1,2. If called on the outer ss, the result would be 0,1
! for ARRAY_DIM=1,2. */
static int
! get_scalarizer_dim_for_array_dim (gfc_ss *ss, int array_dim)
{
! int array_ref_dim;
! int n;
array_ref_dim = 0;
+ for (; ss; ss = ss->parent)
for (n = 0; n < ss->dimen; n++)
if (ss->dim[n] < array_dim)
array_ref_dim++;
*************** get_array_ref_dim (gfc_ss *ss, int loop_
*** 846,851 ****
--- 938,968 ----
}
+ static gfc_ss *
+ innermost_ss (gfc_ss *ss)
+ {
+ while (ss->nested_ss != NULL)
+ ss = ss->nested_ss;
+
+ return ss;
+ }
+
+
+
+ /* Get the array reference dimension corresponding to the given loop dimension.
+ It is different from the true array dimension given by the dim array in
+ the case of a partial array reference (i.e. a(:,:,1,:) for example)
+ It is different from the loop dimension in the case of a transposed array.
+ */
+
+ static int
+ get_array_ref_dim_for_loop_dim (gfc_ss *ss, int loop_dim)
+ {
+ return get_scalarizer_dim_for_array_dim (innermost_ss (ss),
+ ss->dim[loop_dim]);
+ }
+
+
/* Generate code to create and initialize the descriptor for a temporary
array. This is used for both temporaries needed by the scalarizer, and
functions returning arrays. Adjusts the loop variables to be
*************** get_array_ref_dim (gfc_ss *ss, int loop_
*** 857,871 ****
callee allocated array.
PRE, POST, INITIAL, DYNAMIC and DEALLOC are as for
! gfc_trans_allocate_array_storage.
! */
tree
! gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
! 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;
--- 974,988 ----
callee allocated array.
PRE, POST, INITIAL, DYNAMIC and DEALLOC are as for
! gfc_trans_allocate_array_storage. */
tree
! gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
tree eltype, tree initial, bool dynamic,
bool dealloc, bool callee_alloc, locus * where)
{
+ gfc_loopinfo *loop;
+ gfc_ss *s;
gfc_array_info *info;
tree from[GFC_MAX_DIMENSIONS], to[GFC_MAX_DIMENSIONS];
tree type;
*************** gfc_trans_create_temp_array (stmtblock_t
*** 876,881 ****
--- 993,999 ----
tree cond;
tree or_expr;
int n, dim, tmp_dim;
+ int total_dim = 0;
memset (from, 0, sizeof (from));
memset (to, 0, sizeof (to));
*************** gfc_trans_create_temp_array (stmtblock_t
*** 883,897 ****
info = &ss->info->data.array;
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 = ss->dim[n];
/* Callee allocated arrays may not have a known bound yet. */
if (loop->to[n])
--- 1001,1020 ----
info = &ss->info->data.array;
gcc_assert (ss->dimen > 0);
! gcc_assert (ss->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 (s = ss; s; s = s->parent)
+ {
+ loop = s->loop;
+
+ total_dim += loop->dimen;
for (n = 0; n < loop->dimen; n++)
{
! dim = s->dim[n];
/* Callee allocated arrays may not have a known bound yet. */
if (loop->to[n])
*************** gfc_trans_create_temp_array (stmtblock_t
*** 902,914 ****
pre);
loop->from[n] = gfc_index_zero_node;
/* We are constructing the temporary's descriptor based on the loop
dimensions. As the dimensions may be accessed in arbitrary order
(think of transpose) the size taken from the n'th loop may not map
! 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 (ss, n);
from[tmp_dim] = loop->from[n];
to[tmp_dim] = loop->to[n];
--- 1025,1042 ----
pre);
loop->from[n] = gfc_index_zero_node;
+ /* We have just changed the loop bounds, we must clear the
+ corresponding specloop, so that delta calculation is not skipped
+ later in set_delta. */
+ loop->specloop[n] = NULL;
+
/* We are constructing the temporary's descriptor based on the loop
dimensions. As the dimensions may be accessed in arbitrary order
(think of transpose) the size taken from the n'th loop may not map
! 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_scalarizer_dim_for_array_dim (ss, dim);
from[tmp_dim] = loop->from[n];
to[tmp_dim] = loop->to[n];
*************** gfc_trans_create_temp_array (stmtblock_t
*** 917,926 ****
info->end[dim] = gfc_index_zero_node;
info->stride[dim] = gfc_index_one_node;
}
/* Initialize the descriptor. */
type =
! 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;
--- 1045,1055 ----
info->end[dim] = gfc_index_zero_node;
info->stride[dim] = gfc_index_one_node;
}
+ }
/* Initialize the descriptor. */
type =
! gfc_get_array_type_bounds (eltype, total_dim, 0, from, to, 1,
GFC_ARRAY_UNKNOWN, true);
desc = gfc_create_var (type, "atmp");
GFC_DECL_PACKED_ARRAY (desc) = 1;
*************** gfc_trans_create_temp_array (stmtblock_t
*** 949,992 ****
/* If there is at least one null loop->to[n], it is a callee allocated
array. */
! for (n = 0; n < loop->dimen; n++)
! if (loop->to[n] == NULL_TREE)
{
size = NULL_TREE;
break;
}
- for (n = 0; n < loop->dimen; n++)
- {
- dim = ss->dim[n];
-
if (size == NULL_TREE)
{
/* For a callee allocated array express the loop bounds in terms
of the descriptor fields. */
tmp = fold_build2_loc (input_location,
MINUS_EXPR, gfc_array_index_type,
gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]),
gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]));
! loop->to[n] = tmp;
! continue;
}
!
/* Store the stride and bound components in the descriptor. */
gfc_conv_descriptor_stride_set (pre, desc, gfc_rank_cst[n], size);
gfc_conv_descriptor_lbound_set (pre, desc, gfc_rank_cst[n],
gfc_index_zero_node);
! gfc_conv_descriptor_ubound_set (pre, desc, gfc_rank_cst[n],
! to[n]);
! tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
to[n], gfc_index_one_node);
/* Check whether the size for this dimension is negative. */
! cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, tmp,
! gfc_index_zero_node);
cond = gfc_evaluate_now (cond, pre);
if (n == 0)
--- 1078,1123 ----
/* If there is at least one null loop->to[n], it is a callee allocated
array. */
! for (n = 0; n < total_dim; n++)
! if (to[n] == NULL_TREE)
{
size = NULL_TREE;
break;
}
if (size == NULL_TREE)
+ for (s = ss; s; s = s->parent)
+ for (n = 0; n < s->loop->dimen; n++)
{
+ dim = get_scalarizer_dim_for_array_dim (ss, ss->dim[n]);
+
/* For a callee allocated array express the loop bounds in terms
of the descriptor fields. */
tmp = fold_build2_loc (input_location,
MINUS_EXPR, gfc_array_index_type,
gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]),
gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]));
! s->loop->to[n] = tmp;
}
! else
! {
! for (n = 0; n < total_dim; n++)
! {
/* Store the stride and bound components in the descriptor. */
gfc_conv_descriptor_stride_set (pre, desc, gfc_rank_cst[n], size);
gfc_conv_descriptor_lbound_set (pre, desc, gfc_rank_cst[n],
gfc_index_zero_node);
! gfc_conv_descriptor_ubound_set (pre, desc, gfc_rank_cst[n], to[n]);
! tmp = fold_build2_loc (input_location, PLUS_EXPR,
! gfc_array_index_type,
to[n], gfc_index_one_node);
/* Check whether the size for this dimension is negative. */
! cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node,
! tmp, gfc_index_zero_node);
cond = gfc_evaluate_now (cond, pre);
if (n == 0)
*************** gfc_trans_create_temp_array (stmtblock_t
*** 995,1007 ****
or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR,
boolean_type_node, or_expr, cond);
! size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
! size, tmp);
size = gfc_evaluate_now (size, pre);
}
/* Get the size of the array. */
-
if (size && !callee_alloc)
{
/* If or_expr is true, then the extent in at least one
--- 1126,1138 ----
or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR,
boolean_type_node, or_expr, cond);
! size = fold_build2_loc (input_location, MULT_EXPR,
! gfc_array_index_type, size, tmp);
size = gfc_evaluate_now (size, pre);
}
+ }
/* Get the size of the array. */
if (size && !callee_alloc)
{
/* If or_expr is true, then the extent in at least one
*************** gfc_trans_create_temp_array (stmtblock_t
*** 1024,1031 ****
gfc_trans_allocate_array_storage (pre, post, info, size, nelem, initial,
dynamic, dealloc);
! if (ss->dimen > loop->temp_dim)
! loop->temp_dim = ss->dimen;
return size;
}
--- 1155,1165 ----
gfc_trans_allocate_array_storage (pre, post, info, size, nelem, initial,
dynamic, dealloc);
! while (ss->parent)
! ss = ss->parent;
!
! if (ss->dimen > ss->loop->temp_dim)
! ss->loop->temp_dim = ss->dimen;
return size;
}
*************** trans_constant_array_constructor (gfc_ss
*** 1899,1916 ****
}
}
/* 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 trans_constant_array_constructor. Returns the
iteration count of the loop if suitable, and NULL_TREE otherwise. */
static tree
! constant_array_constructor_loop_size (gfc_loopinfo * loop)
{
tree size = gfc_index_one_node;
tree tmp;
! int i;
for (i = 0; i < loop->dimen; i++)
{
/* If the bounds aren't constant, return NULL_TREE. */
--- 2033,2069 ----
}
}
+
+ static int
+ get_rank (gfc_loopinfo *loop)
+ {
+ int rank;
+
+ rank = 0;
+ for (; loop; loop = loop->parent)
+ rank += loop->dimen;
+
+ return rank;
+ }
+
+
/* 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 trans_constant_array_constructor. Returns the
iteration count of the loop if suitable, and NULL_TREE otherwise. */
static tree
! constant_array_constructor_loop_size (gfc_loopinfo * l)
{
+ gfc_loopinfo *loop;
tree size = gfc_index_one_node;
tree tmp;
! int i, total_dim;
+ total_dim = get_rank (l);
+
+ for (loop = l; loop; loop = loop->parent)
+ {
for (i = 0; i < loop->dimen; i++)
{
/* If the bounds aren't constant, return NULL_TREE. */
*************** constant_array_constructor_loop_size (gf
*** 1919,1925 ****
if (!integer_zerop (loop->from[i]))
{
/* Only allow nonzero "from" in one-dimensional arrays. */
! if (loop->dimen != 1)
return NULL_TREE;
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
--- 2072,2078 ----
if (!integer_zerop (loop->from[i]))
{
/* Only allow nonzero "from" in one-dimensional arrays. */
! if (total_dim != 1)
return NULL_TREE;
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
*************** constant_array_constructor_loop_size (gf
*** 1927,1948 ****
}
else
tmp = loop->to[i];
! tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
! tmp, gfc_index_one_node);
! size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
! size, tmp);
}
return size;
}
/* Array constructors are handled by constructing a temporary, then using that
within the scalarization loop. This is not optimal, but seems by far the
simplest method. */
static void
! gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
{
gfc_constructor_base c;
tree offset;
--- 2080,2129 ----
}
else
tmp = loop->to[i];
! tmp = fold_build2_loc (input_location, PLUS_EXPR,
! gfc_array_index_type, tmp, gfc_index_one_node);
! size = fold_build2_loc (input_location, MULT_EXPR,
! gfc_array_index_type, size, tmp);
! }
}
return size;
}
+ static tree *
+ get_loop_upper_bound_for_array (gfc_ss *array, int array_dim)
+ {
+ gfc_ss *ss;
+ int n;
+
+ gcc_assert (array->nested_ss == NULL);
+
+ for (ss = array; ss; ss = ss->parent)
+ for (n = 0; n < ss->loop->dimen; n++)
+ if (array_dim == get_array_ref_dim_for_loop_dim (ss, n))
+ return &(ss->loop->to[n]);
+
+ gcc_unreachable ();
+ }
+
+
+ static gfc_loopinfo *
+ outermost_loop (gfc_loopinfo * loop)
+ {
+ while (loop->parent != NULL)
+ loop = loop->parent;
+
+ return loop;
+ }
+
+
/* Array constructors are handled by constructing a temporary, then using that
within the scalarization loop. This is not optimal, but seems by far the
simplest method. */
static void
! trans_array_constructor (gfc_ss * ss, locus * where)
{
gfc_constructor_base c;
tree offset;
*************** gfc_trans_array_constructor (gfc_loopinf
*** 1950,1966 ****
--- 2131,2152 ----
tree desc;
tree type;
tree tmp;
+ tree *loop_ubound0;
bool dynamic;
bool old_first_len, old_typespec_chararray_ctor;
tree old_first_len_val;
+ gfc_loopinfo *loop, *outer_loop;
gfc_ss_info *ss_info;
gfc_expr *expr;
+ gfc_ss *s;
/* 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;
+ loop = ss->loop;
+ outer_loop = outermost_loop (loop);
ss_info = ss->info;
expr = ss_info->expr;
*************** gfc_trans_array_constructor (gfc_loopinf
*** 1976,1982 ****
first_len = true;
}
! gcc_assert (ss->dimen == loop->dimen);
c = expr->value.constructor;
if (expr->ts.type == BT_CHARACTER)
--- 2162,2168 ----
first_len = true;
}
! gcc_assert (ss->dimen == ss->loop->dimen);
c = expr->value.constructor;
if (expr->ts.type == BT_CHARACTER)
*************** gfc_trans_array_constructor (gfc_loopinf
*** 1996,2006 ****
gfc_conv_expr_type (&length_se, expr->ts.u.cl->length,
gfc_charlen_type_node);
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_info->string_length);
/* Complex character array constructors should have been taken care of
--- 2182,2192 ----
gfc_conv_expr_type (&length_se, expr->ts.u.cl->length,
gfc_charlen_type_node);
ss_info->string_length = length_se.expr;
! gfc_add_block_to_block (&outer_loop->pre, &length_se.pre);
! gfc_add_block_to_block (&outer_loop->post, &length_se.post);
}
else
! const_string = get_array_ctor_strlen (&outer_loop->pre, c,
&ss_info->string_length);
/* Complex character array constructors should have been taken care of
*************** gfc_trans_array_constructor (gfc_loopinf
*** 2019,2044 ****
/* See if the constructor determines the loop bounds. */
dynamic = false;
! if (expr->shape && loop->dimen > 1 && loop->to[0] == NULL_TREE)
{
/* We have a multidimensional parameter. */
int n;
! for (n = 0; n < expr->rank; n++)
{
! loop->from[n] = gfc_index_zero_node;
! 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,
! loop->to[n], gfc_index_one_node);
}
}
! if (loop->to[0] == NULL_TREE)
{
mpz_t size;
/* We should have a 1-dimensional, zero-based loop. */
gcc_assert (loop->dimen == 1);
gcc_assert (integer_zerop (loop->from[0]));
--- 2205,2237 ----
/* See if the constructor determines the loop bounds. */
dynamic = false;
! loop_ubound0 = get_loop_upper_bound_for_array (ss, 0);
!
! if (expr->shape && get_rank (loop) > 1 && *loop_ubound0 == NULL_TREE)
{
/* We have a multidimensional parameter. */
+ for (s = ss; s; s = s->parent)
+ {
int n;
! for (n = 0; n < s->loop->dimen; n++)
{
! s->loop->from[n] = gfc_index_zero_node;
! s->loop->to[n] = gfc_conv_mpz_to_tree (expr->shape[s->dim[n]],
gfc_index_integer_kind);
! s->loop->to[n] = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
! s->loop->to[n],
! gfc_index_one_node);
! }
}
}
! if (*loop_ubound0 == NULL_TREE)
{
mpz_t size;
/* We should have a 1-dimensional, zero-based loop. */
+ gcc_assert (loop->parent == NULL && loop->nested == NULL);
gcc_assert (loop->dimen == 1);
gcc_assert (integer_zerop (loop->from[0]));
*************** gfc_trans_array_constructor (gfc_loopinf
*** 2067,2084 ****
}
}
! if (TREE_CODE (loop->to[0]) == VAR_DECL)
dynamic = true;
! gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, ss,
! type, NULL_TREE, dynamic, true, false, where);
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;
TREE_USED (offsetvar) = 0;
! gfc_trans_array_constructor_value (&loop->pre, type, desc, c,
&offset, &offsetvar, dynamic);
/* If the array grows dynamically, the upper bound of the loop variable
--- 2260,2277 ----
}
}
! if (TREE_CODE (*loop_ubound0) == VAR_DECL)
dynamic = true;
! gfc_trans_create_temp_array (&outer_loop->pre, &outer_loop->post, ss, type,
! NULL_TREE, dynamic, true, false, where);
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;
TREE_USED (offsetvar) = 0;
! gfc_trans_array_constructor_value (&outer_loop->pre, type, desc, c,
&offset, &offsetvar, dynamic);
/* If the array grows dynamically, the upper bound of the loop variable
*************** gfc_trans_array_constructor (gfc_loopinf
*** 2088,2099 ****
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
offsetvar, gfc_index_one_node);
! tmp = gfc_evaluate_now (tmp, &loop->pre);
gfc_conv_descriptor_ubound_set (&loop->pre, desc, gfc_rank_cst[0], tmp);
! if (loop->to[0] && TREE_CODE (loop->to[0]) == VAR_DECL)
! gfc_add_modify (&loop->pre, loop->to[0], tmp);
else
! loop->to[0] = tmp;
}
if (TREE_USED (offsetvar))
--- 2281,2292 ----
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
offsetvar, gfc_index_one_node);
! tmp = gfc_evaluate_now (tmp, &outer_loop->pre);
gfc_conv_descriptor_ubound_set (&loop->pre, desc, gfc_rank_cst[0], tmp);
! if (*loop_ubound0 && TREE_CODE (*loop_ubound0) == VAR_DECL)
! gfc_add_modify (&outer_loop->pre, *loop_ubound0, tmp);
else
! *loop_ubound0 = tmp;
}
if (TREE_USED (offsetvar))
*************** finish:
*** 2123,2130 ****
loop bounds. */
static void
! set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss)
{
gfc_array_info *info;
gfc_se se;
tree tmp;
--- 2316,2324 ----
loop bounds. */
static void
! set_vector_loop_bounds (gfc_ss * ss)
{
+ gfc_loopinfo *loop, *outer_loop;
gfc_array_info *info;
gfc_se se;
tree tmp;
*************** set_vector_loop_bounds (gfc_loopinfo * l
*** 2133,2146 ****
int n;
int dim;
info = &ss->info->data.array;
for (n = 0; n < loop->dimen; n++)
{
dim = ss->dim[n];
! if (info->ref->u.ar.dimen_type[dim] == DIMEN_VECTOR
! && loop->to[n] == NULL)
! {
/* Loop variable N indexes vector dimension DIM, and we don't
yet know the upper bound of loop variable N. Set it to the
difference between the vector's upper and lower bounds. */
--- 2327,2347 ----
int n;
int dim;
+ outer_loop = outermost_loop (ss->loop);
+
info = &ss->info->data.array;
+ for (; ss; ss = ss->parent)
+ {
+ loop = ss->loop;
+
for (n = 0; n < loop->dimen; n++)
{
dim = ss->dim[n];
! if (info->ref->u.ar.dimen_type[dim] != DIMEN_VECTOR
! || loop->to[n] != NULL)
! continue;
!
/* Loop variable N indexes vector dimension DIM, and we don't
yet know the upper bound of loop variable N. Set it to the
difference between the vector's upper and lower bounds. */
*************** set_vector_loop_bounds (gfc_loopinfo * l
*** 2155,2161 ****
gfc_array_index_type,
gfc_conv_descriptor_ubound_get (desc, zero),
gfc_conv_descriptor_lbound_get (desc, zero));
! tmp = gfc_evaluate_now (tmp, &loop->pre);
loop->to[n] = tmp;
}
}
--- 2356,2362 ----
gfc_array_index_type,
gfc_conv_descriptor_ubound_get (desc, zero),
gfc_conv_descriptor_lbound_get (desc, zero));
! tmp = gfc_evaluate_now (tmp, &outer_loop->pre);
loop->to[n] = tmp;
}
}
*************** static void
*** 2170,2181 ****
--- 2371,2386 ----
gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
locus * where)
{
+ gfc_loopinfo *nested_loop, *outer_loop;
gfc_se se;
gfc_ss_info *ss_info;
gfc_array_info *info;
gfc_expr *expr;
+ bool skip_nested = false;
int n;
+ outer_loop = outermost_loop (loop);
+
/* TODO: This can generate bad code if there are ordering dependencies,
e.g., a callee allocated function and an unknown size constructor. */
gcc_assert (ss != NULL);
*************** gfc_add_loop_ss_code (gfc_loopinfo * loo
*** 2184,2189 ****
--- 2389,2398 ----
{
gcc_assert (ss);
+ /* Cross loop arrays are handled from within the most nested loop. */
+ if (ss->nested_ss != NULL)
+ continue;
+
ss_info = ss->info;
expr = ss_info->expr;
info = &ss_info->data.array;
*************** gfc_add_loop_ss_code (gfc_loopinfo * loo
*** 2195,2201 ****
dimension indices, but not array section bounds. */
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, expr);
! gfc_add_block_to_block (&loop->pre, &se.pre);
if (expr->ts.type != BT_CHARACTER)
{
--- 2404,2410 ----
dimension indices, but not array section bounds. */
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, expr);
! gfc_add_block_to_block (&outer_loop->pre, &se.pre);
if (expr->ts.type != BT_CHARACTER)
{
*************** gfc_add_loop_ss_code (gfc_loopinfo * loo
*** 2204,2214 ****
if (subscript)
se.expr = convert(gfc_array_index_type, se.expr);
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_info->data.scalar.value = se.expr;
ss_info->string_length = se.string_length;
--- 2413,2423 ----
if (subscript)
se.expr = convert(gfc_array_index_type, se.expr);
if (!ss_info->where)
! se.expr = gfc_evaluate_now (se.expr, &outer_loop->pre);
! gfc_add_block_to_block (&outer_loop->pre, &se.post);
}
else
! gfc_add_block_to_block (&outer_loop->post, &se.post);
ss_info->data.scalar.value = se.expr;
ss_info->string_length = se.string_length;
*************** gfc_add_loop_ss_code (gfc_loopinfo * loo
*** 2219,2228 ****
now. */
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, expr);
! gfc_add_block_to_block (&loop->pre, &se.pre);
! gfc_add_block_to_block (&loop->post, &se.post);
! ss_info->data.scalar.value = gfc_evaluate_now (se.expr, &loop->pre);
ss_info->string_length = se.string_length;
break;
--- 2428,2438 ----
now. */
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, expr);
! gfc_add_block_to_block (&outer_loop->pre, &se.pre);
! gfc_add_block_to_block (&outer_loop->post, &se.post);
! ss_info->data.scalar.value = gfc_evaluate_now (se.expr,
! &outer_loop->pre);
ss_info->string_length = se.string_length;
break;
*************** gfc_add_loop_ss_code (gfc_loopinfo * loo
*** 2230,2246 ****
/* Add the expressions for scalar and vector subscripts. */
for (n = 0; n < GFC_MAX_DIMENSIONS; n++)
if (info->subscript[n])
gfc_add_loop_ss_code (loop, info->subscript[n], true, where);
! set_vector_loop_bounds (loop, ss);
break;
case GFC_SS_VECTOR:
/* Get the vector's descriptor and store it in SS. */
gfc_init_se (&se, NULL);
gfc_conv_expr_descriptor (&se, expr, gfc_walk_expr (expr));
! gfc_add_block_to_block (&loop->pre, &se.pre);
! gfc_add_block_to_block (&loop->post, &se.post);
info->descriptor = se.expr;
break;
--- 2440,2461 ----
/* Add the expressions for scalar and vector subscripts. */
for (n = 0; n < GFC_MAX_DIMENSIONS; n++)
if (info->subscript[n])
+ {
gfc_add_loop_ss_code (loop, info->subscript[n], true, where);
+ /* The recursive call will have taken care of the nested loops.
+ No need to do it twice. */
+ skip_nested = true;
+ }
! set_vector_loop_bounds (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, expr, gfc_walk_expr (expr));
! gfc_add_block_to_block (&outer_loop->pre, &se.pre);
! gfc_add_block_to_block (&outer_loop->post, &se.post);
info->descriptor = se.expr;
break;
*************** gfc_add_loop_ss_code (gfc_loopinfo * loo
*** 2255,2262 ****
se.loop = loop;
se.ss = ss;
gfc_conv_expr (&se, expr);
! gfc_add_block_to_block (&loop->pre, &se.pre);
! gfc_add_block_to_block (&loop->post, &se.post);
ss_info->string_length = se.string_length;
break;
--- 2470,2477 ----
se.loop = loop;
se.ss = ss;
gfc_conv_expr (&se, expr);
! gfc_add_block_to_block (&outer_loop->pre, &se.pre);
! gfc_add_block_to_block (&outer_loop->post, &se.post);
ss_info->string_length = se.string_length;
break;
*************** gfc_add_loop_ss_code (gfc_loopinfo * loo
*** 2270,2279 ****
gfc_conv_expr_type (&se, expr->ts.u.cl->length,
gfc_charlen_type_node);
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_trans_array_constructor (loop, ss, where);
break;
case GFC_SS_TEMP:
--- 2485,2494 ----
gfc_conv_expr_type (&se, expr->ts.u.cl->length,
gfc_charlen_type_node);
ss_info->string_length = se.expr;
! gfc_add_block_to_block (&outer_loop->pre, &se.pre);
! gfc_add_block_to_block (&outer_loop->post, &se.post);
}
! trans_array_constructor (ss, where);
break;
case GFC_SS_TEMP:
*************** gfc_add_loop_ss_code (gfc_loopinfo * loo
*** 2285,2290 ****
--- 2500,2510 ----
gcc_unreachable ();
}
}
+
+ if (!skip_nested)
+ for (nested_loop = loop->nested; nested_loop;
+ nested_loop = nested_loop->next)
+ gfc_add_loop_ss_code (nested_loop, nested_loop->ss, subscript, where);
}
*************** gfc_trans_preloop_setup (gfc_loopinfo *
*** 2896,2902 ****
gfc_ss_info *ss_info;
gfc_array_info *info;
gfc_ss_type ss_type;
! gfc_ss *ss;
gfc_array_ref *ar;
int i;
--- 3116,3123 ----
gfc_ss_info *ss_info;
gfc_array_info *info;
gfc_ss_type ss_type;
! gfc_ss *ss, *pss;
! gfc_loopinfo *ploop;
gfc_array_ref *ar;
int i;
*************** gfc_trans_preloop_setup (gfc_loopinfo *
*** 2926,2943 ****
else
ar = NULL;
if (dim == loop->dimen - 1)
i = 0;
else
i = dim + 1;
/* For the time being, there is no loop reordering. */
! gcc_assert (i == loop->order[i]);
! i = loop->order[i];
! if (dim == loop->dimen - 1)
{
! stride = gfc_conv_array_stride (info->descriptor, ss->dim[i]);
/* Calculate the stride of the innermost loop. Hopefully this will
allow the backend optimizers to do their stuff more effectively.
--- 3147,3183 ----
else
ar = NULL;
+ if (dim == loop->dimen - 1 && loop->parent != NULL)
+ {
+ /* If we are in the outermost dimension of this loop, the previous
+ dimension shall be in the parent loop. */
+ gcc_assert (ss->parent != NULL);
+
+ pss = ss->parent;
+ ploop = loop->parent;
+
+ /* ss and ss->parent are about the same array. */
+ gcc_assert (ss_info == pss->info);
+ }
+ else
+ {
+ ploop = loop;
+ pss = ss;
+ }
+
if (dim == loop->dimen - 1)
i = 0;
else
i = dim + 1;
/* For the time being, there is no loop reordering. */
! gcc_assert (i == ploop->order[i]);
! i = ploop->order[i];
! if (dim == loop->dimen - 1 && loop->parent == NULL)
{
! stride = gfc_conv_array_stride (info->descriptor,
! innermost_ss (ss)->dim[i]);
/* Calculate the stride of the innermost loop. Hopefully this will
allow the backend optimizers to do their stuff more effectively.
*************** gfc_trans_preloop_setup (gfc_loopinfo *
*** 2960,2969 ****
}
else
/* 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)
info->saved_offset = info->offset;
}
}
--- 3200,3209 ----
}
else
/* Add the offset for the previous loop dimension. */
! add_array_offset (pblock, ploop, ss, ar, pss->dim[i], i);
/* Remember this offset for the second loop. */
! if (dim == loop->temp_dim - 1 && loop->parent == NULL)
info->saved_offset = info->offset;
}
}
*************** gfc_trans_scalarizing_loops (gfc_loopinf
*** 3148,3153 ****
--- 3388,3394 ----
/* Clear all the used flags. */
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
+ if (ss->parent == NULL)
ss->info->useflags = 0;
}
*************** done:
*** 3369,3375 ****
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->dimen; n++)
--- 3610,3618 ----
switch (ss_info->type)
{
case GFC_SS_SECTION:
! /* Get the descriptor for the array. If it is a cross loops array,
! we got the descriptor already in the outermost loop. */
! if (ss->parent == NULL)
gfc_conv_ss_descriptor (&loop->pre, ss, !loop->array_parameter);
for (n = 0; n < ss->dimen; n++)
*************** done:
*** 3659,3664 ****
--- 3902,3910 ----
tmp = gfc_finish_block (&block);
gfc_add_expr_to_block (&loop->pre, tmp);
}
+
+ for (loop = loop->nested; loop; loop = loop->next)
+ gfc_conv_ss_startstride (loop);
}
/* Return true if both symbols could refer to the same data object. Does
*************** temporary:
*** 3919,3943 ****
}
! /* Initialize the scalarization loop. Creates the loop variables. Determines
! the range of the loop variables. Creates a temporary if required.
! Calculates how to transform from loop variables to array indices for each
! expression. Also generates code for scalar expressions which have been
! moved outside the loop. */
! void
! gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
{
int n, dim, spec_dim;
gfc_array_info *info;
gfc_array_info *specinfo;
! gfc_ss *ss, *tmp_ss;
tree tmp;
! gfc_ss *loopspec[GFC_MAX_DIMENSIONS];
bool dynamic[GFC_MAX_DIMENSIONS];
mpz_t *cshape;
mpz_t i;
mpz_init (i);
for (n = 0; n < loop->dimen; n++)
{
--- 4165,4189 ----
}
! /* Browse through each array's information from the scalarizer and set the loop
! bounds according to the "best" one (per dimension), i.e. the one which
! provides the most information (constant bounds, shape, etc). */
! static void
! set_loop_bounds (gfc_loopinfo *loop)
{
int n, dim, spec_dim;
gfc_array_info *info;
gfc_array_info *specinfo;
! gfc_ss *ss;
tree tmp;
! gfc_ss **loopspec;
bool dynamic[GFC_MAX_DIMENSIONS];
mpz_t *cshape;
mpz_t i;
+ loopspec = loop->specloop;
+
mpz_init (i);
for (n = 0; n < loop->dimen; n++)
{
*************** gfc_conv_loop_setup (gfc_loopinfo * loop
*** 4057,4063 ****
&& INTEGER_CST_P (info->stride[dim]))
{
loop->from[n] = info->start[dim];
! 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);
--- 4303,4309 ----
&& INTEGER_CST_P (info->stride[dim]))
{
loop->from[n] = info->start[dim];
! mpz_set (i, cshape[get_array_ref_dim_for_loop_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);
*************** gfc_conv_loop_setup (gfc_loopinfo * loop
*** 4119,4124 ****
--- 4365,4392 ----
loop->from[n] = gfc_index_zero_node;
}
}
+ mpz_clear (i);
+
+ for (loop = loop->nested; loop; loop = loop->next)
+ set_loop_bounds (loop);
+ }
+
+
+ static void set_delta (gfc_loopinfo *loop);
+
+
+ /* Initialize the scalarization loop. Creates the loop variables. Determines
+ the range of the loop variables. Creates a temporary if required.
+ Also generates code for scalar expressions which have been
+ moved outside the loop. */
+
+ void
+ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
+ {
+ gfc_ss *tmp_ss;
+ tree tmp;
+
+ set_loop_bounds (loop);
/* Add all the scalar code that can be taken out of the loops.
This may include calculating the loop bounds, so do it before
*************** gfc_conv_loop_setup (gfc_loopinfo * loop
*** 4133,4138 ****
--- 4401,4407 ----
tmp_ss_info = tmp_ss->info;
gcc_assert (tmp_ss_info->type == GFC_SS_TEMP);
+ gcc_assert (loop->parent == NULL);
/* Make absolutely sure that this is a complete type. */
if (tmp_ss_info->string_length)
*************** gfc_conv_loop_setup (gfc_loopinfo * loop
*** 4147,4167 ****
gcc_assert (tmp_ss->dimen != 0);
! gfc_trans_create_temp_array (&loop->pre, &loop->post, loop,
! tmp_ss, tmp, NULL_TREE,
! false, true, false, where);
}
- for (n = 0; n < loop->temp_dim; n++)
- loopspec[loop->order[n]] = NULL;
-
- mpz_clear (i);
-
/* For array parameters we don't have loop variables, so don't calculate the
translations. */
if (loop->array_parameter)
return;
/* Calculate the translation from loop variables to array indices. */
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
{
--- 4416,4448 ----
gcc_assert (tmp_ss->dimen != 0);
! gfc_trans_create_temp_array (&loop->pre, &loop->post, tmp_ss, tmp,
! NULL_TREE, false, true, false, where);
}
/* For array parameters we don't have loop variables, so don't calculate the
translations. */
if (loop->array_parameter)
return;
+ set_delta (loop);
+ }
+
+
+ /* Calculates how to transform from loop variables to array indices for each
+ array: once loop bounds are chosen, sets the difference (DELTA field) between
+ loop bounds and array reference bounds, for each array info. */
+
+ static void
+ set_delta (gfc_loopinfo *loop)
+ {
+ gfc_ss *ss, **loopspec;
+ gfc_array_info *info;
+ tree tmp;
+ int n, dim;
+
+ loopspec = loop->specloop;
+
/* Calculate the translation from loop variables to array indices. */
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
{
*************** gfc_conv_loop_setup (gfc_loopinfo * loop
*** 4199,4204 ****
--- 4480,4488 ----
}
}
}
+
+ for (loop = loop->nested; loop; loop = loop->next)
+ set_delta (loop);
}
diff --git a/trans-array.h b/trans-array.h
index 57805b6ac5cfb0dd06cdd029c2fcc2f0989ebfc7..aad8c47b6f13ea6ba5ab17c677d44e26ce0aee60 100644
*** a/trans-array.h
--- b/trans-array.h
*************** void gfc_set_loop_bounds_from_array_spec
*** 31,39 ****
gfc_se *, gfc_array_spec *);
/* Generate code to create a temporary array. */
! tree gfc_trans_create_temp_array (stmtblock_t *, stmtblock_t *, gfc_loopinfo *,
! gfc_ss *, tree, tree, bool, bool, bool,
! locus *);
/* Generate function entry code for allocation of compiler allocated array
variables. */
--- 31,38 ----
gfc_se *, gfc_array_spec *);
/* Generate code to create a temporary array. */
! tree gfc_trans_create_temp_array (stmtblock_t *, stmtblock_t *, gfc_ss *,
! tree, tree, bool, bool, bool, locus *);
/* Generate function entry code for allocation of compiler allocated array
variables. */
diff --git a/trans-expr.c b/trans-expr.c
index 01d4ca3885fece6c4840c7d59861967ffe979e0c..4cfdc3e09067a5d0ee715db0e5b87f6efed791c1 100644
*** a/trans-expr.c
--- b/trans-expr.c
*************** void
*** 83,88 ****
--- 83,89 ----
gfc_advance_se_ss_chain (gfc_se * se)
{
gfc_se *p;
+ gfc_ss *ss;
gcc_assert (se != NULL && se->ss != NULL && se->ss != gfc_ss_terminator);
*************** gfc_advance_se_ss_chain (gfc_se * se)
*** 91,99 ****
while (p != NULL)
{
/* Simple consistency check. */
! gcc_assert (p->parent == NULL || p->parent->ss == p->ss);
! p->ss = p->ss->next;
p = p->parent;
}
--- 92,109 ----
while (p != NULL)
{
/* Simple consistency check. */
! gcc_assert (p->parent == NULL || p->parent->ss == p->ss
! || p->parent->ss->nested_ss == p->ss);
!
! /* If we were in a nested loop, the next scalarized expression can be
! on the parent ss' next pointer. Thus we should not take the next
! pointer blindly, but rather go up one nest level as long as next
! is the end of chain. */
! ss = p->ss;
! while (ss->next == gfc_ss_terminator && ss->parent != NULL)
! ss = ss->parent;
! p->ss = ss->next;
p = p->parent;
}
*************** gfc_conv_procedure_call (gfc_se * se, gf
*** 3606,3612 ****
returns a pointer, the temporary will be a shallow copy and
mustn't be deallocated. */
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->info->expr->where);
--- 3616,3622 ----
returns a pointer, the temporary will be a shallow copy and
mustn't be deallocated. */
callee_alloc = comp->attr.allocatable || comp->attr.pointer;
! gfc_trans_create_temp_array (&se->pre, &se->post, se->ss,
tmp, NULL_TREE, false,
!comp->attr.pointer, callee_alloc,
&se->ss->info->expr->where);
*************** gfc_conv_procedure_call (gfc_se * se, gf
*** 3642,3648 ****
returns a pointer, the temporary will be a shallow copy and
mustn't be deallocated. */
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->info->expr->where);
--- 3652,3658 ----
returns a pointer, the temporary will be a shallow copy and
mustn't be deallocated. */
callee_alloc = sym->attr.allocatable || sym->attr.pointer;
! gfc_trans_create_temp_array (&se->pre, &se->post, se->ss,
tmp, NULL_TREE, false,
!sym->attr.pointer, callee_alloc,
&se->ss->info->expr->where);
diff --git a/trans-intrinsic.c b/trans-intrinsic.c
index fcc59d7086a684b66b9a3f19351e70c33b8c2dba..c3a414b789b1ffa9b65c4af99b734af11e88f67e 100644
*** a/trans-intrinsic.c
--- b/trans-intrinsic.c
*************** gfc_conv_intrinsic_transfer (gfc_se * se
*** 5501,5509 ****
/* Build a destination descriptor, using the pointer, source, as the
data field. */
! gfc_trans_create_temp_array (&se->pre, &se->post, se->loop,
! se->ss, mold_type, NULL_TREE, false, true, false,
! &expr->where);
/* Cast the pointer to the result. */
tmp = gfc_conv_descriptor_data_get (info->descriptor);
--- 5501,5508 ----
/* Build a destination descriptor, using the pointer, source, as the
data field. */
! gfc_trans_create_temp_array (&se->pre, &se->post, se->ss, mold_type,
! NULL_TREE, false, true, false, &expr->where);
/* Cast the pointer to the result. */
tmp = gfc_conv_descriptor_data_get (info->descriptor);
diff --git a/trans-stmt.c b/trans-stmt.c
index 86a56e8c19a40cae900b6f5d72cb3c0e6270e740..2e023207e0eede6cdcc0239c072dce85b9d5218a 100644
*** a/trans-stmt.c
--- b/trans-stmt.c
*************** gfc_conv_elemental_dependencies (gfc_se
*** 309,319 ****
size = gfc_create_var (gfc_array_index_type, NULL);
data = gfc_create_var (pvoid_type_node, NULL);
gfc_init_block (&temp_post);
! tmp = gfc_trans_create_temp_array (&se->pre, &temp_post,
! &tmp_loop, ss, temptype,
! initial,
! false, true, false,
! &arg->expr->where);
gfc_add_modify (&se->pre, size, tmp);
tmp = fold_convert (pvoid_type_node, info->data);
gfc_add_modify (&se->pre, data, tmp);
--- 309,318 ----
size = gfc_create_var (gfc_array_index_type, NULL);
data = gfc_create_var (pvoid_type_node, NULL);
gfc_init_block (&temp_post);
! ss->loop = &tmp_loop;
! tmp = gfc_trans_create_temp_array (&se->pre, &temp_post, ss,
! temptype, initial, false, true,
! false, &arg->expr->where);
gfc_add_modify (&se->pre, size, tmp);
tmp = fold_convert (pvoid_type_node, info->data);
gfc_add_modify (&se->pre, data, tmp);
diff --git a/trans.h b/trans.h
index c35b1ae0fdacbb3812588188f118dd760922cc3f..4d745f144ceb205db9c6aec76ad08c815a654e23 100644
*** a/trans.h
--- b/trans.h
*************** gfc_ss_type;
*** 185,190 ****
--- 185,191 ----
typedef struct gfc_ss_info
{
+ int refcount;
gfc_ss_type type;
gfc_expr *expr;
tree string_length;
*************** typedef struct gfc_ss
*** 245,250 ****
--- 246,262 ----
struct gfc_ss *loop_chain;
struct gfc_ss *next;
+ /* Non-null if the ss is part of a nested loop. */
+ struct gfc_ss *parent;
+
+ /* If the evaluation of an expression requires a nested loop (for example
+ if the sum intrinsic is evaluated inline), this points to the nested
+ loop's gfc_ss. */
+ struct gfc_ss *nested_ss;
+
+ /* The loop this gfc_ss is in. */
+ struct gfc_loopinfo *loop;
+
unsigned is_alloc_lhs:1;
}
gfc_ss;
*************** typedef struct gfc_loopinfo
*** 267,272 ****
--- 279,290 ----
/* The SS describing the temporary used in an assignment. */
gfc_ss *temp_ss;
+ /* Non-null if this loop is nested in another one. */
+ struct gfc_loopinfo *parent;
+
+ /* Chain of nested loops. */
+ struct gfc_loopinfo *nested, *next;
+
/* The scalarization loop index variables. */
tree loopvar[GFC_MAX_DIMENSIONS];
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [07..12/66] inline sum and product: Preliminary cleanups
2011-10-27 23:43 [Patch, fortran] [00/66] PR fortran/43829 Inline sum and product (AKA scalarization of reductions) Mikael Morin
2011-10-27 23:32 ` [Patch, fortran] [20..30/66] inline sum and product: Update core structs Mikael Morin
@ 2011-10-27 23:35 ` Mikael Morin
2011-10-27 23:31 ` [Patch, fortran] [07/66] inline sum and product: Preliminary cleanups: Useless coarray code removal Mikael Morin
` (5 more replies)
2011-10-27 23:35 ` [Patch, fortran] [31..53/66] inline sum and product: Update the scalarizer Mikael Morin
` (6 subsequent siblings)
8 siblings, 6 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:35 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 412 bytes --]
This is a collection of independant and mostly trivial cleanups.
I don't attach the combined patch as it is the concatenation of the separate
patches.
Patch 07: Useless coarray code removal.
Patch 08: Remove redundant condition.
Patch 09: Assertify condition.
Patch 10: Use array dimensions instead of loop dimensions.
Patch 11: Skip temporary arrays for loopspec choice.
Patch 12: Stop loop before end marker.
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [33/66] inline sum and product: Update the scalarizer.
2011-10-27 23:35 ` [Patch, fortran] [31..53/66] inline sum and product: Update the scalarizer Mikael Morin
` (2 preceding siblings ...)
2011-10-27 23:35 ` [Patch, fortran] [45/66] inline sum and product: Update the scalarizer: Update dimension mapping inversion functions Mikael Morin
@ 2011-10-27 23:35 ` Mikael Morin
2011-10-27 23:35 ` [Patch, fortran] [47..48/66] inline sum and product: Update the scalarizer: New gfc_loopinfo::nested_loop field Mikael Morin
` (8 subsequent siblings)
12 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:35 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 665 bytes --]
gfc_trans_create_temp_array has code like this:
for (n = 0; n < loop->dimen; n++)
{
if (size == NULL)
{
/* blah */
continue;
}
/* bleh */
}
We are going to update this to handle more than one loop.
However the two branches will get different treatments (see patches 45 and 46),
so we can't keep one single for loop for both branches.
This patch changes the code into:
if (size == NULL)
{
for (n = 0; n < loop->dimen; n++)
{
/* blah */
}
}
else
{
for (n = 0; n < loop->dimen; n++
{
/* bleh */
}
}
Context diff with blank spaces ignored also attached.
OK?
[-- Attachment #2: pr43829-33.CL --]
[-- Type: text/plain, Size: 151 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (gfc_trans_create_temp_array): Move invariant condition
out of the containing loop.
[-- Attachment #3: pr43829-33.patch --]
[-- Type: text/x-diff, Size: 2954 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 545f2fb..663d12e 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -961,12 +961,12 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
break;
}
- for (n = 0; n < loop->dimen; n++)
+ if (size == NULL_TREE)
{
- dim = ss->dim[n];
-
- if (size == NULL_TREE)
+ for (n = 0; n < loop->dimen; n++)
{
+ dim = ss->dim[n];
+
/* For a callee allocated array express the loop bounds in terms
of the descriptor fields. */
tmp = fold_build2_loc (input_location,
@@ -974,39 +974,42 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]),
gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]));
loop->to[n] = tmp;
- continue;
}
-
- /* Store the stride and bound components in the descriptor. */
- gfc_conv_descriptor_stride_set (pre, desc, gfc_rank_cst[n], size);
+ }
+ else
+ {
+ for (n = 0; n < loop->dimen; n++)
+ {
+ /* Store the stride and bound components in the descriptor. */
+ gfc_conv_descriptor_stride_set (pre, desc, gfc_rank_cst[n], size);
- gfc_conv_descriptor_lbound_set (pre, desc, gfc_rank_cst[n],
- gfc_index_zero_node);
+ gfc_conv_descriptor_lbound_set (pre, desc, gfc_rank_cst[n],
+ gfc_index_zero_node);
- gfc_conv_descriptor_ubound_set (pre, desc, gfc_rank_cst[n],
- to[n]);
+ gfc_conv_descriptor_ubound_set (pre, desc, gfc_rank_cst[n], to[n]);
- tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
- to[n], gfc_index_one_node);
+ tmp = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type,
+ to[n], gfc_index_one_node);
- /* Check whether the size for this dimension is negative. */
- cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, tmp,
- gfc_index_zero_node);
- cond = gfc_evaluate_now (cond, pre);
+ /* Check whether the size for this dimension is negative. */
+ cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node,
+ tmp, gfc_index_zero_node);
+ cond = gfc_evaluate_now (cond, pre);
- if (n == 0)
- or_expr = cond;
- else
- or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR,
- boolean_type_node, or_expr, cond);
+ if (n == 0)
+ or_expr = cond;
+ else
+ or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR,
+ boolean_type_node, or_expr, cond);
- size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- size, tmp);
- size = gfc_evaluate_now (size, pre);
+ size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, size, tmp);
+ size = gfc_evaluate_now (size, pre);
+ }
}
/* Get the size of the array. */
-
if (size && !callee_alloc)
{
/* If or_expr is true, then the extent in at least one
[-- Attachment #4: pr43829-33.diff --]
[-- Type: text/x-diff, Size: 3645 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 545f2fb21a90c09ee439ae3f56656317b18eeb0a..663d12e6e6925b0d458ccbb1558204b46249f482 100644
*** a/trans-array.c
--- b/trans-array.c
*************** gfc_trans_create_temp_array (stmtblock_t
*** 961,972 ****
break;
}
for (n = 0; n < loop->dimen; n++)
{
dim = ss->dim[n];
- if (size == NULL_TREE)
- {
/* For a callee allocated array express the loop bounds in terms
of the descriptor fields. */
tmp = fold_build2_loc (input_location,
--- 961,972 ----
break;
}
+ if (size == NULL_TREE)
+ {
for (n = 0; n < loop->dimen; n++)
{
dim = ss->dim[n];
/* For a callee allocated array express the loop bounds in terms
of the descriptor fields. */
tmp = fold_build2_loc (input_location,
*************** gfc_trans_create_temp_array (stmtblock_t
*** 974,997 ****
gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]),
gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]));
loop->to[n] = tmp;
- continue;
}
!
/* Store the stride and bound components in the descriptor. */
gfc_conv_descriptor_stride_set (pre, desc, gfc_rank_cst[n], size);
gfc_conv_descriptor_lbound_set (pre, desc, gfc_rank_cst[n],
gfc_index_zero_node);
! gfc_conv_descriptor_ubound_set (pre, desc, gfc_rank_cst[n],
! to[n]);
! tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
to[n], gfc_index_one_node);
/* Check whether the size for this dimension is negative. */
! cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, tmp,
! gfc_index_zero_node);
cond = gfc_evaluate_now (cond, pre);
if (n == 0)
--- 974,1000 ----
gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]),
gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]));
loop->to[n] = tmp;
}
! }
! else
! {
! for (n = 0; n < loop->dimen; n++)
! {
/* Store the stride and bound components in the descriptor. */
gfc_conv_descriptor_stride_set (pre, desc, gfc_rank_cst[n], size);
gfc_conv_descriptor_lbound_set (pre, desc, gfc_rank_cst[n],
gfc_index_zero_node);
! gfc_conv_descriptor_ubound_set (pre, desc, gfc_rank_cst[n], to[n]);
! tmp = fold_build2_loc (input_location, PLUS_EXPR,
! gfc_array_index_type,
to[n], gfc_index_one_node);
/* Check whether the size for this dimension is negative. */
! cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node,
! tmp, gfc_index_zero_node);
cond = gfc_evaluate_now (cond, pre);
if (n == 0)
*************** gfc_trans_create_temp_array (stmtblock_t
*** 1000,1012 ****
or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR,
boolean_type_node, or_expr, cond);
! size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
! size, tmp);
size = gfc_evaluate_now (size, pre);
}
/* Get the size of the array. */
-
if (size && !callee_alloc)
{
/* If or_expr is true, then the extent in at least one
--- 1003,1015 ----
or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR,
boolean_type_node, or_expr, cond);
! size = fold_build2_loc (input_location, MULT_EXPR,
! gfc_array_index_type, size, tmp);
size = gfc_evaluate_now (size, pre);
}
+ }
/* Get the size of the array. */
if (size && !callee_alloc)
{
/* If or_expr is true, then the extent in at least one
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [45/66] inline sum and product: Update the scalarizer: Update dimension mapping inversion functions.
2011-10-27 23:35 ` [Patch, fortran] [31..53/66] inline sum and product: Update the scalarizer Mikael Morin
2011-10-27 23:34 ` [Patch, fortran] [31/66] inline sum and product: Update the scalarizer: Split gfc_conv_loop_setup Mikael Morin
2011-10-27 23:34 ` [Patch, fortran] [32/66] inline sum and product: Update the scalarizer: clear specloop in gfc_trans_create_temp_arrays Mikael Morin
@ 2011-10-27 23:35 ` Mikael Morin
2011-10-27 23:35 ` [Patch, fortran] [33/66] inline sum and product: Update the scalarizer Mikael Morin
` (9 subsequent siblings)
12 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:35 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 1873 bytes --]
gfc_trans_create_temp_arrays has been using loop bounds to set array
temporary bounds; this is a sensible thing to do as gfc_conv_loop_setup
tries to set loop bounds according to the most information (especially w.r.t.
constantness) it can find.
For plain arrays like `a(:,:)' or `b(:,1,:)', it's quite simple, as there is
a direct maping between loop bounds and temporary bounds.
Now, if we are creating a temporary for the argument of `transpose(a(:,1,1,:))'
we have to be careful as the loop has a direct mapping to
`transpose(a(:,1,1:))', while the temporary has a direct mapping to
`a(:,1,1,:)'. It is currently done (in get_array_ref_dim) by looking at the dim
array which is in the case above: {3,0}. If we want to know the bounds of the
first dimension (or zero'th as it is zero-based) of the temporary, we see that
dim[0] == 3, and that there is one element in dim that is below 3. Thus bounds
are to be taken from dimension number one (the second as it is zero-based)
of the loop.
The same function is used to retrieve the shape dimension from the loop
dimension in gfc_conv_loop_setup.
Now, let's throw sum in the mix. Now we have to generate bounds properly
when generating a temporary either for the inner or outer arrays in the
following cases:
sum(a(:,1,1,:), dim=1)
transpose(sum(a(:,1,:,:), dim=1))
sum(transpose(a(:,1,1,:)), dim=1)
For the outer array, in all cases, the current implementation can be kept as is,
as the inner loop can be completely ignored.
For the inner array, however, we have to take care of the current loop, and all
the parents ones it is in, so this patch adds a walk towards the outer array.
With this change, the function can't be used as is anymore in
gfc_conv_loop_setup, as it is ignoring nested loops: we have to start from the
most nested array slice before calling the function. This patch also does that.
OK?
[-- Attachment #2: pr43829-45.CL --]
[-- Type: text/plain, Size: 384 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (get_array_ref_dim, get_scalarizer_dim_for_array_dim):
Rename the former to the latter and loop over the parents.
(innermost_ss): New function.
(get_array_ref_dim_for_loop_dim): New function.
(gfc_trans_create_temp_array): Use get_scalarizer_dim_for_array_dim.
(set_loop_bounds): Use get_array_dim_for_loop_dim).
[-- Attachment #3: pr43829-45.patch --]
[-- Type: text/x-diff, Size: 3723 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 25d9a37..d918fa8 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -868,28 +868,62 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post,
}
-/* Get the array reference dimension corresponding to the given loop dimension.
- It is different from the true array dimension given by the dim array in
- the case of a partial array reference
- It is different from the loop dimension in the case of a transposed array.
- */
+/* Get the scalarizer array dimension corresponding to actual array dimension
+ given by ARRAY_DIM.
+
+ For example, if SS represents the array ref a(1,:,:,1), it is a
+ bidimensional scalarizer array, and the result would be 0 for ARRAY_DIM=1,
+ and 1 for ARRAY_DIM=2.
+ If SS represents transpose(a(:,1,1,:)), it is again a bidimensional
+ scalarizer array, and the result would be 1 for ARRAY_DIM=0 and 0 for
+ ARRAY_DIM=3.
+ If SS represents sum(a(:,:,:,1), dim=1), it is a 2+1-dimensional scalarizer
+ array. If called on the inner ss, the result would be respectively 0,1,2 for
+ ARRAY_DIM=0,1,2. If called on the outer ss, the result would be 0,1
+ for ARRAY_DIM=1,2. */
static int
-get_array_ref_dim (gfc_ss *ss, int loop_dim)
+get_scalarizer_dim_for_array_dim (gfc_ss *ss, int array_dim)
{
- int n, array_dim, array_ref_dim;
+ int array_ref_dim;
+ int n;
array_ref_dim = 0;
- array_dim = ss->dim[loop_dim];
- for (n = 0; n < ss->dimen; n++)
- if (ss->dim[n] < array_dim)
- array_ref_dim++;
+ for (; ss; ss = ss->parent)
+ for (n = 0; n < ss->dimen; n++)
+ if (ss->dim[n] < array_dim)
+ array_ref_dim++;
return array_ref_dim;
}
+static gfc_ss *
+innermost_ss (gfc_ss *ss)
+{
+ while (ss->nested_ss != NULL)
+ ss = ss->nested_ss;
+
+ return ss;
+}
+
+
+
+/* Get the array reference dimension corresponding to the given loop dimension.
+ It is different from the true array dimension given by the dim array in
+ the case of a partial array reference (i.e. a(:,:,1,:) for example)
+ It is different from the loop dimension in the case of a transposed array.
+ */
+
+static int
+get_array_ref_dim_for_loop_dim (gfc_ss *ss, int loop_dim)
+{
+ return get_scalarizer_dim_for_array_dim (innermost_ss (ss),
+ ss->dim[loop_dim]);
+}
+
+
/* Generate code to create and initialize the descriptor for a temporary
array. This is used for both temporaries needed by the scalarizer, and
functions returning arrays. Adjusts the loop variables to be
@@ -959,7 +993,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
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 (ss, n);
+ tmp_dim = get_scalarizer_dim_for_array_dim (ss, dim);
from[tmp_dim] = loop->from[n];
to[tmp_dim] = loop->to[n];
@@ -1011,7 +1045,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
{
for (n = 0; n < loop->dimen; n++)
{
- dim = ss->dim[n];
+ dim = get_scalarizer_dim_for_array_dim (ss, ss->dim[n]);
/* For a callee allocated array express the loop bounds in terms
of the descriptor fields. */
@@ -4126,7 +4160,7 @@ set_loop_bounds (gfc_loopinfo *loop)
&& INTEGER_CST_P (info->stride[dim]))
{
loop->from[n] = info->start[dim];
- mpz_set (i, cshape[get_array_ref_dim (loopspec[n], n)]);
+ mpz_set (i, cshape[get_array_ref_dim_for_loop_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);
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [47..48/66] inline sum and product: Update the scalarizer: New gfc_loopinfo::nested_loop field.
2011-10-27 23:35 ` [Patch, fortran] [31..53/66] inline sum and product: Update the scalarizer Mikael Morin
` (3 preceding siblings ...)
2011-10-27 23:35 ` [Patch, fortran] [33/66] inline sum and product: Update the scalarizer Mikael Morin
@ 2011-10-27 23:35 ` Mikael Morin
2011-10-27 23:35 ` [Patch, fortran] [44/66] inline sum and product: Update the scalarizer: New gfc_ss::nested_ss field Mikael Morin
` (7 subsequent siblings)
12 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:35 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 182 bytes --]
This introduces the nested_loop list of nested loops inside a gfc_loopinfo
struct (patch 47).
Patch 48 adds to the scalarizer functions self-recursive calls on the nested
loops.
OK?
[-- Attachment #2: pr43829-47.CL --]
[-- Type: text/plain, Size: 213 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans.h (struct gfc_loopinfo): New fields nested and next.
* trans-array.c (gfc_add_ss_to_loop): Update list of nested list if
ss has non-null nested_ss field.
[-- Attachment #3: pr43829-47.patch --]
[-- Type: text/x-diff, Size: 1368 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 1a86ae6..0c1dc89 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -645,6 +645,7 @@ void
gfc_add_ss_to_loop (gfc_loopinfo * loop, gfc_ss * head)
{
gfc_ss *ss;
+ gfc_loopinfo *nested_loop;
if (head == gfc_ss_terminator)
return;
@@ -654,6 +655,21 @@ gfc_add_ss_to_loop (gfc_loopinfo * loop, gfc_ss * head)
ss = head;
for (; ss && ss != gfc_ss_terminator; ss = ss->next)
{
+ if (ss->nested_ss)
+ {
+ nested_loop = ss->nested_ss->loop;
+
+ /* More than one ss can belong to the same loop. Hence, we add the
+ loop to the chain only if it is different from the previously
+ added one, to avoid duplicate nested loops. */
+ if (nested_loop != loop->nested)
+ {
+ gcc_assert (nested_loop->next == NULL);
+ nested_loop->next = loop->nested;
+ loop->nested = nested_loop;
+ }
+ }
+
if (ss->next == gfc_ss_terminator)
ss->loop_chain = loop->ss;
else
diff --git a/trans.h b/trans.h
index 0608879..0549aa7 100644
--- a/trans.h
+++ b/trans.h
@@ -279,6 +279,9 @@ typedef struct gfc_loopinfo
/* The SS describing the temporary used in an assignment. */
gfc_ss *temp_ss;
+ /* Chain of nested loops. */
+ struct gfc_loopinfo *nested, *next;
+
/* The scalarization loop index variables. */
tree loopvar[GFC_MAX_DIMENSIONS];
[-- Attachment #4: pr43829-48.CL --]
[-- Type: text/plain, Size: 404 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (gfc_add_loop_ss_code): Skip non-nestedmost ss.
Call recursively gfc_add_loop_ss_code for all the nested loops.
(gfc_conv_ss_startstride): Only get the descriptor for the outermost
ss. Call recursively gfc_conv_ss_startstride for all the nested loops.
(set_loop_bounds): Call recursively for all the nested loops.
(set_delta): Ditto.
[-- Attachment #5: pr43829-48.patch --]
[-- Type: text/x-diff, Size: 2875 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 0c1dc89..27356a1 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -2295,10 +2295,12 @@ static void
gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
locus * where)
{
+ gfc_loopinfo *nested_loop;
gfc_se se;
gfc_ss_info *ss_info;
gfc_array_info *info;
gfc_expr *expr;
+ bool skip_nested = false;
int n;
/* TODO: This can generate bad code if there are ordering dependencies,
@@ -2309,6 +2311,10 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
{
gcc_assert (ss);
+ /* Cross loop arrays are handled from within the most nested loop. */
+ if (ss->nested_ss != NULL)
+ continue;
+
ss_info = ss->info;
expr = ss_info->expr;
info = &ss_info->data.array;
@@ -2355,7 +2361,12 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
/* Add the expressions for scalar and vector subscripts. */
for (n = 0; n < GFC_MAX_DIMENSIONS; n++)
if (info->subscript[n])
- gfc_add_loop_ss_code (loop, info->subscript[n], true, where);
+ {
+ gfc_add_loop_ss_code (loop, info->subscript[n], true, where);
+ /* The recursive call will have taken care of the nested loops.
+ No need to do it twice. */
+ skip_nested = true;
+ }
set_vector_loop_bounds (ss);
break;
@@ -2410,6 +2421,11 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
gcc_unreachable ();
}
}
+
+ if (!skip_nested)
+ for (nested_loop = loop->nested; nested_loop;
+ nested_loop = nested_loop->next)
+ gfc_add_loop_ss_code (nested_loop, nested_loop->ss, subscript, where);
}
@@ -3495,8 +3511,10 @@ done:
switch (ss_info->type)
{
case GFC_SS_SECTION:
- /* Get the descriptor for the array. */
- gfc_conv_ss_descriptor (&loop->pre, ss, !loop->array_parameter);
+ /* Get the descriptor for the array. If it is a cross loops array,
+ we got the descriptor already in the outermost loop. */
+ if (ss->parent == NULL)
+ gfc_conv_ss_descriptor (&loop->pre, ss, !loop->array_parameter);
for (n = 0; n < ss->dimen; n++)
gfc_conv_section_startstride (loop, ss, ss->dim[n]);
@@ -3785,6 +3803,9 @@ done:
tmp = gfc_finish_block (&block);
gfc_add_expr_to_block (&loop->pre, tmp);
}
+
+ for (loop = loop->nested; loop; loop = loop->next)
+ gfc_conv_ss_startstride (loop);
}
/* Return true if both symbols could refer to the same data object. Does
@@ -4246,6 +4267,9 @@ set_loop_bounds (gfc_loopinfo *loop)
}
}
mpz_clear (i);
+
+ for (loop = loop->nested; loop; loop = loop->next)
+ set_loop_bounds (loop);
}
@@ -4356,6 +4380,9 @@ set_delta (gfc_loopinfo *loop)
}
}
}
+
+ for (loop = loop->nested; loop; loop = loop->next)
+ set_delta (loop);
}
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [24/66] inline sum and product: Update core structs: Move expr.
2011-10-27 23:32 ` [Patch, fortran] [20..30/66] inline sum and product: Update core structs Mikael Morin
` (6 preceding siblings ...)
2011-10-27 23:34 ` [Patch, fortran] [27/66] inline sum and product: Update core structs: Move temp struct Mikael Morin
@ 2011-10-27 23:35 ` Mikael Morin
2011-10-27 23:35 ` [Patch, fortran] [21/66] inline sum and product: Update core structs: Move dim and dimen Mikael Morin
` (2 subsequent siblings)
10 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:35 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 54 bytes --]
This moves expr field from gfc_ss to gfc_ss_info.
OK?
[-- Attachment #2: pr43829-24.CL --]
[-- Type: text/plain, Size: 1062 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans.h (struct gfc_ss, struct gfc_ss_info): Move field expr from
the former struct to the latter.
* trans-array.c
(gfc_get_array_ss, gfc_get_scalar_ss,
gfc_trans_constant_array_constructor, gfc_trans_array_constructor,
gfc_add_loop_ss_code, gfc_conv_ss_descriptor,
gfc_trans_array_bound_check, gfc_conv_array_index_offset,
gfc_conv_scalarized_array_ref, gfc_conv_ss_startstride,
gfc_could_be_alias, gfc_conv_resolve_dependencies,
gfc_conv_loop_setup, gfc_conv_expr_descriptor,
gfc_alloc_allocatable_for_assignment): Update references to expr and
factor common reference chains where possible.
* trans-const.c (gfc_conv_constant): Ditto.
* trans-expr.c (gfc_conv_variable, gfc_conv_procedure_call,
gfc_conv_array_constructor_expr, gfc_conv_expr,
gfc_conv_expr_reference): Ditto.
* trans-intrinsic.c (trans_this_image, gfc_conv_intrinsic_bound,
gfc_conv_intrinsic_cobound, gfc_conv_intrinsic_funcall,
gfc_add_intrinsic_ss_code): Ditto.
* trans-stmt.c (gfc_conv_elemental_dependencies): Ditto.
[-- Attachment #3: pr43829-24.patch --]
[-- Type: text/x-diff, Size: 28447 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 80dadf4..65f7ade 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -533,11 +533,11 @@ gfc_get_array_ss (gfc_ss *next, gfc_expr *expr, int dimen, gfc_ss_type type)
ss_info = gfc_get_ss_info ();
ss_info->type = type;
+ ss_info->expr = expr;
ss = gfc_get_ss ();
ss->info = ss_info;
ss->next = next;
- ss->expr = expr;
ss->dimen = dimen;
for (i = 0; i < ss->dimen; i++)
ss->dim[i] = i;
@@ -581,11 +581,11 @@ gfc_get_scalar_ss (gfc_ss *next, gfc_expr *expr)
ss_info = gfc_get_ss_info ();
ss_info->type = GFC_SS_SCALAR;
+ ss_info->expr = expr;
ss = gfc_get_ss ();
ss->info = ss_info;
ss->next = next;
- ss->expr = expr;
return ss;
}
@@ -1882,7 +1882,7 @@ trans_constant_array_constructor (gfc_ss * ss, tree type)
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;
@@ -1953,19 +1953,22 @@ 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_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;
+ 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;
@@ -1973,22 +1976,22 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
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;
gfc_add_block_to_block (&loop->pre, &length_se.pre);
@@ -2002,26 +2005,26 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
and not end up here. */
gcc_assert (ss->string_length);
- ss->expr->ts.u.cl->backend_decl = ss->string_length;
+ expr->ts.u.cl->backend_decl = ss->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->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,
@@ -2166,6 +2169,8 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
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,
@@ -2176,16 +2181,19 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
{
gcc_assert (ss);
- switch (ss->info->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. */
@@ -2206,7 +2214,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
/* 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);
@@ -2227,7 +2235,7 @@ 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;
@@ -2243,20 +2251,20 @@ 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;
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->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;
gfc_add_block_to_block (&loop->pre, &se.pre);
@@ -2284,13 +2292,16 @@ static void
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;
@@ -2473,7 +2484,7 @@ trans_array_bound_check (gfc_se * se, gfc_ss *ss, tree index, int n,
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)
@@ -2624,10 +2635,10 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i,
Use the stride returned by the function call and stored in
the descriptor for the temporary. */
if (se->ss && se->ss->info->type == GFC_SS_FUNCTION
- && se->ss->expr
- && se->ss->expr->symtree
- && se->ss->expr->symtree->n.sym->result
- && se->ss->expr->symtree->n.sym->result->attr.pointer)
+ && se->ss->info->expr
+ && se->ss->info->expr->symtree
+ && se->ss->info->expr->symtree->n.sym->result
+ && se->ss->info->expr->symtree->n.sym->result->attr.pointer)
stride = gfc_conv_descriptor_stride_get (info->descriptor,
gfc_rank_cst[dim]);
@@ -2655,9 +2666,11 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar)
tree index;
tree tmp;
gfc_ss *ss;
+ gfc_expr *expr;
int n;
ss = se->ss;
+ expr = ss->info->expr;
info = &ss->data.info;
if (ar)
n = se->loop->order[0];
@@ -2671,11 +2684,10 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar)
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);
}
@@ -3305,7 +3317,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
/* 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:
@@ -3332,14 +3344,18 @@ done:
/* Loop over all the SS in the chain. */
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
{
+ gfc_ss_info *ss_info;
gfc_array_info *info;
+ gfc_expr *expr;
+ ss_info = ss->info;
+ expr = ss_info->expr;
info = &ss->data.info;
- if (ss->expr && ss->expr->shape && !info->shape)
- info->shape = ss->expr->shape;
+ if (expr && expr->shape && !info->shape)
+ info->shape = expr->shape;
- switch (ss->info->type)
+ switch (ss_info->type)
{
case GFC_SS_SECTION:
/* Get the descriptor for the array. */
@@ -3350,7 +3366,7 @@ done:
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:
@@ -3401,14 +3417,23 @@ 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->info->type != GFC_SS_SECTION)
+ ss_info = ss->info;
+ if (ss_info->type != GFC_SS_SECTION)
continue;
/* Catch allocatable lhs in f2003. */
if (gfc_option.flag_realloc_lhs && ss->is_alloc_lhs)
continue;
+ expr = ss_info->expr;
+ expr_loc = &expr->where;
+ expr_name = expr->symtree->name;
+
gfc_start_block (&inner);
/* TODO: range checking for mapped dimensions. */
@@ -3434,9 +3459,9 @@ 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;
@@ -3493,14 +3518,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));
@@ -3515,9 +3540,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);
@@ -3547,14 +3572,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));
@@ -3564,9 +3589,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);
@@ -3593,10 +3618,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]));
@@ -3610,10 +3635,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);
@@ -3666,12 +3691,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;
@@ -3689,7 +3718,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->data.info.ref; lref = lref->next)
{
if (lref->type != REF_COMPONENT)
continue;
@@ -3709,7 +3738,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->data.info.ref;
rref = rref->next)
{
if (rref->type != REF_COMPONENT)
@@ -3744,7 +3773,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->data.info.ref; rref = rref->next)
{
if (rref->type != REF_COMPONENT)
break;
@@ -3780,20 +3809,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->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;
@@ -3801,8 +3835,8 @@ 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]);
@@ -3861,7 +3895,7 @@ 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);
@@ -3949,7 +3983,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;
@@ -5739,6 +5773,7 @@ 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_array_info *info;
int need_tmp;
@@ -5750,12 +5785,14 @@ 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_type = ss->info->type;
+ ss_info = ss->info;
+ ss_type = ss_info->type;
+ ss_expr = ss_info->expr;
/* Special case things we know we can pass easily. */
switch (expr->expr_type)
@@ -5765,7 +5802,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
Otherwise we need to copy it into a temporary. */
gcc_assert (ss_type == GFC_SS_SECTION);
- gcc_assert (ss->expr == expr);
+ gcc_assert (ss_expr == expr);
info = &ss->data.info;
/* Get the descriptor for the array. */
@@ -5843,7 +5880,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)
@@ -5855,9 +5892,9 @@ 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)
@@ -7211,11 +7248,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. */
@@ -7226,7 +7263,7 @@ 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)
@@ -7236,7 +7273,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
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)
diff --git a/trans-const.c b/trans-const.c
index 84a8339..0cf2719 100644
--- a/trans-const.c
+++ b/trans-const.c
@@ -385,9 +385,12 @@ gfc_conv_constant (gfc_se * se, gfc_expr * expr)
ss = se->ss;
if (ss != NULL)
{
+ 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 (se->ss->expr == expr);
+ 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;
diff --git a/trans-expr.c b/trans-expr.c
index 5a94615..2e620ad 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,11 +623,12 @@ 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)
{
/* 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;
@@ -3604,8 +3606,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;
@@ -3640,8 +3642,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;
@@ -4243,7 +4245,7 @@ gfc_conv_array_constructor_expr (gfc_se * se, gfc_expr * expr)
ss = se->ss;
gcc_assert (ss != NULL && ss != gfc_ss_terminator);
- gcc_assert (ss->expr == expr && ss->info->type == GFC_SS_CONSTRUCTOR);
+ gcc_assert (ss->info->expr == expr && ss->info->type == GFC_SS_CONSTRUCTOR);
gfc_conv_tmp_array_ref (se);
}
@@ -4827,7 +4829,7 @@ gfc_conv_expr (gfc_se * se, gfc_expr * expr)
gfc_ss *ss;
ss = se->ss;
- if (ss && ss->expr == expr
+ if (ss && ss->info->expr == expr
&& (ss->info->type == GFC_SS_SCALAR
|| ss->info->type == GFC_SS_REFERENCE))
{
@@ -4957,7 +4959,7 @@ gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr)
tree var;
ss = se->ss;
- if (ss && ss->expr == expr
+ if (ss && ss->info->expr == expr
&& ss->info->type == GFC_SS_REFERENCE)
{
/* Returns a reference to the scalar evaluated outside the loop
diff --git a/trans-intrinsic.c b/trans-intrinsic.c
index dff16dc..ef9360b 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);
@@ -6800,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-stmt.c b/trans-stmt.c
index c89419a..936a4ee 100644
--- a/trans-stmt.c
+++ b/trans-stmt.c
@@ -220,7 +220,7 @@ 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;
break;
diff --git a/trans.h b/trans.h
index 13d4c58..5922360 100644
--- a/trans.h
+++ b/trans.h
@@ -186,6 +186,7 @@ gfc_ss_type;
typedef struct gfc_ss_info
{
gfc_ss_type type;
+ gfc_expr *expr;
}
gfc_ss_info;
@@ -204,7 +205,6 @@ typedef struct gfc_ss
{
gfc_ss_info *info;
- gfc_expr *expr;
tree string_length;
union
{
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [30/66] inline sum and product: Update core structs: Move where flag.
2011-10-27 23:32 ` [Patch, fortran] [20..30/66] inline sum and product: Update core structs Mikael Morin
` (8 preceding siblings ...)
2011-10-27 23:35 ` [Patch, fortran] [21/66] inline sum and product: Update core structs: Move dim and dimen Mikael Morin
@ 2011-10-27 23:35 ` Mikael Morin
2011-10-27 23:43 ` [Patch, fortran] [28/66] inline sum and product: Update core structs: Move info struct Mikael Morin
10 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:35 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 55 bytes --]
This moves where field from gfc_ss to gfc_ss_info.
OK?
[-- Attachment #2: pr43829-30.CL --]
[-- Type: text/plain, Size: 275 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans.h (struct gfc_ss, struct gfc_ss_info): Move field
gfc_ss::where into gfc_ss_info.
* trans-array.c (gfc_add_loop_ss_code):
Update reference chains.
* trans-stmt.c (gfc_trans_where_assign, gfc_trans_where_3): Ditto.
[-- Attachment #3: pr43829-30.patch --]
[-- Type: text/x-diff, Size: 2268 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 427bb7b..045c426 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -2203,7 +2203,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
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);
}
diff --git a/trans-stmt.c b/trans-stmt.c
index 101a651..86a56e8 100644
--- a/trans-stmt.c
+++ b/trans-stmt.c
@@ -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 907c271..c35b1ae 100644
--- a/trans.h
+++ b/trans.h
@@ -214,6 +214,9 @@ typedef struct gfc_ss_info
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;
@@ -242,9 +245,7 @@ typedef struct gfc_ss
struct gfc_ss *loop_chain;
struct gfc_ss *next;
- /* The bit 'where' suppresses precalculation of scalars in WHERE assignments.
- */
- unsigned where:1, is_alloc_lhs:1;
+ unsigned is_alloc_lhs:1;
}
gfc_ss;
#define gfc_get_ss() XCNEW (gfc_ss)
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [44/66] inline sum and product: Update the scalarizer: New gfc_ss::nested_ss field.
2011-10-27 23:35 ` [Patch, fortran] [31..53/66] inline sum and product: Update the scalarizer Mikael Morin
` (4 preceding siblings ...)
2011-10-27 23:35 ` [Patch, fortran] [47..48/66] inline sum and product: Update the scalarizer: New gfc_loopinfo::nested_loop field Mikael Morin
@ 2011-10-27 23:35 ` Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [35..39/66] inline sum and product: Update the scalarizer: New gfc_ss::loop field Mikael Morin
` (6 subsequent siblings)
12 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:35 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 155 bytes --]
To be able, from one outer gfc_ss struct, to descend into the corresponding
inner gfc_ss struct in the nested loop, this introduces a nested_ss field.
OK?
[-- Attachment #2: pr43829-44.CL --]
[-- Type: text/plain, Size: 235 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans.h (struct gfc_ss): New field nested_ss.
* trans-array.c (gfc_mark_ss_chain_used): Mark recursively nested
structs.
* trans-expr.c (gfc_advance_se_ss_chain): Update assertion.
[-- Attachment #3: pr43829-44.patch --]
[-- Type: text/x-diff, Size: 1046 bytes --]
diff --git a/trans-expr.c b/trans-expr.c
index 72d35f8..4cfdc3e 100644
--- a/trans-expr.c
+++ b/trans-expr.c
@@ -92,7 +92,8 @@ gfc_advance_se_ss_chain (gfc_se * se)
while (p != NULL)
{
/* Simple consistency check. */
- gcc_assert (p->parent == NULL || p->parent->ss == p->ss);
+ gcc_assert (p->parent == NULL || p->parent->ss == p->ss
+ || p->parent->ss->nested_ss == p->ss);
/* If we were in a nested loop, the next scalarized expression can be
on the parent ss' next pointer. Thus we should not take the next
diff --git a/trans.h b/trans.h
index 53c5ce2..0608879 100644
--- a/trans.h
+++ b/trans.h
@@ -249,6 +249,11 @@ typedef struct gfc_ss
/* Non-null if the ss is part of a nested loop. */
struct gfc_ss *parent;
+ /* If the evaluation of an expression requires a nested loop (for example
+ if the sum intrinsic is evaluated inline), this points to the nested
+ loop's gfc_ss. */
+ struct gfc_ss *nested_ss;
+
/* The loop this gfc_ss is in. */
struct gfc_loopinfo *loop;
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [21/66] inline sum and product: Update core structs: Move dim and dimen.
2011-10-27 23:32 ` [Patch, fortran] [20..30/66] inline sum and product: Update core structs Mikael Morin
` (7 preceding siblings ...)
2011-10-27 23:35 ` [Patch, fortran] [24/66] inline sum and product: Update core structs: Move expr Mikael Morin
@ 2011-10-27 23:35 ` Mikael Morin
2011-10-27 23:35 ` [Patch, fortran] [30/66] inline sum and product: Update core structs: Move where flag Mikael Morin
2011-10-27 23:43 ` [Patch, fortran] [28/66] inline sum and product: Update core structs: Move info struct Mikael Morin
10 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:35 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 403 bytes --]
This moves dim and dimen fields from gfc_array_info to gfc_ss.
The gfc_ss::data::temp::dimen field is also removed as it is now redundant.
The only non-trivial change is the removal of the dim array initialization in
gfc_conv_loop_setup (when the temp_ss's type is changed from GFC_SS_TEMP
to GFC_SS_SECTION) made useless by the apperance of the very same initialization
earlier in gfc_get_temp_ss.
OK?
[-- Attachment #2: pr43829-21.CL --]
[-- Type: text/plain, Size: 977 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans.h (struct gfc_array_info): Move dim and dimen fields...
(struct gfc_ss): ... here. Remove gfc_ss::data::temp::dimen field.
* trans-array.c (gfc_conv_loop_setup): Remove temp_ss dim array
initialization.
(gfc_get_temp_ss): Initialize dim and dimen.
(gfc_free_ss, gfc_get_array_ss, gfc_get_temp_ss,
gfc_set_loop_bounds_from_array_spec, get_array_ref_dim,
gfc_trans_create_temp_array, gfc_trans_constant_array_constructor,
gfc_set_vector_loop_bounds, gfc_conv_scalarized_array_ref,
gfc_trans_preloop_setup, gfc_conv_ss_startstride,
gfc_conv_resolve_dependencies, gfc_conv_loop_setup, transposed_dims,
gfc_conv_expr_descriptor, gfc_alloc_allocatable_for_assignment,
gfc_walk_array_ref): Update field references.
* trans-expr.c (gfc_conv_subref_array_arg, gfc_conv_procedure_call):
Ditto.
* trans-intrinsic.c (walk_inline_intrinsic_transpose): Ditto.
* trans-stmt.c (gfc_conv_elemental_dependencies): Ditto.
[-- Attachment #3: pr43829-21.patch --]
[-- Type: text/x-diff, Size: 18116 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 2e1a8d4..6ff60dc 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -496,10 +496,10 @@ gfc_free_ss (gfc_ss * ss)
switch (ss->type)
{
case GFC_SS_SECTION:
- for (n = 0; n < ss->data.info.dimen; n++)
+ for (n = 0; n < ss->dimen; n++)
{
- if (ss->data.info.subscript[ss->data.info.dim[n]])
- gfc_free_ss_chain (ss->data.info.subscript[ss->data.info.dim[n]]);
+ if (ss->data.info.subscript[ss->dim[n]])
+ gfc_free_ss_chain (ss->data.info.subscript[ss->dim[n]]);
}
break;
@@ -517,17 +517,15 @@ gfc_ss *
gfc_get_array_ss (gfc_ss *next, gfc_expr *expr, int dimen, gfc_ss_type type)
{
gfc_ss *ss;
- gfc_array_info *info;
int i;
ss = gfc_get_ss ();
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 +537,16 @@ gfc_ss *
gfc_get_temp_ss (tree type, tree string_length, int dimen)
{
gfc_ss *ss;
+ int i;
ss = gfc_get_ss ();
ss->next = gfc_ss_terminator;
ss->type = GFC_SS_TEMP;
ss->string_length = string_length;
- ss->data.temp.dimen = dimen;
ss->data.temp.type = type;
+ ss->dimen = dimen;
+ for (i = 0; i < ss->dimen; i++)
+ ss->dim[i] = i;
return ss;
}
@@ -642,7 +643,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)
@@ -810,15 +811,12 @@ static int
get_array_ref_dim (gfc_ss *ss, int loop_dim)
{
int n, array_dim, array_ref_dim;
- gfc_array_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;
@@ -861,8 +859,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
info = &ss->data.info;
- 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 +868,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 +897,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 +935,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 +1001,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;
}
@@ -1869,7 +1867,7 @@ trans_constant_array_constructor (gfc_ss * ss, tree type)
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;
@@ -1950,7 +1948,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
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)
@@ -2111,7 +2109,7 @@ set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss)
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)
{
@@ -2633,16 +2631,17 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar)
tree decl = NULL_TREE;
tree index;
tree tmp;
+ gfc_ss *ss;
int n;
- info = &se->ss->data.info;
+ ss = se->ss;
+ info = &ss->data.info;
if (ar)
n = se->loop->order[0];
else
n = 0;
- index = 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))
@@ -2873,8 +2872,8 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
info = &ss->data.info;
- 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 +2891,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 +2914,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)
@@ -3271,7 +3270,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
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!. */
@@ -3283,7 +3282,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
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:
@@ -3312,8 +3311,8 @@ done:
/* 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:
@@ -3333,9 +3332,9 @@ 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;
@@ -3387,7 +3386,7 @@ done:
{
bool check_upper;
- dim = info->dim[n];
+ dim = ss->dim[n];
if (info->ref->u.ar.dimen_type[dim] != DIMEN_RANGE)
continue;
@@ -3776,10 +3775,10 @@ gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest,
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. */
@@ -3853,7 +3852,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
int n, dim, spec_dim;
gfc_array_info *info;
gfc_array_info *specinfo;
- gfc_ss *ss;
+ gfc_ss *ss, *tmp_ss;
tree tmp;
gfc_ss *loopspec[GFC_MAX_DIMENSIONS];
bool dynamic[GFC_MAX_DIMENSIONS];
@@ -3878,12 +3877,12 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
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
{
@@ -3971,7 +3970,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
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;
@@ -4047,8 +4046,9 @@ 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);
@@ -4060,17 +4060,13 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
loop->temp_ss->string_length);
tmp = loop->temp_ss->data.temp.type;
- n = loop->temp_ss->data.temp.dimen;
memset (&loop->temp_ss->data.info, 0, sizeof (gfc_array_info));
loop->temp_ss->type = GFC_SS_SECTION;
- loop->temp_ss->data.info.dimen = n;
- gcc_assert (loop->temp_ss->data.info.dimen != 0);
- for (n = 0; n < loop->temp_ss->data.info.dimen; n++)
- loop->temp_ss->data.info.dim[n] = n;
+ gcc_assert (tmp_ss->dimen != 0);
gfc_trans_create_temp_array (&loop->pre, &loop->post, loop,
- loop->temp_ss, tmp, NULL_TREE,
+ tmp_ss, tmp, NULL_TREE,
false, true, false, where);
}
@@ -4094,12 +4090,12 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
info = &ss->data.info;
- for (n = 0; n < info->dimen; n++)
+ for (n = 0; n < ss->dimen; n++)
{
/* If we are specifying the range the delta is already set. */
if (loopspec[n] != ss)
{
- dim = ss->data.info.dim[n];
+ dim = ss->dim[n];
/* Calculate the offset relative to the loop variable.
First multiply by the stride. */
@@ -5657,16 +5653,15 @@ get_array_charlen (gfc_expr *expr, gfc_se *se)
}
}
+
/* Helper function to check dimensions. */
static bool
transposed_dims (gfc_ss *ss)
{
- gfc_array_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;
}
@@ -5899,7 +5894,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
loop.dimen);
se->string_length = loop.temp_ss->string_length;
- gcc_assert (loop.temp_ss->data.temp.dimen == loop.dimen);
+ gcc_assert (loop.temp_ss->dimen == loop.dimen);
gfc_add_ss_to_loop (&loop, loop.temp_ss);
}
@@ -5972,7 +5967,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)
{
@@ -6087,7 +6082,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. */
@@ -7376,7 +7371,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
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]);
@@ -7678,8 +7673,8 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref)
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:
@@ -7689,8 +7684,8 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref)
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:
@@ -7700,7 +7695,7 @@ 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
+ gcc_assert (newss->dimen > 0
|| newss->data.info.ref->u.ar.as->corank > 0);
ss = newss;
break;
diff --git a/trans-expr.c b/trans-expr.c
index 636c0b0..84222f5 100644
--- a/trans-expr.c
+++ b/trans-expr.c
@@ -2489,7 +2489,7 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77,
outside the innermost loop, so the overall transfer could be
optimized further. */
info = &rse.ss->data.info;
- dimen = info->dimen;
+ dimen = rse.ss->dimen;
tmp_index = gfc_index_zero_node;
for (n = dimen - 1; n > 0; n--)
@@ -3582,7 +3582,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);
@@ -3618,7 +3618,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);
diff --git a/trans-intrinsic.c b/trans-intrinsic.c
index 47313e6..3f8d514 100644
--- a/trans-intrinsic.c
+++ b/trans-intrinsic.c
@@ -6757,15 +6757,13 @@ walk_inline_intrinsic_transpose (gfc_ss *ss, gfc_expr *expr)
&& tmp_ss->type != GFC_SS_REFERENCE)
{
int tmp_dim;
- gfc_array_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... */
diff --git a/trans-stmt.c b/trans-stmt.c
index aa7591b..c66d6b5 100644
--- a/trans-stmt.c
+++ b/trans-stmt.c
@@ -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]);
diff --git a/trans.h b/trans.h
index 6f9f6c8..5acab12 100644
--- a/trans.h
+++ b/trans.h
@@ -113,7 +113,6 @@ gfc_coarray_type;
typedef struct gfc_array_info
{
- int dimen;
/* The ref that holds information on this section. */
gfc_ref *ref;
/* The descriptor of this array. */
@@ -134,10 +133,6 @@ typedef struct gfc_array_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_array_info;
@@ -212,9 +207,6 @@ typedef struct gfc_ss
/* GFC_SS_TEMP. */
struct
{
- /* The rank of the temporary. May be less than the rank of the
- assigned expression. */
- int dimen;
tree type;
}
temp;
@@ -223,6 +215,11 @@ typedef struct gfc_ss
}
data;
+ 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;
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [13/66] inline sum and product: Interfaces changes: gfc_trans_array_constructor
2011-10-28 0:02 ` [Patch, fortran] [13..19/66] inline sum and product: Interfaces changes Mikael Morin
` (2 preceding siblings ...)
2011-10-27 23:32 ` [Patch, fortran] [15/66] inline sum and product: Interfaces changes: obtain name more simply Mikael Morin
@ 2011-10-27 23:36 ` Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [16/66] inline sum and product: Interfaces changes: gfc_trans_create_temp_array Mikael Morin
` (2 subsequent siblings)
6 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:36 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 357 bytes --]
loop.temp_dim is set by gfc_trans_create_temp_array; there should be no reason
why that value wouldn't suit gfc_trans_constant_array_constructor, which has
then no reason to set the value directly.
This patch remove that code.
Then, the loop argument is useless and can be removed too.
The function is static, so it loses its gfc_ prefix along the way.
OK?
[-- Attachment #2: pr43829-13.CL --]
[-- Type: text/plain, Size: 305 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (gfc_trans_constant_array_constructor,
trans_constant_array_constructor): Rename the former to the latter.
Don't set the rank of the temporary for the loop. Remove then unused
loop argument.
(gfc_trans_array_constructor): Update call.
[-- Attachment #3: pr43829-13.patch --]
[-- Type: text/x-diff, Size: 1443 bytes --]
diff --git a/trans-array.c b/trans-array.c
index f611302..c39fc9e 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -1849,8 +1849,7 @@ gfc_build_constant_array_constructor (gfc_expr * expr, tree type)
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;
tree tmp;
@@ -1871,14 +1870,11 @@ gfc_trans_constant_array_constructor (gfc_loopinfo * loop,
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
@@ -2033,7 +2029,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
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;
}
}
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [55..56/66] inline sum and product: Prevent regressions: Fix gfc_conv_elemental_dependencies.
2011-10-28 0:22 ` [Patch, fortran] [54..61/66] inline sum and product: Prevent regressions Mikael Morin
@ 2011-10-27 23:36 ` Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [60/66] inline sum and product: Update the scalarizer: Fix error markers Mikael Morin
` (3 subsequent siblings)
4 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:36 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 698 bytes --]
gfc_conv_elemental_dependency had some ad-hoc fixes to replace one array by its
temporary in the scalarizer.
It was using a fake gfc_loopinfo struct so that gfc_trans_create_temp_array
doesn't overwrite the real one. It was using fake array references and custom
delta calculation, so that scalarizer's partial offset calculation used the
right array index while accessing the temporary even if it believed it was
accessing the regular array.
Patch 56 removes those fixes, replaces the array gfc_ss struct with a new
one for the temporary and calls gfc_set_delta to update arrays' delta after
calling gfc_trans_create_temp_array.
Patch 55 is a preliminary patch making some functions public.
OK?
[-- Attachment #2: pr43829-55.CL --]
[-- Type: text/plain, Size: 312 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.h (gfc_free_ss, gfc_set_delta): New prototypes.
* trans-array.c (gfc_free_ss): Remove forward declaration.
Make non-static.
(set_delta, gfc_set_delta): Remove forward declaration.
Make non-static and rename the former to the later. Update uses.
[-- Attachment #3: pr43829-55.patch --]
[-- Type: text/x-diff, Size: 3076 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 3c0c110..acd9aec 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -466,8 +466,6 @@ gfc_mark_ss_chain_used (gfc_ss * ss, unsigned flags)
ss->info->useflags = flags;
}
-static void gfc_free_ss (gfc_ss *);
-
/* Free a gfc_ss chain. */
@@ -500,7 +498,7 @@ free_ss_info (gfc_ss_info *ss_info)
/* Free a SS. */
-static void
+void
gfc_free_ss (gfc_ss * ss)
{
gfc_ss_info *ss_info;
@@ -1027,7 +1025,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
/* We have just changed the loop bounds, we must clear the
corresponding specloop, so that delta calculation is not skipped
- later in set_delta. */
+ later in gfc_set_delta. */
loop->specloop[n] = NULL;
/* We are constructing the temporary's descriptor based on the loop
@@ -4372,9 +4370,6 @@ set_loop_bounds (gfc_loopinfo *loop)
}
-static void set_delta (gfc_loopinfo *loop);
-
-
/* Initialize the scalarization loop. Creates the loop variables. Determines
the range of the loop variables. Creates a temporary if required.
Also generates code for scalar expressions which have been
@@ -4422,10 +4417,8 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
/* For array parameters we don't have loop variables, so don't calculate the
translations. */
- if (loop->array_parameter)
- return;
-
- set_delta (loop);
+ if (!loop->array_parameter)
+ gfc_set_delta (loop);
}
@@ -4433,8 +4426,8 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
array: once loop bounds are chosen, sets the difference (DELTA field) between
loop bounds and array reference bounds, for each array info. */
-static void
-set_delta (gfc_loopinfo *loop)
+void
+gfc_set_delta (gfc_loopinfo *loop)
{
gfc_ss *ss, **loopspec;
gfc_array_info *info;
@@ -4482,7 +4475,7 @@ set_delta (gfc_loopinfo *loop)
}
for (loop = loop->nested; loop; loop = loop->next)
- set_delta (loop);
+ gfc_set_delta (loop);
}
diff --git a/trans-array.h b/trans-array.h
index aad8c47..bd593bd 100644
--- a/trans-array.h
+++ b/trans-array.h
@@ -88,6 +88,8 @@ void gfc_add_ss_to_loop (gfc_loopinfo *, gfc_ss *);
void gfc_mark_ss_chain_used (gfc_ss *, unsigned);
/* Free a gfc_ss chain. */
void gfc_free_ss_chain (gfc_ss *);
+/* Free a single gfc_ss element. */
+void gfc_free_ss (gfc_ss *);
/* Allocate a new array type ss. */
gfc_ss *gfc_get_array_ss (gfc_ss *, gfc_expr *, int, gfc_ss_type);
/* Allocate a new temporary type ss. */
@@ -111,6 +113,8 @@ void gfc_trans_scalarizing_loops (gfc_loopinfo *, stmtblock_t *);
void gfc_trans_scalarized_loop_boundary (gfc_loopinfo *, stmtblock_t *);
/* Initialize the scalarization loop parameters. */
void gfc_conv_loop_setup (gfc_loopinfo *, locus *);
+/* Set each array's delta. */
+void gfc_set_delta (gfc_loopinfo *);
/* Resolve array assignment dependencies. */
void gfc_conv_resolve_dependencies (gfc_loopinfo *, gfc_ss *, gfc_ss *);
/* Build a null array descriptor constructor. */
[-- Attachment #4: pr43829-56.CL --]
[-- Type: text/plain, Size: 386 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-expr.c (gfc_conv_procedure_call): Handle temporaries for
arguments to elemental calls.
* trans-stmt.c (replace_ss): New function.
(gfc_conv_elemental_dependencies): Remove temporary loop handling.
Create a new ss for the temporary and replace the original one with it.
Remove fake array references. Recalculate all offsets.
[-- Attachment #5: pr43829-56.patch --]
[-- Type: text/x-diff, Size: 6291 bytes --]
diff --git a/trans-expr.c b/trans-expr.c
index 4cfdc3e..cf9f0f7 100644
--- a/trans-expr.c
+++ b/trans-expr.c
@@ -2997,8 +2997,19 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
{
/* An elemental function inside a scalarized loop. */
gfc_init_se (&parmse, se);
- gfc_conv_expr_reference (&parmse, e);
parm_kind = ELEMENTAL;
+
+ if (se->ss->dimen > 0
+ && se->ss->info->data.array.ref == NULL)
+ {
+ gfc_conv_tmp_array_ref (&parmse);
+ if (e->ts.type == BT_CHARACTER)
+ gfc_conv_string_parameter (&parmse);
+ else
+ parmse.expr = gfc_build_addr_expr (NULL_TREE, parmse.expr);
+ }
+ else
+ gfc_conv_expr_reference (&parmse, e);
}
else
{
diff --git a/trans-stmt.c b/trans-stmt.c
index 2e02320..0d793f9 100644
--- a/trans-stmt.c
+++ b/trans-stmt.c
@@ -178,6 +178,41 @@ gfc_trans_entry (gfc_code * code)
}
+/* Replace a gfc_ss structure by another both in the gfc_se struct
+ and the gfc_loopinfo struct. This is used in gfc_conv_elemental_dependencies
+ to replace a variable ss by the corresponding temporary. */
+
+static void
+replace_ss (gfc_se *se, gfc_ss *old_ss, gfc_ss *new_ss)
+{
+ gfc_ss **sess, **loopss;
+
+ /* The old_ss is a ss for a single variable. */
+ gcc_assert (old_ss->info->type == GFC_SS_SECTION);
+
+ for (sess = &(se->ss); *sess != gfc_ss_terminator; sess = &((*sess)->next))
+ if (*sess == old_ss)
+ break;
+ gcc_assert (*sess != gfc_ss_terminator);
+
+ *sess = new_ss;
+ new_ss->next = old_ss->next;
+
+
+ for (loopss = &(se->loop->ss); *loopss != gfc_ss_terminator;
+ loopss = &((*loopss)->loop_chain))
+ if (*loopss == old_ss)
+ break;
+ gcc_assert (*loopss != gfc_ss_terminator);
+
+ *loopss = new_ss;
+ new_ss->loop_chain = old_ss->loop_chain;
+ new_ss->loop = old_ss->loop;
+
+ gfc_free_ss (old_ss);
+}
+
+
/* Check for dependencies between INTENT(IN) and INTENT(OUT) arguments of
elemental subroutines. Make temporaries for output arguments if any such
dependencies are found. Output arguments are chosen because internal_unpack
@@ -190,15 +225,10 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
gfc_actual_arglist *arg0;
gfc_expr *e;
gfc_formal_arglist *formal;
- gfc_loopinfo tmp_loop;
gfc_se parmse;
gfc_ss *ss;
- gfc_array_info *info;
gfc_symbol *fsym;
- gfc_ref *ref;
- int n;
tree data;
- tree offset;
tree size;
tree tmp;
@@ -217,14 +247,9 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
continue;
/* Obtain the info structure for the current argument. */
- info = NULL;
for (ss = loopse->ss; ss && ss != gfc_ss_terminator; ss = ss->next)
- {
- if (ss->info->expr != e)
- continue;
- info = &ss->info->data.array;
+ if (ss->info->expr == e)
break;
- }
/* If there is a dependency, create a temporary and use it
instead of the variable. */
@@ -237,49 +262,17 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
{
tree initial, temptype;
stmtblock_t temp_post;
+ gfc_ss *tmp_ss;
- /* 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 = 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];
- tmp_loop.order[n] = loopse->loop->order[n];
- }
+ tmp_ss = gfc_get_array_ss (gfc_ss_terminator, NULL, ss->dimen,
+ GFC_SS_SECTION);
+ gfc_mark_ss_chain_used (tmp_ss, 1);
+ tmp_ss->info->expr = ss->info->expr;
+ replace_ss (loopse, ss, tmp_ss);
/* Obtain the argument descriptor for unpacking. */
gfc_init_se (&parmse, NULL);
parmse.want_pointer = 1;
-
- /* The scalarizer introduces some specific peculiarities when
- handling elemental subroutines; the stride can be needed up to
- the dim_array - 1, rather than dim_loop - 1 to calculate
- offsets outside the loop. For this reason, we make sure that
- the descriptor has the dimensionality of the array by converting
- trailing elements into ranges with end = start. */
- for (ref = e->ref; ref; ref = ref->next)
- if (ref->type == REF_ARRAY && ref->u.ar.type == AR_SECTION)
- break;
-
- if (ref)
- {
- bool seen_range = false;
- for (n = 0; n < ref->u.ar.dimen; n++)
- {
- if (ref->u.ar.dimen_type[n] == DIMEN_RANGE)
- seen_range = true;
-
- if (!seen_range
- || ref->u.ar.dimen_type[n] != DIMEN_ELEMENT)
- continue;
-
- ref->u.ar.end[n] = gfc_copy_expr (ref->u.ar.start[n]);
- ref->u.ar.dimen_type[n] = DIMEN_RANGE;
- }
- }
-
gfc_conv_expr_descriptor (&parmse, e, gfc_walk_expr (e));
gfc_add_block_to_block (&se->pre, &parmse.pre);
@@ -309,28 +302,15 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
size = gfc_create_var (gfc_array_index_type, NULL);
data = gfc_create_var (pvoid_type_node, NULL);
gfc_init_block (&temp_post);
- ss->loop = &tmp_loop;
- tmp = gfc_trans_create_temp_array (&se->pre, &temp_post, ss,
+ tmp = gfc_trans_create_temp_array (&se->pre, &temp_post, tmp_ss,
temptype, initial, false, true,
false, &arg->expr->where);
gfc_add_modify (&se->pre, size, tmp);
- tmp = fold_convert (pvoid_type_node, info->data);
+ tmp = fold_convert (pvoid_type_node, tmp_ss->info->data.array.data);
gfc_add_modify (&se->pre, data, tmp);
- /* Calculate the offset for the temporary. */
- offset = gfc_index_zero_node;
- for (n = 0; n < ss->dimen; n++)
- {
- tmp = gfc_conv_descriptor_stride_get (info->descriptor,
- gfc_rank_cst[n]);
- tmp = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type,
- loopse->loop->from[n], tmp);
- offset = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type, offset, tmp);
- }
- info->offset = gfc_create_var (gfc_array_index_type, NULL);
- gfc_add_modify (&se->pre, info->offset, offset);
+ /* Update other ss' delta. */
+ gfc_set_delta (loopse->loop);
/* Copy the result back using unpack. */
tmp = build_call_expr_loc (input_location,
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [01..06/66] inline sum and product: Prepare gfc_trans_preloop_setup
2011-10-27 23:43 [Patch, fortran] [00/66] PR fortran/43829 Inline sum and product (AKA scalarization of reductions) Mikael Morin
` (3 preceding siblings ...)
2011-10-27 23:36 ` [Patch, fortran] [62..66/66] inline sum and product: Inline sum Mikael Morin
@ 2011-10-27 23:36 ` Mikael Morin
2011-10-27 23:30 ` [Patch, fortran] [01/66] " Mikael Morin
` (5 more replies)
2011-10-28 0:02 ` [Patch, fortran] [13..19/66] inline sum and product: Interfaces changes Mikael Morin
` (3 subsequent siblings)
8 siblings, 6 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:36 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 207 bytes --]
This is a 6 steps program to update gfc_trans_preloop_setup.
gfc_trans_preloop_setup appeared completely rewritten. These step by step
patches show that it is not the case.
Combined patch attached here.
OK?
[-- Attachment #2: pr43829-1..6.diff --]
[-- Type: text/x-diff, Size: 5595 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 3472804e4c6344e68d15af2feee627429ca61018..f615e4e6a10d59b6878033876f7b170f516e651b 100644
*** a/trans-array.c
--- b/trans-array.c
*************** gfc_conv_array_ref (gfc_se * se, gfc_arr
*** 2830,2835 ****
--- 2830,2863 ----
}
+ /* 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_ss_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 = gfc_conv_array_index_offset (&se, info, 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. */
*************** static void
*** 2837,2847 ****
gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
stmtblock_t * pblock)
{
- tree index;
tree stride;
gfc_ss_info *info;
gfc_ss *ss;
! gfc_se se;
int i;
/* This code will be executed before entering the scalarization loop
--- 2865,2874 ----
gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
stmtblock_t * pblock)
{
tree stride;
gfc_ss_info *info;
gfc_ss *ss;
! gfc_array_ref *ar;
int i;
/* This code will be executed before entering the scalarization loop
*************** gfc_trans_preloop_setup (gfc_loopinfo *
*** 2860,2933 ****
if (dim >= info->dimen)
continue;
- if (dim == info->dimen - 1)
- {
- /* For the outermost loop calculate the offset due to any
- elemental dimensions. It will have been initialized with the
- base offset of the array. */
if (info->ref)
! {
! for (i = 0; i < info->ref->u.ar.dimen; i++)
! {
! if (info->ref->u.ar.dimen_type[i] != DIMEN_ELEMENT)
! continue;
! gfc_init_se (&se, NULL);
! se.loop = loop;
! se.expr = info->descriptor;
! stride = gfc_conv_array_stride (info->descriptor, i);
! index = gfc_conv_array_index_offset (&se, info, i, -1,
! &info->ref->u.ar,
! stride);
! gfc_add_block_to_block (pblock, &se.pre);
! info->offset = fold_build2_loc (input_location, PLUS_EXPR,
! gfc_array_index_type,
! info->offset, index);
! info->offset = gfc_evaluate_now (info->offset, pblock);
! }
! }
! i = loop->order[0];
! /* For the time being, the innermost loop is unconditionally on
! the first dimension of the scalarization loop. */
! gcc_assert (i == 0);
stride = gfc_conv_array_stride (info->descriptor, info->dim[i]);
/* Calculate the stride of the innermost loop. Hopefully this will
allow the backend optimizers to do their stuff more effectively.
*/
info->stride0 = gfc_evaluate_now (stride, pblock);
- }
- else
- {
- /* Add the offset for the previous loop dimension. */
- gfc_array_ref *ar;
if (info->ref)
{
! ar = &info->ref->u.ar;
! i = loop->order[dim + 1];
! }
! else
{
! ar = NULL;
! i = dim + 1;
! }
! gfc_init_se (&se, NULL);
! se.loop = loop;
! se.expr = info->descriptor;
! stride = gfc_conv_array_stride (info->descriptor, info->dim[i]);
! index = gfc_conv_array_index_offset (&se, info, info->dim[i], i,
! ar, stride);
! gfc_add_block_to_block (pblock, &se.pre);
! info->offset = fold_build2_loc (input_location, PLUS_EXPR,
! gfc_array_index_type, info->offset,
! index);
! info->offset = gfc_evaluate_now (info->offset, pblock);
}
/* Remember this offset for the second loop. */
if (dim == loop->temp_dim - 1)
--- 2887,2934 ----
if (dim >= info->dimen)
continue;
+ gcc_assert (info->dimen == loop->dimen);
if (info->ref)
! ar = &info->ref->u.ar;
! else
! ar = NULL;
! if (dim == loop->dimen - 1)
! i = 0;
! else
! i = dim + 1;
! /* For the time being, there is no loop reordering. */
! gcc_assert (i == loop->order[i]);
! i = loop->order[i];
! if (dim == loop->dimen - 1)
! {
stride = gfc_conv_array_stride (info->descriptor, info->dim[i]);
/* Calculate the stride of the innermost loop. Hopefully this will
allow the backend optimizers to do their stuff more effectively.
*/
info->stride0 = gfc_evaluate_now (stride, pblock);
+ /* For the outermost loop calculate the offset due to any
+ elemental dimensions. It will have been initialized with the
+ base offset of the array. */
if (info->ref)
{
! for (i = 0; i < ar->dimen; i++)
{
! if (ar->dimen_type[i] != DIMEN_ELEMENT)
! continue;
! add_array_offset (pblock, loop, ss, ar, i, /* unused */ -1);
}
+ }
+ }
+ else
+ /* Add the offset for the previous loop dimension. */
+ add_array_offset (pblock, loop, ss, ar, info->dim[i], i);
/* Remember this offset for the second loop. */
if (dim == loop->temp_dim - 1)
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [65/66] inline sum and product: Inline sum: Change se initialization.
2011-10-27 23:36 ` [Patch, fortran] [62..66/66] inline sum and product: Inline sum Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [64/66] inline sum and product: Inline sum: Change loop use Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [66/66] inline sum and product: Inline sum: The end Mikael Morin
@ 2011-10-27 23:36 ` Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [63/66] inline sum and product: Inline sum: Change argument handling Mikael Morin
2011-10-28 0:29 ` [Patch, fortran] [62/66] inline sum and product: Inline sum: Change conditions Mikael Morin
4 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:36 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 276 bytes --]
In the non-scalar case the gfc_se structs are initialized using the se pointer
given as argument to the function. To accomodate this, this patch changes
initialization to NULL with initialization to a pointer (initially set to
NULL for now).
The patch explains it better.
OK?
[-- Attachment #2: pr43829-65.CL --]
[-- Type: text/plain, Size: 145 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-intrinsic.c (gfc_conv_intrinsic_arith):
Introduce parent expression variable. Use it.
[-- Attachment #3: pr43829-65.patch --]
[-- Type: text/x-diff, Size: 1400 bytes --]
diff --git a/trans-intrinsic.c b/trans-intrinsic.c
index f7b1041..25c54fb 100644
--- a/trans-intrinsic.c
+++ b/trans-intrinsic.c
@@ -2574,6 +2574,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
gfc_ss *maskss;
gfc_se arrayse;
gfc_se maskse;
+ gfc_se *parent_se;
gfc_expr *arrayexpr;
gfc_expr *maskexpr;
@@ -2582,6 +2583,8 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
gfc_conv_intrinsic_funcall (se, expr);
return;
}
+ else
+ parent_se = NULL;
type = gfc_typenode_for_spec (&expr->ts);
/* Initialize the result. */
@@ -2654,7 +2657,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
/* If we have a mask, only add this element if the mask is set. */
if (maskexpr && maskexpr->rank > 0)
{
- gfc_init_se (&maskse, NULL);
+ gfc_init_se (&maskse, parent_se);
gfc_copy_loopinfo_to_se (&maskse, ploop);
maskse.ss = maskss;
gfc_conv_expr_val (&maskse, maskexpr);
@@ -2666,7 +2669,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
gfc_init_block (&block);
/* Do the actual summation/product. */
- gfc_init_se (&arrayse, NULL);
+ gfc_init_se (&arrayse, parent_se);
gfc_copy_loopinfo_to_se (&arrayse, ploop);
arrayse.ss = arrayss;
gfc_conv_expr_val (&arrayse, arrayexpr);
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [05/66] inline sum and product: Prepare gfc_trans_preloop_setup
2011-10-27 23:36 ` [Patch, fortran] [01..06/66] inline sum and product: Prepare gfc_trans_preloop_setup Mikael Morin
` (2 preceding siblings ...)
2011-10-27 23:31 ` [Patch, fortran] [03/66] " Mikael Morin
@ 2011-10-27 23:36 ` Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [02/66] " Mikael Morin
2011-10-27 23:38 ` [Patch, fortran] [04/66] " Mikael Morin
5 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:36 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 214 bytes --]
This is for consistency. As dim == dimen-1 means "we are in the outermost loop",
we should check against the loop dimension, not the array dimension.
An assertion is added to check that it is in fact the same.
OK?
[-- Attachment #2: pr43829-5.CL --]
[-- Type: text/plain, Size: 178 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (gfc_trans_preloop_setup): Use loop's dimension instead
of array's dimention. Check that it is indeed the same.
[-- Attachment #3: pr43829-5.patch --]
[-- Type: text/x-diff, Size: 779 bytes --]
diff --git a/trans-array.c b/trans-array.c
index f5e30ae..476978e 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -2861,13 +2861,14 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
if (dim >= info->dimen)
continue;
+ gcc_assert (info->dimen == loop->dimen);
if (info->ref)
ar = &info->ref->u.ar;
else
ar = NULL;
- if (dim == info->dimen - 1)
+ if (dim == loop->dimen - 1)
i = 0;
else
i = dim + 1;
@@ -2876,7 +2877,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
gcc_assert (i == loop->order[i]);
i = loop->order[i];
- if (dim == info->dimen - 1)
+ if (dim == loop->dimen - 1)
{
stride = gfc_conv_array_stride (info->descriptor, info->dim[i]);
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [64/66] inline sum and product: Inline sum: Change loop use.
2011-10-27 23:36 ` [Patch, fortran] [62..66/66] inline sum and product: Inline sum Mikael Morin
@ 2011-10-27 23:36 ` Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [66/66] inline sum and product: Inline sum: The end Mikael Morin
` (3 subsequent siblings)
4 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:36 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 412 bytes --]
In the non-scalar case the scalarizer needs to take code out of the outer loop,
which means that the inner one (the "sum" loop) has already been handled
before entering gfc_conv_intrinsic_arith, which means loop shall be a pointer
to that loop instead of the address of the local loop in that case.
This patch changes local loop uses with a pointer loop use (which is
initialized to the local loop for now).
OK?
[-- Attachment #2: pr43829-64.CL --]
[-- Type: text/plain, Size: 135 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-intrinsic.c (gfc_conv_intrinsic.c): Introduce current loop
pointer. Use it.
[-- Attachment #3: pr43829-64.patch --]
[-- Type: text/x-diff, Size: 2867 bytes --]
diff --git a/trans-intrinsic.c b/trans-intrinsic.c
index b701502..f7b1041 100644
--- a/trans-intrinsic.c
+++ b/trans-intrinsic.c
@@ -2568,7 +2568,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
stmtblock_t body;
stmtblock_t block;
tree tmp;
- gfc_loopinfo loop;
+ gfc_loopinfo loop, *ploop;
gfc_actual_arglist *arg_array, *arg_mask;
gfc_ss *arrayss;
gfc_ss *maskss;
@@ -2646,14 +2646,16 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
gfc_mark_ss_chain_used (arrayss, 1);
if (maskexpr && maskexpr->rank > 0)
gfc_mark_ss_chain_used (maskss, 1);
+
+ ploop = &loop;
/* Generate the loop body. */
- gfc_start_scalarized_body (&loop, &body);
+ gfc_start_scalarized_body (ploop, &body);
/* If we have a mask, only add this element if the mask is set. */
if (maskexpr && maskexpr->rank > 0)
{
gfc_init_se (&maskse, NULL);
- gfc_copy_loopinfo_to_se (&maskse, &loop);
+ gfc_copy_loopinfo_to_se (&maskse, ploop);
maskse.ss = maskss;
gfc_conv_expr_val (&maskse, maskexpr);
gfc_add_block_to_block (&body, &maskse.pre);
@@ -2665,7 +2667,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
/* Do the actual summation/product. */
gfc_init_se (&arrayse, NULL);
- gfc_copy_loopinfo_to_se (&arrayse, &loop);
+ gfc_copy_loopinfo_to_se (&arrayse, ploop);
arrayse.ss = arrayss;
gfc_conv_expr_val (&arrayse, arrayexpr);
gfc_add_block_to_block (&block, &arrayse.pre);
@@ -2753,7 +2755,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
tmp = gfc_finish_block (&block);
gfc_add_expr_to_block (&body, tmp);
- gfc_trans_scalarizing_loops (&loop, &body);
+ gfc_trans_scalarizing_loops (ploop, &body);
/* For a scalar mask, enclose the loop in an if statement. */
if (maskexpr && maskexpr->rank == 0)
@@ -2761,8 +2763,8 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
gfc_init_se (&maskse, NULL);
gfc_conv_expr_val (&maskse, maskexpr);
gfc_init_block (&block);
- gfc_add_block_to_block (&block, &loop.pre);
- gfc_add_block_to_block (&block, &loop.post);
+ gfc_add_block_to_block (&block, &ploop->pre);
+ gfc_add_block_to_block (&block, &ploop->post);
tmp = gfc_finish_block (&block);
tmp = build3_v (COND_EXPR, maskse.expr, tmp,
@@ -2772,11 +2774,11 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
}
else
{
- gfc_add_block_to_block (&se->pre, &loop.pre);
- gfc_add_block_to_block (&se->pre, &loop.post);
+ gfc_add_block_to_block (&se->pre, &ploop->pre);
+ gfc_add_block_to_block (&se->pre, &ploop->post);
}
- gfc_cleanup_loop (&loop);
+ gfc_cleanup_loop (ploop);
if (norm2)
{
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [66/66] inline sum and product: Inline sum: The end.
2011-10-27 23:36 ` [Patch, fortran] [62..66/66] inline sum and product: Inline sum Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [64/66] inline sum and product: Inline sum: Change loop use Mikael Morin
@ 2011-10-27 23:36 ` Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [65/66] inline sum and product: Inline sum: Change se initialization Mikael Morin
` (2 subsequent siblings)
4 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:36 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 1631 bytes --]
This is the final patch.
Context diff also provided as gfc_conv_intrinsic_arith has many blank changes.
The changes in gfc_conv_intrinsic_arith involve the new initialization for
parent_se and ploop, a few additional conditions for scalar-specific stuff,
and a specific handling for scalar masks in the non-scalar case.
The rest is the sum array walking/the construction of the base nested gfc_ss
structs. We are trying to allow more than one level of sums. The full sum
"ARRAY" argument is passed to gfc_walk_subexpr; it returns a chain of full
arrays, to which we attach that of the "MASK" argument. From the resulting chain
of full arrays, dimension "DIM" is then moved to a new chain of gfc_ss structs.
This move in fact is only a move of one element of gfc_ss struct's dim
array, as all the rest is shared. The result of this is a chain of reduced
(by one dimension) gfc_ss structs, with on each one of them a nested_ss pointer
pointing to a gfc_ss struct having the missing dimension. If the sum result is
itself an actual argument to another sum call, the reduced chain is reduced
further by one dimension and one gets three levels of gfc_ss structs, etc.
The handling of reversed vs non-reversed is quite a mess (see the comment of
nest_loop_dimension), but I think it's correct.
The handling of walk_inline_intrinsic_arith is complicated by the fact that
arguments are not consumed by gfc_conv_intrinsic_arith in the same order,
depending on whether the mask is array or scalar. So we have to make sure
that it is at the right position in the chain generated by
walk_inline_intrinsic_arith. See the comment there.
OK?
[-- Attachment #2: pr43829-66.CL --]
[-- Type: text/plain, Size: 484 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
PR fortran/43829
* trans-array.c (gfc_conv_expr_descriptor): Accept the inline intrinsic
case in the assertion.
* trans-intrinsic (enter_nested_loop): New function.
(gfc_conv_intrinsic_arith): Support non-scalar cases.
(nest_loop_dimension, walk_inline_intrinsic_arith): New functions.
(walk_inline_intrinsic_function): Handle sum and product.
(gfc_inline_intrinsic_function_p): Ditto.
* trans.h (gfc_get_loopinfo): New macro.
[-- Attachment #3: pr43829-66.patch --]
[-- Type: text/x-diff, Size: 10431 bytes --]
diff --git a/trans-array.c b/trans-array.c
index acd9aec..262743d 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -6187,7 +6187,8 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
gcc_assert ((expr->value.function.esym != NULL
&& expr->value.function.esym->attr.elemental)
|| (expr->value.function.isym != NULL
- && expr->value.function.isym->elemental));
+ && expr->value.function.isym->elemental)
+ || gfc_inline_intrinsic_function_p (expr));
else
gcc_assert (ss_type == GFC_SS_INTRINSIC);
diff --git a/trans-intrinsic.c b/trans-intrinsic.c
index 25c54fb..973f912 100644
--- a/trans-intrinsic.c
+++ b/trans-intrinsic.c
@@ -2557,6 +2557,20 @@ gfc_conv_intrinsic_count (gfc_se * se, gfc_expr * expr)
se->expr = resvar;
}
+
+/* Update given gfc_se to have ss component pointing to the nested gfc_ss
+ struct and return the corresponding loopinfo. */
+
+static gfc_loopinfo *
+enter_nested_loop (gfc_se *se)
+{
+ se->ss = se->ss->nested_ss;
+ gcc_assert (se->ss == se->ss->loop->ss);
+
+ return se->ss->loop;
+}
+
+
/* Inline implementation of the sum and product intrinsics. */
static void
gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
@@ -2570,18 +2584,18 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
tree tmp;
gfc_loopinfo loop, *ploop;
gfc_actual_arglist *arg_array, *arg_mask;
- gfc_ss *arrayss;
- gfc_ss *maskss;
+ gfc_ss *arrayss = NULL;
+ gfc_ss *maskss = NULL;
gfc_se arrayse;
gfc_se maskse;
gfc_se *parent_se;
gfc_expr *arrayexpr;
gfc_expr *maskexpr;
- if (se->ss)
+ if (expr->rank > 0)
{
- gfc_conv_intrinsic_funcall (se, expr);
- return;
+ gcc_assert (gfc_inline_intrinsic_function_p (expr));
+ parent_se = se;
}
else
parent_se = NULL;
@@ -2613,10 +2627,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
arg_array = expr->value.function.actual;
- /* Walk the arguments. */
arrayexpr = arg_array->expr;
- arrayss = gfc_walk_expr (arrayexpr);
- gcc_assert (arrayss != gfc_ss_terminator);
if (op == NE_EXPR || norm2)
/* PARITY and NORM2. */
@@ -2628,29 +2639,42 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
maskexpr = arg_mask->expr;
}
- if (maskexpr && maskexpr->rank > 0)
+ if (expr->rank == 0)
{
- maskss = gfc_walk_expr (maskexpr);
- gcc_assert (maskss != gfc_ss_terminator);
- }
- else
- maskss = NULL;
+ /* Walk the arguments. */
+ arrayss = gfc_walk_expr (arrayexpr);
+ gcc_assert (arrayss != gfc_ss_terminator);
- /* Initialize the scalarizer. */
- gfc_init_loopinfo (&loop);
- gfc_add_ss_to_loop (&loop, arrayss);
- if (maskexpr && maskexpr->rank > 0)
- gfc_add_ss_to_loop (&loop, maskss);
+ if (maskexpr && maskexpr->rank > 0)
+ {
+ maskss = gfc_walk_expr (maskexpr);
+ gcc_assert (maskss != gfc_ss_terminator);
+ }
+ else
+ maskss = NULL;
- /* Initialize the loop. */
- gfc_conv_ss_startstride (&loop);
- gfc_conv_loop_setup (&loop, &expr->where);
+ /* Initialize the scalarizer. */
+ gfc_init_loopinfo (&loop);
+ gfc_add_ss_to_loop (&loop, arrayss);
+ if (maskexpr && maskexpr->rank > 0)
+ gfc_add_ss_to_loop (&loop, maskss);
- gfc_mark_ss_chain_used (arrayss, 1);
- if (maskexpr && maskexpr->rank > 0)
- gfc_mark_ss_chain_used (maskss, 1);
+ /* Initialize the loop. */
+ gfc_conv_ss_startstride (&loop);
+ gfc_conv_loop_setup (&loop, &expr->where);
+
+ gfc_mark_ss_chain_used (arrayss, 1);
+ if (maskexpr && maskexpr->rank > 0)
+ gfc_mark_ss_chain_used (maskss, 1);
+
+ ploop = &loop;
+ }
+ else
+ /* All the work has been done in the parent loops. */
+ ploop = enter_nested_loop (se);
+
+ gcc_assert (ploop);
- ploop = &loop;
/* Generate the loop body. */
gfc_start_scalarized_body (ploop, &body);
@@ -2659,7 +2683,8 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
{
gfc_init_se (&maskse, parent_se);
gfc_copy_loopinfo_to_se (&maskse, ploop);
- maskse.ss = maskss;
+ if (expr->rank == 0)
+ maskse.ss = maskss;
gfc_conv_expr_val (&maskse, maskexpr);
gfc_add_block_to_block (&body, &maskse.pre);
@@ -2671,7 +2696,8 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
/* Do the actual summation/product. */
gfc_init_se (&arrayse, parent_se);
gfc_copy_loopinfo_to_se (&arrayse, ploop);
- arrayse.ss = arrayss;
+ if (expr->rank == 0)
+ arrayse.ss = arrayss;
gfc_conv_expr_val (&arrayse, arrayexpr);
gfc_add_block_to_block (&block, &arrayse.pre);
@@ -2763,17 +2789,29 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
/* For a scalar mask, enclose the loop in an if statement. */
if (maskexpr && maskexpr->rank == 0)
{
- gfc_init_se (&maskse, NULL);
- gfc_conv_expr_val (&maskse, maskexpr);
gfc_init_block (&block);
gfc_add_block_to_block (&block, &ploop->pre);
gfc_add_block_to_block (&block, &ploop->post);
tmp = gfc_finish_block (&block);
- tmp = build3_v (COND_EXPR, maskse.expr, tmp,
- build_empty_stmt (input_location));
+ if (expr->rank > 0)
+ {
+ tmp = build3_v (COND_EXPR, se->ss->info->data.scalar.value, tmp,
+ build_empty_stmt (input_location));
+ gfc_advance_se_ss_chain (se);
+ }
+ else
+ {
+ gcc_assert (expr->rank == 0);
+ gfc_init_se (&maskse, NULL);
+ gfc_conv_expr_val (&maskse, maskexpr);
+ tmp = build3_v (COND_EXPR, maskse.expr, tmp,
+ build_empty_stmt (input_location));
+ }
+
gfc_add_expr_to_block (&block, tmp);
gfc_add_block_to_block (&se->pre, &block);
+ gcc_assert (se->post.head == NULL);
}
else
{
@@ -2781,7 +2819,8 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
gfc_add_block_to_block (&se->pre, &ploop->post);
}
- gfc_cleanup_loop (ploop);
+ if (expr->rank == 0)
+ gfc_cleanup_loop (ploop);
if (norm2)
{
@@ -6801,12 +6840,127 @@ walk_inline_intrinsic_transpose (gfc_ss *ss, gfc_expr *expr)
}
+/* Move the given dimension of the given gfc_ss list to a nested gfc_ss list.
+ This has the side effect of reversing the nested list, so there is no
+ need to call gfc_reverse_ss on it (the given list is assumed not to be
+ reversed yet). */
+
+static gfc_ss *
+nest_loop_dimension (gfc_ss *ss, int dim)
+{
+ int ss_dim, i;
+ gfc_ss *new_ss, *prev_ss = gfc_ss_terminator;
+ gfc_loopinfo *new_loop;
+
+ gcc_assert (ss != gfc_ss_terminator);
+
+ for (; ss != gfc_ss_terminator; ss = ss->next)
+ {
+ new_ss = gfc_get_ss ();
+ new_ss->next = prev_ss;
+ new_ss->parent = ss;
+ new_ss->info = ss->info;
+ new_ss->info->refcount++;
+ if (ss->dimen != 0)
+ {
+ gcc_assert (ss->info->type != GFC_SS_SCALAR
+ && ss->info->type != GFC_SS_REFERENCE);
+
+ new_ss->dimen = 1;
+ new_ss->dim[0] = ss->dim[dim];
+
+ gcc_assert (dim < ss->dimen);
+
+ ss_dim = --ss->dimen;
+ for (i = dim; i < ss_dim; i++)
+ ss->dim[i] = ss->dim[i + 1];
+
+ ss->dim[ss_dim] = 0;
+ }
+ prev_ss = new_ss;
+
+ if (ss->nested_ss)
+ {
+ ss->nested_ss->parent = new_ss;
+ new_ss->nested_ss = ss->nested_ss;
+ }
+ ss->nested_ss = new_ss;
+ }
+
+ new_loop = gfc_get_loopinfo ();
+ gfc_init_loopinfo (new_loop);
+
+ gcc_assert (prev_ss != NULL);
+ gcc_assert (prev_ss != gfc_ss_terminator);
+ gfc_add_ss_to_loop (new_loop, prev_ss);
+ return new_ss->parent;
+}
+
+
+/* Create the gfc_ss list for the SUM/PRODUCT arguments when the function
+ is to be inlined. */
+
+static gfc_ss *
+walk_inline_intrinsic_arith (gfc_ss *ss, gfc_expr *expr)
+{
+ gfc_ss *tmp_ss, *tail, *array_ss;
+ gfc_actual_arglist *arg1, *arg2, *arg3;
+ int sum_dim;
+ bool scalar_mask = false;
+
+ /* The rank of the result will be determined later. */
+ arg1 = expr->value.function.actual;
+ arg2 = arg1->next;
+ arg3 = arg2->next;
+ gcc_assert (arg3 != NULL);
+
+ if (expr->rank == 0)
+ return ss;
+
+ tmp_ss = gfc_ss_terminator;
+
+ if (arg3->expr)
+ {
+ gfc_ss *mask_ss;
+
+ mask_ss = gfc_walk_subexpr (tmp_ss, arg3->expr);
+ if (mask_ss == tmp_ss)
+ scalar_mask = 1;
+
+ tmp_ss = mask_ss;
+ }
+
+ array_ss = gfc_walk_subexpr (tmp_ss, arg1->expr);
+ gcc_assert (array_ss != tmp_ss);
+
+ /* Odd thing: If the mask is scalar, it is used by the frontend after
+ the array (to make it array around the nested loop). Thus it shall
+ be after array_ss once the gfc_ss list is reversed. */
+ if (scalar_mask)
+ tmp_ss = gfc_get_scalar_ss (array_ss, arg3->expr);
+ else
+ tmp_ss = array_ss;
+
+ /* "Hide" the dimension on which we will sum in the first arg's scalarization
+ chain. */
+ sum_dim = mpz_get_si (arg2->expr->value.integer) - 1;
+ tail = nest_loop_dimension (tmp_ss, sum_dim);
+ tail->next = ss;
+
+ return tmp_ss;
+}
+
+
static gfc_ss *
walk_inline_intrinsic_function (gfc_ss * ss, gfc_expr * expr)
{
switch (expr->value.function.isym->id)
{
+ case GFC_ISYM_PRODUCT:
+ case GFC_ISYM_SUM:
+ return walk_inline_intrinsic_arith (ss, expr);
+
case GFC_ISYM_TRANSPOSE:
return walk_inline_intrinsic_transpose (ss, expr);
@@ -6868,11 +7022,26 @@ gfc_walk_intrinsic_libfunc (gfc_ss * ss, gfc_expr * expr)
bool
gfc_inline_intrinsic_function_p (gfc_expr *expr)
{
+ gfc_actual_arglist *args;
+
if (!expr->value.function.isym)
return false;
switch (expr->value.function.isym->id)
{
+ case GFC_ISYM_PRODUCT:
+ case GFC_ISYM_SUM:
+ /* Disable inline expansion if code size matters. */
+ if (optimize_size)
+ return false;
+
+ args = expr->value.function.actual;
+ /* We need to be able to subset the SUM argument at compile-time. */
+ if (args->next->expr && args->next->expr->expr_type != EXPR_CONSTANT)
+ return false;
+
+ return true;
+
case GFC_ISYM_TRANSPOSE:
return true;
diff --git a/trans.h b/trans.h
index 5757865..22033d3 100644
--- a/trans.h
+++ b/trans.h
@@ -310,6 +310,7 @@ typedef struct gfc_loopinfo
}
gfc_loopinfo;
+#define gfc_get_loopinfo() XCNEW (gfc_loopinfo)
/* Information about a symbol that has been shadowed by a temporary. */
typedef struct
[-- Attachment #4: pr43829-66.diff --]
[-- Type: text/x-diff, Size: 10772 bytes --]
diff --git a/trans-array.c b/trans-array.c
index acd9aec18fefc6631ad443c5dff2d3014a9d6565..262743d0d3779b4f02a63d604bd9a621401ae84e 100644
*** a/trans-array.c
--- b/trans-array.c
*************** gfc_conv_expr_descriptor (gfc_se * se, g
*** 6187,6193 ****
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);
--- 6187,6194 ----
gcc_assert ((expr->value.function.esym != NULL
&& expr->value.function.esym->attr.elemental)
|| (expr->value.function.isym != NULL
! && expr->value.function.isym->elemental)
! || gfc_inline_intrinsic_function_p (expr));
else
gcc_assert (ss_type == GFC_SS_INTRINSIC);
diff --git a/trans-intrinsic.c b/trans-intrinsic.c
index 25c54fb6db9cbc7e80e3b3adca77b3bb13b15304..973f912a624bdd442b3851471432c358118438d6 100644
*** a/trans-intrinsic.c
--- b/trans-intrinsic.c
*************** gfc_conv_intrinsic_count (gfc_se * se, g
*** 2557,2562 ****
--- 2557,2576 ----
se->expr = resvar;
}
+
+ /* Update given gfc_se to have ss component pointing to the nested gfc_ss
+ struct and return the corresponding loopinfo. */
+
+ static gfc_loopinfo *
+ enter_nested_loop (gfc_se *se)
+ {
+ se->ss = se->ss->nested_ss;
+ gcc_assert (se->ss == se->ss->loop->ss);
+
+ return se->ss->loop;
+ }
+
+
/* Inline implementation of the sum and product intrinsics. */
static void
gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
*************** gfc_conv_intrinsic_arith (gfc_se * se, g
*** 2570,2587 ****
tree tmp;
gfc_loopinfo loop, *ploop;
gfc_actual_arglist *arg_array, *arg_mask;
! gfc_ss *arrayss;
! gfc_ss *maskss;
gfc_se arrayse;
gfc_se maskse;
gfc_se *parent_se;
gfc_expr *arrayexpr;
gfc_expr *maskexpr;
! if (se->ss)
{
! gfc_conv_intrinsic_funcall (se, expr);
! return;
}
else
parent_se = NULL;
--- 2584,2601 ----
tree tmp;
gfc_loopinfo loop, *ploop;
gfc_actual_arglist *arg_array, *arg_mask;
! gfc_ss *arrayss = NULL;
! gfc_ss *maskss = NULL;
gfc_se arrayse;
gfc_se maskse;
gfc_se *parent_se;
gfc_expr *arrayexpr;
gfc_expr *maskexpr;
! if (expr->rank > 0)
{
! gcc_assert (gfc_inline_intrinsic_function_p (expr));
! parent_se = se;
}
else
parent_se = NULL;
*************** gfc_conv_intrinsic_arith (gfc_se * se, g
*** 2613,2622 ****
arg_array = expr->value.function.actual;
- /* Walk the arguments. */
arrayexpr = arg_array->expr;
- arrayss = gfc_walk_expr (arrayexpr);
- gcc_assert (arrayss != gfc_ss_terminator);
if (op == NE_EXPR || norm2)
/* PARITY and NORM2. */
--- 2627,2633 ----
*************** gfc_conv_intrinsic_arith (gfc_se * se, g
*** 2628,2633 ****
--- 2639,2650 ----
maskexpr = arg_mask->expr;
}
+ if (expr->rank == 0)
+ {
+ /* Walk the arguments. */
+ arrayss = gfc_walk_expr (arrayexpr);
+ gcc_assert (arrayss != gfc_ss_terminator);
+
if (maskexpr && maskexpr->rank > 0)
{
maskss = gfc_walk_expr (maskexpr);
*************** gfc_conv_intrinsic_arith (gfc_se * se, g
*** 2651,2656 ****
--- 2668,2680 ----
gfc_mark_ss_chain_used (maskss, 1);
ploop = &loop;
+ }
+ else
+ /* All the work has been done in the parent loops. */
+ ploop = enter_nested_loop (se);
+
+ gcc_assert (ploop);
+
/* Generate the loop body. */
gfc_start_scalarized_body (ploop, &body);
*************** gfc_conv_intrinsic_arith (gfc_se * se, g
*** 2659,2664 ****
--- 2683,2689 ----
{
gfc_init_se (&maskse, parent_se);
gfc_copy_loopinfo_to_se (&maskse, ploop);
+ if (expr->rank == 0)
maskse.ss = maskss;
gfc_conv_expr_val (&maskse, maskexpr);
gfc_add_block_to_block (&body, &maskse.pre);
*************** gfc_conv_intrinsic_arith (gfc_se * se, g
*** 2671,2676 ****
--- 2696,2702 ----
/* Do the actual summation/product. */
gfc_init_se (&arrayse, parent_se);
gfc_copy_loopinfo_to_se (&arrayse, ploop);
+ if (expr->rank == 0)
arrayse.ss = arrayss;
gfc_conv_expr_val (&arrayse, arrayexpr);
gfc_add_block_to_block (&block, &arrayse.pre);
*************** gfc_conv_intrinsic_arith (gfc_se * se, g
*** 2763,2779 ****
/* For a scalar mask, enclose the loop in an if statement. */
if (maskexpr && maskexpr->rank == 0)
{
- gfc_init_se (&maskse, NULL);
- gfc_conv_expr_val (&maskse, maskexpr);
gfc_init_block (&block);
gfc_add_block_to_block (&block, &ploop->pre);
gfc_add_block_to_block (&block, &ploop->post);
tmp = gfc_finish_block (&block);
tmp = build3_v (COND_EXPR, maskse.expr, tmp,
build_empty_stmt (input_location));
gfc_add_expr_to_block (&block, tmp);
gfc_add_block_to_block (&se->pre, &block);
}
else
{
--- 2789,2817 ----
/* For a scalar mask, enclose the loop in an if statement. */
if (maskexpr && maskexpr->rank == 0)
{
gfc_init_block (&block);
gfc_add_block_to_block (&block, &ploop->pre);
gfc_add_block_to_block (&block, &ploop->post);
tmp = gfc_finish_block (&block);
+ if (expr->rank > 0)
+ {
+ tmp = build3_v (COND_EXPR, se->ss->info->data.scalar.value, tmp,
+ build_empty_stmt (input_location));
+ gfc_advance_se_ss_chain (se);
+ }
+ else
+ {
+ gcc_assert (expr->rank == 0);
+ gfc_init_se (&maskse, NULL);
+ gfc_conv_expr_val (&maskse, maskexpr);
tmp = build3_v (COND_EXPR, maskse.expr, tmp,
build_empty_stmt (input_location));
+ }
+
gfc_add_expr_to_block (&block, tmp);
gfc_add_block_to_block (&se->pre, &block);
+ gcc_assert (se->post.head == NULL);
}
else
{
*************** gfc_conv_intrinsic_arith (gfc_se * se, g
*** 2781,2786 ****
--- 2819,2825 ----
gfc_add_block_to_block (&se->pre, &ploop->post);
}
+ if (expr->rank == 0)
gfc_cleanup_loop (ploop);
if (norm2)
*************** walk_inline_intrinsic_transpose (gfc_ss
*** 6801,6812 ****
--- 6840,6966 ----
}
+ /* Move the given dimension of the given gfc_ss list to a nested gfc_ss list.
+ This has the side effect of reversing the nested list, so there is no
+ need to call gfc_reverse_ss on it (the given list is assumed not to be
+ reversed yet). */
+
+ static gfc_ss *
+ nest_loop_dimension (gfc_ss *ss, int dim)
+ {
+ int ss_dim, i;
+ gfc_ss *new_ss, *prev_ss = gfc_ss_terminator;
+ gfc_loopinfo *new_loop;
+
+ gcc_assert (ss != gfc_ss_terminator);
+
+ for (; ss != gfc_ss_terminator; ss = ss->next)
+ {
+ new_ss = gfc_get_ss ();
+ new_ss->next = prev_ss;
+ new_ss->parent = ss;
+ new_ss->info = ss->info;
+ new_ss->info->refcount++;
+ if (ss->dimen != 0)
+ {
+ gcc_assert (ss->info->type != GFC_SS_SCALAR
+ && ss->info->type != GFC_SS_REFERENCE);
+
+ new_ss->dimen = 1;
+ new_ss->dim[0] = ss->dim[dim];
+
+ gcc_assert (dim < ss->dimen);
+
+ ss_dim = --ss->dimen;
+ for (i = dim; i < ss_dim; i++)
+ ss->dim[i] = ss->dim[i + 1];
+
+ ss->dim[ss_dim] = 0;
+ }
+ prev_ss = new_ss;
+
+ if (ss->nested_ss)
+ {
+ ss->nested_ss->parent = new_ss;
+ new_ss->nested_ss = ss->nested_ss;
+ }
+ ss->nested_ss = new_ss;
+ }
+
+ new_loop = gfc_get_loopinfo ();
+ gfc_init_loopinfo (new_loop);
+
+ gcc_assert (prev_ss != NULL);
+ gcc_assert (prev_ss != gfc_ss_terminator);
+ gfc_add_ss_to_loop (new_loop, prev_ss);
+ return new_ss->parent;
+ }
+
+
+ /* Create the gfc_ss list for the SUM/PRODUCT arguments when the function
+ is to be inlined. */
+
+ static gfc_ss *
+ walk_inline_intrinsic_arith (gfc_ss *ss, gfc_expr *expr)
+ {
+ gfc_ss *tmp_ss, *tail, *array_ss;
+ gfc_actual_arglist *arg1, *arg2, *arg3;
+ int sum_dim;
+ bool scalar_mask = false;
+
+ /* The rank of the result will be determined later. */
+ arg1 = expr->value.function.actual;
+ arg2 = arg1->next;
+ arg3 = arg2->next;
+ gcc_assert (arg3 != NULL);
+
+ if (expr->rank == 0)
+ return ss;
+
+ tmp_ss = gfc_ss_terminator;
+
+ if (arg3->expr)
+ {
+ gfc_ss *mask_ss;
+
+ mask_ss = gfc_walk_subexpr (tmp_ss, arg3->expr);
+ if (mask_ss == tmp_ss)
+ scalar_mask = 1;
+
+ tmp_ss = mask_ss;
+ }
+
+ array_ss = gfc_walk_subexpr (tmp_ss, arg1->expr);
+ gcc_assert (array_ss != tmp_ss);
+
+ /* Odd thing: If the mask is scalar, it is used by the frontend after
+ the array (to make it array around the nested loop). Thus it shall
+ be after array_ss once the gfc_ss list is reversed. */
+ if (scalar_mask)
+ tmp_ss = gfc_get_scalar_ss (array_ss, arg3->expr);
+ else
+ tmp_ss = array_ss;
+
+ /* "Hide" the dimension on which we will sum in the first arg's scalarization
+ chain. */
+ sum_dim = mpz_get_si (arg2->expr->value.integer) - 1;
+ tail = nest_loop_dimension (tmp_ss, sum_dim);
+ tail->next = ss;
+
+ return tmp_ss;
+ }
+
+
static gfc_ss *
walk_inline_intrinsic_function (gfc_ss * ss, gfc_expr * expr)
{
switch (expr->value.function.isym->id)
{
+ case GFC_ISYM_PRODUCT:
+ case GFC_ISYM_SUM:
+ return walk_inline_intrinsic_arith (ss, expr);
+
case GFC_ISYM_TRANSPOSE:
return walk_inline_intrinsic_transpose (ss, expr);
*************** gfc_walk_intrinsic_libfunc (gfc_ss * ss,
*** 6868,6878 ****
--- 7022,7047 ----
bool
gfc_inline_intrinsic_function_p (gfc_expr *expr)
{
+ gfc_actual_arglist *args;
+
if (!expr->value.function.isym)
return false;
switch (expr->value.function.isym->id)
{
+ case GFC_ISYM_PRODUCT:
+ case GFC_ISYM_SUM:
+ /* Disable inline expansion if code size matters. */
+ if (optimize_size)
+ return false;
+
+ args = expr->value.function.actual;
+ /* We need to be able to subset the SUM argument at compile-time. */
+ if (args->next->expr && args->next->expr->expr_type != EXPR_CONSTANT)
+ return false;
+
+ return true;
+
case GFC_ISYM_TRANSPOSE:
return true;
diff --git a/trans.h b/trans.h
index 5757865b3a180a32e5baa320c56d235924df68dc..22033d38d157f5c85eba6fcb8ee92ab28dc22535 100644
*** a/trans.h
--- b/trans.h
*************** typedef struct gfc_loopinfo
*** 310,315 ****
--- 310,316 ----
}
gfc_loopinfo;
+ #define gfc_get_loopinfo() XCNEW (gfc_loopinfo)
/* Information about a symbol that has been shadowed by a temporary. */
typedef struct
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [34/66] inline sum and product: Update the scalarizer: gfc_ss_info refcounting
2011-10-27 23:35 ` [Patch, fortran] [31..53/66] inline sum and product: Update the scalarizer Mikael Morin
` (6 preceding siblings ...)
2011-10-27 23:36 ` [Patch, fortran] [35..39/66] inline sum and product: Update the scalarizer: New gfc_ss::loop field Mikael Morin
@ 2011-10-27 23:36 ` Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [46/66] inline sum and product: Update the scalarizer: Update gfc_trans_create_temp_array Mikael Morin
` (4 subsequent siblings)
12 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:36 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 153 bytes --]
As there will be more than one gfc_ss struct pointing to a single gfc_ss_info,
it needs to be reference counted. This introduces reference counting.
OK?
[-- Attachment #2: pr43829-34.CL --]
[-- Type: text/plain, Size: 265 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans.h (struct gfc_ss_info): New field refcount.
* trans-array.c (free_ss_info): Decrement refcount. Return early if
still non-zero.
(gfc_get_array_ss, gfc_get_temp_ss, gfc_get_scalar_ss): Increment
refcount.
[-- Attachment #3: pr43829-34.patch --]
[-- Type: text/x-diff, Size: 1277 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 663d12e..abb6db2 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -489,6 +489,11 @@ gfc_free_ss_chain (gfc_ss * ss)
static void
free_ss_info (gfc_ss_info *ss_info)
{
+ ss_info->refcount--;
+ if (ss_info->refcount > 0)
+ return;
+
+ gcc_assert (ss_info->refcount == 0);
free (ss_info);
}
@@ -532,6 +537,7 @@ gfc_get_array_ss (gfc_ss *next, gfc_expr *expr, int dimen, gfc_ss_type type)
int i;
ss_info = gfc_get_ss_info ();
+ ss_info->refcount++;
ss_info->type = type;
ss_info->expr = expr;
@@ -556,6 +562,7 @@ gfc_get_temp_ss (tree type, tree string_length, int dimen)
int i;
ss_info = gfc_get_ss_info ();
+ ss_info->refcount++;
ss_info->type = GFC_SS_TEMP;
ss_info->string_length = string_length;
ss_info->data.temp.type = type;
@@ -580,6 +587,7 @@ gfc_get_scalar_ss (gfc_ss *next, gfc_expr *expr)
gfc_ss_info *ss_info;
ss_info = gfc_get_ss_info ();
+ ss_info->refcount++;
ss_info->type = GFC_SS_SCALAR;
ss_info->expr = expr;
diff --git a/trans.h b/trans.h
index c35b1ae..02f2b42 100644
--- a/trans.h
+++ b/trans.h
@@ -185,6 +185,7 @@ gfc_ss_type;
typedef struct gfc_ss_info
{
+ int refcount;
gfc_ss_type type;
gfc_expr *expr;
tree string_length;
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [63/66] inline sum and product: Inline sum: Change argument handling.
2011-10-27 23:36 ` [Patch, fortran] [62..66/66] inline sum and product: Inline sum Mikael Morin
` (2 preceding siblings ...)
2011-10-27 23:36 ` [Patch, fortran] [65/66] inline sum and product: Inline sum: Change se initialization Mikael Morin
@ 2011-10-27 23:36 ` Mikael Morin
2011-10-28 0:29 ` [Patch, fortran] [62/66] inline sum and product: Inline sum: Change conditions Mikael Morin
4 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:36 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 58 bytes --]
This uses named argument to make it easier to follow.
OK?
[-- Attachment #2: pr43829-63.CL --]
[-- Type: text/plain, Size: 131 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-intrinsic.c (gfc_conv_intrinsic_arith): Small argument handling
cleanup.
[-- Attachment #3: pr43829-63.patch --]
[-- Type: text/x-diff, Size: 1220 bytes --]
diff --git a/trans-intrinsic.c b/trans-intrinsic.c
index 342d2cb..b701502 100644
--- a/trans-intrinsic.c
+++ b/trans-intrinsic.c
@@ -2569,7 +2569,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
stmtblock_t block;
tree tmp;
gfc_loopinfo loop;
- gfc_actual_arglist *actual;
+ gfc_actual_arglist *arg_array, *arg_mask;
gfc_ss *arrayss;
gfc_ss *maskss;
gfc_se arrayse;
@@ -2608,9 +2608,10 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
gfc_add_modify (&se->pre, resvar, tmp);
+ arg_array = expr->value.function.actual;
+
/* Walk the arguments. */
- actual = expr->value.function.actual;
- arrayexpr = actual->expr;
+ arrayexpr = arg_array->expr;
arrayss = gfc_walk_expr (arrayexpr);
gcc_assert (arrayss != gfc_ss_terminator);
@@ -2619,9 +2620,9 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
maskexpr = NULL;
else
{
- actual = actual->next->next;
- gcc_assert (actual);
- maskexpr = actual->expr;
+ arg_mask = arg_array->next->next;
+ gcc_assert (arg_mask != NULL);
+ maskexpr = arg_mask->expr;
}
if (maskexpr && maskexpr->rank > 0)
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [46/66] inline sum and product: Update the scalarizer: Update gfc_trans_create_temp_array.
2011-10-27 23:35 ` [Patch, fortran] [31..53/66] inline sum and product: Update the scalarizer Mikael Morin
` (7 preceding siblings ...)
2011-10-27 23:36 ` [Patch, fortran] [34/66] inline sum and product: Update the scalarizer: gfc_ss_info refcounting Mikael Morin
@ 2011-10-27 23:36 ` Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [40..43/66] inline sum and product: Update the scalarizer: New gfc_ss::parent field Mikael Morin
` (3 subsequent siblings)
12 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:36 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 108 bytes --]
This updates gfc_trans_create_temp_array with looking at parent (outer) ss.
Context diff also provided.
OK?
[-- Attachment #2: pr43829-46.CL --]
[-- Type: text/plain, Size: 119 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (gfc_trans_create_temp_array): Loop over the parents.
[-- Attachment #3: pr43829-46.patch --]
[-- Type: text/x-diff, Size: 4253 bytes --]
diff --git a/trans-array.c b/trans-array.c
index d918fa8..1a86ae6 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -943,6 +943,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
bool dealloc, bool callee_alloc, locus * where)
{
gfc_loopinfo *loop;
+ gfc_ss *s;
gfc_array_info *info;
tree from[GFC_MAX_DIMENSIONS], to[GFC_MAX_DIMENSIONS];
tree type;
@@ -966,41 +967,45 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
if (gfc_option.warn_array_temp && where)
gfc_warning ("Creating array temporary at %L", where);
- loop = ss->loop;
- total_dim = loop->dimen;
/* Set the lower bound to zero. */
- for (n = 0; n < loop->dimen; n++)
+ for (s = ss; s; s = s->parent)
{
- dim = ss->dim[n];
+ loop = s->loop;
+
+ total_dim += loop->dimen;
+ for (n = 0; n < loop->dimen; n++)
+ {
+ dim = s->dim[n];
- /* Callee allocated arrays may not have a known bound yet. */
- if (loop->to[n])
- loop->to[n] = gfc_evaluate_now (
+ /* Callee allocated arrays may not have a known bound yet. */
+ if (loop->to[n])
+ loop->to[n] = gfc_evaluate_now (
fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
loop->to[n], loop->from[n]),
pre);
- loop->from[n] = gfc_index_zero_node;
-
- /* We have just changed the loop bounds, we must clear the
- corresponding specloop, so that delta calculation is not skipped
- later in set_delta. */
- loop->specloop[n] = NULL;
-
- /* We are constructing the temporary's descriptor based on the loop
- dimensions. As the dimensions may be accessed in arbitrary order
- (think of transpose) the size taken from the n'th loop may not map
- 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_scalarizer_dim_for_array_dim (ss, dim);
- from[tmp_dim] = loop->from[n];
- to[tmp_dim] = loop->to[n];
-
- info->delta[dim] = gfc_index_zero_node;
- info->start[dim] = gfc_index_zero_node;
- info->end[dim] = gfc_index_zero_node;
- info->stride[dim] = gfc_index_one_node;
+ loop->from[n] = gfc_index_zero_node;
+
+ /* We have just changed the loop bounds, we must clear the
+ corresponding specloop, so that delta calculation is not skipped
+ later in set_delta. */
+ loop->specloop[n] = NULL;
+
+ /* We are constructing the temporary's descriptor based on the loop
+ dimensions. As the dimensions may be accessed in arbitrary order
+ (think of transpose) the size taken from the n'th loop may not map
+ 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_scalarizer_dim_for_array_dim (ss, dim);
+ from[tmp_dim] = loop->from[n];
+ to[tmp_dim] = loop->to[n];
+
+ info->delta[dim] = gfc_index_zero_node;
+ info->start[dim] = gfc_index_zero_node;
+ info->end[dim] = gfc_index_zero_node;
+ info->stride[dim] = gfc_index_one_node;
+ }
}
/* Initialize the descriptor. */
@@ -1042,8 +1047,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
}
if (size == NULL_TREE)
- {
- for (n = 0; n < loop->dimen; n++)
+ for (s = ss; s; s = s->parent)
+ for (n = 0; n < s->loop->dimen; n++)
{
dim = get_scalarizer_dim_for_array_dim (ss, ss->dim[n]);
@@ -1053,9 +1058,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
MINUS_EXPR, gfc_array_index_type,
gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]),
gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]));
- loop->to[n] = tmp;
+ s->loop->to[n] = tmp;
}
- }
else
{
for (n = 0; n < total_dim; n++)
@@ -1112,6 +1116,9 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
gfc_trans_allocate_array_storage (pre, post, info, size, nelem, initial,
dynamic, dealloc);
+ while (ss->parent)
+ ss = ss->parent;
+
if (ss->dimen > ss->loop->temp_dim)
ss->loop->temp_dim = ss->dimen;
[-- Attachment #4: pr43829-46.diff --]
[-- Type: text/x-diff, Size: 3941 bytes --]
diff --git a/trans-array.c b/trans-array.c
index d918fa820093edb19f100364faafd4f4839083e8..1a86ae66c59e2814d7735d66c6418b46fa59585b 100644
*** a/trans-array.c
--- b/trans-array.c
*************** gfc_trans_create_temp_array (stmtblock_t
*** 943,948 ****
--- 943,949 ----
bool dealloc, bool callee_alloc, locus * where)
{
gfc_loopinfo *loop;
+ gfc_ss *s;
gfc_array_info *info;
tree from[GFC_MAX_DIMENSIONS], to[GFC_MAX_DIMENSIONS];
tree type;
*************** gfc_trans_create_temp_array (stmtblock_t
*** 966,977 ****
if (gfc_option.warn_array_temp && where)
gfc_warning ("Creating array temporary at %L", where);
- loop = ss->loop;
- total_dim = loop->dimen;
/* Set the lower bound to zero. */
for (n = 0; n < loop->dimen; n++)
{
! dim = ss->dim[n];
/* Callee allocated arrays may not have a known bound yet. */
if (loop->to[n])
--- 967,981 ----
if (gfc_option.warn_array_temp && where)
gfc_warning ("Creating array temporary at %L", where);
/* Set the lower bound to zero. */
+ for (s = ss; s; s = s->parent)
+ {
+ loop = s->loop;
+
+ total_dim += loop->dimen;
for (n = 0; n < loop->dimen; n++)
{
! dim = s->dim[n];
/* Callee allocated arrays may not have a known bound yet. */
if (loop->to[n])
*************** gfc_trans_create_temp_array (stmtblock_t
*** 990,997 ****
/* We are constructing the temporary's descriptor based on the loop
dimensions. As the dimensions may be accessed in arbitrary order
(think of transpose) the size taken from the n'th loop may not map
! 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_scalarizer_dim_for_array_dim (ss, dim);
from[tmp_dim] = loop->from[n];
--- 994,1001 ----
/* We are constructing the temporary's descriptor based on the loop
dimensions. As the dimensions may be accessed in arbitrary order
(think of transpose) the size taken from the n'th loop may not map
! 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_scalarizer_dim_for_array_dim (ss, dim);
from[tmp_dim] = loop->from[n];
*************** gfc_trans_create_temp_array (stmtblock_t
*** 1002,1007 ****
--- 1006,1012 ----
info->end[dim] = gfc_index_zero_node;
info->stride[dim] = gfc_index_one_node;
}
+ }
/* Initialize the descriptor. */
type =
*************** gfc_trans_create_temp_array (stmtblock_t
*** 1042,1049 ****
}
if (size == NULL_TREE)
! {
! for (n = 0; n < loop->dimen; n++)
{
dim = get_scalarizer_dim_for_array_dim (ss, ss->dim[n]);
--- 1047,1054 ----
}
if (size == NULL_TREE)
! for (s = ss; s; s = s->parent)
! for (n = 0; n < s->loop->dimen; n++)
{
dim = get_scalarizer_dim_for_array_dim (ss, ss->dim[n]);
*************** gfc_trans_create_temp_array (stmtblock_t
*** 1053,1060 ****
MINUS_EXPR, gfc_array_index_type,
gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]),
gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]));
! loop->to[n] = tmp;
! }
}
else
{
--- 1058,1064 ----
MINUS_EXPR, gfc_array_index_type,
gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]),
gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]));
! s->loop->to[n] = tmp;
}
else
{
*************** gfc_trans_create_temp_array (stmtblock_t
*** 1112,1117 ****
--- 1116,1124 ----
gfc_trans_allocate_array_storage (pre, post, info, size, nelem, initial,
dynamic, dealloc);
+ while (ss->parent)
+ ss = ss->parent;
+
if (ss->dimen > ss->loop->temp_dim)
ss->loop->temp_dim = ss->dimen;
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [52/66] inline sum and product: Update the scalarizer: New outermost_loop function.
2011-10-27 23:35 ` [Patch, fortran] [31..53/66] inline sum and product: Update the scalarizer Mikael Morin
` (9 preceding siblings ...)
2011-10-27 23:36 ` [Patch, fortran] [40..43/66] inline sum and product: Update the scalarizer: New gfc_ss::parent field Mikael Morin
@ 2011-10-27 23:36 ` Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [53/66] inline sum and product: Update the scalarizer: Update gfc_trans_preloop_setup Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [49..51/66] inline sum and product: Update the scalarizer: New parent loop Mikael Morin
12 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:36 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 124 bytes --]
This uses the just added parent loop pointer to create an outermost_loop
function and use it throughout the scalarizer.
OK?
[-- Attachment #2: pr43829-52.CL --]
[-- Type: text/plain, Size: 226 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (outermost_loop): New function.
(gfc_trans_array_constructor, gfc_set_vector_loop_bounds,
gfc_add_loop_ss_code): Put generated code out of the outermost loop.
[-- Attachment #3: pr43829-52.patch --]
[-- Type: text/x-diff, Size: 7681 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 299bd80..0f3d171 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -2108,6 +2108,16 @@ get_loop_upper_bound_for_array (gfc_ss *array, int array_dim)
}
+static gfc_loopinfo *
+outermost_loop (gfc_loopinfo * loop)
+{
+ while (loop->parent != NULL)
+ loop = loop->parent;
+
+ return loop;
+}
+
+
/* Array constructors are handled by constructing a temporary, then using that
within the scalarization loop. This is not optimal, but seems by far the
simplest method. */
@@ -2125,7 +2135,7 @@ trans_array_constructor (gfc_ss * ss, locus * where)
bool dynamic;
bool old_first_len, old_typespec_chararray_ctor;
tree old_first_len_val;
- gfc_loopinfo *loop;
+ gfc_loopinfo *loop, *outer_loop;
gfc_ss_info *ss_info;
gfc_expr *expr;
gfc_ss *s;
@@ -2136,6 +2146,7 @@ trans_array_constructor (gfc_ss * ss, locus * where)
old_typespec_chararray_ctor = typespec_chararray_ctor;
loop = ss->loop;
+ outer_loop = outermost_loop (loop);
ss_info = ss->info;
expr = ss_info->expr;
@@ -2171,11 +2182,11 @@ trans_array_constructor (gfc_ss * ss, locus * where)
gfc_conv_expr_type (&length_se, expr->ts.u.cl->length,
gfc_charlen_type_node);
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);
+ gfc_add_block_to_block (&outer_loop->pre, &length_se.pre);
+ gfc_add_block_to_block (&outer_loop->post, &length_se.post);
}
else
- const_string = get_array_ctor_strlen (&loop->pre, c,
+ const_string = get_array_ctor_strlen (&outer_loop->pre, c,
&ss_info->string_length);
/* Complex character array constructors should have been taken care of
@@ -2252,15 +2263,15 @@ trans_array_constructor (gfc_ss * ss, locus * where)
if (TREE_CODE (*loop_ubound0) == VAR_DECL)
dynamic = true;
- gfc_trans_create_temp_array (&loop->pre, &loop->post, ss, type, NULL_TREE,
- dynamic, true, false, where);
+ gfc_trans_create_temp_array (&outer_loop->pre, &outer_loop->post, ss, type,
+ NULL_TREE, dynamic, true, false, where);
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;
TREE_USED (offsetvar) = 0;
- gfc_trans_array_constructor_value (&loop->pre, type, desc, c,
+ gfc_trans_array_constructor_value (&outer_loop->pre, type, desc, c,
&offset, &offsetvar, dynamic);
/* If the array grows dynamically, the upper bound of the loop variable
@@ -2270,10 +2281,10 @@ trans_array_constructor (gfc_ss * ss, locus * where)
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
offsetvar, gfc_index_one_node);
- tmp = gfc_evaluate_now (tmp, &loop->pre);
+ tmp = gfc_evaluate_now (tmp, &outer_loop->pre);
gfc_conv_descriptor_ubound_set (&loop->pre, desc, gfc_rank_cst[0], tmp);
if (*loop_ubound0 && TREE_CODE (*loop_ubound0) == VAR_DECL)
- gfc_add_modify (&loop->pre, *loop_ubound0, tmp);
+ gfc_add_modify (&outer_loop->pre, *loop_ubound0, tmp);
else
*loop_ubound0 = tmp;
}
@@ -2307,7 +2318,7 @@ finish:
static void
set_vector_loop_bounds (gfc_ss * ss)
{
- gfc_loopinfo *loop;
+ gfc_loopinfo *loop, *outer_loop;
gfc_array_info *info;
gfc_se se;
tree tmp;
@@ -2316,6 +2327,8 @@ set_vector_loop_bounds (gfc_ss * ss)
int n;
int dim;
+ outer_loop = outermost_loop (ss->loop);
+
info = &ss->info->data.array;
for (; ss; ss = ss->parent)
@@ -2343,7 +2356,7 @@ set_vector_loop_bounds (gfc_ss * ss)
gfc_array_index_type,
gfc_conv_descriptor_ubound_get (desc, zero),
gfc_conv_descriptor_lbound_get (desc, zero));
- tmp = gfc_evaluate_now (tmp, &loop->pre);
+ tmp = gfc_evaluate_now (tmp, &outer_loop->pre);
loop->to[n] = tmp;
}
}
@@ -2358,7 +2371,7 @@ static void
gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
locus * where)
{
- gfc_loopinfo *nested_loop;
+ gfc_loopinfo *nested_loop, *outer_loop;
gfc_se se;
gfc_ss_info *ss_info;
gfc_array_info *info;
@@ -2366,6 +2379,8 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
bool skip_nested = false;
int n;
+ outer_loop = outermost_loop (loop);
+
/* TODO: This can generate bad code if there are ordering dependencies,
e.g., a callee allocated function and an unknown size constructor. */
gcc_assert (ss != NULL);
@@ -2389,7 +2404,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
dimension indices, but not array section bounds. */
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, expr);
- gfc_add_block_to_block (&loop->pre, &se.pre);
+ gfc_add_block_to_block (&outer_loop->pre, &se.pre);
if (expr->ts.type != BT_CHARACTER)
{
@@ -2398,11 +2413,11 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
if (subscript)
se.expr = convert(gfc_array_index_type, se.expr);
if (!ss_info->where)
- se.expr = gfc_evaluate_now (se.expr, &loop->pre);
- gfc_add_block_to_block (&loop->pre, &se.post);
+ se.expr = gfc_evaluate_now (se.expr, &outer_loop->pre);
+ gfc_add_block_to_block (&outer_loop->pre, &se.post);
}
else
- gfc_add_block_to_block (&loop->post, &se.post);
+ gfc_add_block_to_block (&outer_loop->post, &se.post);
ss_info->data.scalar.value = se.expr;
ss_info->string_length = se.string_length;
@@ -2413,10 +2428,11 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
now. */
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, expr);
- gfc_add_block_to_block (&loop->pre, &se.pre);
- gfc_add_block_to_block (&loop->post, &se.post);
+ gfc_add_block_to_block (&outer_loop->pre, &se.pre);
+ gfc_add_block_to_block (&outer_loop->post, &se.post);
- ss_info->data.scalar.value = gfc_evaluate_now (se.expr, &loop->pre);
+ ss_info->data.scalar.value = gfc_evaluate_now (se.expr,
+ &outer_loop->pre);
ss_info->string_length = se.string_length;
break;
@@ -2438,8 +2454,8 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
/* Get the vector's descriptor and store it in SS. */
gfc_init_se (&se, NULL);
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);
+ gfc_add_block_to_block (&outer_loop->pre, &se.pre);
+ gfc_add_block_to_block (&outer_loop->post, &se.post);
info->descriptor = se.expr;
break;
@@ -2454,8 +2470,8 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
se.loop = loop;
se.ss = ss;
gfc_conv_expr (&se, expr);
- gfc_add_block_to_block (&loop->pre, &se.pre);
- gfc_add_block_to_block (&loop->post, &se.post);
+ gfc_add_block_to_block (&outer_loop->pre, &se.pre);
+ gfc_add_block_to_block (&outer_loop->post, &se.post);
ss_info->string_length = se.string_length;
break;
@@ -2469,8 +2485,8 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
gfc_conv_expr_type (&se, expr->ts.u.cl->length,
gfc_charlen_type_node);
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_add_block_to_block (&outer_loop->pre, &se.pre);
+ gfc_add_block_to_block (&outer_loop->post, &se.post);
}
trans_array_constructor (ss, where);
break;
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [09/66] inline sum and product: Preliminary cleanups: Assertify condition.
2011-10-27 23:35 ` [Patch, fortran] [07..12/66] inline sum and product: Preliminary cleanups Mikael Morin
` (3 preceding siblings ...)
2011-10-27 23:32 ` [Patch, fortran] [12/66] inline sum and product: Preliminary cleanups: Stop loop before end marker Mikael Morin
@ 2011-10-27 23:36 ` Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [11/66] inline sum and product: Preliminary cleanups: Skip temporary case Mikael Morin
5 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:36 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 0 bytes --]
[-- Attachment #2: pr43829-9.CL --]
[-- Type: text/plain, Size: 117 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (gfc_trans_preloop_setup): Assertify one condition.
[-- Attachment #3: pr43829-9.patch --]
[-- Type: text/x-diff, Size: 388 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 5500ec4..8359af2 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -2885,8 +2885,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
info = &ss->data.info;
- if (dim >= info->dimen)
- continue;
+ gcc_assert (dim < info->dimen);
gcc_assert (info->dimen == loop->dimen);
if (info->ref)
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [49..51/66] inline sum and product: Update the scalarizer: New parent loop.
2011-10-27 23:35 ` [Patch, fortran] [31..53/66] inline sum and product: Update the scalarizer Mikael Morin
` (11 preceding siblings ...)
2011-10-27 23:36 ` [Patch, fortran] [53/66] inline sum and product: Update the scalarizer: Update gfc_trans_preloop_setup Mikael Morin
@ 2011-10-27 23:36 ` Mikael Morin
12 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:36 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 227 bytes --]
This introduces a convenience pointer parent for the gfc_loopinfo struct
(patch 49).
Patches 50 and 51 (with context diff) use it to update
gfc_trans_array_constructor and constant_array_constructor_loop_size
respectively.
OK?
[-- Attachment #2: pr43829-49.CL --]
[-- Type: text/plain, Size: 291 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans.h (struct gfc_loopinfo): New field parent.
* trans-array.c (gfc_cleanup_loop): Free nested loops.
(gfc_add_ss_to_loop): Set nested_loop's parent loop.
(gfc_trans_array_constructor): Update assertion.
(gfc_conv_loop_setup): Ditto.
[-- Attachment #3: pr43829-49.patch --]
[-- Type: text/x-diff, Size: 2362 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 27356a1..5659b70 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -604,6 +604,7 @@ gfc_get_scalar_ss (gfc_ss *next, gfc_expr *expr)
void
gfc_cleanup_loop (gfc_loopinfo * loop)
{
+ gfc_loopinfo *loop_next, **ploop;
gfc_ss *ss;
gfc_ss *next;
@@ -615,6 +616,23 @@ gfc_cleanup_loop (gfc_loopinfo * loop)
gfc_free_ss (ss);
ss = next;
}
+
+ /* Remove reference to self in the parent loop. */
+ if (loop->parent)
+ for (ploop = &loop->parent->nested; *ploop; ploop = &(*ploop)->next)
+ if (*ploop == loop)
+ {
+ *ploop = loop->next;
+ break;
+ }
+
+ /* Free non-freed nested loops. */
+ for (loop = loop->nested; loop; loop = loop_next)
+ {
+ loop_next = loop->next;
+ gfc_cleanup_loop (loop);
+ free (loop);
+ }
}
@@ -664,10 +682,15 @@ gfc_add_ss_to_loop (gfc_loopinfo * loop, gfc_ss * head)
added one, to avoid duplicate nested loops. */
if (nested_loop != loop->nested)
{
+ gcc_assert (nested_loop->parent == NULL);
+ nested_loop->parent = loop;
+
gcc_assert (nested_loop->next == NULL);
nested_loop->next = loop->nested;
loop->nested = nested_loop;
}
+ else
+ gcc_assert (nested_loop->parent == loop);
}
if (ss->next == gfc_ss_terminator)
@@ -2158,6 +2181,7 @@ trans_array_constructor (gfc_ss * ss, locus * where)
mpz_t size;
/* We should have a 1-dimensional, zero-based loop. */
+ gcc_assert (loop->parent == NULL && loop->nested == NULL);
gcc_assert (loop->dimen == 1);
gcc_assert (integer_zerop (loop->from[0]));
@@ -4302,6 +4326,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
tmp_ss_info = tmp_ss->info;
gcc_assert (tmp_ss_info->type == GFC_SS_TEMP);
+ gcc_assert (loop->parent == NULL);
/* Make absolutely sure that this is a complete type. */
if (tmp_ss_info->string_length)
diff --git a/trans.h b/trans.h
index 0549aa7..4d745f1 100644
--- a/trans.h
+++ b/trans.h
@@ -279,6 +279,9 @@ typedef struct gfc_loopinfo
/* The SS describing the temporary used in an assignment. */
gfc_ss *temp_ss;
+ /* Non-null if this loop is nested in another one. */
+ struct gfc_loopinfo *parent;
+
/* Chain of nested loops. */
struct gfc_loopinfo *nested, *next;
[-- Attachment #4: pr43829-50.CL --]
[-- Type: text/plain, Size: 180 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (get_rank, get_loop_upper_bound_for_array):
New functions.
(gfc_trans_array_constructor): Handle multiple loops.
[-- Attachment #5: pr43829-50.patch --]
[-- Type: text/x-diff, Size: 3195 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 5659b70..083ce5c 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -2034,6 +2034,19 @@ trans_constant_array_constructor (gfc_ss * ss, tree type)
}
+static int
+get_rank (gfc_loopinfo *loop)
+{
+ int rank;
+
+ rank = 0;
+ for (; loop; loop = loop->parent)
+ rank += loop->dimen;
+
+ return rank;
+}
+
+
/* 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 trans_constant_array_constructor. Returns the
@@ -2072,6 +2085,23 @@ constant_array_constructor_loop_size (gfc_loopinfo * loop)
}
+static tree *
+get_loop_upper_bound_for_array (gfc_ss *array, int array_dim)
+{
+ gfc_ss *ss;
+ int n;
+
+ gcc_assert (array->nested_ss == NULL);
+
+ for (ss = array; ss; ss = ss->parent)
+ for (n = 0; n < ss->loop->dimen; n++)
+ if (array_dim == get_array_ref_dim_for_loop_dim (ss, n))
+ return &(ss->loop->to[n]);
+
+ gcc_unreachable ();
+}
+
+
/* Array constructors are handled by constructing a temporary, then using that
within the scalarization loop. This is not optimal, but seems by far the
simplest method. */
@@ -2085,6 +2115,7 @@ trans_array_constructor (gfc_ss * ss, locus * where)
tree desc;
tree type;
tree tmp;
+ tree *loop_ubound0;
bool dynamic;
bool old_first_len, old_typespec_chararray_ctor;
tree old_first_len_val;
@@ -2114,7 +2145,7 @@ trans_array_constructor (gfc_ss * ss, locus * where)
first_len = true;
}
- gcc_assert (ss->dimen == loop->dimen);
+ gcc_assert (ss->dimen == ss->loop->dimen);
c = expr->value.constructor;
if (expr->ts.type == BT_CHARACTER)
@@ -2157,7 +2188,9 @@ trans_array_constructor (gfc_ss * ss, locus * where)
/* See if the constructor determines the loop bounds. */
dynamic = false;
- if (expr->shape && loop->dimen > 1 && loop->to[0] == NULL_TREE)
+ loop_ubound0 = get_loop_upper_bound_for_array (ss, 0);
+
+ if (expr->shape && get_rank (loop) > 1 && *loop_ubound0 == NULL_TREE)
{
/* We have a multidimensional parameter. */
for (s = ss; s; s = s->parent)
@@ -2176,7 +2209,7 @@ trans_array_constructor (gfc_ss * ss, locus * where)
}
}
- if (loop->to[0] == NULL_TREE)
+ if (*loop_ubound0 == NULL_TREE)
{
mpz_t size;
@@ -2210,7 +2243,7 @@ trans_array_constructor (gfc_ss * ss, locus * where)
}
}
- if (TREE_CODE (loop->to[0]) == VAR_DECL)
+ if (TREE_CODE (*loop_ubound0) == VAR_DECL)
dynamic = true;
gfc_trans_create_temp_array (&loop->pre, &loop->post, ss, type, NULL_TREE,
@@ -2233,10 +2266,10 @@ trans_array_constructor (gfc_ss * ss, locus * where)
offsetvar, gfc_index_one_node);
tmp = gfc_evaluate_now (tmp, &loop->pre);
gfc_conv_descriptor_ubound_set (&loop->pre, desc, gfc_rank_cst[0], tmp);
- if (loop->to[0] && TREE_CODE (loop->to[0]) == VAR_DECL)
- gfc_add_modify (&loop->pre, loop->to[0], tmp);
+ if (*loop_ubound0 && TREE_CODE (*loop_ubound0) == VAR_DECL)
+ gfc_add_modify (&loop->pre, *loop_ubound0, tmp);
else
- loop->to[0] = tmp;
+ *loop_ubound0 = tmp;
}
if (TREE_USED (offsetvar))
[-- Attachment #6: pr43829-51.CL --]
[-- Type: text/plain, Size: 129 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (constant_array_constructor_loop_size):
Handle multiple loops.
[-- Attachment #7: pr43829-51.patch --]
[-- Type: text/x-diff, Size: 2029 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 083ce5c..299bd80 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -2053,32 +2053,38 @@ get_rank (gfc_loopinfo *loop)
iteration count of the loop if suitable, and NULL_TREE otherwise. */
static tree
-constant_array_constructor_loop_size (gfc_loopinfo * loop)
+constant_array_constructor_loop_size (gfc_loopinfo * l)
{
+ gfc_loopinfo *loop;
tree size = gfc_index_one_node;
tree tmp;
- int i;
+ int i, total_dim;
+
+ total_dim = get_rank (l);
- for (i = 0; i < loop->dimen; i++)
+ for (loop = l; loop; loop = loop->parent)
{
- /* If the bounds aren't constant, return NULL_TREE. */
- if (!INTEGER_CST_P (loop->from[i]) || !INTEGER_CST_P (loop->to[i]))
- return NULL_TREE;
- if (!integer_zerop (loop->from[i]))
+ for (i = 0; i < loop->dimen; i++)
{
- /* Only allow nonzero "from" in one-dimensional arrays. */
- if (loop->dimen != 1)
+ /* If the bounds aren't constant, return NULL_TREE. */
+ if (!INTEGER_CST_P (loop->from[i]) || !INTEGER_CST_P (loop->to[i]))
return NULL_TREE;
- tmp = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type,
- loop->to[i], loop->from[i]);
+ if (!integer_zerop (loop->from[i]))
+ {
+ /* Only allow nonzero "from" in one-dimensional arrays. */
+ if (total_dim != 1)
+ return NULL_TREE;
+ tmp = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type,
+ loop->to[i], loop->from[i]);
+ }
+ else
+ tmp = loop->to[i];
+ tmp = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type, tmp, gfc_index_one_node);
+ size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, size, tmp);
}
- else
- tmp = loop->to[i];
- tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
- tmp, gfc_index_one_node);
- size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- size, tmp);
}
return size;
[-- Attachment #8: pr43829-51.diff --]
[-- Type: text/x-diff, Size: 2320 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 083ce5c77ee5a97219710a7274575d03bd82db37..299bd80756401aa68435a99bff874e0ff9981aa1 100644
*** a/trans-array.c
--- b/trans-array.c
*************** get_rank (gfc_loopinfo *loop)
*** 2053,2064 ****
iteration count of the loop if suitable, and NULL_TREE otherwise. */
static tree
! constant_array_constructor_loop_size (gfc_loopinfo * loop)
{
tree size = gfc_index_one_node;
tree tmp;
! int i;
for (i = 0; i < loop->dimen; i++)
{
/* If the bounds aren't constant, return NULL_TREE. */
--- 2053,2069 ----
iteration count of the loop if suitable, and NULL_TREE otherwise. */
static tree
! constant_array_constructor_loop_size (gfc_loopinfo * l)
{
+ gfc_loopinfo *loop;
tree size = gfc_index_one_node;
tree tmp;
! int i, total_dim;
!
! total_dim = get_rank (l);
+ for (loop = l; loop; loop = loop->parent)
+ {
for (i = 0; i < loop->dimen; i++)
{
/* If the bounds aren't constant, return NULL_TREE. */
*************** constant_array_constructor_loop_size (gf
*** 2067,2073 ****
if (!integer_zerop (loop->from[i]))
{
/* Only allow nonzero "from" in one-dimensional arrays. */
! if (loop->dimen != 1)
return NULL_TREE;
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
--- 2072,2078 ----
if (!integer_zerop (loop->from[i]))
{
/* Only allow nonzero "from" in one-dimensional arrays. */
! if (total_dim != 1)
return NULL_TREE;
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
*************** constant_array_constructor_loop_size (gf
*** 2075,2084 ****
}
else
tmp = loop->to[i];
! tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
! tmp, gfc_index_one_node);
! size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
! size, tmp);
}
return size;
--- 2080,2090 ----
}
else
tmp = loop->to[i];
! tmp = fold_build2_loc (input_location, PLUS_EXPR,
! gfc_array_index_type, tmp, gfc_index_one_node);
! size = fold_build2_loc (input_location, MULT_EXPR,
! gfc_array_index_type, size, tmp);
! }
}
return size;
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [60/66] inline sum and product: Update the scalarizer: Fix error markers.
2011-10-28 0:22 ` [Patch, fortran] [54..61/66] inline sum and product: Prevent regressions Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [55..56/66] inline sum and product: Prevent regressions: Fix gfc_conv_elemental_dependencies Mikael Morin
@ 2011-10-27 23:36 ` Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [57..59/66] inline sum and product: Prevent regressions: Fix {min, max}{loc, val} Mikael Morin
` (2 subsequent siblings)
4 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:36 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 365 bytes --]
This makes the necessary changes for the error markers to be generated at the
right place in the testcase.
that is for:
foo( &
sum(bar,1) &
)
if sum(bar,1) requires a temporary, the warning is emitted on the second line
instead of the first one, so that one can distinguish between array generated
for the argument, for the function result, etc.
OK?
[-- Attachment #2: pr43829-60.CL --]
[-- Type: text/plain, Size: 155 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* array.c (match_subscript): Skip whitespaces before setting locus.
* matchexp.c (match_level_1): Ditto.
[-- Attachment #3: pr43829-60.patch --]
[-- Type: text/x-diff, Size: 626 bytes --]
diff --git a/array.c b/array.c
index 3e6b9d2..a1449fd 100644
--- a/array.c
+++ b/array.c
@@ -70,6 +70,7 @@ match_subscript (gfc_array_ref *ar, int init, bool match_star)
i = ar->dimen + ar->codimen;
+ gfc_gobble_whitespace ();
ar->c_where[i] = gfc_current_locus;
ar->start[i] = ar->end[i] = ar->stride[i] = NULL;
diff --git a/matchexp.c b/matchexp.c
index 8b99ce9..cd70dc0 100644
--- a/matchexp.c
+++ b/matchexp.c
@@ -201,6 +201,7 @@ match_level_1 (gfc_expr **result)
locus where;
match m;
+ gfc_gobble_whitespace ();
where = gfc_current_locus;
uop = NULL;
m = match_defined_operator (&uop);
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [35..39/66] inline sum and product: Update the scalarizer: New gfc_ss::loop field.
2011-10-27 23:35 ` [Patch, fortran] [31..53/66] inline sum and product: Update the scalarizer Mikael Morin
` (5 preceding siblings ...)
2011-10-27 23:35 ` [Patch, fortran] [44/66] inline sum and product: Update the scalarizer: New gfc_ss::nested_ss field Mikael Morin
@ 2011-10-27 23:36 ` Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [34/66] inline sum and product: Update the scalarizer: gfc_ss_info refcounting Mikael Morin
` (5 subsequent siblings)
12 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:36 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 475 bytes --]
To avoid confusion between multiple loops, a new loop field is added to
the gfc_ss (patch 35).
Then we can remove superfluous loop argument in function interfaces:
- set_vector_loop_bounds (patch 36)
- gfc_trans_array_constructor (patch 37)
- gfc_trans_create_temp_array (patch 39)
Patch 38 prepares patch 39 by adding a new variable total_dim which will be
the sum of multiple nested loop dimensions so that the number of loop usages
(through loop.dimen) is reduced.
OK?
[-- Attachment #2: pr43829-35.CL --]
[-- Type: text/plain, Size: 179 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans.h (struct gfc_ss): New field loop.
* trans-array.c (set_ss_loop): New function.
(gfc_add_ss_to_loop): Call set_ss_loop.
[-- Attachment #3: pr43829-35.patch --]
[-- Type: text/x-diff, Size: 1224 bytes --]
diff --git a/trans-array.c b/trans-array.c
index abb6db2..e64767a 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -618,6 +618,27 @@ gfc_cleanup_loop (gfc_loopinfo * loop)
}
+static void
+set_ss_loop (gfc_ss *ss, gfc_loopinfo *loop)
+{
+ int n;
+
+ for (; ss != gfc_ss_terminator; ss = ss->next)
+ {
+ ss->loop = loop;
+
+ if (ss->info->type == GFC_SS_SCALAR
+ || ss->info->type == GFC_SS_REFERENCE
+ || ss->info->type == GFC_SS_TEMP)
+ continue;
+
+ for (n = 0; n < GFC_MAX_DIMENSIONS; n++)
+ if (ss->info->data.array.subscript[n] != NULL)
+ set_ss_loop (ss->info->data.array.subscript[n], loop);
+ }
+}
+
+
/* Associate a SS chain with a loop. */
void
@@ -628,6 +649,8 @@ gfc_add_ss_to_loop (gfc_loopinfo * loop, gfc_ss * head)
if (head == gfc_ss_terminator)
return;
+ set_ss_loop (head, loop);
+
ss = head;
for (; ss && ss != gfc_ss_terminator; ss = ss->next)
{
diff --git a/trans.h b/trans.h
index 02f2b42..62bcc64 100644
--- a/trans.h
+++ b/trans.h
@@ -246,6 +246,9 @@ typedef struct gfc_ss
struct gfc_ss *loop_chain;
struct gfc_ss *next;
+ /* The loop this gfc_ss is in. */
+ struct gfc_loopinfo *loop;
+
unsigned is_alloc_lhs:1;
}
gfc_ss;
[-- Attachment #4: pr43829-36.CL --]
[-- Type: text/plain, Size: 174 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (gfc_set_vector_loop_bounds): Get loop from ss.
Remove loop argument.
(gfc_add_loop_ss_code): Update call.
[-- Attachment #5: pr43829-36.patch --]
[-- Type: text/x-diff, Size: 850 bytes --]
diff --git a/trans-array.c b/trans-array.c
index e64767a..a305ac3 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -2162,8 +2162,9 @@ finish:
loop bounds. */
static void
-set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss)
+set_vector_loop_bounds (gfc_ss * ss)
{
+ gfc_loopinfo *loop;
gfc_array_info *info;
gfc_se se;
tree tmp;
@@ -2173,6 +2174,7 @@ set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss)
int dim;
info = &ss->info->data.array;
+ loop = ss->loop;
for (n = 0; n < loop->dimen; n++)
{
@@ -2271,7 +2273,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
if (info->subscript[n])
gfc_add_loop_ss_code (loop, info->subscript[n], true, where);
- set_vector_loop_bounds (loop, ss);
+ set_vector_loop_bounds (ss);
break;
case GFC_SS_VECTOR:
[-- Attachment #6: pr43829-37.CL --]
[-- Type: text/plain, Size: 234 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (gfc_trans_array_constructor, trans_array_constructor):
Rename the former to the later. Get loop from ss.
Remove loop argument.
(gfc_add_loop_ss_code): Update call.
[-- Attachment #7: pr43829-37.patch --]
[-- Type: text/x-diff, Size: 1290 bytes --]
diff --git a/trans-array.c b/trans-array.c
index a305ac3..01a411a 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -1981,7 +1981,7 @@ constant_array_constructor_loop_size (gfc_loopinfo * loop)
simplest method. */
static void
-gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
+trans_array_constructor (gfc_ss * ss, locus * where)
{
gfc_constructor_base c;
tree offset;
@@ -1992,6 +1992,7 @@ 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_loopinfo *loop;
gfc_ss_info *ss_info;
gfc_expr *expr;
@@ -2000,6 +2001,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
old_first_len_val = first_len_val;
old_typespec_chararray_ctor = typespec_chararray_ctor;
+ loop = ss->loop;
ss_info = ss->info;
expr = ss_info->expr;
@@ -2314,7 +2316,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
gfc_add_block_to_block (&loop->pre, &se.pre);
gfc_add_block_to_block (&loop->post, &se.post);
}
- gfc_trans_array_constructor (loop, ss, where);
+ trans_array_constructor (ss, where);
break;
case GFC_SS_TEMP:
[-- Attachment #8: pr43829-38.CL --]
[-- Type: text/plain, Size: 182 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (gfc_trans_create_temp_array): New variable total_dim.
Set total_dim to loop's rank. Replace usages of loop's rank.
[-- Attachment #9: pr43829-38.patch --]
[-- Type: text/x-diff, Size: 1729 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 01a411a..b2388c1 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -907,6 +907,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
tree cond;
tree or_expr;
int n, dim, tmp_dim;
+ int total_dim = 0;
memset (from, 0, sizeof (from));
memset (to, 0, sizeof (to));
@@ -919,6 +920,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
if (gfc_option.warn_array_temp && where)
gfc_warning ("Creating array temporary at %L", where);
+ total_dim = loop->dimen;
/* Set the lower bound to zero. */
for (n = 0; n < loop->dimen; n++)
{
@@ -956,7 +958,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
/* Initialize the descriptor. */
type =
- gfc_get_array_type_bounds (eltype, ss->dimen, 0, from, to, 1,
+ gfc_get_array_type_bounds (eltype, total_dim, 0, from, to, 1,
GFC_ARRAY_UNKNOWN, true);
desc = gfc_create_var (type, "atmp");
GFC_DECL_PACKED_ARRAY (desc) = 1;
@@ -985,8 +987,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
/* If there is at least one null loop->to[n], it is a callee allocated
array. */
- for (n = 0; n < loop->dimen; n++)
- if (loop->to[n] == NULL_TREE)
+ for (n = 0; n < total_dim; n++)
+ if (to[n] == NULL_TREE)
{
size = NULL_TREE;
break;
@@ -1009,7 +1011,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
}
else
{
- for (n = 0; n < loop->dimen; n++)
+ for (n = 0; n < total_dim; n++)
{
/* Store the stride and bound components in the descriptor. */
gfc_conv_descriptor_stride_set (pre, desc, gfc_rank_cst[n], size);
[-- Attachment #10: pr43829-39.CL --]
[-- Type: text/plain, Size: 554 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.h (gfc_trans_create_temp_array): Remove loop argument.
* trans-array.c (gfc_trans_create_temp_array): Get loop from ss.
Update reference to loop. Remove loop argument.
(gfc_trans_array_constructor, gfc_conv_loop_setup): Update calls to
gfc_trans_create_temp_array.
* trans-expr.c (gfc_conv_procedure_call): Ditto.
* trans-intrinsic.c (gfc_conv_intrinsic_transfer): Ditto.
* trans-stmt.c (gfc_conv_elemental_dependencies): Ditto.
Set loop before calling gfc_trans_create_temp_array.
[-- Attachment #11: pr43829-39.patch --]
[-- Type: text/x-diff, Size: 5822 bytes --]
diff --git a/trans-array.c b/trans-array.c
index b2388c1..d386a22 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -888,15 +888,14 @@ get_array_ref_dim (gfc_ss *ss, int loop_dim)
callee allocated array.
PRE, POST, INITIAL, DYNAMIC and DEALLOC are as for
- gfc_trans_allocate_array_storage.
- */
+ gfc_trans_allocate_array_storage. */
tree
-gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
- gfc_loopinfo * loop, gfc_ss * ss,
+gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
tree eltype, tree initial, bool dynamic,
bool dealloc, bool callee_alloc, locus * where)
{
+ gfc_loopinfo *loop;
gfc_array_info *info;
tree from[GFC_MAX_DIMENSIONS], to[GFC_MAX_DIMENSIONS];
tree type;
@@ -915,11 +914,12 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
info = &ss->info->data.array;
gcc_assert (ss->dimen > 0);
- gcc_assert (loop->dimen == ss->dimen);
+ gcc_assert (ss->loop->dimen == ss->dimen);
if (gfc_option.warn_array_temp && where)
gfc_warning ("Creating array temporary at %L", where);
+ loop = ss->loop;
total_dim = loop->dimen;
/* Set the lower bound to zero. */
for (n = 0; n < loop->dimen; n++)
@@ -1065,8 +1065,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 (ss->dimen > loop->temp_dim)
- loop->temp_dim = ss->dimen;
+ if (ss->dimen > ss->loop->temp_dim)
+ ss->loop->temp_dim = ss->dimen;
return size;
}
@@ -2113,8 +2113,8 @@ trans_array_constructor (gfc_ss * ss, locus * where)
if (TREE_CODE (loop->to[0]) == VAR_DECL)
dynamic = true;
- gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, ss,
- type, NULL_TREE, dynamic, true, false, where);
+ gfc_trans_create_temp_array (&loop->pre, &loop->post, ss, type, NULL_TREE,
+ dynamic, true, false, where);
desc = ss_info->data.array.descriptor;
offset = gfc_index_zero_node;
@@ -4211,9 +4211,8 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
gcc_assert (tmp_ss->dimen != 0);
- gfc_trans_create_temp_array (&loop->pre, &loop->post, loop,
- tmp_ss, tmp, NULL_TREE,
- false, true, false, where);
+ gfc_trans_create_temp_array (&loop->pre, &loop->post, tmp_ss, tmp,
+ NULL_TREE, false, true, false, where);
}
/* For array parameters we don't have loop variables, so don't calculate the
diff --git a/trans-array.h b/trans-array.h
index 57805b6..aad8c47 100644
--- a/trans-array.h
+++ b/trans-array.h
@@ -31,9 +31,8 @@ void gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping *,
gfc_se *, gfc_array_spec *);
/* Generate code to create a temporary array. */
-tree gfc_trans_create_temp_array (stmtblock_t *, stmtblock_t *, gfc_loopinfo *,
- gfc_ss *, tree, tree, bool, bool, bool,
- locus *);
+tree gfc_trans_create_temp_array (stmtblock_t *, stmtblock_t *, gfc_ss *,
+ tree, tree, bool, bool, bool, locus *);
/* Generate function entry code for allocation of compiler allocated array
variables. */
diff --git a/trans-expr.c b/trans-expr.c
index 01d4ca3..e091c89 100644
--- a/trans-expr.c
+++ b/trans-expr.c
@@ -3606,7 +3606,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
returns a pointer, the temporary will be a shallow copy and
mustn't be deallocated. */
callee_alloc = comp->attr.allocatable || comp->attr.pointer;
- gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, se->ss,
+ gfc_trans_create_temp_array (&se->pre, &se->post, se->ss,
tmp, NULL_TREE, false,
!comp->attr.pointer, callee_alloc,
&se->ss->info->expr->where);
@@ -3642,7 +3642,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
returns a pointer, the temporary will be a shallow copy and
mustn't be deallocated. */
callee_alloc = sym->attr.allocatable || sym->attr.pointer;
- gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, se->ss,
+ gfc_trans_create_temp_array (&se->pre, &se->post, se->ss,
tmp, NULL_TREE, false,
!sym->attr.pointer, callee_alloc,
&se->ss->info->expr->where);
diff --git a/trans-intrinsic.c b/trans-intrinsic.c
index fcc59d7..c3a414b 100644
--- a/trans-intrinsic.c
+++ b/trans-intrinsic.c
@@ -5501,9 +5501,8 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr)
/* Build a destination descriptor, using the pointer, source, as the
data field. */
- gfc_trans_create_temp_array (&se->pre, &se->post, se->loop,
- se->ss, mold_type, NULL_TREE, false, true, false,
- &expr->where);
+ gfc_trans_create_temp_array (&se->pre, &se->post, se->ss, mold_type,
+ NULL_TREE, false, true, false, &expr->where);
/* Cast the pointer to the result. */
tmp = gfc_conv_descriptor_data_get (info->descriptor);
diff --git a/trans-stmt.c b/trans-stmt.c
index 86a56e8..2e02320 100644
--- a/trans-stmt.c
+++ b/trans-stmt.c
@@ -309,11 +309,10 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
size = gfc_create_var (gfc_array_index_type, NULL);
data = gfc_create_var (pvoid_type_node, NULL);
gfc_init_block (&temp_post);
- tmp = gfc_trans_create_temp_array (&se->pre, &temp_post,
- &tmp_loop, ss, temptype,
- initial,
- false, true, false,
- &arg->expr->where);
+ ss->loop = &tmp_loop;
+ tmp = gfc_trans_create_temp_array (&se->pre, &temp_post, ss,
+ temptype, initial, false, true,
+ false, &arg->expr->where);
gfc_add_modify (&se->pre, size, tmp);
tmp = fold_convert (pvoid_type_node, info->data);
gfc_add_modify (&se->pre, data, tmp);
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [62..66/66] inline sum and product: Inline sum.
2011-10-27 23:43 [Patch, fortran] [00/66] PR fortran/43829 Inline sum and product (AKA scalarization of reductions) Mikael Morin
` (2 preceding siblings ...)
2011-10-27 23:35 ` [Patch, fortran] [31..53/66] inline sum and product: Update the scalarizer Mikael Morin
@ 2011-10-27 23:36 ` Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [64/66] inline sum and product: Inline sum: Change loop use Mikael Morin
` (4 more replies)
2011-10-27 23:36 ` [Patch, fortran] [01..06/66] inline sum and product: Prepare gfc_trans_preloop_setup Mikael Morin
` (4 subsequent siblings)
8 siblings, 5 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:36 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 442 bytes --]
This is the purpose of all the serie of patches: inline sum and product.
Patches 62..65, possibly don't deserve a patch of their own, they just make
the changes in gfc_conv_intrinsic_arith easier to read.
The combined diff (context, ignoring indent changes) also attached here.
Patch 62: Change conditions.
Patch 63: Update argument handling.
Patch 64: Change loop usage.
Patch 65: Change gfc_se structs initializers.
Patch 66: Inline sum.
[-- Attachment #2: pr43829-62..66.diff --]
[-- Type: text/x-diff, Size: 13917 bytes --]
diff --git a/trans-array.c b/trans-array.c
index acd9aec18fefc6631ad443c5dff2d3014a9d6565..262743d0d3779b4f02a63d604bd9a621401ae84e 100644
*** a/trans-array.c
--- b/trans-array.c
*************** gfc_conv_expr_descriptor (gfc_se * se, g
*** 6187,6193 ****
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);
--- 6187,6194 ----
gcc_assert ((expr->value.function.esym != NULL
&& expr->value.function.esym->attr.elemental)
|| (expr->value.function.isym != NULL
! && expr->value.function.isym->elemental)
! || gfc_inline_intrinsic_function_p (expr));
else
gcc_assert (ss_type == GFC_SS_INTRINSIC);
diff --git a/trans-intrinsic.c b/trans-intrinsic.c
index 3cdc1e0970aa4f787a60c96e50572a0bb1cb2a6e..973f912a624bdd442b3851471432c358118438d6 100644
*** a/trans-intrinsic.c
--- b/trans-intrinsic.c
*************** gfc_conv_intrinsic_count (gfc_se * se, g
*** 2557,2562 ****
--- 2557,2576 ----
se->expr = resvar;
}
+
+ /* Update given gfc_se to have ss component pointing to the nested gfc_ss
+ struct and return the corresponding loopinfo. */
+
+ static gfc_loopinfo *
+ enter_nested_loop (gfc_se *se)
+ {
+ se->ss = se->ss->nested_ss;
+ gcc_assert (se->ss == se->ss->loop->ss);
+
+ return se->ss->loop;
+ }
+
+
/* Inline implementation of the sum and product intrinsics. */
static void
gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
*************** gfc_conv_intrinsic_arith (gfc_se * se, g
*** 2568,2587 ****
stmtblock_t body;
stmtblock_t block;
tree tmp;
! gfc_loopinfo loop;
! gfc_actual_arglist *actual;
! gfc_ss *arrayss;
! gfc_ss *maskss;
gfc_se arrayse;
gfc_se maskse;
gfc_expr *arrayexpr;
gfc_expr *maskexpr;
! if (se->ss)
{
! gfc_conv_intrinsic_funcall (se, expr);
! return;
}
type = gfc_typenode_for_spec (&expr->ts);
/* Initialize the result. */
--- 2582,2604 ----
stmtblock_t body;
stmtblock_t block;
tree tmp;
! gfc_loopinfo loop, *ploop;
! gfc_actual_arglist *arg_array, *arg_mask;
! gfc_ss *arrayss = NULL;
! gfc_ss *maskss = NULL;
gfc_se arrayse;
gfc_se maskse;
+ gfc_se *parent_se;
gfc_expr *arrayexpr;
gfc_expr *maskexpr;
! if (expr->rank > 0)
{
! gcc_assert (gfc_inline_intrinsic_function_p (expr));
! parent_se = se;
}
+ else
+ parent_se = NULL;
type = gfc_typenode_for_spec (&expr->ts);
/* Initialize the result. */
*************** gfc_conv_intrinsic_arith (gfc_se * se, g
*** 2608,2630 ****
gfc_add_modify (&se->pre, resvar, tmp);
! /* Walk the arguments. */
! actual = expr->value.function.actual;
! arrayexpr = actual->expr;
! arrayss = gfc_walk_expr (arrayexpr);
! gcc_assert (arrayss != gfc_ss_terminator);
if (op == NE_EXPR || norm2)
/* PARITY and NORM2. */
maskexpr = NULL;
else
{
! actual = actual->next->next;
! gcc_assert (actual);
! maskexpr = actual->expr;
}
! if (maskexpr && maskexpr->rank != 0)
{
maskss = gfc_walk_expr (maskexpr);
gcc_assert (maskss != gfc_ss_terminator);
--- 2625,2651 ----
gfc_add_modify (&se->pre, resvar, tmp);
! arg_array = expr->value.function.actual;
!
! arrayexpr = arg_array->expr;
if (op == NE_EXPR || norm2)
/* PARITY and NORM2. */
maskexpr = NULL;
else
{
! arg_mask = arg_array->next->next;
! gcc_assert (arg_mask != NULL);
! maskexpr = arg_mask->expr;
}
! if (expr->rank == 0)
! {
! /* Walk the arguments. */
! arrayss = gfc_walk_expr (arrayexpr);
! gcc_assert (arrayss != gfc_ss_terminator);
!
! if (maskexpr && maskexpr->rank > 0)
{
maskss = gfc_walk_expr (maskexpr);
gcc_assert (maskss != gfc_ss_terminator);
*************** gfc_conv_intrinsic_arith (gfc_se * se, g
*** 2635,2641 ****
/* Initialize the scalarizer. */
gfc_init_loopinfo (&loop);
gfc_add_ss_to_loop (&loop, arrayss);
! if (maskss)
gfc_add_ss_to_loop (&loop, maskss);
/* Initialize the loop. */
--- 2656,2662 ----
/* Initialize the scalarizer. */
gfc_init_loopinfo (&loop);
gfc_add_ss_to_loop (&loop, arrayss);
! if (maskexpr && maskexpr->rank > 0)
gfc_add_ss_to_loop (&loop, maskss);
/* Initialize the loop. */
*************** gfc_conv_intrinsic_arith (gfc_se * se, g
*** 2643,2658 ****
gfc_conv_loop_setup (&loop, &expr->where);
gfc_mark_ss_chain_used (arrayss, 1);
! if (maskss)
gfc_mark_ss_chain_used (maskss, 1);
/* Generate the loop body. */
! gfc_start_scalarized_body (&loop, &body);
/* If we have a mask, only add this element if the mask is set. */
! if (maskss)
{
! gfc_init_se (&maskse, NULL);
! gfc_copy_loopinfo_to_se (&maskse, &loop);
maskse.ss = maskss;
gfc_conv_expr_val (&maskse, maskexpr);
gfc_add_block_to_block (&body, &maskse.pre);
--- 2664,2689 ----
gfc_conv_loop_setup (&loop, &expr->where);
gfc_mark_ss_chain_used (arrayss, 1);
! if (maskexpr && maskexpr->rank > 0)
gfc_mark_ss_chain_used (maskss, 1);
+
+ ploop = &loop;
+ }
+ else
+ /* All the work has been done in the parent loops. */
+ ploop = enter_nested_loop (se);
+
+ gcc_assert (ploop);
+
/* Generate the loop body. */
! gfc_start_scalarized_body (ploop, &body);
/* If we have a mask, only add this element if the mask is set. */
! if (maskexpr && maskexpr->rank > 0)
{
! gfc_init_se (&maskse, parent_se);
! gfc_copy_loopinfo_to_se (&maskse, ploop);
! if (expr->rank == 0)
maskse.ss = maskss;
gfc_conv_expr_val (&maskse, maskexpr);
gfc_add_block_to_block (&body, &maskse.pre);
*************** gfc_conv_intrinsic_arith (gfc_se * se, g
*** 2663,2670 ****
gfc_init_block (&block);
/* Do the actual summation/product. */
! gfc_init_se (&arrayse, NULL);
! gfc_copy_loopinfo_to_se (&arrayse, &loop);
arrayse.ss = arrayss;
gfc_conv_expr_val (&arrayse, arrayexpr);
gfc_add_block_to_block (&block, &arrayse.pre);
--- 2694,2702 ----
gfc_init_block (&block);
/* Do the actual summation/product. */
! gfc_init_se (&arrayse, parent_se);
! gfc_copy_loopinfo_to_se (&arrayse, ploop);
! if (expr->rank == 0)
arrayse.ss = arrayss;
gfc_conv_expr_val (&arrayse, arrayexpr);
gfc_add_block_to_block (&block, &arrayse.pre);
*************** gfc_conv_intrinsic_arith (gfc_se * se, g
*** 2740,2746 ****
gfc_add_block_to_block (&block, &arrayse.post);
! if (maskss)
{
/* We enclose the above in if (mask) {...} . */
--- 2772,2778 ----
gfc_add_block_to_block (&block, &arrayse.post);
! if (maskexpr && maskexpr->rank > 0)
{
/* We enclose the above in if (mask) {...} . */
*************** gfc_conv_intrinsic_arith (gfc_se * se, g
*** 2752,2781 ****
tmp = gfc_finish_block (&block);
gfc_add_expr_to_block (&body, tmp);
! gfc_trans_scalarizing_loops (&loop, &body);
/* For a scalar mask, enclose the loop in an if statement. */
! if (maskexpr && maskss == NULL)
{
- gfc_init_se (&maskse, NULL);
- gfc_conv_expr_val (&maskse, maskexpr);
gfc_init_block (&block);
! gfc_add_block_to_block (&block, &loop.pre);
! gfc_add_block_to_block (&block, &loop.post);
tmp = gfc_finish_block (&block);
tmp = build3_v (COND_EXPR, maskse.expr, tmp,
build_empty_stmt (input_location));
gfc_add_expr_to_block (&block, tmp);
gfc_add_block_to_block (&se->pre, &block);
}
else
{
! gfc_add_block_to_block (&se->pre, &loop.pre);
! gfc_add_block_to_block (&se->pre, &loop.post);
}
! gfc_cleanup_loop (&loop);
if (norm2)
{
--- 2784,2826 ----
tmp = gfc_finish_block (&block);
gfc_add_expr_to_block (&body, tmp);
! gfc_trans_scalarizing_loops (ploop, &body);
/* For a scalar mask, enclose the loop in an if statement. */
! if (maskexpr && maskexpr->rank == 0)
{
gfc_init_block (&block);
! gfc_add_block_to_block (&block, &ploop->pre);
! gfc_add_block_to_block (&block, &ploop->post);
tmp = gfc_finish_block (&block);
+ if (expr->rank > 0)
+ {
+ tmp = build3_v (COND_EXPR, se->ss->info->data.scalar.value, tmp,
+ build_empty_stmt (input_location));
+ gfc_advance_se_ss_chain (se);
+ }
+ else
+ {
+ gcc_assert (expr->rank == 0);
+ gfc_init_se (&maskse, NULL);
+ gfc_conv_expr_val (&maskse, maskexpr);
tmp = build3_v (COND_EXPR, maskse.expr, tmp,
build_empty_stmt (input_location));
+ }
+
gfc_add_expr_to_block (&block, tmp);
gfc_add_block_to_block (&se->pre, &block);
+ gcc_assert (se->post.head == NULL);
}
else
{
! gfc_add_block_to_block (&se->pre, &ploop->pre);
! gfc_add_block_to_block (&se->pre, &ploop->post);
}
! if (expr->rank == 0)
! gfc_cleanup_loop (ploop);
if (norm2)
{
*************** walk_inline_intrinsic_transpose (gfc_ss
*** 6795,6806 ****
--- 6840,6966 ----
}
+ /* Move the given dimension of the given gfc_ss list to a nested gfc_ss list.
+ This has the side effect of reversing the nested list, so there is no
+ need to call gfc_reverse_ss on it (the given list is assumed not to be
+ reversed yet). */
+
+ static gfc_ss *
+ nest_loop_dimension (gfc_ss *ss, int dim)
+ {
+ int ss_dim, i;
+ gfc_ss *new_ss, *prev_ss = gfc_ss_terminator;
+ gfc_loopinfo *new_loop;
+
+ gcc_assert (ss != gfc_ss_terminator);
+
+ for (; ss != gfc_ss_terminator; ss = ss->next)
+ {
+ new_ss = gfc_get_ss ();
+ new_ss->next = prev_ss;
+ new_ss->parent = ss;
+ new_ss->info = ss->info;
+ new_ss->info->refcount++;
+ if (ss->dimen != 0)
+ {
+ gcc_assert (ss->info->type != GFC_SS_SCALAR
+ && ss->info->type != GFC_SS_REFERENCE);
+
+ new_ss->dimen = 1;
+ new_ss->dim[0] = ss->dim[dim];
+
+ gcc_assert (dim < ss->dimen);
+
+ ss_dim = --ss->dimen;
+ for (i = dim; i < ss_dim; i++)
+ ss->dim[i] = ss->dim[i + 1];
+
+ ss->dim[ss_dim] = 0;
+ }
+ prev_ss = new_ss;
+
+ if (ss->nested_ss)
+ {
+ ss->nested_ss->parent = new_ss;
+ new_ss->nested_ss = ss->nested_ss;
+ }
+ ss->nested_ss = new_ss;
+ }
+
+ new_loop = gfc_get_loopinfo ();
+ gfc_init_loopinfo (new_loop);
+
+ gcc_assert (prev_ss != NULL);
+ gcc_assert (prev_ss != gfc_ss_terminator);
+ gfc_add_ss_to_loop (new_loop, prev_ss);
+ return new_ss->parent;
+ }
+
+
+ /* Create the gfc_ss list for the SUM/PRODUCT arguments when the function
+ is to be inlined. */
+
+ static gfc_ss *
+ walk_inline_intrinsic_arith (gfc_ss *ss, gfc_expr *expr)
+ {
+ gfc_ss *tmp_ss, *tail, *array_ss;
+ gfc_actual_arglist *arg1, *arg2, *arg3;
+ int sum_dim;
+ bool scalar_mask = false;
+
+ /* The rank of the result will be determined later. */
+ arg1 = expr->value.function.actual;
+ arg2 = arg1->next;
+ arg3 = arg2->next;
+ gcc_assert (arg3 != NULL);
+
+ if (expr->rank == 0)
+ return ss;
+
+ tmp_ss = gfc_ss_terminator;
+
+ if (arg3->expr)
+ {
+ gfc_ss *mask_ss;
+
+ mask_ss = gfc_walk_subexpr (tmp_ss, arg3->expr);
+ if (mask_ss == tmp_ss)
+ scalar_mask = 1;
+
+ tmp_ss = mask_ss;
+ }
+
+ array_ss = gfc_walk_subexpr (tmp_ss, arg1->expr);
+ gcc_assert (array_ss != tmp_ss);
+
+ /* Odd thing: If the mask is scalar, it is used by the frontend after
+ the array (to make it array around the nested loop). Thus it shall
+ be after array_ss once the gfc_ss list is reversed. */
+ if (scalar_mask)
+ tmp_ss = gfc_get_scalar_ss (array_ss, arg3->expr);
+ else
+ tmp_ss = array_ss;
+
+ /* "Hide" the dimension on which we will sum in the first arg's scalarization
+ chain. */
+ sum_dim = mpz_get_si (arg2->expr->value.integer) - 1;
+ tail = nest_loop_dimension (tmp_ss, sum_dim);
+ tail->next = ss;
+
+ return tmp_ss;
+ }
+
+
static gfc_ss *
walk_inline_intrinsic_function (gfc_ss * ss, gfc_expr * expr)
{
switch (expr->value.function.isym->id)
{
+ case GFC_ISYM_PRODUCT:
+ case GFC_ISYM_SUM:
+ return walk_inline_intrinsic_arith (ss, expr);
+
case GFC_ISYM_TRANSPOSE:
return walk_inline_intrinsic_transpose (ss, expr);
*************** gfc_walk_intrinsic_libfunc (gfc_ss * ss,
*** 6862,6872 ****
--- 7022,7047 ----
bool
gfc_inline_intrinsic_function_p (gfc_expr *expr)
{
+ gfc_actual_arglist *args;
+
if (!expr->value.function.isym)
return false;
switch (expr->value.function.isym->id)
{
+ case GFC_ISYM_PRODUCT:
+ case GFC_ISYM_SUM:
+ /* Disable inline expansion if code size matters. */
+ if (optimize_size)
+ return false;
+
+ args = expr->value.function.actual;
+ /* We need to be able to subset the SUM argument at compile-time. */
+ if (args->next->expr && args->next->expr->expr_type != EXPR_CONSTANT)
+ return false;
+
+ return true;
+
case GFC_ISYM_TRANSPOSE:
return true;
diff --git a/trans.h b/trans.h
index 5757865b3a180a32e5baa320c56d235924df68dc..22033d38d157f5c85eba6fcb8ee92ab28dc22535 100644
*** a/trans.h
--- b/trans.h
*************** typedef struct gfc_loopinfo
*** 310,315 ****
--- 310,316 ----
}
gfc_loopinfo;
+ #define gfc_get_loopinfo() XCNEW (gfc_loopinfo)
/* Information about a symbol that has been shadowed by a temporary. */
typedef struct
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [16/66] inline sum and product: Interfaces changes: gfc_trans_create_temp_array
2011-10-28 0:02 ` [Patch, fortran] [13..19/66] inline sum and product: Interfaces changes Mikael Morin
` (3 preceding siblings ...)
2011-10-27 23:36 ` [Patch, fortran] [13/66] inline sum and product: Interfaces changes: gfc_trans_array_constructor Mikael Morin
@ 2011-10-27 23:36 ` Mikael Morin
2011-10-27 23:43 ` [Patch, fortran] [18/66] inline sum and product: Interfaces changes: get_array_ref_dim Mikael Morin
2011-10-27 23:44 ` [Patch, fortran] [19/66] inline sum and product: Interfaces changes: dim_ok Mikael Morin
6 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:36 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 222 bytes --]
gfc_trans_create_temp_array uses dimensions heavily, and dimensions are to be
moved from gfc_ss_info to gfc_ss. To have them still available in
gfc_trans_create_temp_array, the gfc_ss_info argument should be a gfc_ss.
OK?
[-- Attachment #2: pr43829-16.CL --]
[-- Type: text/plain, Size: 475 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.h (gfc_trans_create_temp_array): Replace info argument
with ss argument.
* trans-array.c (gfc_trans_create_temp_array): Ditto. Get info from ss.
(gfc_trans_array_constructor, gfc_conv_loop_setup): Update call to
gfc_trans_create_temp_array.
* trans-expr.c (gfc_conv_procedure_call): Ditto.
* trans-intrinsic.c (gfc_conv_intrinsic_transfer): Ditto.
* trans-stmt.c (gfc_conv_elemental_dependencies): Ditto.
[-- Attachment #3: pr43829-16.patch --]
[-- Type: text/x-diff, Size: 4482 bytes --]
diff --git a/trans-array.c b/trans-array.c
index d8f5448..0e7c1c1 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -838,10 +838,11 @@ get_array_ref_dim (gfc_ss_info *info, int loop_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_ss_info *info;
tree from[GFC_MAX_DIMENSIONS], to[GFC_MAX_DIMENSIONS];
tree type;
tree desc;
@@ -855,6 +856,8 @@ 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;
+
gcc_assert (info->dimen > 0);
gcc_assert (loop->dimen == info->dimen);
@@ -2038,7 +2041,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
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;
@@ -4061,7 +4064,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
loop->temp_ss->data.info.dim[n] = n;
gfc_trans_create_temp_array (&loop->pre, &loop->post, loop,
- &loop->temp_ss->data.info, tmp, NULL_TREE,
+ loop->temp_ss, tmp, NULL_TREE,
false, true, false, where);
}
diff --git a/trans-array.h b/trans-array.h
index 4d737bd..57805b6 100644
--- a/trans-array.h
+++ b/trans-array.h
@@ -32,7 +32,7 @@ void gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping *,
/* Generate code to create a temporary array. */
tree gfc_trans_create_temp_array (stmtblock_t *, stmtblock_t *, gfc_loopinfo *,
- gfc_ss_info *, tree, tree, bool, bool, bool,
+ gfc_ss *, tree, tree, bool, bool, bool,
locus *);
/* Generate function entry code for allocation of compiler allocated array
diff --git a/trans-expr.c b/trans-expr.c
index 09b98d0..b2c1739 100644
--- a/trans-expr.c
+++ b/trans-expr.c
@@ -3602,8 +3602,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
returns a pointer, the temporary will be a shallow copy and
mustn't be deallocated. */
callee_alloc = comp->attr.allocatable || comp->attr.pointer;
- gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, info, tmp,
- NULL_TREE, false, !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);
/* Pass the temporary as the first argument. */
@@ -3637,8 +3638,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
returns a pointer, the temporary will be a shallow copy and
mustn't be deallocated. */
callee_alloc = sym->attr.allocatable || sym->attr.pointer;
- gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, info, tmp,
- NULL_TREE, false, !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);
/* Pass the temporary as the first argument. */
diff --git a/trans-intrinsic.c b/trans-intrinsic.c
index 83fc4fc..95161f8 100644
--- a/trans-intrinsic.c
+++ b/trans-intrinsic.c
@@ -5502,7 +5502,7 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr)
/* Build a destination descriptor, using the pointer, source, as the
data field. */
gfc_trans_create_temp_array (&se->pre, &se->post, se->loop,
- info, mold_type, NULL_TREE, false, true, false,
+ se->ss, mold_type, NULL_TREE, false, true, false,
&expr->where);
/* Cast the pointer to the result. */
diff --git a/trans-stmt.c b/trans-stmt.c
index c71eeec..c7ae360 100644
--- a/trans-stmt.c
+++ b/trans-stmt.c
@@ -310,7 +310,7 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
data = gfc_create_var (pvoid_type_node, NULL);
gfc_init_block (&temp_post);
tmp = gfc_trans_create_temp_array (&se->pre, &temp_post,
- &tmp_loop, info, temptype,
+ &tmp_loop, ss, temptype,
initial,
false, true, false,
&arg->expr->where);
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [53/66] inline sum and product: Update the scalarizer: Update gfc_trans_preloop_setup.
2011-10-27 23:35 ` [Patch, fortran] [31..53/66] inline sum and product: Update the scalarizer Mikael Morin
` (10 preceding siblings ...)
2011-10-27 23:36 ` [Patch, fortran] [52/66] inline sum and product: Update the scalarizer: New outermost_loop function Mikael Morin
@ 2011-10-27 23:36 ` Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [49..51/66] inline sum and product: Update the scalarizer: New parent loop Mikael Morin
12 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:36 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 682 bytes --]
This updates gfc_trans_preloop_setup to handle multiple loops.
The preliminary patches 1..6 have made it quite painless:
- the condition "this is the the outermost dimension" is changed from
`dim == loop->dimen - 1' to `dim == loop->dimen - 1 && loop->parent == NULL'
- to retrieve information about the parent loop:
* if we are not in the outermost dimension, the parent loop's gfc_loopinfo
struct is the current one, same for the gfc_ss struct, and the loop index
is dim + 1.
* if we are in the outermost dimension, the parent loop's gfc_loopinfo
struct is the current's parent field, same for the gfc_ss struct, and the
loop index is 0.
OK?
[-- Attachment #2: pr43829-53.CL --]
[-- Type: text/plain, Size: 153 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (gfc_trans_preloop_setup): Create pointers to outer
dimension's ss and loop. Use them.
[-- Attachment #3: pr43829-53.patch --]
[-- Type: text/x-diff, Size: 2078 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 0f3d171..3c0c110 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -3116,7 +3116,8 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
gfc_ss_info *ss_info;
gfc_array_info *info;
gfc_ss_type ss_type;
- gfc_ss *ss;
+ gfc_ss *ss, *pss;
+ gfc_loopinfo *ploop;
gfc_array_ref *ar;
int i;
@@ -3146,18 +3147,37 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
else
ar = NULL;
+ if (dim == loop->dimen - 1 && loop->parent != NULL)
+ {
+ /* If we are in the outermost dimension of this loop, the previous
+ dimension shall be in the parent loop. */
+ gcc_assert (ss->parent != NULL);
+
+ pss = ss->parent;
+ ploop = loop->parent;
+
+ /* ss and ss->parent are about the same array. */
+ gcc_assert (ss_info == pss->info);
+ }
+ else
+ {
+ ploop = loop;
+ pss = ss;
+ }
+
if (dim == loop->dimen - 1)
i = 0;
else
i = dim + 1;
/* For the time being, there is no loop reordering. */
- gcc_assert (i == loop->order[i]);
- i = loop->order[i];
+ gcc_assert (i == ploop->order[i]);
+ i = ploop->order[i];
- if (dim == loop->dimen - 1)
+ if (dim == loop->dimen - 1 && loop->parent == NULL)
{
- stride = gfc_conv_array_stride (info->descriptor, ss->dim[i]);
+ stride = gfc_conv_array_stride (info->descriptor,
+ innermost_ss (ss)->dim[i]);
/* Calculate the stride of the innermost loop. Hopefully this will
allow the backend optimizers to do their stuff more effectively.
@@ -3180,10 +3200,10 @@ 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, ss->dim[i], i);
+ add_array_offset (pblock, ploop, ss, ar, pss->dim[i], i);
/* Remember this offset for the second loop. */
- if (dim == loop->temp_dim - 1)
+ if (dim == loop->temp_dim - 1 && loop->parent == NULL)
info->saved_offset = info->offset;
}
}
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [11/66] inline sum and product: Preliminary cleanups: Skip temporary case.
2011-10-27 23:35 ` [Patch, fortran] [07..12/66] inline sum and product: Preliminary cleanups Mikael Morin
` (4 preceding siblings ...)
2011-10-27 23:36 ` [Patch, fortran] [09/66] inline sum and product: Preliminary cleanups: Assertify condition Mikael Morin
@ 2011-10-27 23:36 ` Mikael Morin
5 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:36 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 682 bytes --]
We can't use temporaries to guess loop dimensions, as temporaries' bounds are
calculated from loop dimensions.
In the union:
union
{
struct { ... } scalar;
struct { ... } temp;
struct gfc_ss_info info
}
data;
We are currently accessing data.struct.info even in the GFC_SS_TEMP case where
it is not defined. However, the aliasing and the code interact in such a way
that the temporary is never chosen to get loop bounds; so it works.
This patch prevents accessing gfc_ss::data::info in cases it has invalid
content, so that we can update gfc_ss_info without caring about aliasing
problems.
OK?
[-- Attachment #2: pr43829-11.CL --]
[-- Type: text/plain, Size: 116 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (gfc_conv_loop_setup): Also skip temporary arrays.
[-- Attachment #3: pr43829-11.patch --]
[-- Type: text/x-diff, Size: 607 bytes --]
diff --git a/trans-array.c b/trans-array.c
index f4d8a85..cfbe909 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -3881,7 +3881,12 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
loop for this dimension. We try to pick the simplest term. */
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
{
- if (ss->type == GFC_SS_SCALAR || ss->type == GFC_SS_REFERENCE)
+ gfc_ss_type ss_type;
+
+ ss_type = ss->type;
+ if (ss_type == GFC_SS_SCALAR
+ || ss_type == GFC_SS_TEMP
+ || ss_type == GFC_SS_REFERENCE)
continue;
info = &ss->data.info;
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [57..59/66] inline sum and product: Prevent regressions: Fix {min, max}{loc, val}
2011-10-28 0:22 ` [Patch, fortran] [54..61/66] inline sum and product: Prevent regressions Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [55..56/66] inline sum and product: Prevent regressions: Fix gfc_conv_elemental_dependencies Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [60/66] inline sum and product: Update the scalarizer: Fix error markers Mikael Morin
@ 2011-10-27 23:36 ` Mikael Morin
2011-10-27 23:43 ` [Patch, fortran] [54/66] inline sum and product: Prevent regressions: Add dependency checking Mikael Morin
2011-10-28 0:01 ` [Patch, fortran] [61/66] inline sum and product: Prevent regressions: Disable frontend optimizations Mikael Morin
4 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:36 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 211 bytes --]
Patches 58 and 59 fix the {min,max}loc and {min,max}val intrinsics which use
multiple loops. See the comments in the patches for details.
Patch 57 avoids duplicated offset calculation in the code generated.
OK?
[-- Attachment #2: pr43829-57.CL --]
[-- Type: text/plain, Size: 150 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): Don't calculate
offset twice in generated code.
[-- Attachment #3: pr43829-57.patch --]
[-- Type: text/x-diff, Size: 1999 bytes --]
diff --git a/trans-intrinsic.c b/trans-intrinsic.c
index c3a414b..ee162ea 100644
--- a/trans-intrinsic.c
+++ b/trans-intrinsic.c
@@ -3090,6 +3090,14 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
TREE_USED (lab2) = 1;
}
+ /* An offset must be added to the loop
+ counter to obtain the required position. */
+ gcc_assert (loop.from[0]);
+
+ tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+ gfc_index_one_node, loop.from[0]);
+ gfc_add_modify (&loop.pre, offset, tmp);
+
gfc_mark_ss_chain_used (arrayss, 1);
if (maskss)
gfc_mark_ss_chain_used (maskss, 1);
@@ -3123,16 +3131,6 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
/* Assign the value to the limit... */
gfc_add_modify (&ifblock, limit, arrayse.expr);
- /* Remember where we are. An offset must be added to the loop
- counter to obtain the required position. */
- if (loop.from[0])
- tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
- gfc_index_one_node, loop.from[0]);
- else
- tmp = gfc_index_one_node;
-
- gfc_add_modify (&block, offset, tmp);
-
if (nonempty == NULL && HONOR_NANS (DECL_MODE (limit)))
{
stmtblock_t ifblock2;
@@ -3232,16 +3230,6 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
/* Assign the value to the limit... */
gfc_add_modify (&ifblock, limit, arrayse.expr);
- /* Remember where we are. An offset must be added to the loop
- counter to obtain the required position. */
- if (loop.from[0])
- tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
- gfc_index_one_node, loop.from[0]);
- else
- tmp = gfc_index_one_node;
-
- gfc_add_modify (&block, offset, tmp);
-
tmp = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (pos),
loop.loopvar[0], offset);
gfc_add_modify (&ifblock, pos, tmp);
[-- Attachment #4: pr43829-58.CL --]
[-- Type: text/plain, Size: 270 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): Set loop's
temporary rank to the loop rank. Mark ss chains for multiple loop
if necessary. Use gfc_trans_scalarized_loop_boundary to end one loop
and start another.
[-- Attachment #5: pr43829-58.patch --]
[-- Type: text/x-diff, Size: 2631 bytes --]
diff --git a/trans-intrinsic.c b/trans-intrinsic.c
index ee162ea..506cdf2 100644
--- a/trans-intrinsic.c
+++ b/trans-intrinsic.c
@@ -3061,6 +3061,23 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
/* Initialize the loop. */
gfc_conv_ss_startstride (&loop);
+
+ /* The code generated can have more than one loop in sequence (see the
+ comment at the function header). This doesn't work well with the
+ scalarizer, which changes arrays' offset when the scalarization loops
+ are generated (see gfc_trans_preloop_setup). Fortunately, {min,max}loc
+ are currently inlined in the scalar case only (for which loop is of rank
+ one). As there is no dependency to care about in that case, there is no
+ temporary, so that we can use the scalarizer temporary code to handle
+ multiple loops. Thus, we set temp_dim here, we call gfc_mark_ss_chain_used
+ with flag=3 later, and we use gfc_trans_scalarized_loop_boundary even later
+ to restore offset.
+ TODO: this prevents inlining of rank > 0 minmaxloc calls, so this
+ should eventually go away. We could either create two loops properly,
+ or find another way to save/restore the array offsets between the two
+ loops (without conflicting with temporary management), or use a single
+ loop minmaxloc implementation. See PR 31067. */
+ loop.temp_dim = loop.dimen;
gfc_conv_loop_setup (&loop, &expr->where);
gcc_assert (loop.dimen == 1);
@@ -3098,9 +3115,9 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
gfc_index_one_node, loop.from[0]);
gfc_add_modify (&loop.pre, offset, tmp);
- gfc_mark_ss_chain_used (arrayss, 1);
+ gfc_mark_ss_chain_used (arrayss, lab1 ? 3 : 1);
if (maskss)
- gfc_mark_ss_chain_used (maskss, 1);
+ gfc_mark_ss_chain_used (maskss, lab1 ? 3 : 1);
/* Generate the loop body. */
gfc_start_scalarized_body (&loop, &body);
@@ -3186,7 +3203,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
if (lab1)
{
- gfc_trans_scalarized_loop_end (&loop, 0, &body);
+ gfc_trans_scalarized_loop_boundary (&loop, &body);
if (HONOR_NANS (DECL_MODE (limit)))
{
@@ -3201,7 +3218,6 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
gfc_add_expr_to_block (&loop.code[0], build1_v (GOTO_EXPR, lab2));
gfc_add_expr_to_block (&loop.code[0], build1_v (LABEL_EXPR, lab1));
- gfc_start_block (&body);
/* If we have a mask, only check this element if the mask is set. */
if (maskss)
[-- Attachment #6: pr43829-59.CL --]
[-- Type: text/plain, Size: 270 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-intrinsic.c (gfc_conv_intrinsic_minmaxval): Set loop's
temporary rank to the loop rank. Mark ss chains for multiple loop
if necessary. Use gfc_trans_scalarized_loop_boundary to end one loop
and start another.
[-- Attachment #7: pr43829-59.patch --]
[-- Type: text/x-diff, Size: 2460 bytes --]
diff --git a/trans-intrinsic.c b/trans-intrinsic.c
index 506cdf2..3cdc1e0 100644
--- a/trans-intrinsic.c
+++ b/trans-intrinsic.c
@@ -3522,6 +3522,22 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op)
/* Initialize the loop. */
gfc_conv_ss_startstride (&loop);
+
+ /* The code generated can have more than one loop in sequence (see the
+ comment at the function header). This doesn't work well with the
+ scalarizer, which changes arrays' offset when the scalarization loops
+ are generated (see gfc_trans_preloop_setup). Fortunately, {min,max}val
+ are currently inlined in the scalar case only. As there is no dependency
+ to care about in that case, there is no temporary, so that we can use the
+ scalarizer temporary code to handle multiple loops. Thus, we set temp_dim
+ here, we call gfc_mark_ss_chain_used with flag=3 later, and we use
+ gfc_trans_scalarized_loop_boundary even later to restore offset.
+ TODO: this prevents inlining of rank > 0 minmaxval calls, so this
+ should eventually go away. We could either create two loops properly,
+ or find another way to save/restore the array offsets between the two
+ loops (without conflicting with temporary management), or use a single
+ loop minmaxval implementation. See PR 31067. */
+ loop.temp_dim = loop.dimen;
gfc_conv_loop_setup (&loop, &expr->where);
if (nonempty == NULL && maskss == NULL
@@ -3553,9 +3569,9 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op)
}
}
- gfc_mark_ss_chain_used (arrayss, 1);
+ gfc_mark_ss_chain_used (arrayss, lab ? 3 : 1);
if (maskss)
- gfc_mark_ss_chain_used (maskss, 1);
+ gfc_mark_ss_chain_used (maskss, lab ? 3 : 1);
/* Generate the loop body. */
gfc_start_scalarized_body (&loop, &body);
@@ -3665,15 +3681,13 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op)
if (lab)
{
- gfc_trans_scalarized_loop_end (&loop, 0, &body);
+ gfc_trans_scalarized_loop_boundary (&loop, &body);
tmp = fold_build3_loc (input_location, COND_EXPR, type, nonempty,
nan_cst, huge_cst);
gfc_add_modify (&loop.code[0], limit, tmp);
gfc_add_expr_to_block (&loop.code[0], build1_v (LABEL_EXPR, lab));
- gfc_start_block (&body);
-
/* If we have a mask, only add this element if the mask is set. */
if (maskss)
{
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [02/66] inline sum and product: Prepare gfc_trans_preloop_setup
2011-10-27 23:36 ` [Patch, fortran] [01..06/66] inline sum and product: Prepare gfc_trans_preloop_setup Mikael Morin
` (3 preceding siblings ...)
2011-10-27 23:36 ` [Patch, fortran] [05/66] " Mikael Morin
@ 2011-10-27 23:36 ` Mikael Morin
2011-10-27 23:38 ` [Patch, fortran] [04/66] " Mikael Morin
5 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:36 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 0 bytes --]
[-- Attachment #2: pr43829-2.CL --]
[-- Type: text/plain, Size: 111 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (gfc_trans_preloop_setup): Move code earlier.
[-- Attachment #3: pr43829-2.patch --]
[-- Type: text/x-diff, Size: 1502 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 4b21476..91359e9 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -2876,6 +2876,17 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
if (dim == info->dimen - 1)
{
+ i = loop->order[0];
+ /* For the time being, the innermost loop is unconditionally on
+ the first dimension of the scalarization loop. */
+ gcc_assert (i == 0);
+ stride = gfc_conv_array_stride (info->descriptor, info->dim[i]);
+
+ /* Calculate the stride of the innermost loop. Hopefully this will
+ allow the backend optimizers to do their stuff more effectively.
+ */
+ info->stride0 = gfc_evaluate_now (stride, pblock);
+
/* For the outermost loop calculate the offset due to any
elemental dimensions. It will have been initialized with the
base offset of the array. */
@@ -2900,17 +2911,6 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
info->offset = gfc_evaluate_now (info->offset, pblock);
}
}
-
- i = loop->order[0];
- /* For the time being, the innermost loop is unconditionally on
- the first dimension of the scalarization loop. */
- gcc_assert (i == 0);
- stride = gfc_conv_array_stride (info->descriptor, info->dim[i]);
-
- /* Calculate the stride of the innermost loop. Hopefully this will
- allow the backend optimizers to do their stuff more effectively.
- */
- info->stride0 = gfc_evaluate_now (stride, pblock);
}
else
{
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [40..43/66] inline sum and product: Update the scalarizer: New gfc_ss::parent field.
2011-10-27 23:35 ` [Patch, fortran] [31..53/66] inline sum and product: Update the scalarizer Mikael Morin
` (8 preceding siblings ...)
2011-10-27 23:36 ` [Patch, fortran] [46/66] inline sum and product: Update the scalarizer: Update gfc_trans_create_temp_array Mikael Morin
@ 2011-10-27 23:36 ` Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [52/66] inline sum and product: Update the scalarizer: New outermost_loop function Mikael Morin
` (2 subsequent siblings)
12 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:36 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 322 bytes --]
We are going to loop over the parent array infos.
This introduces a new parent field to permit this loop (patch 40).
Then it will be used to loop over multiple parent ss:
- gfc_set_loop_bounds_from_array_spec (patch 41 with context diff)
- gfc_trans_array_constructor (patch 42)
- set_vector_loop_bounds (patch 43)
OK?
[-- Attachment #2: pr43829-40.CL --]
[-- Type: text/plain, Size: 264 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans.h (struct gfc_ss): New field parent.
* trans-array.c (gfc_trans_scalarizing_loops): Skip clearing if a
parent exists.
* trans-expr.c (gfc_advance_se_ss_chain): Move to parent ss at the
end of the chain.
[-- Attachment #3: pr43829-40.patch --]
[-- Type: text/x-diff, Size: 1629 bytes --]
diff --git a/trans-array.c b/trans-array.c
index d386a22..abff8b5 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -3193,7 +3193,8 @@ 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->info->useflags = 0;
+ if (ss->parent == NULL)
+ ss->info->useflags = 0;
}
diff --git a/trans-expr.c b/trans-expr.c
index e091c89..72d35f8 100644
--- a/trans-expr.c
+++ b/trans-expr.c
@@ -83,6 +83,7 @@ void
gfc_advance_se_ss_chain (gfc_se * se)
{
gfc_se *p;
+ gfc_ss *ss;
gcc_assert (se != NULL && se->ss != NULL && se->ss != gfc_ss_terminator);
@@ -93,7 +94,15 @@ gfc_advance_se_ss_chain (gfc_se * se)
/* Simple consistency check. */
gcc_assert (p->parent == NULL || p->parent->ss == p->ss);
- p->ss = p->ss->next;
+ /* If we were in a nested loop, the next scalarized expression can be
+ on the parent ss' next pointer. Thus we should not take the next
+ pointer blindly, but rather go up one nest level as long as next
+ is the end of chain. */
+ ss = p->ss;
+ while (ss->next == gfc_ss_terminator && ss->parent != NULL)
+ ss = ss->parent;
+
+ p->ss = ss->next;
p = p->parent;
}
diff --git a/trans.h b/trans.h
index 62bcc64..53c5ce2 100644
--- a/trans.h
+++ b/trans.h
@@ -246,6 +246,9 @@ typedef struct gfc_ss
struct gfc_ss *loop_chain;
struct gfc_ss *next;
+ /* Non-null if the ss is part of a nested loop. */
+ struct gfc_ss *parent;
+
/* The loop this gfc_ss is in. */
struct gfc_loopinfo *loop;
[-- Attachment #4: pr43829-41.CL --]
[-- Type: text/plain, Size: 128 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (gfc_set_loop_bounds_from_array_spec): Loop over the
parents.
[-- Attachment #5: pr43829-41.patch --]
[-- Type: text/x-diff, Size: 2797 bytes --]
diff --git a/trans-array.c b/trans-array.c
index abff8b5..83542f6 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -688,41 +688,54 @@ void
gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping * mapping,
gfc_se * se, gfc_array_spec * as)
{
- int n, dim;
+ int n, dim, total_dim;
gfc_se tmpse;
+ gfc_ss *ss;
tree lower;
tree upper;
tree tmp;
- if (as && as->type == AS_EXPLICIT)
- for (n = 0; n < se->loop->dimen; 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)
- {
- /* Evaluate the lower bound. */
- gfc_init_se (&tmpse, NULL);
- gfc_apply_interface_mapping (mapping, &tmpse, as->lower[dim]);
- gfc_add_block_to_block (&se->pre, &tmpse.pre);
- gfc_add_block_to_block (&se->post, &tmpse.post);
- lower = fold_convert (gfc_array_index_type, tmpse.expr);
-
- /* ...and the upper bound. */
- gfc_init_se (&tmpse, NULL);
- gfc_apply_interface_mapping (mapping, &tmpse, as->upper[dim]);
- gfc_add_block_to_block (&se->pre, &tmpse.pre);
- gfc_add_block_to_block (&se->post, &tmpse.post);
- upper = fold_convert (gfc_array_index_type, tmpse.expr);
-
- /* Set the upper bound of the loop to UPPER - LOWER. */
- tmp = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type, upper, lower);
- tmp = gfc_evaluate_now (tmp, &se->pre);
- se->loop->to[n] = tmp;
- }
- }
+ total_dim = 0;
+
+ if (!as || as->type != AS_EXPLICIT)
+ return;
+
+ for (ss = se->ss; ss; ss = ss->parent)
+ {
+ total_dim += ss->loop->dimen;
+ for (n = 0; n < ss->loop->dimen; n++)
+ {
+ /* The bound is known, nothing to do. */
+ if (ss->loop->to[n] != NULL_TREE)
+ continue;
+
+ dim = ss->dim[n];
+ gcc_assert (dim < as->rank);
+ gcc_assert (ss->loop->dimen <= as->rank);
+
+ /* Evaluate the lower bound. */
+ gfc_init_se (&tmpse, NULL);
+ gfc_apply_interface_mapping (mapping, &tmpse, as->lower[dim]);
+ gfc_add_block_to_block (&se->pre, &tmpse.pre);
+ gfc_add_block_to_block (&se->post, &tmpse.post);
+ lower = fold_convert (gfc_array_index_type, tmpse.expr);
+
+ /* ...and the upper bound. */
+ gfc_init_se (&tmpse, NULL);
+ gfc_apply_interface_mapping (mapping, &tmpse, as->upper[dim]);
+ gfc_add_block_to_block (&se->pre, &tmpse.pre);
+ gfc_add_block_to_block (&se->post, &tmpse.post);
+ upper = fold_convert (gfc_array_index_type, tmpse.expr);
+
+ /* Set the upper bound of the loop to UPPER - LOWER. */
+ tmp = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, upper, lower);
+ tmp = gfc_evaluate_now (tmp, &se->pre);
+ ss->loop->to[n] = tmp;
+ }
+ }
+
+ gcc_assert (total_dim == as->rank);
}
[-- Attachment #6: pr43829-41.diff --]
[-- Type: text/x-diff, Size: 2162 bytes --]
diff --git a/trans-array.c b/trans-array.c
index abff8b5dc732457e5f31957c3728c51340354688..83542f668111b5e43261782ef91bcb2377bfdd46 100644
*** a/trans-array.c
--- b/trans-array.c
*************** void
*** 688,707 ****
gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping * mapping,
gfc_se * se, gfc_array_spec * as)
{
! int n, dim;
gfc_se tmpse;
tree lower;
tree upper;
tree tmp;
! if (as && as->type == AS_EXPLICIT)
! for (n = 0; n < se->loop->dimen; 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)
{
/* Evaluate the lower bound. */
gfc_init_se (&tmpse, NULL);
gfc_apply_interface_mapping (mapping, &tmpse, as->lower[dim]);
--- 688,718 ----
gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping * mapping,
gfc_se * se, gfc_array_spec * as)
{
! int n, dim, total_dim;
gfc_se tmpse;
+ gfc_ss *ss;
tree lower;
tree upper;
tree tmp;
! total_dim = 0;
!
! if (!as || as->type != AS_EXPLICIT)
! return;
!
! for (ss = se->ss; ss; ss = ss->parent)
{
! total_dim += ss->loop->dimen;
! for (n = 0; n < ss->loop->dimen; n++)
{
+ /* The bound is known, nothing to do. */
+ if (ss->loop->to[n] != NULL_TREE)
+ continue;
+
+ dim = ss->dim[n];
+ gcc_assert (dim < as->rank);
+ gcc_assert (ss->loop->dimen <= as->rank);
+
/* Evaluate the lower bound. */
gfc_init_se (&tmpse, NULL);
gfc_apply_interface_mapping (mapping, &tmpse, as->lower[dim]);
*************** gfc_set_loop_bounds_from_array_spec (gfc
*** 720,728 ****
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type, upper, lower);
tmp = gfc_evaluate_now (tmp, &se->pre);
! se->loop->to[n] = tmp;
}
}
}
--- 731,741 ----
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type, upper, lower);
tmp = gfc_evaluate_now (tmp, &se->pre);
! ss->loop->to[n] = tmp;
}
}
+
+ gcc_assert (total_dim == as->rank);
}
[-- Attachment #7: pr43829-42.CL --]
[-- Type: text/plain, Size: 119 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (gfc_trans_array_constructor): Loop over the parents.
[-- Attachment #8: pr43829-42.patch --]
[-- Type: text/x-diff, Size: 1660 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 83542f6..463a0a2 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -1953,6 +1953,7 @@ trans_constant_array_constructor (gfc_ss * ss, tree type)
}
}
+
/* 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 trans_constant_array_constructor. Returns the
@@ -2010,6 +2011,7 @@ trans_array_constructor (gfc_ss * ss, locus * where)
gfc_loopinfo *loop;
gfc_ss_info *ss_info;
gfc_expr *expr;
+ gfc_ss *s;
/* Save the old values for nested checking. */
old_first_len = first_len;
@@ -2078,16 +2080,20 @@ trans_array_constructor (gfc_ss * ss, locus * where)
if (expr->shape && loop->dimen > 1 && loop->to[0] == NULL_TREE)
{
/* We have a multidimensional parameter. */
- int n;
- for (n = 0; n < expr->rank; n++)
- {
- loop->from[n] = gfc_index_zero_node;
- 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,
- loop->to[n], gfc_index_one_node);
- }
+ for (s = ss; s; s = s->parent)
+ {
+ int n;
+ for (n = 0; n < s->loop->dimen; n++)
+ {
+ s->loop->from[n] = gfc_index_zero_node;
+ s->loop->to[n] = gfc_conv_mpz_to_tree (expr->shape[s->dim[n]],
+ gfc_index_integer_kind);
+ s->loop->to[n] = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type,
+ s->loop->to[n],
+ gfc_index_one_node);
+ }
+ }
}
if (loop->to[0] == NULL_TREE)
[-- Attachment #9: pr43829-43.CL --]
[-- Type: text/plain, Size: 118 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (gfc_set_vector_loop_bounds): Loop over the parents.
[-- Attachment #10: pr43829-43.patch --]
[-- Type: text/x-diff, Size: 829 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 463a0a2..25d9a37 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -2197,14 +2197,18 @@ set_vector_loop_bounds (gfc_ss * ss)
int dim;
info = &ss->info->data.array;
- loop = ss->loop;
- for (n = 0; n < loop->dimen; n++)
+ for (; ss; ss = ss->parent)
{
- dim = ss->dim[n];
- if (info->ref->u.ar.dimen_type[dim] == DIMEN_VECTOR
- && loop->to[n] == NULL)
+ loop = ss->loop;
+
+ for (n = 0; n < loop->dimen; n++)
{
+ dim = ss->dim[n];
+ if (info->ref->u.ar.dimen_type[dim] != DIMEN_VECTOR
+ || loop->to[n] != NULL)
+ continue;
+
/* Loop variable N indexes vector dimension DIM, and we don't
yet know the upper bound of loop variable N. Set it to the
difference between the vector's upper and lower bounds. */
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [04/66] inline sum and product: Prepare gfc_trans_preloop_setup
2011-10-27 23:36 ` [Patch, fortran] [01..06/66] inline sum and product: Prepare gfc_trans_preloop_setup Mikael Morin
` (4 preceding siblings ...)
2011-10-27 23:36 ` [Patch, fortran] [02/66] " Mikael Morin
@ 2011-10-27 23:38 ` Mikael Morin
5 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:38 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 0 bytes --]
[-- Attachment #2: pr43829-4.CL --]
[-- Type: text/plain, Size: 150 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (gfc_trans_preloop_setup): Remove redundant assertion.
Special case outermost loop.
[-- Attachment #3: pr43829-4.patch --]
[-- Type: text/x-diff, Size: 872 bytes --]
diff --git a/trans-array.c b/trans-array.c
index e3134f5..f5e30ae 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -2867,7 +2867,10 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
else
ar = NULL;
- i = dim + 1;
+ if (dim == info->dimen - 1)
+ i = 0;
+ else
+ i = dim + 1;
/* For the time being, there is no loop reordering. */
gcc_assert (i == loop->order[i]);
@@ -2875,10 +2878,6 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
if (dim == info->dimen - 1)
{
- i = loop->order[0];
- /* For the time being, the innermost loop is unconditionally on
- the first dimension of the scalarization loop. */
- gcc_assert (i == 0);
stride = gfc_conv_array_stride (info->descriptor, info->dim[i]);
/* Calculate the stride of the innermost loop. Hopefully this will
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [54/66] inline sum and product: Prevent regressions: Add dependency checking.
2011-10-28 0:22 ` [Patch, fortran] [54..61/66] inline sum and product: Prevent regressions Mikael Morin
` (2 preceding siblings ...)
2011-10-27 23:36 ` [Patch, fortran] [57..59/66] inline sum and product: Prevent regressions: Fix {min, max}{loc, val} Mikael Morin
@ 2011-10-27 23:43 ` Mikael Morin
2011-10-28 0:01 ` [Patch, fortran] [61/66] inline sum and product: Prevent regressions: Disable frontend optimizations Mikael Morin
4 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:43 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 56 bytes --]
This adds dependency checking for inline functions.
OK?
[-- Attachment #2: pr43829-54.CL --]
[-- Type: text/plain, Size: 277 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans.h (gfc_inline_intrinsic_function_p): Move prototype...
* gfortran.h (gfc_inline_intrinsic_function_p): ... here.
* dependency.c (gfc_check_argument_var_dependency): Check dependencies
of inline intrinsics' arguments.
[-- Attachment #3: pr43829-54.patch --]
[-- Type: text/x-diff, Size: 1721 bytes --]
diff --git a/dependency.c b/dependency.c
index c43af00..fd7fa73 100644
--- a/dependency.c
+++ b/dependency.c
@@ -713,6 +713,17 @@ gfc_check_argument_var_dependency (gfc_expr *var, sym_intent intent,
return gfc_check_fncall_dependency (var, intent, NULL,
expr->value.function.actual,
ELEM_CHECK_VARIABLE);
+
+ if (gfc_inline_intrinsic_function_p (expr))
+ {
+ /* The TRANSPOSE case should have been caught in the
+ noncopying intrinsic case above. */
+ gcc_assert (expr->value.function.isym->id != GFC_ISYM_TRANSPOSE);
+
+ return gfc_check_fncall_dependency (var, intent, NULL,
+ expr->value.function.actual,
+ ELEM_CHECK_VARIABLE);
+ }
}
return 0;
diff --git a/gfortran.h b/gfortran.h
index da3477d..b869ca3 100644
--- a/gfortran.h
+++ b/gfortran.h
@@ -2880,6 +2880,9 @@ void gfc_generate_code (gfc_namespace *);
void gfc_generate_module_code (gfc_namespace *);
void gfc_init_coarray_decl (bool);
+/* trans-intrinsic.c */
+bool gfc_inline_intrinsic_function_p (gfc_expr *);
+
/* bbt.c */
typedef int (*compare_fn) (void *, void *);
void gfc_insert_bbt (void *, void *, compare_fn);
diff --git a/trans.h b/trans.h
index 4d745f1..5757865 100644
--- a/trans.h
+++ b/trans.h
@@ -396,9 +396,6 @@ tree gfc_builtin_decl_for_float_kind (enum built_in_function, int);
tree gfc_conv_intrinsic_subroutine (gfc_code *);
void gfc_conv_intrinsic_function (gfc_se *, gfc_expr *);
-/* Is the intrinsic expanded inline. */
-bool gfc_inline_intrinsic_function_p (gfc_expr *);
-
/* Does an intrinsic map directly to an external library call
This is true for array-returning intrinsics, unless
gfc_inline_intrinsic_function_p returns true. */
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [18/66] inline sum and product: Interfaces changes: get_array_ref_dim
2011-10-28 0:02 ` [Patch, fortran] [13..19/66] inline sum and product: Interfaces changes Mikael Morin
` (4 preceding siblings ...)
2011-10-27 23:36 ` [Patch, fortran] [16/66] inline sum and product: Interfaces changes: gfc_trans_create_temp_array Mikael Morin
@ 2011-10-27 23:43 ` Mikael Morin
2011-10-27 23:44 ` [Patch, fortran] [19/66] inline sum and product: Interfaces changes: dim_ok Mikael Morin
6 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:43 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 106 bytes --]
Same as previous patch, get_array_ref_dim uses dimensions and thus needs
a gfc_ss struct as argument.
OK?
[-- Attachment #2: pr43829-18.CL --]
[-- Type: text/plain, Size: 244 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (get_array_ref_dim): Change argument type and name.
Obtain previous argument from the new argument in the body.
(gfc_trans_create_temp_arry, gfc_conv_loop_setup): Update calls.
[-- Attachment #3: pr43829-18.patch --]
[-- Type: text/x-diff, Size: 1284 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 6af4fd6..eeed8bb 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -807,9 +807,12 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post,
*/
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;
+ gfc_ss_info *info;
+
+ info = &ss->data.info;
array_ref_dim = 0;
array_dim = info->dim[loop_dim];
@@ -884,7 +887,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
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];
@@ -3976,7 +3979,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
&& 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);
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [28/66] inline sum and product: Update core structs: Move info struct.
2011-10-27 23:32 ` [Patch, fortran] [20..30/66] inline sum and product: Update core structs Mikael Morin
` (9 preceding siblings ...)
2011-10-27 23:35 ` [Patch, fortran] [30/66] inline sum and product: Update core structs: Move where flag Mikael Morin
@ 2011-10-27 23:43 ` Mikael Morin
10 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:43 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 168 bytes --]
This moves data::info field from gfc_ss to gfc_ss_info.
The name is changed to array, as it is for all the non-scalar and non-temp
cases, thus all the array cases.
OK?
[-- Attachment #2: pr43829-28.CL --]
[-- Type: text/plain, Size: 1145 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans.h (struct gfc_ss, struct gfc_ss_info): Move field
gfc_ss::data::info into gfc_ss_info::data and remove empty union
gfc_ss::data.
* trans-array.c (gfc_free_ss, gfc_trans_create_temp_array,
gfc_trans_constant_array_constructor, gfc_trans_array_constructor,
gfc_set_vector_loop_bounds, gfc_add_loop_ss_code,
gfc_conv_ss_descriptor, gfc_trans_array_bound_check,
gfc_conv_array_index_offset, gfc_conv_scalarized_array_ref,
add_array_offset, gfc_trans_preloop_setup,
gfc_trans_scalarized_boundary, gfc_conv_section_startstride,
gfc_conv_ss_startstride, gfc_could_be_alias,
gfc_conv_loop_setup, gfc_conv_expr_descriptor,
gfc_alloc_allocatable_for_assignment, gfc_walk_array_ref):
Update reference chains and factor them where possible.
* trans-expr.c (gfc_conv_variable, gfc_conv_subref_array_arg,
gfc_conv_procedure_call, gfc_trans_subarray_assign): Updata reference
chains.
* trans-intrinsic.c (gfc_conv_intrinsic_transfer): Ditto.
* trans-io.c (transfer_array_component): Ditto.
* trans-stmt.c (gfc_conv_elemental_dependencies,
gfc_trans_pointer_assign_need_temp): Ditto.
[-- Attachment #3: pr43829-28.patch --]
[-- Type: text/x-diff, Size: 21840 bytes --]
diff --git a/trans-array.c b/trans-array.c
index 173e52b..78e1443 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -508,8 +508,8 @@ gfc_free_ss (gfc_ss * ss)
case GFC_SS_SECTION:
for (n = 0; n < ss->dimen; n++)
{
- if (ss->data.info.subscript[ss->dim[n]])
- gfc_free_ss_chain (ss->data.info.subscript[ss->dim[n]]);
+ if (ss_info->data.array.subscript[ss->dim[n]])
+ gfc_free_ss_chain (ss_info->data.array.subscript[ss->dim[n]]);
}
break;
@@ -880,7 +880,7 @@ 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 (ss->dimen > 0);
gcc_assert (loop->dimen == ss->dimen);
@@ -1884,7 +1884,7 @@ trans_constant_array_constructor (gfc_ss * ss, tree 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);
@@ -2073,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;
@@ -2133,7 +2133,7 @@ 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++)
{
@@ -2149,7 +2149,7 @@ set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss)
&& 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,
@@ -2172,6 +2172,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
{
gfc_se se;
gfc_ss_info *ss_info;
+ gfc_array_info *info;
gfc_expr *expr;
int n;
@@ -2185,6 +2186,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
ss_info = ss->info;
expr = ss_info->expr;
+ info = &ss_info->data.array;
switch (ss_info->type)
{
@@ -2227,9 +2229,8 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
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;
@@ -2240,7 +2241,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
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:
@@ -2295,9 +2296,11 @@ 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_info->expr->expr_type == EXPR_VARIABLE);
@@ -2305,7 +2308,7 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base)
se.descriptor_only = 1;
gfc_conv_expr_lhs (&se, ss_info->expr);
gfc_add_block_to_block (block, &se.pre);
- ss->data.info.descriptor = se.expr;
+ info->descriptor = se.expr;
ss_info->string_length = se.string_length;
if (base)
@@ -2320,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;
}
}
@@ -2481,7 +2484,7 @@ 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);
@@ -2555,7 +2558,7 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i,
tree desc;
tree data;
- info = &ss->data.info;
+ info = &ss->info->data.array;
/* Get the index into the array for this dimension. */
if (ar)
@@ -2582,7 +2585,7 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i,
gcc_assert (info && se->loop);
gcc_assert (info->subscript[dim]
&& info->subscript[dim]->info->type == GFC_SS_VECTOR);
- desc = info->subscript[dim]->data.info.descriptor;
+ desc = info->subscript[dim]->info->data.array.descriptor;
/* Get a zero-based index into the vector. */
index = fold_build2_loc (input_location, MINUS_EXPR,
@@ -2673,7 +2676,7 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar)
ss = se->ss;
expr = ss->info->expr;
- info = &ss->data.info;
+ info = &ss->info->data.array;
if (ar)
n = se->loop->order[0];
else
@@ -2866,7 +2869,7 @@ add_array_offset (stmtblock_t *pblock, gfc_loopinfo *loop, gfc_ss *ss,
gfc_array_info *info;
tree stride, index;
- info = &ss->data.info;
+ info = &ss->info->data.array;
gfc_init_se (&se, NULL);
se.loop = loop;
@@ -2890,6 +2893,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
stmtblock_t * pblock)
{
tree stride;
+ gfc_ss_info *ss_info;
gfc_array_info *info;
gfc_ss_type ss_type;
gfc_ss *ss;
@@ -2900,17 +2904,19 @@ 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)
{
+ ss_info = ss->info;
+
if ((ss->useflags & flag) == 0)
continue;
- ss_type = ss->info->type;
+ ss_type = ss_info->type;
if (ss_type != GFC_SS_SECTION
&& ss_type != GFC_SS_FUNCTION
&& ss_type != GFC_SS_CONSTRUCTOR
&& ss_type != GFC_SS_COMPONENT)
continue;
- info = &ss->data.info;
+ info = &ss_info->data.array;
gcc_assert (dim < ss->dimen);
gcc_assert (ss->dimen == loop->dimen);
@@ -3175,18 +3181,21 @@ gfc_trans_scalarized_loop_boundary (gfc_loopinfo * loop, stmtblock_t * body)
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
{
gfc_ss_type ss_type;
+ gfc_ss_info *ss_info;
+
+ ss_info = ss->info;
if ((ss->useflags & 2) == 0)
continue;
- ss_type = ss->info->type;
+ ss_type = ss_info->type;
if (ss_type != GFC_SS_SECTION
&& ss_type != GFC_SS_FUNCTION
&& ss_type != GFC_SS_CONSTRUCTOR
&& ss_type != GFC_SS_COMPONENT)
continue;
- ss->data.info.offset = ss->data.info.saved_offset;
+ ss_info->data.array.offset = ss_info->data.array.saved_offset;
}
/* Restart all the inner loops we just finished. */
@@ -3253,7 +3262,7 @@ gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int dim)
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)
@@ -3352,7 +3361,7 @@ done:
ss_info = ss->info;
expr = ss_info->expr;
- info = &ss->data.info;
+ info = &ss_info->data.array;
if (expr && expr->shape && !info->shape)
info->shape = expr->shape;
@@ -3388,9 +3397,9 @@ done:
{
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;
@@ -3439,7 +3448,7 @@ done:
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. */
@@ -3466,7 +3475,7 @@ done:
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
@@ -3720,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 = lexpr->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;
@@ -3740,7 +3749,7 @@ gfc_could_be_alias (gfc_ss * lss, gfc_ss * rss)
return 1;
}
- for (rref = rexpr->ref; rref != rss->data.info.ref;
+ for (rref = rexpr->ref; rref != rss->info->data.array.ref;
rref = rref->next)
{
if (rref->type != REF_COMPONENT)
@@ -3775,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 = rexpr->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;
@@ -3946,12 +3955,12 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
|| ss_type == GFC_SS_REFERENCE)
continue;
- info = &ss->data.info;
+ info = &ss->info->data.array;
dim = ss->dim[n];
if (loopspec[n] != NULL)
{
- specinfo = &loopspec[n]->data.info;
+ specinfo = &loopspec[n]->info->data.array;
spec_dim = loopspec[n]->dim[n];
}
else
@@ -4039,7 +4048,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
that's bad news. */
gcc_assert (loopspec[n]);
- info = &loopspec[n]->data.info;
+ info = &loopspec[n]->info->data.array;
dim = loopspec[n]->dim[n];
/* Set the extents of this range. */
@@ -4133,7 +4142,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
tmp_ss_info->string_length);
tmp = tmp_ss_info->data.temp.type;
- memset (&loop->temp_ss->data.info, 0, sizeof (gfc_array_info));
+ memset (&tmp_ss_info->data.array, 0, sizeof (gfc_array_info));
tmp_ss_info->type = GFC_SS_SECTION;
gcc_assert (tmp_ss->dimen != 0);
@@ -4164,7 +4173,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
&& ss_type != GFC_SS_CONSTRUCTOR)
continue;
- info = &ss->data.info;
+ info = &ss->info->data.array;
for (n = 0; n < ss->dimen; n++)
{
@@ -5805,7 +5814,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
gcc_assert (ss_type == GFC_SS_SECTION);
gcc_assert (ss_expr == expr);
- info = &ss->data.info;
+ info = &ss_info->data.array;
/* Get the descriptor for the array. */
gfc_conv_ss_descriptor (&se->pre, ss, 0);
@@ -5915,7 +5924,7 @@ 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;
@@ -5927,7 +5936,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
&& gfc_constant_array_constructor_p (expr->value.constructor))
{
need_tmp = 0;
- info = &ss->data.info;
+ info = &ss_info->data.array;
}
else
{
@@ -6027,7 +6036,7 @@ 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))
{
@@ -7220,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;
@@ -7271,6 +7281,8 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
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;
@@ -7285,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);
@@ -7355,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;
@@ -7445,9 +7457,9 @@ 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++)
@@ -7457,9 +7469,9 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
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. */
@@ -7523,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. */
@@ -7717,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. */
@@ -7735,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++)
@@ -7749,7 +7761,7 @@ 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:
@@ -7765,7 +7777,7 @@ 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->info->data.array.subscript[n] = indexss;
newss->dim[newss->dimen] = n;
newss->dimen++;
break;
@@ -7778,7 +7790,7 @@ 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->dimen > 0
- || newss->data.info.ref->u.ar.as->corank > 0);
+ || newss->info->data.array.ref->u.ar.as->corank > 0);
ss = newss;
break;
diff --git a/trans-expr.c b/trans-expr.c
index 55853f1..b175b62 100644
--- a/trans-expr.c
+++ b/trans-expr.c
@@ -633,9 +633,9 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
gcc_assert (ss_info->expr == expr);
/* A scalarized term. We already know the descriptor. */
- se->expr = se->ss->data.info.descriptor;
+ se->expr = ss_info->data.array.descriptor;
se->string_length = ss_info->string_length;
- for (ref = se->ss->data.info.ref; ref; ref = ref->next)
+ for (ref = ss_info->data.array.ref; ref; ref = ref->next)
if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT)
break;
}
@@ -2413,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. */
@@ -2492,7 +2492,7 @@ 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;
+ info = &rse.ss->info->data.array;
dimen = rse.ss->dimen;
tmp_index = gfc_index_zero_node;
@@ -2910,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;
@@ -4375,7 +4375,7 @@ 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_array = &lss->data.info;
+ 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);
diff --git a/trans-intrinsic.c b/trans-intrinsic.c
index ef9360b..a3b7383 100644
--- a/trans-intrinsic.c
+++ b/trans-intrinsic.c
@@ -5276,7 +5276,7 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr)
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
diff --git a/trans-io.c b/trans-io.c
index a97691e..12dfcf8 100644
--- a/trans-io.c
+++ b/trans-io.c
@@ -1949,7 +1949,7 @@ 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_array = &ss->data.info;
+ 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);
diff --git a/trans-stmt.c b/trans-stmt.c
index 936a4ee..101a651 100644
--- a/trans-stmt.c
+++ b/trans-stmt.c
@@ -222,7 +222,7 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
{
if (ss->info->expr != e)
continue;
- info = &ss->data.info;
+ info = &ss->info->data.array;
break;
}
@@ -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. */
diff --git a/trans.h b/trans.h
index 60708e9..e74da41 100644
--- a/trans.h
+++ b/trans.h
@@ -204,6 +204,9 @@ typedef struct gfc_ss_info
tree type;
}
temp;
+
+ /* All other types. */
+ gfc_array_info array;
}
data;
}
@@ -224,13 +227,6 @@ typedef struct gfc_ss
{
gfc_ss_info *info;
- union
- {
- /* All other types. */
- gfc_array_info info;
- }
- data;
-
int dimen;
/* Translation from loop dimensions to actual array dimensions.
actual_dim = dim[loop_dim] */
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [00/66] PR fortran/43829 Inline sum and product (AKA scalarization of reductions)
@ 2011-10-27 23:43 Mikael Morin
2011-10-27 23:32 ` [Patch, fortran] [20..30/66] inline sum and product: Update core structs Mikael Morin
` (8 more replies)
0 siblings, 9 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:43 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 5430 bytes --]
Hello,
these patches enable sum and product inlining in the non-scalar case
(before, they were inlined in the scalar case only).
Let's consider the scalar expression:
sum(a(:,1,1,:,:))
This is currently inlined (scalar expression), and the scalarizer has a dim
array designating array dimensions used for scalarization. In the case above,
dim = {0, 3, 4}, and the scalarizer state corresponding to `a' has non-NULL
values in the corresponding lbound[0], lbound[3], lbound[4] (same, for ubound,
stride,...) as presented in the scheme below.
loop
\
--- (...) ---- ss(a) --- (...) ----> gfc_ss_terminator
|\
| descriptor
| |\
| | lbound ( ) ( ) ( ) ( ) ( )
| \
| ubound ( ) ( ) ( ) ( ) ( )
| ^ ^ ^
\ +----+ | |
dim | +-----------------+ |
\ | | +--------------------+
---> 0 3 4
Now if one considers the non-scalar expression:
sum(a(:,1,1,:,:), dim=2)
the dim array would now be only {3} as we are suming on the second non-scalar
dimension only, which means that lbound[0] and lbound[4] (same for ubound,
stride...) are left available for another scalarizer. This set of patches
make the necessary changes so that another scalarizer can use those dimensions
left available as below.
loop
\
--- (...) ---- ss(sum(a,2)) --- (...) ----> gfc_ss_terminator
|\
| dim
| \
| ---> 0 4
| | +----------------------+
| +----+ |
\ | |
descriptor | |
/ |\ V V
| | lbound ( ) ( ) ( ) ( ) ( )
| \
| ubound ( ) ( ) ( ) ( ) ( )
| ^
| +-------------------+
| ---> 3
| /
| dim
|/
--- (...) ---- nested_ss(a) --- (...) ----> gfc_ss_terminator
/
nested_loop
* Structure changes.
Between the outer scalarizer loop (using dimensions 0 and 4 above) and the inner
one (using dimension 3) almost all the information is the same:
type, expression, descriptor, string_length, ...
So, in order to not have to update many structs at the same type, if one
item needs to be updated, a new struct is created containing all the shared
content, and all the gfc_ss structs have a pointer to it instead of holding
the content directly.
Left in the gfc_ss structs are dim array and dimension for the obvious that
they depend on the loop. This requires that those fields are moved from
gfc_ss_info, and is the reason for most of the 13..19 patches.
Also left in the gfc_ss structs are the linked list pointers, for the same
reason that they depend on the loop. They don't need to be moved though.
All the rest is moved to the new shared struct.
See patches 20..30 for details.
A bunch of new pointers are added to ease retrieval of related content: loop
associated with a gfc_ss struct, parent gfc_ss struct (i.e. the one in the outer
loop), associated gfc_ss struct in the inner loop.
The gfc_loopinfo structs get the same kind of changes: three additional fields;
one for the outer loop, and two for a linked list of nested loop pointers.
See patches 31..53 for details
* Code changes
All the changes above require the whole scalarizer to be updated, not only
because its core structures have changed, but also to handle more than one loop:
- In cases we were previously looping over all the dimensions of a loop,
we'll now need to loop over all the dimensions and over all the loops
available. For example gfc_trans_create_temp_array uses loop bounds to guess
allocation size; it has to consider more than one loop now.
- In cases we were focusing on one single array, we have to take into account
the fact that the array information can be scattered across multiple loops.
- The code that was executed before the loop previously has to be taken out
of the outermost loop now. This implies that the inner loop is already
available when handling the outer loop. It will in fact be created at walk
time.
See patches 31..53 for details.
A few corner cases not in the core of the scalarizer need additional fixes to
prevent regressions, in patches 54..61. The rest (62..66) takes care of inlining
sum (and product).
The full patch is attached for the compulsive testers.
To ease (well, somewhat) review, the patch has been split into pieces.
See my follow-up mails for details. The general outline is below.
There is no need to spend too much reviewing power on the 1..30 patches, unless
there is a concern about the core struct changes.
01..06: Step by step gfc_trans_preloop_setup rewrite.
07..12: Various preliminary cleanups.
13..19: Function interfaces changes.
20..30: Core structs reorganisation.
31..53: Update the scalarizer.
54..61: Prevent regressions.
62..66: Inline sum.
Regression tested on x86_64-unknown-freebsd8.2. OK for trunk?
Mikael
PS: I hereby confess my failure to not split the patch too much. :-(
[-- Attachment #2: pr43829-tests.CL --]
[-- Type: text/plain, Size: 348 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
PR fortran/43829
* gfortran.dg/function_optimize_7.f90: Disable sum inlining.
* gfortran.dg/inline_sum_1.f90: New.
* gfortran.dg/inline_sum_2.f90: New.
* gfortran.dg/inline_sum_bounds_check_1.f90: New.
* gfortran.dg/inline_sum_bounds_check_2.f90: New.
* gfortran.dg/inline_product_1.f90: New.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: function_optimize_7.f90.diff --]
[-- Type: text/x-diff; charset="us-ascii", Size: 848 bytes --]
Index: function_optimize_7.f90
===================================================================
--- function_optimize_7.f90 (révision 180154)
+++ function_optimize_7.f90 (copie de travail)
@@ -12,6 +12,7 @@
real, intent(out) :: z
character(60) :: line
real, external :: ext_func
+ integer :: one = 1
interface
elemental function element(x)
real, intent(in) :: x
@@ -33,7 +34,7 @@
z = element(x) + element(x)
i = mypure(x) - mypure(x)
z = elem_impure(x) - elem_impure(x)
- s_out = sum(s_in,1) + 3.14 / sum(s_in,1) ! { dg-warning "Creating array temporary" }
+ s_out = sum(s_in,one) + 3.14 / sum(s_in,one) ! { dg-warning "Creating array temporary" }
end subroutine xx
! { dg-final { scan-tree-dump-times "matmul_r4" 1 "original" } }
! { dg-final { scan-tree-dump-times "__builtin_sinf" 1 "original" } }
[-- Attachment #4: inline_sum_2.f90 --]
[-- Type: text/plain, Size: 485 bytes --]
! { dg-do run }
! PR fortran/43829
! Scalarization of reductions.
! Test that inlined sum is correct.
! We can't check for the absence of temporary arrays generated on the run-time
! testcase, as inlining is disabled at -Os, so it will fail in that case.
! Thus, the test is splitted into two independant files, one checking for
! the absence of temporaries, and one (this one) checking that the code
! generated remains valid at all optimization levels.
include 'inline_sum_1.f90'
[-- Attachment #5: inline_sum_1.f90 --]
[-- Type: text/plain, Size: 6450 bytes --]
! { dg-do compile }
! { dg-options "-Warray-temporaries -O -fdump-tree-original" }
!
! PR fortran/43829
! Scalarization of reductions.
! Test that sum is properly inlined.
! This is the compile time test only; for the runtime test see inline_sum_2.f90
! We can't test for temporaries on the run time test directly, as it tries
! several optimization options among which -Os, and sum inlining is disabled
! at -Os.
implicit none
integer :: i, j, k
integer, parameter :: q = 2
integer, parameter :: nx=3, ny=2*q, nz=5
integer, parameter, dimension(nx,ny,nz) :: p = &
& reshape ((/ (i**2, i=1,size(p)) /), shape(p))
integer, parameter, dimension( ny,nz) :: px = &
& reshape ((/ (( &
& nx*( nx*j+nx*ny*k+1)*( nx*j+nx*ny*k+1+ (nx-1)) &
& + nx*(nx-1)*(2*nx-1)/6, &
& j=0,ny-1), k=0,nz-1) /), shape(px))
integer, parameter, dimension(nx, nz) :: py = &
& reshape ((/ (( &
& ny*(i +nx*ny*k+1)*(i +nx*ny*k+1+nx *(ny-1)) &
& +(nx )**2*ny*(ny-1)*(2*ny-1)/6, &
& i=0,nx-1), k=0,nz-1) /), shape(py))
integer, parameter, dimension(nx,ny ) :: pz = &
& reshape ((/ (( &
& nz*(i+nx*j +1)*(i+nx*j +1+nx*ny*(nz-1)) &
& +(nx*ny)**2*nz*(nz-1)*(2*nz-1)/6, &
& i=0,nx-1), j=0,ny-1) /), shape(pz))
integer, dimension(nx,ny,nz) :: a
integer, dimension( ny,nz) :: ax
integer, dimension(nx, nz) :: ay
integer, dimension(nx,ny ) :: az
logical, dimension(nx,ny,nz) :: m, true
integer, dimension(nx,ny) :: b
integer, dimension(nx,nx) :: onesx
integer, dimension(ny,ny) :: onesy
integer, dimension(nz,nz) :: onesz
a = p
m = reshape((/ ((/ .true., .false. /), i=1,size(m)/2) /), shape(m))
true = reshape((/ (.true., i=1,size(true)) /), shape(true))
onesx = reshape((/ ((1, j=1,i),(0,j=1,nx-i),i=1,size(onesx,2)) /), shape(onesx))
onesy = reshape((/ ((1, j=1,i),(0,j=1,ny-i),i=1,size(onesy,2)) /), shape(onesy))
onesz = reshape((/ ((1, j=1,i),(0,j=1,nz-i),i=1,size(onesz,2)) /), shape(onesz))
! Correct results in simple cases
ax = sum(a,1)
if (any(ax /= px)) call abort
ay = sum(a,2)
if (any(ay /= py)) call abort
az = sum(a,3)
if (any(az /= pz)) call abort
! Masks work
if (any(sum(a,1,.false.) /= 0)) call abort
if (any(sum(a,2,.true.) /= py)) call abort
if (any(sum(a,3,m) /= merge(pz,0,m(:,:,1)))) call abort
if (any(sum(a,2,m) /= merge(sum(a(:, ::2,:),2),&
sum(a(:,2::2,:),2),&
m(:,1,:)))) call abort
! It works too with array constructors ...
if (any(sum( &
reshape((/ (i*i,i=1,size(a)) /), shape(a)), &
1, &
true) /= ax)) call abort
! ... and with vector subscripts
if (any(sum( &
a((/ (i,i=1,nx) /), &
(/ (i,i=1,ny) /), &
(/ (i,i=1,nz) /)), &
1) /= ax)) call abort
if (any(sum( &
a(sum(onesx(:,:),1), & ! unnecessary { dg-warning "Creating array temporary" }
sum(onesy(:,:),1), & ! unnecessary { dg-warning "Creating array temporary" }
sum(onesz(:,:),1)), & ! unnecessary { dg-warning "Creating array temporary" }
1) /= ax)) call abort
! Nested sums work
if (sum(sum(sum(a,1),1),1) /= sum(a)) call abort
if (sum(sum(sum(a,1),2),1) /= sum(a)) call abort
if (sum(sum(sum(a,3),1),1) /= sum(a)) call abort
if (sum(sum(sum(a,3),2),1) /= sum(a)) call abort
if (any(sum(sum(a,1),1) /= sum(sum(a,2),1))) call abort
if (any(sum(sum(a,1),2) /= sum(sum(a,3),1))) call abort
if (any(sum(sum(a,2),2) /= sum(sum(a,3),2))) call abort
! Temps are unavoidable here (function call's argument or result)
ax = sum(neid3(a),1) ! { dg-warning "Creating array temporary" }
! Sums as part of a bigger expr work
if (any(1+sum(eid(a),1)+ax+sum( &
neid3(a), & ! { dg-warning "Creating array temporary" }
1)+1 /= 3*ax+2)) call abort
if (any(1+eid(sum(a,2))+ay+ &
neid2( & ! { dg-warning "Creating array temporary" }
sum(a,2) & ! { dg-warning "Creating array temporary" }
)+1 /= 3*ay+2)) call abort
if (any(sum(eid(sum(a,3))+az+2* &
neid2(az) & ! { dg-warning "Creating array temporary" }
,1)+1 /= 4*sum(az,1)+1)) call abort
if (any(sum(transpose(sum(a,1)),1)+sum(az,1) /= sum(ax,2)+sum(sum(a,3),1))) call abort
! Creates a temp when needed.
a(1,:,:) = sum(a,1) ! unnecessary { dg-warning "Creating array temporary" }
if (any(a(1,:,:) /= ax)) call abort
b = p(:,:,1)
call set(b(2:,1), sum(b(:nx-1,:),2)) ! { dg-warning "Creating array temporary" }
if (any(b(2:,1) /= ay(1:nx-1,1))) call abort
b = p(:,:,1)
call set(b(:,1), sum(b,2)) ! unnecessary { dg-warning "Creating array temporary" }
if (any(b(:,1) /= ay(:,1))) call abort
b = p(:,:,1)
call tes(sum(eid(b(:nx-1,:)),2), b(2:,1)) ! { dg-warning "Creating array temporary" }
if (any(b(2:,1) /= ay(1:nx-1,1))) call abort
b = p(:,:,1)
call tes(eid(sum(b,2)), b(:,1)) ! unnecessary { dg-warning "Creating array temporary" }
if (any(b(:,1) /= ay(:,1))) call abort
contains
elemental function eid (x)
integer, intent(in) :: x
integer :: eid
eid = x
end function eid
function neid2 (x)
integer, intent(in) :: x(:,:)
integer :: neid2(size(x,1),size(x,2))
neid2 = x
end function neid2
function neid3 (x)
integer, intent(in) :: x(:,:,:)
integer :: neid3(size(x,1),size(x,2),size(x,3))
neid3 = x
end function neid3
elemental subroutine set (o, i)
integer, intent(in) :: i
integer, intent(out) :: o
o = i
end subroutine set
elemental subroutine tes (i, o)
integer, intent(in) :: i
integer, intent(out) :: o
o = i
end subroutine tes
end
! { dg-final { scan-tree-dump-times "struct array._integer\\(kind=4\\) atmp" 13 "original" } }
! { dg-final { scan-tree-dump-times "struct array\[^\\n\]*atmp" 13 "original" } }
! { dg-final { scan-tree-dump-times "_gfortran_sum_" 0 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
[-- Attachment #6: inline_sum_bounds_check_1.f90 --]
[-- Type: text/plain, Size: 466 bytes --]
! { dg-do run }
! { dg-options "-fbounds-check" }
integer, parameter :: nx = 3, ny = 4
integer :: i, j, too_big
integer, parameter, dimension(nx,ny) :: p = &
reshape((/ (i*i, i=1,size(p)) /), shape(p))
integer, dimension(nx,ny) :: a
integer, dimension(:), allocatable :: b
allocate(b(nx))
a = p
too_big = ny + 1
b = sum(a(:,1:too_big),2)
end
! { dg-shouldfail "outside of expected range" }
[-- Attachment #7: inline_sum_bounds_check_2.f90 --]
[-- Type: text/plain, Size: 467 bytes --]
! { dg-do run }
! { dg-options "-fbounds-check" }
integer, parameter :: nx = 3, ny = 4
integer :: i, j, too_big
integer, parameter, dimension(nx,ny) :: p = &
reshape((/ (i*i, i=1,size(p)) /), shape(p))
integer, dimension(nx,ny) :: a
integer, dimension(:), allocatable :: c
allocate(c(ny))
a = p
too_big = nx + 1
c = sum(a(1:too_big,:),2)
end
! { dg-shouldfail "outside of expected range" }
[-- Attachment #8: inline_product_1.f90 --]
[-- Type: text/plain, Size: 846 bytes --]
! { dg-do compile }
! { dg-options "-Warray-temporaries -O -fdump-tree-original" }
!
! PR fortran/43829
! Scalarization of reductions.
! Test that product is properly inlined.
! For more extended tests, see inline_sum_1.f90
implicit none
integer :: i
integer, parameter :: q = 2
integer, parameter :: nx=3, ny=2*q, nz=5
integer, parameter, dimension(nx,ny,nz) :: p = &
& reshape ((/ (i, i=1,size(p)) /), shape(p))
integer, dimension(nx,ny,nz) :: a
integer, dimension(nx, nz) :: ay
a = p
ay = product(a,2)
end
! { dg-final { scan-tree-dump-times "struct array._integer\\(kind=4\\) atmp" 0 "original" } }
! { dg-final { scan-tree-dump-times "struct array\[^\\n\]*atmp" 0 "original" } }
! { dg-final { scan-tree-dump-times "_gfortran_product_" 0 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
[-- Attachment #9: pr43829-full.diff --]
[-- Type: text/x-diff, Size: 141602 bytes --]
diff --git a/array.c b/array.c
index 3e6b9d2..a1449fd 100644
--- a/array.c
+++ b/array.c
@@ -70,6 +70,7 @@ match_subscript (gfc_array_ref *ar, int init, bool match_star)
i = ar->dimen + ar->codimen;
+ gfc_gobble_whitespace ();
ar->c_where[i] = gfc_current_locus;
ar->start[i] = ar->end[i] = ar->stride[i] = NULL;
diff --git a/dependency.c b/dependency.c
index c43af00..fd7fa73 100644
--- a/dependency.c
+++ b/dependency.c
@@ -713,6 +713,17 @@ gfc_check_argument_var_dependency (gfc_expr *var, sym_intent intent,
return gfc_check_fncall_dependency (var, intent, NULL,
expr->value.function.actual,
ELEM_CHECK_VARIABLE);
+
+ if (gfc_inline_intrinsic_function_p (expr))
+ {
+ /* The TRANSPOSE case should have been caught in the
+ noncopying intrinsic case above. */
+ gcc_assert (expr->value.function.isym->id != GFC_ISYM_TRANSPOSE);
+
+ return gfc_check_fncall_dependency (var, intent, NULL,
+ expr->value.function.actual,
+ ELEM_CHECK_VARIABLE);
+ }
}
return 0;
diff --git a/frontend-passes.c b/frontend-passes.c
index 5b1a644..a19f22d 100644
--- a/frontend-passes.c
+++ b/frontend-passes.c
@@ -203,8 +203,8 @@ cfe_register_funcs (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
/* Conversions are handled on the fly by the middle end,
transpose during trans-* stages and TRANSFER by the middle end. */
if ((*e)->value.function.isym->id == GFC_ISYM_CONVERSION
- || (*e)->value.function.isym->id == GFC_ISYM_TRANSPOSE
- || (*e)->value.function.isym->id == GFC_ISYM_TRANSFER)
+ || (*e)->value.function.isym->id == GFC_ISYM_TRANSFER
+ || gfc_inline_intrinsic_function_p (*e))
return 0;
/* Don't create an array temporary for elemental functions,
@@ -567,7 +567,8 @@ optimize_binop_array_assignment (gfc_code *c, gfc_expr **rhs, bool seen_op)
&& ! (e->value.function.isym
&& (e->value.function.isym->elemental
|| e->ts.type != c->expr1->ts.type
- || e->ts.kind != c->expr1->ts.kind)))
+ || e->ts.kind != c->expr1->ts.kind))
+ && ! gfc_inline_intrinsic_function_p (e))
{
gfc_code *n;
diff --git a/gfortran.h b/gfortran.h
index da3477d..b869ca3 100644
--- a/gfortran.h
+++ b/gfortran.h
@@ -2880,6 +2880,9 @@ void gfc_generate_code (gfc_namespace *);
void gfc_generate_module_code (gfc_namespace *);
void gfc_init_coarray_decl (bool);
+/* trans-intrinsic.c */
+bool gfc_inline_intrinsic_function_p (gfc_expr *);
+
/* bbt.c */
typedef int (*compare_fn) (void *, void *);
void gfc_insert_bbt (void *, void *, compare_fn);
diff --git a/matchexp.c b/matchexp.c
index 8b99ce9..cd70dc0 100644
--- a/matchexp.c
+++ b/matchexp.c
@@ -201,6 +201,7 @@ match_level_1 (gfc_expr **result)
locus where;
match m;
+ gfc_gobble_whitespace ();
where = gfc_current_locus;
uop = NULL;
m = match_defined_operator (&uop);
diff --git a/trans-array.c b/trans-array.c
index 3472804..80875a7 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -463,11 +463,9 @@ 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 *);
-
/* Free a gfc_ss chain. */
@@ -486,20 +484,35 @@ gfc_free_ss_chain (gfc_ss * ss)
}
+static void
+free_ss_info (gfc_ss_info *ss_info)
+{
+ ss_info->refcount--;
+ if (ss_info->refcount > 0)
+ return;
+
+ gcc_assert (ss_info->refcount == 0);
+ free (ss_info);
+}
+
+
/* Free a SS. */
-static void
+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 +520,7 @@ gfc_free_ss (gfc_ss * ss)
break;
}
+ free_ss_info (ss_info);
free (ss);
}
@@ -517,17 +531,20 @@ 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->refcount++;
+ 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 +556,21 @@ 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->refcount++;
+ 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 +582,16 @@ 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->refcount++;
+ 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;
}
@@ -572,6 +602,7 @@ gfc_get_scalar_ss (gfc_ss *next, gfc_expr *expr)
void
gfc_cleanup_loop (gfc_loopinfo * loop)
{
+ gfc_loopinfo *loop_next, **ploop;
gfc_ss *ss;
gfc_ss *next;
@@ -583,6 +614,44 @@ gfc_cleanup_loop (gfc_loopinfo * loop)
gfc_free_ss (ss);
ss = next;
}
+
+ /* Remove reference to self in the parent loop. */
+ if (loop->parent)
+ for (ploop = &loop->parent->nested; *ploop; ploop = &(*ploop)->next)
+ if (*ploop == loop)
+ {
+ *ploop = loop->next;
+ break;
+ }
+
+ /* Free non-freed nested loops. */
+ for (loop = loop->nested; loop; loop = loop_next)
+ {
+ loop_next = loop->next;
+ gfc_cleanup_loop (loop);
+ free (loop);
+ }
+}
+
+
+static void
+set_ss_loop (gfc_ss *ss, gfc_loopinfo *loop)
+{
+ int n;
+
+ for (; ss != gfc_ss_terminator; ss = ss->next)
+ {
+ ss->loop = loop;
+
+ if (ss->info->type == GFC_SS_SCALAR
+ || ss->info->type == GFC_SS_REFERENCE
+ || ss->info->type == GFC_SS_TEMP)
+ continue;
+
+ for (n = 0; n < GFC_MAX_DIMENSIONS; n++)
+ if (ss->info->data.array.subscript[n] != NULL)
+ set_ss_loop (ss->info->data.array.subscript[n], loop);
+ }
}
@@ -592,13 +661,36 @@ void
gfc_add_ss_to_loop (gfc_loopinfo * loop, gfc_ss * head)
{
gfc_ss *ss;
+ gfc_loopinfo *nested_loop;
if (head == gfc_ss_terminator)
return;
+ set_ss_loop (head, loop);
+
ss = head;
for (; ss && ss != gfc_ss_terminator; ss = ss->next)
{
+ if (ss->nested_ss)
+ {
+ nested_loop = ss->nested_ss->loop;
+
+ /* More than one ss can belong to the same loop. Hence, we add the
+ loop to the chain only if it is different from the previously
+ added one, to avoid duplicate nested loops. */
+ if (nested_loop != loop->nested)
+ {
+ gcc_assert (nested_loop->parent == NULL);
+ nested_loop->parent = loop;
+
+ gcc_assert (nested_loop->next == NULL);
+ nested_loop->next = loop->nested;
+ loop->nested = nested_loop;
+ }
+ else
+ gcc_assert (nested_loop->parent == loop);
+ }
+
if (ss->next == gfc_ss_terminator)
ss->loop_chain = loop->ss;
else
@@ -633,41 +725,54 @@ void
gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping * mapping,
gfc_se * se, gfc_array_spec * as)
{
- int n, dim;
+ int n, dim, total_dim;
gfc_se tmpse;
+ gfc_ss *ss;
tree lower;
tree upper;
tree tmp;
- if (as && as->type == AS_EXPLICIT)
- for (n = 0; n < se->loop->dimen; n++)
- {
- dim = se->ss->data.info.dim[n];
- gcc_assert (dim < as->rank);
- gcc_assert (se->loop->dimen == as->rank);
- if (se->loop->to[n] == NULL_TREE)
- {
- /* Evaluate the lower bound. */
- gfc_init_se (&tmpse, NULL);
- gfc_apply_interface_mapping (mapping, &tmpse, as->lower[dim]);
- gfc_add_block_to_block (&se->pre, &tmpse.pre);
- gfc_add_block_to_block (&se->post, &tmpse.post);
- lower = fold_convert (gfc_array_index_type, tmpse.expr);
-
- /* ...and the upper bound. */
- gfc_init_se (&tmpse, NULL);
- gfc_apply_interface_mapping (mapping, &tmpse, as->upper[dim]);
- gfc_add_block_to_block (&se->pre, &tmpse.pre);
- gfc_add_block_to_block (&se->post, &tmpse.post);
- upper = fold_convert (gfc_array_index_type, tmpse.expr);
-
- /* Set the upper bound of the loop to UPPER - LOWER. */
- tmp = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type, upper, lower);
- tmp = gfc_evaluate_now (tmp, &se->pre);
- se->loop->to[n] = tmp;
- }
- }
+ total_dim = 0;
+
+ if (!as || as->type != AS_EXPLICIT)
+ return;
+
+ for (ss = se->ss; ss; ss = ss->parent)
+ {
+ total_dim += ss->loop->dimen;
+ for (n = 0; n < ss->loop->dimen; n++)
+ {
+ /* The bound is known, nothing to do. */
+ if (ss->loop->to[n] != NULL_TREE)
+ continue;
+
+ dim = ss->dim[n];
+ gcc_assert (dim < as->rank);
+ gcc_assert (ss->loop->dimen <= as->rank);
+
+ /* Evaluate the lower bound. */
+ gfc_init_se (&tmpse, NULL);
+ gfc_apply_interface_mapping (mapping, &tmpse, as->lower[dim]);
+ gfc_add_block_to_block (&se->pre, &tmpse.pre);
+ gfc_add_block_to_block (&se->post, &tmpse.post);
+ lower = fold_convert (gfc_array_index_type, tmpse.expr);
+
+ /* ...and the upper bound. */
+ gfc_init_se (&tmpse, NULL);
+ gfc_apply_interface_mapping (mapping, &tmpse, as->upper[dim]);
+ gfc_add_block_to_block (&se->pre, &tmpse.pre);
+ gfc_add_block_to_block (&se->post, &tmpse.post);
+ upper = fold_convert (gfc_array_index_type, tmpse.expr);
+
+ /* Set the upper bound of the loop to UPPER - LOWER. */
+ tmp = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, upper, lower);
+ tmp = gfc_evaluate_now (tmp, &se->pre);
+ ss->loop->to[n] = tmp;
+ }
+ }
+
+ gcc_assert (total_dim == as->rank);
}
@@ -685,7 +790,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;
@@ -800,28 +905,62 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post,
}
-/* Get the array reference dimension corresponding to the given loop dimension.
- It is different from the true array dimension given by the dim array in
- the case of a partial array reference
- It is different from the loop dimension in the case of a transposed array.
- */
+/* Get the scalarizer array dimension corresponding to actual array dimension
+ given by ARRAY_DIM.
+
+ For example, if SS represents the array ref a(1,:,:,1), it is a
+ bidimensional scalarizer array, and the result would be 0 for ARRAY_DIM=1,
+ and 1 for ARRAY_DIM=2.
+ If SS represents transpose(a(:,1,1,:)), it is again a bidimensional
+ scalarizer array, and the result would be 1 for ARRAY_DIM=0 and 0 for
+ ARRAY_DIM=3.
+ If SS represents sum(a(:,:,:,1), dim=1), it is a 2+1-dimensional scalarizer
+ array. If called on the inner ss, the result would be respectively 0,1,2 for
+ ARRAY_DIM=0,1,2. If called on the outer ss, the result would be 0,1
+ for ARRAY_DIM=1,2. */
static int
-get_array_ref_dim (gfc_ss_info *info, int loop_dim)
+get_scalarizer_dim_for_array_dim (gfc_ss *ss, int array_dim)
{
- int n, array_dim, array_ref_dim;
+ int array_ref_dim;
+ int n;
array_ref_dim = 0;
- array_dim = info->dim[loop_dim];
- for (n = 0; n < info->dimen; n++)
- if (n != loop_dim && info->dim[n] < array_dim)
- array_ref_dim++;
+ for (; ss; ss = ss->parent)
+ for (n = 0; n < ss->dimen; n++)
+ if (ss->dim[n] < array_dim)
+ array_ref_dim++;
return array_ref_dim;
}
+static gfc_ss *
+innermost_ss (gfc_ss *ss)
+{
+ while (ss->nested_ss != NULL)
+ ss = ss->nested_ss;
+
+ return ss;
+}
+
+
+
+/* Get the array reference dimension corresponding to the given loop dimension.
+ It is different from the true array dimension given by the dim array in
+ the case of a partial array reference (i.e. a(:,:,1,:) for example)
+ It is different from the loop dimension in the case of a transposed array.
+ */
+
+static int
+get_array_ref_dim_for_loop_dim (gfc_ss *ss, int loop_dim)
+{
+ return get_scalarizer_dim_for_array_dim (innermost_ss (ss),
+ ss->dim[loop_dim]);
+}
+
+
/* Generate code to create and initialize the descriptor for a temporary
array. This is used for both temporaries needed by the scalarizer, and
functions returning arrays. Adjusts the loop variables to be
@@ -833,15 +972,16 @@ get_array_ref_dim (gfc_ss_info *info, int loop_dim)
callee allocated array.
PRE, POST, INITIAL, DYNAMIC and DEALLOC are as for
- gfc_trans_allocate_array_storage.
- */
+ gfc_trans_allocate_array_storage. */
tree
-gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
- gfc_loopinfo * loop, gfc_ss_info * info,
+gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
tree eltype, tree initial, bool dynamic,
bool dealloc, bool callee_alloc, locus * where)
{
+ gfc_loopinfo *loop;
+ gfc_ss *s;
+ gfc_array_info *info;
tree from[GFC_MAX_DIMENSIONS], to[GFC_MAX_DIMENSIONS];
tree type;
tree desc;
@@ -851,49 +991,63 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
tree cond;
tree or_expr;
int n, dim, tmp_dim;
+ int total_dim = 0;
memset (from, 0, sizeof (from));
memset (to, 0, sizeof (to));
- gcc_assert (info->dimen > 0);
- gcc_assert (loop->dimen == info->dimen);
+ info = &ss->info->data.array;
+
+ gcc_assert (ss->dimen > 0);
+ gcc_assert (ss->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++)
+ for (s = ss; s; s = s->parent)
{
- dim = info->dim[n];
+ loop = s->loop;
- /* Callee allocated arrays may not have a known bound yet. */
- if (loop->to[n])
- loop->to[n] = gfc_evaluate_now (
+ total_dim += loop->dimen;
+ for (n = 0; n < loop->dimen; n++)
+ {
+ dim = s->dim[n];
+
+ /* Callee allocated arrays may not have a known bound yet. */
+ if (loop->to[n])
+ loop->to[n] = gfc_evaluate_now (
fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
loop->to[n], loop->from[n]),
pre);
- loop->from[n] = gfc_index_zero_node;
-
- /* We are constructing the temporary's descriptor based on the loop
- dimensions. As the dimensions may be accessed in arbitrary order
- (think of transpose) the size taken from the n'th loop may not map
- 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);
- from[tmp_dim] = loop->from[n];
- to[tmp_dim] = loop->to[n];
-
- info->delta[dim] = gfc_index_zero_node;
- info->start[dim] = gfc_index_zero_node;
- info->end[dim] = gfc_index_zero_node;
- info->stride[dim] = gfc_index_one_node;
+ loop->from[n] = gfc_index_zero_node;
+
+ /* We have just changed the loop bounds, we must clear the
+ corresponding specloop, so that delta calculation is not skipped
+ later in gfc_set_delta. */
+ loop->specloop[n] = NULL;
+
+ /* We are constructing the temporary's descriptor based on the loop
+ dimensions. As the dimensions may be accessed in arbitrary order
+ (think of transpose) the size taken from the n'th loop may not map
+ 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_scalarizer_dim_for_array_dim (ss, dim);
+ from[tmp_dim] = loop->from[n];
+ to[tmp_dim] = loop->to[n];
+
+ info->delta[dim] = gfc_index_zero_node;
+ info->start[dim] = gfc_index_zero_node;
+ info->end[dim] = gfc_index_zero_node;
+ info->stride[dim] = gfc_index_one_node;
+ }
}
/* Initialize the descriptor. */
type =
- gfc_get_array_type_bounds (eltype, info->dimen, 0, from, to, 1,
+ gfc_get_array_type_bounds (eltype, total_dim, 0, from, to, 1,
GFC_ARRAY_UNKNOWN, true);
desc = gfc_create_var (type, "atmp");
GFC_DECL_PACKED_ARRAY (desc) = 1;
@@ -922,59 +1076,61 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
/* If there is at least one null loop->to[n], it is a callee allocated
array. */
- for (n = 0; n < loop->dimen; n++)
- if (loop->to[n] == NULL_TREE)
+ for (n = 0; n < total_dim; n++)
+ if (to[n] == NULL_TREE)
{
size = NULL_TREE;
break;
}
- for (n = 0; n < loop->dimen; n++)
- {
- dim = info->dim[n];
-
- if (size == NULL_TREE)
+ if (size == NULL_TREE)
+ for (s = ss; s; s = s->parent)
+ for (n = 0; n < s->loop->dimen; n++)
{
+ dim = get_scalarizer_dim_for_array_dim (ss, ss->dim[n]);
+
/* For a callee allocated array express the loop bounds in terms
of the descriptor fields. */
tmp = fold_build2_loc (input_location,
MINUS_EXPR, gfc_array_index_type,
gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]),
gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]));
- loop->to[n] = tmp;
- continue;
+ s->loop->to[n] = tmp;
}
-
- /* Store the stride and bound components in the descriptor. */
- gfc_conv_descriptor_stride_set (pre, desc, gfc_rank_cst[n], size);
+ else
+ {
+ for (n = 0; n < total_dim; n++)
+ {
+ /* Store the stride and bound components in the descriptor. */
+ gfc_conv_descriptor_stride_set (pre, desc, gfc_rank_cst[n], size);
- gfc_conv_descriptor_lbound_set (pre, desc, gfc_rank_cst[n],
- gfc_index_zero_node);
+ gfc_conv_descriptor_lbound_set (pre, desc, gfc_rank_cst[n],
+ gfc_index_zero_node);
- gfc_conv_descriptor_ubound_set (pre, desc, gfc_rank_cst[n],
- to[n]);
+ gfc_conv_descriptor_ubound_set (pre, desc, gfc_rank_cst[n], to[n]);
- tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
- to[n], gfc_index_one_node);
+ tmp = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type,
+ to[n], gfc_index_one_node);
- /* Check whether the size for this dimension is negative. */
- cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, tmp,
- gfc_index_zero_node);
- cond = gfc_evaluate_now (cond, pre);
+ /* Check whether the size for this dimension is negative. */
+ cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node,
+ tmp, gfc_index_zero_node);
+ cond = gfc_evaluate_now (cond, pre);
- if (n == 0)
- or_expr = cond;
- else
- or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR,
- boolean_type_node, or_expr, cond);
+ if (n == 0)
+ or_expr = cond;
+ else
+ or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR,
+ boolean_type_node, or_expr, cond);
- size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- size, tmp);
- size = gfc_evaluate_now (size, pre);
+ size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, size, tmp);
+ size = gfc_evaluate_now (size, pre);
+ }
}
/* Get the size of the array. */
-
if (size && !callee_alloc)
{
/* If or_expr is true, then the extent in at least one
@@ -997,8 +1153,11 @@ 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;
+ while (ss->parent)
+ ss = ss->parent;
+
+ if (ss->dimen > ss->loop->temp_dim)
+ ss->loop->temp_dim = ss->dimen;
return size;
}
@@ -1849,77 +2008,120 @@ gfc_build_constant_array_constructor (gfc_expr * expr, tree type)
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 = &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;
info->end[i] = gfc_index_zero_node;
info->stride[i] = gfc_index_one_node;
}
+}
+
+
+static int
+get_rank (gfc_loopinfo *loop)
+{
+ int rank;
- if (info->dimen > loop->temp_dim)
- loop->temp_dim = info->dimen;
+ rank = 0;
+ for (; loop; loop = loop->parent)
+ rank += loop->dimen;
+
+ return rank;
}
+
/* 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
-constant_array_constructor_loop_size (gfc_loopinfo * loop)
+constant_array_constructor_loop_size (gfc_loopinfo * l)
{
+ gfc_loopinfo *loop;
tree size = gfc_index_one_node;
tree tmp;
- int i;
+ int i, total_dim;
+
+ total_dim = get_rank (l);
- for (i = 0; i < loop->dimen; i++)
+ for (loop = l; loop; loop = loop->parent)
{
- /* If the bounds aren't constant, return NULL_TREE. */
- if (!INTEGER_CST_P (loop->from[i]) || !INTEGER_CST_P (loop->to[i]))
- return NULL_TREE;
- if (!integer_zerop (loop->from[i]))
+ for (i = 0; i < loop->dimen; i++)
{
- /* Only allow nonzero "from" in one-dimensional arrays. */
- if (loop->dimen != 1)
+ /* If the bounds aren't constant, return NULL_TREE. */
+ if (!INTEGER_CST_P (loop->from[i]) || !INTEGER_CST_P (loop->to[i]))
return NULL_TREE;
- tmp = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type,
- loop->to[i], loop->from[i]);
+ if (!integer_zerop (loop->from[i]))
+ {
+ /* Only allow nonzero "from" in one-dimensional arrays. */
+ if (total_dim != 1)
+ return NULL_TREE;
+ tmp = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type,
+ loop->to[i], loop->from[i]);
+ }
+ else
+ tmp = loop->to[i];
+ tmp = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type, tmp, gfc_index_one_node);
+ size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, size, tmp);
}
- else
- tmp = loop->to[i];
- tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
- tmp, gfc_index_one_node);
- size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- size, tmp);
}
return size;
}
+static tree *
+get_loop_upper_bound_for_array (gfc_ss *array, int array_dim)
+{
+ gfc_ss *ss;
+ int n;
+
+ gcc_assert (array->nested_ss == NULL);
+
+ for (ss = array; ss; ss = ss->parent)
+ for (n = 0; n < ss->loop->dimen; n++)
+ if (array_dim == get_array_ref_dim_for_loop_dim (ss, n))
+ return &(ss->loop->to[n]);
+
+ gcc_unreachable ();
+}
+
+
+static gfc_loopinfo *
+outermost_loop (gfc_loopinfo * loop)
+{
+ while (loop->parent != NULL)
+ loop = loop->parent;
+
+ return loop;
+}
+
+
/* Array constructors are handled by constructing a temporary, then using that
within the scalarization loop. This is not optimal, but seems by far the
simplest method. */
static void
-gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
+trans_array_constructor (gfc_ss * ss)
{
gfc_constructor_base c;
tree offset;
@@ -1927,90 +2129,107 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
tree desc;
tree type;
tree tmp;
+ tree *loop_ubound0;
bool dynamic;
bool old_first_len, old_typespec_chararray_ctor;
tree old_first_len_val;
+ gfc_loopinfo *loop, *outer_loop;
+ gfc_ss_info *ss_info;
+ gfc_expr *expr;
+ gfc_ss *s;
/* 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;
+ loop = ss->loop;
+ outer_loop = outermost_loop (loop);
+ 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 == ss->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;
- gfc_add_block_to_block (&loop->pre, &length_se.pre);
- gfc_add_block_to_block (&loop->post, &length_se.post);
+ ss_info->string_length = length_se.expr;
+ gfc_add_block_to_block (&outer_loop->pre, &length_se.pre);
+ gfc_add_block_to_block (&outer_loop->post, &length_se.post);
}
else
- const_string = get_array_ctor_strlen (&loop->pre, c,
- &ss->string_length);
+ const_string = get_array_ctor_strlen (&outer_loop->pre, c,
+ &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)
+ loop_ubound0 = get_loop_upper_bound_for_array (ss, 0);
+
+ if (expr->shape && get_rank (loop) > 1 && *loop_ubound0 == NULL_TREE)
{
/* We have a multidimensional parameter. */
- int n;
- for (n = 0; n < ss->expr->rank; n++)
- {
- loop->from[n] = gfc_index_zero_node;
- loop->to[n] = gfc_conv_mpz_to_tree (ss->expr->shape [n],
- gfc_index_integer_kind);
- loop->to[n] = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type,
- loop->to[n], gfc_index_one_node);
- }
+ for (s = ss; s; s = s->parent)
+ {
+ int n;
+ for (n = 0; n < s->loop->dimen; n++)
+ {
+ s->loop->from[n] = gfc_index_zero_node;
+ s->loop->to[n] = gfc_conv_mpz_to_tree (expr->shape[s->dim[n]],
+ gfc_index_integer_kind);
+ s->loop->to[n] = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type,
+ s->loop->to[n],
+ gfc_index_one_node);
+ }
+ }
}
- if (loop->to[0] == NULL_TREE)
+ if (*loop_ubound0 == NULL_TREE)
{
mpz_t size;
/* We should have a 1-dimensional, zero-based loop. */
+ gcc_assert (loop->parent == NULL && loop->nested == NULL);
gcc_assert (loop->dimen == 1);
gcc_assert (integer_zerop (loop->from[0]));
@@ -2033,24 +2252,24 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
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)
+ if (TREE_CODE (*loop_ubound0) == VAR_DECL)
dynamic = true;
- gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, &ss->data.info,
- type, NULL_TREE, dynamic, true, false, where);
+ gfc_trans_create_temp_array (&outer_loop->pre, &outer_loop->post, ss, type,
+ NULL_TREE, dynamic, true, false, &expr->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;
TREE_USED (offsetvar) = 0;
- gfc_trans_array_constructor_value (&loop->pre, type, desc, c,
+ gfc_trans_array_constructor_value (&outer_loop->pre, type, desc, c,
&offset, &offsetvar, dynamic);
/* If the array grows dynamically, the upper bound of the loop variable
@@ -2060,12 +2279,12 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
offsetvar, gfc_index_one_node);
- tmp = gfc_evaluate_now (tmp, &loop->pre);
+ tmp = gfc_evaluate_now (tmp, &outer_loop->pre);
gfc_conv_descriptor_ubound_set (&loop->pre, desc, gfc_rank_cst[0], tmp);
- if (loop->to[0] && TREE_CODE (loop->to[0]) == VAR_DECL)
- gfc_add_modify (&loop->pre, loop->to[0], tmp);
+ if (*loop_ubound0 && TREE_CODE (*loop_ubound0) == VAR_DECL)
+ gfc_add_modify (&outer_loop->pre, *loop_ubound0, tmp);
else
- loop->to[0] = tmp;
+ *loop_ubound0 = tmp;
}
if (TREE_USED (offsetvar))
@@ -2095,8 +2314,10 @@ finish:
loop bounds. */
static void
-gfc_set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss_info * info)
+set_vector_loop_bounds (gfc_ss * ss)
{
+ gfc_loopinfo *loop, *outer_loop;
+ gfc_array_info *info;
gfc_se se;
tree tmp;
tree desc;
@@ -2104,27 +2325,36 @@ gfc_set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss_info * info)
int n;
int dim;
- for (n = 0; n < loop->dimen; n++)
+ outer_loop = outermost_loop (ss->loop);
+
+ info = &ss->info->data.array;
+
+ for (; ss; ss = ss->parent)
{
- dim = info->dim[n];
- if (info->ref->u.ar.dimen_type[dim] == DIMEN_VECTOR
- && loop->to[n] == NULL)
+ loop = ss->loop;
+
+ for (n = 0; n < loop->dimen; n++)
{
+ dim = ss->dim[n];
+ if (info->ref->u.ar.dimen_type[dim] != DIMEN_VECTOR
+ || loop->to[n] != NULL)
+ continue;
+
/* Loop variable N indexes vector dimension DIM, and we don't
yet know the upper bound of loop variable N. Set it to the
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,
gfc_conv_descriptor_ubound_get (desc, zero),
gfc_conv_descriptor_lbound_get (desc, zero));
- tmp = gfc_evaluate_now (tmp, &loop->pre);
+ tmp = gfc_evaluate_now (tmp, &outer_loop->pre);
loop->to[n] = tmp;
}
}
@@ -2136,12 +2366,18 @@ gfc_set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss_info * info)
but before the actual scalarizing loops. */
static void
-gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
- locus * where)
+add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript)
{
+ gfc_loopinfo *nested_loop, *outer_loop;
gfc_se se;
+ gfc_ss_info *ss_info;
+ gfc_array_info *info;
+ gfc_expr *expr;
+ bool skip_nested = false;
int n;
+ outer_loop = outermost_loop (loop);
+
/* TODO: This can generate bad code if there are ordering dependencies,
e.g., a callee allocated function and an unknown size constructor. */
gcc_assert (ss != NULL);
@@ -2150,61 +2386,74 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
{
gcc_assert (ss);
- switch (ss->type)
+ /* Cross loop arrays are handled from within the most nested loop. */
+ if (ss->nested_ss != NULL)
+ continue;
+
+ 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_add_block_to_block (&loop->pre, &se.pre);
+ gfc_conv_expr (&se, expr);
+ gfc_add_block_to_block (&outer_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)
- se.expr = gfc_evaluate_now (se.expr, &loop->pre);
- gfc_add_block_to_block (&loop->pre, &se.post);
+ if (!ss_info->where)
+ se.expr = gfc_evaluate_now (se.expr, &outer_loop->pre);
+ gfc_add_block_to_block (&outer_loop->pre, &se.post);
}
else
- gfc_add_block_to_block (&loop->post, &se.post);
+ gfc_add_block_to_block (&outer_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_add_block_to_block (&loop->pre, &se.pre);
- gfc_add_block_to_block (&loop->post, &se.post);
+ gfc_conv_expr (&se, expr);
+ gfc_add_block_to_block (&outer_loop->pre, &se.pre);
+ gfc_add_block_to_block (&outer_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,
+ &outer_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);
-
- gfc_set_vector_loop_bounds (loop, &ss->data.info);
+ if (info->subscript[n])
+ {
+ add_loop_ss_code (loop, info->subscript[n], true);
+ /* The recursive call will have taken care of the nested loops.
+ No need to do it twice. */
+ skip_nested = true;
+ }
+
+ set_vector_loop_bounds (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_add_block_to_block (&loop->pre, &se.pre);
- gfc_add_block_to_block (&loop->post, &se.post);
- ss->data.info.descriptor = se.expr;
+ gfc_conv_expr_descriptor (&se, expr, gfc_walk_expr (expr));
+ gfc_add_block_to_block (&outer_loop->pre, &se.pre);
+ gfc_add_block_to_block (&outer_loop->post, &se.post);
+ info->descriptor = se.expr;
break;
case GFC_SS_INTRINSIC:
@@ -2217,26 +2466,26 @@ 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_add_block_to_block (&loop->pre, &se.pre);
- gfc_add_block_to_block (&loop->post, &se.post);
- ss->string_length = se.string_length;
+ gfc_conv_expr (&se, expr);
+ gfc_add_block_to_block (&outer_loop->pre, &se.pre);
+ gfc_add_block_to_block (&outer_loop->post, &se.post);
+ 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;
- gfc_add_block_to_block (&loop->pre, &se.pre);
- gfc_add_block_to_block (&loop->post, &se.post);
+ ss_info->string_length = se.expr;
+ gfc_add_block_to_block (&outer_loop->pre, &se.pre);
+ gfc_add_block_to_block (&outer_loop->post, &se.post);
}
- gfc_trans_array_constructor (loop, ss, where);
+ trans_array_constructor (ss);
break;
case GFC_SS_TEMP:
@@ -2248,6 +2497,11 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
gcc_unreachable ();
}
}
+
+ if (!skip_nested)
+ for (nested_loop = loop->nested; nested_loop;
+ nested_loop = nested_loop->next)
+ add_loop_ss_code (nested_loop, nested_loop->ss, subscript);
}
@@ -2258,16 +2512,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)
{
@@ -2281,15 +2540,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;
}
}
@@ -2430,42 +2689,25 @@ gfc_conv_array_ubound (tree descriptor, int dim)
/* 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->info->data.array.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));
@@ -2525,13 +2767,16 @@ gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n,
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->info->data.array;
+
/* Get the index into the array for this dimension. */
if (ar)
{
@@ -2544,21 +2789,20 @@ gfc_conv_array_index_offset (gfc_se * se, gfc_ss_info * info, 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 = 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);
- 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,
@@ -2578,10 +2822,9 @@ gfc_conv_array_index_offset (gfc_se * se, gfc_ss_info * info, int dim, int i,
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:
@@ -2613,11 +2856,11 @@ gfc_conv_array_index_offset (gfc_se * se, gfc_ss_info * info, 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]);
@@ -2640,31 +2883,33 @@ gfc_conv_array_index_offset (gfc_se * se, gfc_ss_info * info, 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 = 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);
}
@@ -2674,7 +2919,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);
}
@@ -2830,6 +3075,33 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
}
+/* 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->info->data.array;
+
+ 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. */
@@ -2837,100 +3109,98 @@ static void
gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
stmtblock_t * pblock)
{
- tree index;
tree stride;
- gfc_ss_info *info;
- gfc_ss *ss;
- gfc_se se;
+ gfc_ss_info *ss_info;
+ gfc_array_info *info;
+ gfc_ss_type ss_type;
+ gfc_ss *ss, *pss;
+ gfc_loopinfo *ploop;
+ gfc_array_ref *ar;
int i;
/* This code will be executed before entering the scalarization loop
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;
- if (dim >= info->dimen)
- continue;
+ gcc_assert (dim < ss->dimen);
+ gcc_assert (ss->dimen == loop->dimen);
+
+ if (info->ref)
+ ar = &info->ref->u.ar;
+ else
+ ar = NULL;
- if (dim == info->dimen - 1)
+ if (dim == loop->dimen - 1 && loop->parent != NULL)
{
- /* For the outermost loop calculate the offset due to any
- elemental dimensions. It will have been initialized with the
- base offset of the array. */
- if (info->ref)
- {
- for (i = 0; i < info->ref->u.ar.dimen; i++)
- {
- if (info->ref->u.ar.dimen_type[i] != DIMEN_ELEMENT)
- continue;
+ /* If we are in the outermost dimension of this loop, the previous
+ dimension shall be in the parent loop. */
+ gcc_assert (ss->parent != NULL);
- gfc_init_se (&se, NULL);
- se.loop = loop;
- se.expr = info->descriptor;
- stride = gfc_conv_array_stride (info->descriptor, i);
- index = gfc_conv_array_index_offset (&se, info, i, -1,
- &info->ref->u.ar,
- stride);
- gfc_add_block_to_block (pblock, &se.pre);
-
- info->offset = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type,
- info->offset, index);
- info->offset = gfc_evaluate_now (info->offset, pblock);
- }
- }
+ pss = ss->parent;
+ ploop = loop->parent;
- 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]);
+ /* ss and ss->parent are about the same array. */
+ gcc_assert (ss_info == pss->info);
+ }
+ else
+ {
+ ploop = loop;
+ pss = ss;
+ }
+
+ if (dim == loop->dimen - 1)
+ i = 0;
+ else
+ i = dim + 1;
+
+ /* For the time being, there is no loop reordering. */
+ gcc_assert (i == ploop->order[i]);
+ i = ploop->order[i];
+
+ if (dim == loop->dimen - 1 && loop->parent == NULL)
+ {
+ stride = gfc_conv_array_stride (info->descriptor,
+ innermost_ss (ss)->dim[i]);
/* Calculate the stride of the innermost loop. Hopefully this will
allow the backend optimizers to do their stuff more effectively.
*/
info->stride0 = gfc_evaluate_now (stride, pblock);
- }
- else
- {
- /* Add the offset for the previous loop dimension. */
- gfc_array_ref *ar;
+ /* For the outermost loop calculate the offset due to any
+ elemental dimensions. It will have been initialized with the
+ base offset of the array. */
if (info->ref)
{
- ar = &info->ref->u.ar;
- i = loop->order[dim + 1];
- }
- else
- {
- ar = NULL;
- i = dim + 1;
- }
+ for (i = 0; i < ar->dimen; i++)
+ {
+ 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, 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_array_offset (pblock, loop, ss, ar, i, /* unused */ -1);
+ }
+ }
}
+ else
+ /* Add the offset for the previous loop dimension. */
+ add_array_offset (pblock, ploop, ss, ar, pss->dim[i], i);
/* Remember this offset for the second loop. */
- if (dim == loop->temp_dim - 1)
+ if (dim == loop->temp_dim - 1 && loop->parent == NULL)
info->saved_offset = info->offset;
}
}
@@ -3114,8 +3384,9 @@ gfc_trans_scalarizing_loops (gfc_loopinfo * loop, stmtblock_t * body)
gfc_add_expr_to_block (&loop->pre, tmp);
/* Clear all the used flags. */
- for (ss = loop->ss; ss; ss = ss->loop_chain)
- ss->useflags = 0;
+ for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
+ if (ss->parent == NULL)
+ ss->info->useflags = 0;
}
@@ -3147,15 +3418,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. */
@@ -3217,12 +3495,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)
@@ -3277,25 +3555,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:
@@ -3315,21 +3593,31 @@ 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;
+
+ 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);
+ /* Get the descriptor for the array. If it is a cross loops array,
+ we got the descriptor already in the outermost loop. */
+ if (ss->parent == NULL)
+ 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:
@@ -3345,11 +3633,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++)
{
- 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];
+
+ info->start[dim] = gfc_index_zero_node;
+ info->end[dim] = gfc_index_zero_node;
+ info->stride[dim] = gfc_index_one_node;
}
break;
@@ -3366,7 +3656,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;
@@ -3378,18 +3668,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. */
@@ -3397,7 +3696,7 @@ done:
{
bool check_upper;
- dim = info->dim[n];
+ dim = ss->dim[n];
if (info->ref->u.ar.dimen_type[dim] != DIMEN_RANGE)
continue;
@@ -3411,12 +3710,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
@@ -3470,14 +3769,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));
@@ -3492,9 +3791,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);
@@ -3524,14 +3823,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));
@@ -3541,9 +3840,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);
@@ -3570,10 +3869,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]));
@@ -3587,10 +3886,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);
@@ -3600,6 +3899,9 @@ done:
tmp = gfc_finish_block (&block);
gfc_add_expr_to_block (&loop->pre, tmp);
}
+
+ for (loop = loop->nested; loop; loop = loop->next)
+ gfc_conv_ss_startstride (loop);
}
/* Return true if both symbols could refer to the same data object. Does
@@ -3643,12 +3945,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;
@@ -3666,7 +3972,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;
@@ -3686,7 +3992,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)
@@ -3721,7 +4027,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;
@@ -3746,6 +4052,14 @@ gfc_could_be_alias (gfc_ss * lss, gfc_ss * rss)
}
+void gfc_make_loop_temp_ss (tree type, tree string_length, gfc_loopinfo *loop)
+{
+ loop->temp_ss = gfc_get_temp_ss (type, string_length, loop->dimen);
+ gcc_assert (loop->temp_ss->dimen == loop->dimen);
+ gfc_add_ss_to_loop (loop, loop->temp_ss);
+}
+
+
/* Resolve array data dependencies. Creates a temporary if required. */
/* TODO: Calc dependencies with gfc_expr rather than gfc_ss, and move to
dependency.c. */
@@ -3757,20 +4071,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;
@@ -3778,18 +4097,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. */
@@ -3838,38 +4157,36 @@ 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->dimen);
- gfc_add_ss_to_loop (loop, loop->temp_ss);
+ gfc_make_loop_temp_ss (base_type, dest->info->string_length, loop);
}
else
loop->temp_ss = NULL;
}
-/* Initialize the scalarization loop. Creates the loop variables. Determines
- the range of the loop variables. Creates a temporary if required.
- Calculates how to transform from loop variables to array indices for each
- expression. Also generates code for scalar expressions which have been
- moved outside the loop. */
+/* Browse through each array's information from the scalarizer and set the loop
+ bounds according to the "best" one (per dimension), i.e. the one which
+ provides the most information (constant bounds, shape, etc). */
-void
-gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
+static void
+set_loop_bounds (gfc_loopinfo *loop)
{
int n, dim, spec_dim;
- gfc_ss_info *info;
- gfc_ss_info *specinfo;
+ gfc_array_info *info;
+ gfc_array_info *specinfo;
gfc_ss *ss;
tree tmp;
- gfc_ss *loopspec[GFC_MAX_DIMENSIONS];
+ gfc_ss **loopspec;
bool dynamic[GFC_MAX_DIMENSIONS];
mpz_t *cshape;
mpz_t i;
+ loopspec = loop->specloop;
+
mpz_init (i);
for (n = 0; n < loop->dimen; n++)
{
@@ -3879,16 +4196,21 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
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];
+ 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
{
@@ -3897,19 +4219,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.
@@ -3921,7 +4243,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;
@@ -3930,7 +4252,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;
@@ -3941,7 +4263,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])
@@ -3953,7 +4275,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])
@@ -3975,16 +4297,16 @@ 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]))
{
loop->from[n] = info->start[dim];
- mpz_set (i, cshape[get_array_ref_dim (info, n)]);
+ mpz_set (i, cshape[get_array_ref_dim_for_loop_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);
@@ -3999,7 +4321,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
@@ -4046,65 +4368,98 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
loop->from[n] = gfc_index_zero_node;
}
}
+ mpz_clear (i);
+
+ for (loop = loop->nested; loop; loop = loop->next)
+ set_loop_bounds (loop);
+}
+
+
+/* Initialize the scalarization loop. Creates the loop variables. Determines
+ the range of the loop variables. Creates a temporary if required.
+ Also generates code for scalar expressions which have been
+ moved outside the loop. */
+
+void
+gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
+{
+ gfc_ss *tmp_ss;
+ tree tmp;
+
+ set_loop_bounds (loop);
/* Add all the scalar code that can be taken out of the loops.
This may include calculating the loop bounds, so do it before
allocating the temporary. */
- gfc_add_loop_ss_code (loop, loop->ss, false, where);
+ add_loop_ss_code (loop, loop->ss, false);
+ 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);
+ gcc_assert (loop->parent == NULL);
/* 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->data.info, tmp, NULL_TREE,
- false, true, false, where);
+ gfc_trans_create_temp_array (&loop->pre, &loop->post, tmp_ss, tmp,
+ NULL_TREE, false, true, false, where);
}
- for (n = 0; n < loop->temp_dim; n++)
- loopspec[loop->order[n]] = NULL;
-
- mpz_clear (i);
-
/* For array parameters we don't have loop variables, so don't calculate the
translations. */
- if (loop->array_parameter)
- return;
+ if (!loop->array_parameter)
+ gfc_set_delta (loop);
+}
+
+
+/* Calculates how to transform from loop variables to array indices for each
+ array: once loop bounds are chosen, sets the difference (DELTA field) between
+ loop bounds and array reference bounds, for each array info. */
+
+void
+gfc_set_delta (gfc_loopinfo *loop)
+{
+ gfc_ss *ss, **loopspec;
+ gfc_array_info *info;
+ tree tmp;
+ int n, dim;
+
+ loopspec = loop->specloop;
/* 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. */
@@ -4123,6 +4478,9 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
}
}
}
+
+ for (loop = loop->nested; loop; loop = loop->next)
+ gfc_set_delta (loop);
}
@@ -5662,15 +6020,17 @@ get_array_charlen (gfc_expr *expr, gfc_se *se)
}
}
+
/* 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
@@ -5705,8 +6065,10 @@ dim_ok (gfc_ss_info *info)
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;
@@ -5716,11 +6078,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)
{
@@ -5728,9 +6094,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);
@@ -5757,7 +6123,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
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)
{
@@ -5807,7 +6173,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)
@@ -5819,16 +6185,17 @@ 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));
+ && expr->value.function.isym->elemental)
+ || gfc_inline_intrinsic_function_p (expr));
else
- gcc_assert (ss->type == GFC_SS_INTRINSIC);
+ gcc_assert (ss_type == GFC_SS_INTRINSIC);
need_tmp = 1;
if (expr->ts.type == BT_CHARACTER
@@ -5840,19 +6207,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
{
@@ -5894,15 +6261,13 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
get_array_charlen (expr, se);
/* Tell the scalarizer to make a temporary. */
- loop.temp_ss = gfc_get_temp_ss (gfc_typenode_for_spec (&expr->ts),
- ((expr->ts.type == BT_CHARACTER)
- ? expr->ts.u.cl->backend_decl
- : NULL),
- loop.dimen);
+ gfc_make_loop_temp_ss (gfc_typenode_for_spec (&expr->ts),
+ ((expr->ts.type == BT_CHARACTER)
+ ? expr->ts.u.cl->backend_decl
+ : NULL),
+ &loop);
- se->string_length = loop.temp_ss->string_length;
- gcc_assert (loop.temp_ss->data.temp.dimen == loop.dimen);
- gfc_add_ss_to_loop (&loop, loop.temp_ss);
+ se->string_length = loop.temp_ss->info->string_length;
}
gfc_conv_loop_setup (&loop, & expr->where);
@@ -5952,12 +6317,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 && 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
{
@@ -5974,7 +6339,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)
{
@@ -6058,8 +6423,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
{
@@ -6089,7 +6454,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. */
@@ -7145,6 +7510,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;
@@ -7175,11 +7541,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. */
@@ -7190,17 +7556,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)
@@ -7210,7 +7578,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);
@@ -7280,7 +7648,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;
@@ -7370,21 +7738,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. */
@@ -7448,11 +7816,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. */
@@ -7636,13 +8004,13 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref)
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 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. */
@@ -7660,7 +8028,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++)
@@ -7674,14 +8042,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:
@@ -7690,9 +8058,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:
@@ -7702,8 +8070,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;
@@ -7814,7 +8182,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-array.h b/trans-array.h
index 4d737bd..9894b6a 100644
--- a/trans-array.h
+++ b/trans-array.h
@@ -31,9 +31,8 @@ void gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping *,
gfc_se *, gfc_array_spec *);
/* Generate code to create a temporary array. */
-tree gfc_trans_create_temp_array (stmtblock_t *, stmtblock_t *, gfc_loopinfo *,
- gfc_ss_info *, tree, tree, bool, bool, bool,
- locus *);
+tree gfc_trans_create_temp_array (stmtblock_t *, stmtblock_t *, gfc_ss *,
+ tree, tree, bool, bool, bool, locus *);
/* Generate function entry code for allocation of compiler allocated array
variables. */
@@ -89,6 +88,8 @@ void gfc_add_ss_to_loop (gfc_loopinfo *, gfc_ss *);
void gfc_mark_ss_chain_used (gfc_ss *, unsigned);
/* Free a gfc_ss chain. */
void gfc_free_ss_chain (gfc_ss *);
+/* Free a single gfc_ss element. */
+void gfc_free_ss (gfc_ss *);
/* Allocate a new array type ss. */
gfc_ss *gfc_get_array_ss (gfc_ss *, gfc_expr *, int, gfc_ss_type);
/* Allocate a new temporary type ss. */
@@ -112,6 +113,10 @@ void gfc_trans_scalarizing_loops (gfc_loopinfo *, stmtblock_t *);
void gfc_trans_scalarized_loop_boundary (gfc_loopinfo *, stmtblock_t *);
/* Initialize the scalarization loop parameters. */
void gfc_conv_loop_setup (gfc_loopinfo *, locus *);
+/* Set each array's delta. */
+void gfc_set_delta (gfc_loopinfo *);
+/* Create and register a new gfc_ss for the loop's temporary. */
+void gfc_make_loop_temp_ss (tree, tree, gfc_loopinfo *);
/* Resolve array assignment dependencies. */
void gfc_conv_resolve_dependencies (gfc_loopinfo *, gfc_ss *, gfc_ss *);
/* Build a null array descriptor constructor. */
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 09b98d0..4b40327 100644
--- a/trans-expr.c
+++ b/trans-expr.c
@@ -83,6 +83,7 @@ void
gfc_advance_se_ss_chain (gfc_se * se)
{
gfc_se *p;
+ gfc_ss *ss;
gcc_assert (se != NULL && se->ss != NULL && se->ss != gfc_ss_terminator);
@@ -91,9 +92,18 @@ gfc_advance_se_ss_chain (gfc_se * se)
while (p != NULL)
{
/* Simple consistency check. */
- gcc_assert (p->parent == NULL || p->parent->ss == p->ss);
+ gcc_assert (p->parent == NULL || p->parent->ss == p->ss
+ || p->parent->ss->nested_ss == p->ss);
+
+ /* If we were in a nested loop, the next scalarized expression can be
+ on the parent ss' next pointer. Thus we should not take the next
+ pointer blindly, but rather go up one nest level as long as next
+ is the end of chain. */
+ ss = p->ss;
+ while (ss->next == gfc_ss_terminator && ss->parent != NULL)
+ ss = ss->parent;
- p->ss = p->ss->next;
+ p->ss = ss->next;
p = p->parent;
}
@@ -613,6 +623,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 +633,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 +2373,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;
@@ -2395,21 +2409,18 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77,
|| GFC_DESCRIPTOR_TYPE_P (base_type))
base_type = gfc_get_element_type (base_type);
- loop.temp_ss = gfc_get_temp_ss (base_type, ((expr->ts.type == BT_CHARACTER)
- ? expr->ts.u.cl->backend_decl
- : NULL),
- loop.dimen);
+ gfc_make_loop_temp_ss (base_type, (expr->ts.type == BT_CHARACTER)
+ ? expr->ts.u.cl->backend_decl
+ : NULL,
+ &loop);
- parmse->string_length = loop.temp_ss->string_length;
-
- /* Associate the SS with the loop. */
- gfc_add_ss_to_loop (&loop, loop.temp_ss);
+ parmse->string_length = loop.temp_ss->info->string_length;
/* Setup the scalarizing loops. */
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 +2499,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 +2865,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 +2904,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 +2917,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,12 +2990,23 @@ 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);
- gfc_conv_expr_reference (&parmse, e);
parm_kind = ELEMENTAL;
+
+ if (se->ss->dimen > 0
+ && se->ss->info->data.array.ref == NULL)
+ {
+ gfc_conv_tmp_array_ref (&parmse);
+ if (e->ts.type == BT_CHARACTER)
+ gfc_conv_string_parameter (&parmse);
+ else
+ parmse.expr = gfc_build_addr_expr (NULL_TREE, parmse.expr);
+ }
+ else
+ gfc_conv_expr_reference (&parmse, e);
}
else
{
@@ -3582,7 +3604,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);
@@ -3602,9 +3624,10 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
returns a pointer, the temporary will be a shallow copy and
mustn't be deallocated. */
callee_alloc = comp->attr.allocatable || comp->attr.pointer;
- gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, info, tmp,
- NULL_TREE, false, !comp->attr.pointer,
- callee_alloc, &se->ss->expr->where);
+ gfc_trans_create_temp_array (&se->pre, &se->post, se->ss,
+ tmp, NULL_TREE, false,
+ !comp->attr.pointer, callee_alloc,
+ &se->ss->info->expr->where);
/* Pass the temporary as the first argument. */
result = info->descriptor;
@@ -3617,7 +3640,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);
@@ -3637,9 +3660,10 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
returns a pointer, the temporary will be a shallow copy and
mustn't be deallocated. */
callee_alloc = sym->attr.allocatable || sym->attr.pointer;
- gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, info, tmp,
- NULL_TREE, false, !sym->attr.pointer,
- callee_alloc, &se->ss->expr->where);
+ gfc_trans_create_temp_array (&se->pre, &se->post, se->ss,
+ tmp, NULL_TREE, false,
+ !sym->attr.pointer, callee_alloc,
+ &se->ss->info->expr->where);
/* Pass the temporary as the first argument. */
result = info->descriptor;
@@ -4237,8 +4261,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);
}
@@ -4342,6 +4369,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;
@@ -4365,19 +4393,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. */
@@ -4420,8 +4449,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);
@@ -4817,15 +4846,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;
}
@@ -4942,10 +4978,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. */
@@ -6150,7 +6188,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 83fc4fc..973f912 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);
@@ -2557,6 +2557,20 @@ gfc_conv_intrinsic_count (gfc_se * se, gfc_expr * expr)
se->expr = resvar;
}
+
+/* Update given gfc_se to have ss component pointing to the nested gfc_ss
+ struct and return the corresponding loopinfo. */
+
+static gfc_loopinfo *
+enter_nested_loop (gfc_se *se)
+{
+ se->ss = se->ss->nested_ss;
+ gcc_assert (se->ss == se->ss->loop->ss);
+
+ return se->ss->loop;
+}
+
+
/* Inline implementation of the sum and product intrinsics. */
static void
gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
@@ -2568,20 +2582,23 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
stmtblock_t body;
stmtblock_t block;
tree tmp;
- gfc_loopinfo loop;
- gfc_actual_arglist *actual;
- gfc_ss *arrayss;
- gfc_ss *maskss;
+ gfc_loopinfo loop, *ploop;
+ gfc_actual_arglist *arg_array, *arg_mask;
+ gfc_ss *arrayss = NULL;
+ gfc_ss *maskss = NULL;
gfc_se arrayse;
gfc_se maskse;
+ gfc_se *parent_se;
gfc_expr *arrayexpr;
gfc_expr *maskexpr;
- if (se->ss)
+ if (expr->rank > 0)
{
- gfc_conv_intrinsic_funcall (se, expr);
- return;
+ gcc_assert (gfc_inline_intrinsic_function_p (expr));
+ parent_se = se;
}
+ else
+ parent_se = NULL;
type = gfc_typenode_for_spec (&expr->ts);
/* Initialize the result. */
@@ -2608,52 +2625,66 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
gfc_add_modify (&se->pre, resvar, tmp);
- /* Walk the arguments. */
- actual = expr->value.function.actual;
- arrayexpr = actual->expr;
- arrayss = gfc_walk_expr (arrayexpr);
- gcc_assert (arrayss != gfc_ss_terminator);
+ arg_array = expr->value.function.actual;
+
+ arrayexpr = arg_array->expr;
if (op == NE_EXPR || norm2)
/* PARITY and NORM2. */
maskexpr = NULL;
else
{
- actual = actual->next->next;
- gcc_assert (actual);
- maskexpr = actual->expr;
+ arg_mask = arg_array->next->next;
+ gcc_assert (arg_mask != NULL);
+ maskexpr = arg_mask->expr;
}
- if (maskexpr && maskexpr->rank != 0)
+ if (expr->rank == 0)
{
- maskss = gfc_walk_expr (maskexpr);
- gcc_assert (maskss != gfc_ss_terminator);
+ /* Walk the arguments. */
+ arrayss = gfc_walk_expr (arrayexpr);
+ gcc_assert (arrayss != gfc_ss_terminator);
+
+ if (maskexpr && maskexpr->rank > 0)
+ {
+ maskss = gfc_walk_expr (maskexpr);
+ gcc_assert (maskss != gfc_ss_terminator);
+ }
+ else
+ maskss = NULL;
+
+ /* Initialize the scalarizer. */
+ gfc_init_loopinfo (&loop);
+ gfc_add_ss_to_loop (&loop, arrayss);
+ if (maskexpr && maskexpr->rank > 0)
+ gfc_add_ss_to_loop (&loop, maskss);
+
+ /* Initialize the loop. */
+ gfc_conv_ss_startstride (&loop);
+ gfc_conv_loop_setup (&loop, &expr->where);
+
+ gfc_mark_ss_chain_used (arrayss, 1);
+ if (maskexpr && maskexpr->rank > 0)
+ gfc_mark_ss_chain_used (maskss, 1);
+
+ ploop = &loop;
}
else
- maskss = NULL;
-
- /* Initialize the scalarizer. */
- gfc_init_loopinfo (&loop);
- gfc_add_ss_to_loop (&loop, arrayss);
- if (maskss)
- gfc_add_ss_to_loop (&loop, maskss);
+ /* All the work has been done in the parent loops. */
+ ploop = enter_nested_loop (se);
- /* Initialize the loop. */
- gfc_conv_ss_startstride (&loop);
- gfc_conv_loop_setup (&loop, &expr->where);
+ gcc_assert (ploop);
- gfc_mark_ss_chain_used (arrayss, 1);
- if (maskss)
- gfc_mark_ss_chain_used (maskss, 1);
/* Generate the loop body. */
- gfc_start_scalarized_body (&loop, &body);
+ gfc_start_scalarized_body (ploop, &body);
/* If we have a mask, only add this element if the mask is set. */
- if (maskss)
+ if (maskexpr && maskexpr->rank > 0)
{
- gfc_init_se (&maskse, NULL);
- gfc_copy_loopinfo_to_se (&maskse, &loop);
- maskse.ss = maskss;
+ gfc_init_se (&maskse, parent_se);
+ gfc_copy_loopinfo_to_se (&maskse, ploop);
+ if (expr->rank == 0)
+ maskse.ss = maskss;
gfc_conv_expr_val (&maskse, maskexpr);
gfc_add_block_to_block (&body, &maskse.pre);
@@ -2663,9 +2694,10 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
gfc_init_block (&block);
/* Do the actual summation/product. */
- gfc_init_se (&arrayse, NULL);
- gfc_copy_loopinfo_to_se (&arrayse, &loop);
- arrayse.ss = arrayss;
+ gfc_init_se (&arrayse, parent_se);
+ gfc_copy_loopinfo_to_se (&arrayse, ploop);
+ if (expr->rank == 0)
+ arrayse.ss = arrayss;
gfc_conv_expr_val (&arrayse, arrayexpr);
gfc_add_block_to_block (&block, &arrayse.pre);
@@ -2740,7 +2772,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
gfc_add_block_to_block (&block, &arrayse.post);
- if (maskss)
+ if (maskexpr && maskexpr->rank > 0)
{
/* We enclose the above in if (mask) {...} . */
@@ -2752,30 +2784,43 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
tmp = gfc_finish_block (&block);
gfc_add_expr_to_block (&body, tmp);
- gfc_trans_scalarizing_loops (&loop, &body);
+ gfc_trans_scalarizing_loops (ploop, &body);
/* For a scalar mask, enclose the loop in an if statement. */
- if (maskexpr && maskss == NULL)
+ if (maskexpr && maskexpr->rank == 0)
{
- gfc_init_se (&maskse, NULL);
- gfc_conv_expr_val (&maskse, maskexpr);
gfc_init_block (&block);
- gfc_add_block_to_block (&block, &loop.pre);
- gfc_add_block_to_block (&block, &loop.post);
+ gfc_add_block_to_block (&block, &ploop->pre);
+ gfc_add_block_to_block (&block, &ploop->post);
tmp = gfc_finish_block (&block);
- tmp = build3_v (COND_EXPR, maskse.expr, tmp,
- build_empty_stmt (input_location));
+ if (expr->rank > 0)
+ {
+ tmp = build3_v (COND_EXPR, se->ss->info->data.scalar.value, tmp,
+ build_empty_stmt (input_location));
+ gfc_advance_se_ss_chain (se);
+ }
+ else
+ {
+ gcc_assert (expr->rank == 0);
+ gfc_init_se (&maskse, NULL);
+ gfc_conv_expr_val (&maskse, maskexpr);
+ tmp = build3_v (COND_EXPR, maskse.expr, tmp,
+ build_empty_stmt (input_location));
+ }
+
gfc_add_expr_to_block (&block, tmp);
gfc_add_block_to_block (&se->pre, &block);
+ gcc_assert (se->post.head == NULL);
}
else
{
- gfc_add_block_to_block (&se->pre, &loop.pre);
- gfc_add_block_to_block (&se->pre, &loop.post);
+ gfc_add_block_to_block (&se->pre, &ploop->pre);
+ gfc_add_block_to_block (&se->pre, &ploop->post);
}
- gfc_cleanup_loop (&loop);
+ if (expr->rank == 0)
+ gfc_cleanup_loop (ploop);
if (norm2)
{
@@ -3061,6 +3106,23 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
/* Initialize the loop. */
gfc_conv_ss_startstride (&loop);
+
+ /* The code generated can have more than one loop in sequence (see the
+ comment at the function header). This doesn't work well with the
+ scalarizer, which changes arrays' offset when the scalarization loops
+ are generated (see gfc_trans_preloop_setup). Fortunately, {min,max}loc
+ are currently inlined in the scalar case only (for which loop is of rank
+ one). As there is no dependency to care about in that case, there is no
+ temporary, so that we can use the scalarizer temporary code to handle
+ multiple loops. Thus, we set temp_dim here, we call gfc_mark_ss_chain_used
+ with flag=3 later, and we use gfc_trans_scalarized_loop_boundary even later
+ to restore offset.
+ TODO: this prevents inlining of rank > 0 minmaxloc calls, so this
+ should eventually go away. We could either create two loops properly,
+ or find another way to save/restore the array offsets between the two
+ loops (without conflicting with temporary management), or use a single
+ loop minmaxloc implementation. See PR 31067. */
+ loop.temp_dim = loop.dimen;
gfc_conv_loop_setup (&loop, &expr->where);
gcc_assert (loop.dimen == 1);
@@ -3090,9 +3152,17 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
TREE_USED (lab2) = 1;
}
- gfc_mark_ss_chain_used (arrayss, 1);
+ /* An offset must be added to the loop
+ counter to obtain the required position. */
+ gcc_assert (loop.from[0]);
+
+ tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+ gfc_index_one_node, loop.from[0]);
+ gfc_add_modify (&loop.pre, offset, tmp);
+
+ gfc_mark_ss_chain_used (arrayss, lab1 ? 3 : 1);
if (maskss)
- gfc_mark_ss_chain_used (maskss, 1);
+ gfc_mark_ss_chain_used (maskss, lab1 ? 3 : 1);
/* Generate the loop body. */
gfc_start_scalarized_body (&loop, &body);
@@ -3123,16 +3193,6 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
/* Assign the value to the limit... */
gfc_add_modify (&ifblock, limit, arrayse.expr);
- /* Remember where we are. An offset must be added to the loop
- counter to obtain the required position. */
- if (loop.from[0])
- tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
- gfc_index_one_node, loop.from[0]);
- else
- tmp = gfc_index_one_node;
-
- gfc_add_modify (&block, offset, tmp);
-
if (nonempty == NULL && HONOR_NANS (DECL_MODE (limit)))
{
stmtblock_t ifblock2;
@@ -3188,7 +3248,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
if (lab1)
{
- gfc_trans_scalarized_loop_end (&loop, 0, &body);
+ gfc_trans_scalarized_loop_boundary (&loop, &body);
if (HONOR_NANS (DECL_MODE (limit)))
{
@@ -3203,7 +3263,6 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
gfc_add_expr_to_block (&loop.code[0], build1_v (GOTO_EXPR, lab2));
gfc_add_expr_to_block (&loop.code[0], build1_v (LABEL_EXPR, lab1));
- gfc_start_block (&body);
/* If we have a mask, only check this element if the mask is set. */
if (maskss)
@@ -3232,16 +3291,6 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
/* Assign the value to the limit... */
gfc_add_modify (&ifblock, limit, arrayse.expr);
- /* Remember where we are. An offset must be added to the loop
- counter to obtain the required position. */
- if (loop.from[0])
- tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
- gfc_index_one_node, loop.from[0]);
- else
- tmp = gfc_index_one_node;
-
- gfc_add_modify (&block, offset, tmp);
-
tmp = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (pos),
loop.loopvar[0], offset);
gfc_add_modify (&ifblock, pos, tmp);
@@ -3518,6 +3567,22 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op)
/* Initialize the loop. */
gfc_conv_ss_startstride (&loop);
+
+ /* The code generated can have more than one loop in sequence (see the
+ comment at the function header). This doesn't work well with the
+ scalarizer, which changes arrays' offset when the scalarization loops
+ are generated (see gfc_trans_preloop_setup). Fortunately, {min,max}val
+ are currently inlined in the scalar case only. As there is no dependency
+ to care about in that case, there is no temporary, so that we can use the
+ scalarizer temporary code to handle multiple loops. Thus, we set temp_dim
+ here, we call gfc_mark_ss_chain_used with flag=3 later, and we use
+ gfc_trans_scalarized_loop_boundary even later to restore offset.
+ TODO: this prevents inlining of rank > 0 minmaxval calls, so this
+ should eventually go away. We could either create two loops properly,
+ or find another way to save/restore the array offsets between the two
+ loops (without conflicting with temporary management), or use a single
+ loop minmaxval implementation. See PR 31067. */
+ loop.temp_dim = loop.dimen;
gfc_conv_loop_setup (&loop, &expr->where);
if (nonempty == NULL && maskss == NULL
@@ -3549,9 +3614,9 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op)
}
}
- gfc_mark_ss_chain_used (arrayss, 1);
+ gfc_mark_ss_chain_used (arrayss, lab ? 3 : 1);
if (maskss)
- gfc_mark_ss_chain_used (maskss, 1);
+ gfc_mark_ss_chain_used (maskss, lab ? 3 : 1);
/* Generate the loop body. */
gfc_start_scalarized_body (&loop, &body);
@@ -3661,15 +3726,13 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op)
if (lab)
{
- gfc_trans_scalarized_loop_end (&loop, 0, &body);
+ gfc_trans_scalarized_loop_boundary (&loop, &body);
tmp = fold_build3_loc (input_location, COND_EXPR, type, nonempty,
nan_cst, huge_cst);
gfc_add_modify (&loop.code[0], limit, tmp);
gfc_add_expr_to_block (&loop.code[0], build1_v (LABEL_EXPR, lab));
- gfc_start_block (&body);
-
/* If we have a mask, only add this element if the mask is set. */
if (maskss)
{
@@ -5269,14 +5332,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
@@ -5501,9 +5564,8 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr)
/* Build a destination descriptor, using the pointer, source, as the
data field. */
- gfc_trans_create_temp_array (&se->pre, &se->post, se->loop,
- info, mold_type, NULL_TREE, false, true, false,
- &expr->where);
+ gfc_trans_create_temp_array (&se->pre, &se->post, se->ss, mold_type,
+ NULL_TREE, false, true, false, &expr->where);
/* Cast the pointer to the result. */
tmp = gfc_conv_descriptor_data_get (info->descriptor);
@@ -6634,7 +6696,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 +6815,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... */
@@ -6780,12 +6840,127 @@ walk_inline_intrinsic_transpose (gfc_ss *ss, gfc_expr *expr)
}
+/* Move the given dimension of the given gfc_ss list to a nested gfc_ss list.
+ This has the side effect of reversing the nested list, so there is no
+ need to call gfc_reverse_ss on it (the given list is assumed not to be
+ reversed yet). */
+
+static gfc_ss *
+nest_loop_dimension (gfc_ss *ss, int dim)
+{
+ int ss_dim, i;
+ gfc_ss *new_ss, *prev_ss = gfc_ss_terminator;
+ gfc_loopinfo *new_loop;
+
+ gcc_assert (ss != gfc_ss_terminator);
+
+ for (; ss != gfc_ss_terminator; ss = ss->next)
+ {
+ new_ss = gfc_get_ss ();
+ new_ss->next = prev_ss;
+ new_ss->parent = ss;
+ new_ss->info = ss->info;
+ new_ss->info->refcount++;
+ if (ss->dimen != 0)
+ {
+ gcc_assert (ss->info->type != GFC_SS_SCALAR
+ && ss->info->type != GFC_SS_REFERENCE);
+
+ new_ss->dimen = 1;
+ new_ss->dim[0] = ss->dim[dim];
+
+ gcc_assert (dim < ss->dimen);
+
+ ss_dim = --ss->dimen;
+ for (i = dim; i < ss_dim; i++)
+ ss->dim[i] = ss->dim[i + 1];
+
+ ss->dim[ss_dim] = 0;
+ }
+ prev_ss = new_ss;
+
+ if (ss->nested_ss)
+ {
+ ss->nested_ss->parent = new_ss;
+ new_ss->nested_ss = ss->nested_ss;
+ }
+ ss->nested_ss = new_ss;
+ }
+
+ new_loop = gfc_get_loopinfo ();
+ gfc_init_loopinfo (new_loop);
+
+ gcc_assert (prev_ss != NULL);
+ gcc_assert (prev_ss != gfc_ss_terminator);
+ gfc_add_ss_to_loop (new_loop, prev_ss);
+ return new_ss->parent;
+}
+
+
+/* Create the gfc_ss list for the SUM/PRODUCT arguments when the function
+ is to be inlined. */
+
+static gfc_ss *
+walk_inline_intrinsic_arith (gfc_ss *ss, gfc_expr *expr)
+{
+ gfc_ss *tmp_ss, *tail, *array_ss;
+ gfc_actual_arglist *arg1, *arg2, *arg3;
+ int sum_dim;
+ bool scalar_mask = false;
+
+ /* The rank of the result will be determined later. */
+ arg1 = expr->value.function.actual;
+ arg2 = arg1->next;
+ arg3 = arg2->next;
+ gcc_assert (arg3 != NULL);
+
+ if (expr->rank == 0)
+ return ss;
+
+ tmp_ss = gfc_ss_terminator;
+
+ if (arg3->expr)
+ {
+ gfc_ss *mask_ss;
+
+ mask_ss = gfc_walk_subexpr (tmp_ss, arg3->expr);
+ if (mask_ss == tmp_ss)
+ scalar_mask = 1;
+
+ tmp_ss = mask_ss;
+ }
+
+ array_ss = gfc_walk_subexpr (tmp_ss, arg1->expr);
+ gcc_assert (array_ss != tmp_ss);
+
+ /* Odd thing: If the mask is scalar, it is used by the frontend after
+ the array (to make it array around the nested loop). Thus it shall
+ be after array_ss once the gfc_ss list is reversed. */
+ if (scalar_mask)
+ tmp_ss = gfc_get_scalar_ss (array_ss, arg3->expr);
+ else
+ tmp_ss = array_ss;
+
+ /* "Hide" the dimension on which we will sum in the first arg's scalarization
+ chain. */
+ sum_dim = mpz_get_si (arg2->expr->value.integer) - 1;
+ tail = nest_loop_dimension (tmp_ss, sum_dim);
+ tail->next = ss;
+
+ return tmp_ss;
+}
+
+
static gfc_ss *
walk_inline_intrinsic_function (gfc_ss * ss, gfc_expr * expr)
{
switch (expr->value.function.isym->id)
{
+ case GFC_ISYM_PRODUCT:
+ case GFC_ISYM_SUM:
+ return walk_inline_intrinsic_arith (ss, expr);
+
case GFC_ISYM_TRANSPOSE:
return walk_inline_intrinsic_transpose (ss, expr);
@@ -6802,7 +6977,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:
@@ -6847,11 +7022,26 @@ gfc_walk_intrinsic_libfunc (gfc_ss * ss, gfc_expr * expr)
bool
gfc_inline_intrinsic_function_p (gfc_expr *expr)
{
+ gfc_actual_arglist *args;
+
if (!expr->value.function.isym)
return false;
switch (expr->value.function.isym->id)
{
+ case GFC_ISYM_PRODUCT:
+ case GFC_ISYM_SUM:
+ /* Disable inline expansion if code size matters. */
+ if (optimize_size)
+ return false;
+
+ args = expr->value.function.actual;
+ /* We need to be able to subset the SUM argument at compile-time. */
+ if (args->next->expr && args->next->expr->expr_type != EXPR_CONSTANT)
+ return false;
+
+ return true;
+
case GFC_ISYM_TRANSPOSE:
return true;
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 c71eeec..0d793f9 100644
--- a/trans-stmt.c
+++ b/trans-stmt.c
@@ -178,6 +178,41 @@ gfc_trans_entry (gfc_code * code)
}
+/* Replace a gfc_ss structure by another both in the gfc_se struct
+ and the gfc_loopinfo struct. This is used in gfc_conv_elemental_dependencies
+ to replace a variable ss by the corresponding temporary. */
+
+static void
+replace_ss (gfc_se *se, gfc_ss *old_ss, gfc_ss *new_ss)
+{
+ gfc_ss **sess, **loopss;
+
+ /* The old_ss is a ss for a single variable. */
+ gcc_assert (old_ss->info->type == GFC_SS_SECTION);
+
+ for (sess = &(se->ss); *sess != gfc_ss_terminator; sess = &((*sess)->next))
+ if (*sess == old_ss)
+ break;
+ gcc_assert (*sess != gfc_ss_terminator);
+
+ *sess = new_ss;
+ new_ss->next = old_ss->next;
+
+
+ for (loopss = &(se->loop->ss); *loopss != gfc_ss_terminator;
+ loopss = &((*loopss)->loop_chain))
+ if (*loopss == old_ss)
+ break;
+ gcc_assert (*loopss != gfc_ss_terminator);
+
+ *loopss = new_ss;
+ new_ss->loop_chain = old_ss->loop_chain;
+ new_ss->loop = old_ss->loop;
+
+ gfc_free_ss (old_ss);
+}
+
+
/* Check for dependencies between INTENT(IN) and INTENT(OUT) arguments of
elemental subroutines. Make temporaries for output arguments if any such
dependencies are found. Output arguments are chosen because internal_unpack
@@ -190,15 +225,10 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
gfc_actual_arglist *arg0;
gfc_expr *e;
gfc_formal_arglist *formal;
- gfc_loopinfo tmp_loop;
gfc_se parmse;
gfc_ss *ss;
- gfc_ss_info *info;
gfc_symbol *fsym;
- gfc_ref *ref;
- int n;
tree data;
- tree offset;
tree size;
tree tmp;
@@ -217,14 +247,9 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
continue;
/* Obtain the info structure for the current argument. */
- info = NULL;
for (ss = loopse->ss; ss && ss != gfc_ss_terminator; ss = ss->next)
- {
- if (ss->expr != e)
- continue;
- info = &ss->data.info;
+ if (ss->info->expr == e)
break;
- }
/* If there is a dependency, create a temporary and use it
instead of the variable. */
@@ -237,49 +262,17 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
{
tree initial, temptype;
stmtblock_t temp_post;
+ gfc_ss *tmp_ss;
- /* 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.to[n] = loopse->loop->to[n];
- tmp_loop.from[n] = loopse->loop->from[n];
- tmp_loop.order[n] = loopse->loop->order[n];
- }
+ tmp_ss = gfc_get_array_ss (gfc_ss_terminator, NULL, ss->dimen,
+ GFC_SS_SECTION);
+ gfc_mark_ss_chain_used (tmp_ss, 1);
+ tmp_ss->info->expr = ss->info->expr;
+ replace_ss (loopse, ss, tmp_ss);
/* Obtain the argument descriptor for unpacking. */
gfc_init_se (&parmse, NULL);
parmse.want_pointer = 1;
-
- /* The scalarizer introduces some specific peculiarities when
- handling elemental subroutines; the stride can be needed up to
- the dim_array - 1, rather than dim_loop - 1 to calculate
- offsets outside the loop. For this reason, we make sure that
- the descriptor has the dimensionality of the array by converting
- trailing elements into ranges with end = start. */
- for (ref = e->ref; ref; ref = ref->next)
- if (ref->type == REF_ARRAY && ref->u.ar.type == AR_SECTION)
- break;
-
- if (ref)
- {
- bool seen_range = false;
- for (n = 0; n < ref->u.ar.dimen; n++)
- {
- if (ref->u.ar.dimen_type[n] == DIMEN_RANGE)
- seen_range = true;
-
- if (!seen_range
- || ref->u.ar.dimen_type[n] != DIMEN_ELEMENT)
- continue;
-
- ref->u.ar.end[n] = gfc_copy_expr (ref->u.ar.start[n]);
- ref->u.ar.dimen_type[n] = DIMEN_RANGE;
- }
- }
-
gfc_conv_expr_descriptor (&parmse, e, gfc_walk_expr (e));
gfc_add_block_to_block (&se->pre, &parmse.pre);
@@ -309,29 +302,15 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
size = gfc_create_var (gfc_array_index_type, NULL);
data = gfc_create_var (pvoid_type_node, NULL);
gfc_init_block (&temp_post);
- tmp = gfc_trans_create_temp_array (&se->pre, &temp_post,
- &tmp_loop, info, temptype,
- initial,
- false, true, false,
- &arg->expr->where);
+ tmp = gfc_trans_create_temp_array (&se->pre, &temp_post, tmp_ss,
+ temptype, initial, false, true,
+ false, &arg->expr->where);
gfc_add_modify (&se->pre, size, tmp);
- tmp = fold_convert (pvoid_type_node, info->data);
+ tmp = fold_convert (pvoid_type_node, tmp_ss->info->data.array.data);
gfc_add_modify (&se->pre, data, tmp);
- /* Calculate the offset for the temporary. */
- offset = gfc_index_zero_node;
- for (n = 0; n < info->dimen; n++)
- {
- tmp = gfc_conv_descriptor_stride_get (info->descriptor,
- gfc_rank_cst[n]);
- tmp = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type,
- loopse->loop->from[n], tmp);
- offset = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type, offset, tmp);
- }
- info->offset = gfc_create_var (gfc_array_index_type, NULL);
- gfc_add_modify (&se->pre, info->offset, offset);
+ /* Update other ss' delta. */
+ gfc_set_delta (loopse->loop);
/* Copy the result back using unpack. */
tmp = build_call_expr_loc (input_location,
@@ -3306,7 +3285,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 +3367,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 +4027,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 +4041,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 +4480,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 +4495,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..22033d3 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,82 @@ 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
{
+ int refcount;
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;
+ /* Non-null if the ss is part of a nested loop. */
+ struct gfc_ss *parent;
+
+ /* If the evaluation of an expression requires a nested loop (for example
+ if the sum intrinsic is evaluated inline), this points to the nested
+ loop's gfc_ss. */
+ struct gfc_ss *nested_ss;
+
+ /* The loop this gfc_ss is in. */
+ struct gfc_loopinfo *loop;
+
+ unsigned is_alloc_lhs:1;
}
gfc_ss;
#define gfc_get_ss() XCNEW (gfc_ss)
@@ -252,6 +279,12 @@ typedef struct gfc_loopinfo
/* The SS describing the temporary used in an assignment. */
gfc_ss *temp_ss;
+ /* Non-null if this loop is nested in another one. */
+ struct gfc_loopinfo *parent;
+
+ /* Chain of nested loops. */
+ struct gfc_loopinfo *nested, *next;
+
/* The scalarization loop index variables. */
tree loopvar[GFC_MAX_DIMENSIONS];
@@ -277,6 +310,7 @@ typedef struct gfc_loopinfo
}
gfc_loopinfo;
+#define gfc_get_loopinfo() XCNEW (gfc_loopinfo)
/* Information about a symbol that has been shadowed by a temporary. */
typedef struct
@@ -363,9 +397,6 @@ tree gfc_builtin_decl_for_float_kind (enum built_in_function, int);
tree gfc_conv_intrinsic_subroutine (gfc_code *);
void gfc_conv_intrinsic_function (gfc_se *, gfc_expr *);
-/* Is the intrinsic expanded inline. */
-bool gfc_inline_intrinsic_function_p (gfc_expr *);
-
/* Does an intrinsic map directly to an external library call
This is true for array-returning intrinsics, unless
gfc_inline_intrinsic_function_p returns true. */
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [19/66] inline sum and product: Interfaces changes: dim_ok
2011-10-28 0:02 ` [Patch, fortran] [13..19/66] inline sum and product: Interfaces changes Mikael Morin
` (5 preceding siblings ...)
2011-10-27 23:43 ` [Patch, fortran] [18/66] inline sum and product: Interfaces changes: get_array_ref_dim Mikael Morin
@ 2011-10-27 23:44 ` Mikael Morin
6 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-27 23:44 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 207 bytes --]
Same as previous patch, dim_ok uses dimensions and needs a gfc_ss struct as
argument.
The name is changed to the more descriptive transposed_dims and the logic
is inverted (dim_ok <=> !transposed_dims).
OK?
[-- Attachment #2: pr43829-19.CL --]
[-- Type: text/plain, Size: 214 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (dim_ok, transposed_dims): Rename the former to the
latter. Change argument type. Invert return value.
(gfc_conv_expr_descriptor): Update calls.
[-- Attachment #3: pr43829-19.patch --]
[-- Type: text/x-diff, Size: 1242 bytes --]
diff --git a/trans-array.c b/trans-array.c
index eeed8bb..dc4dccd 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -5659,13 +5659,16 @@ get_array_charlen (gfc_expr *expr, gfc_se *se)
/* Helper function to check dimensions. */
static bool
-dim_ok (gfc_ss_info *info)
+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)
- return false;
- return true;
+ return true;
+ return false;
}
/* Convert an array for passing as an actual argument. Expressions and
@@ -5752,7 +5755,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
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)
{
@@ -5949,7 +5952,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * 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;
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [61/66] inline sum and product: Prevent regressions: Disable frontend optimizations.
2011-10-28 0:22 ` [Patch, fortran] [54..61/66] inline sum and product: Prevent regressions Mikael Morin
` (3 preceding siblings ...)
2011-10-27 23:43 ` [Patch, fortran] [54/66] inline sum and product: Prevent regressions: Add dependency checking Mikael Morin
@ 2011-10-28 0:01 ` Mikael Morin
4 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-28 0:01 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 246 bytes --]
Not exactly a regression, but frontend optimizations can make things worse
by forcing temporary generation.
This disables common function elimination and binary operator optimization
for inline intrinsics.
I hope I didn't miss anything else.
OK?
[-- Attachment #2: pr43829-61.CL --]
[-- Type: text/plain, Size: 250 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* frontend-passes.c (cfe_register_funcs): Return early in the case
of an inline intrinsic function.
(optimize_binop_array_assignment): Skip optimization in the case of
an inline intrinsic function.
[-- Attachment #3: pr43829-61.patch --]
[-- Type: text/x-diff, Size: 1103 bytes --]
diff --git a/frontend-passes.c b/frontend-passes.c
index 5b1a644..a19f22d 100644
--- a/frontend-passes.c
+++ b/frontend-passes.c
@@ -203,8 +203,8 @@ cfe_register_funcs (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
/* Conversions are handled on the fly by the middle end,
transpose during trans-* stages and TRANSFER by the middle end. */
if ((*e)->value.function.isym->id == GFC_ISYM_CONVERSION
- || (*e)->value.function.isym->id == GFC_ISYM_TRANSPOSE
- || (*e)->value.function.isym->id == GFC_ISYM_TRANSFER)
+ || (*e)->value.function.isym->id == GFC_ISYM_TRANSFER
+ || gfc_inline_intrinsic_function_p (*e))
return 0;
/* Don't create an array temporary for elemental functions,
@@ -567,7 +567,8 @@ optimize_binop_array_assignment (gfc_code *c, gfc_expr **rhs, bool seen_op)
&& ! (e->value.function.isym
&& (e->value.function.isym->elemental
|| e->ts.type != c->expr1->ts.type
- || e->ts.kind != c->expr1->ts.kind)))
+ || e->ts.kind != c->expr1->ts.kind))
+ && ! gfc_inline_intrinsic_function_p (e))
{
gfc_code *n;
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [13..19/66] inline sum and product: Interfaces changes
2011-10-27 23:43 [Patch, fortran] [00/66] PR fortran/43829 Inline sum and product (AKA scalarization of reductions) Mikael Morin
` (4 preceding siblings ...)
2011-10-27 23:36 ` [Patch, fortran] [01..06/66] inline sum and product: Prepare gfc_trans_preloop_setup Mikael Morin
@ 2011-10-28 0:02 ` Mikael Morin
2011-10-27 23:31 ` [Patch, fortran] [14/66] inline sum and product: Interfaces changes: gfc_trans_array_bound_check, gfc_conv_array_index_offset Mikael Morin
` (6 more replies)
2011-10-28 0:22 ` [Patch, fortran] [54..61/66] inline sum and product: Prevent regressions Mikael Morin
` (2 subsequent siblings)
8 siblings, 7 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-28 0:02 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 903 bytes --]
This is another preliminary change, to update function interfaces requiring
it, so that afterwards structures can be changed internally without impacting
function interfaces.
The main reason for these changes is that gfc_ss_info's dim and dimen fields
are to be moved to struct gfc_ss. Thus functions having a pointer to type
gfc_ss_info as argument will lose access to those fields; the argument needs to
be changed to a gfc_ss type (patches 14, 16, 17, 18, 19).
Patches 13 and 15 are additional cleanups removing useless or redundant code
They are part of this serie as they also involve interface changes.
Patch 13: gfc_trans_constant_array_constructor.
Patch 14: gfc_trans_array_bound_check, gfc_conv_array_index_offset.
Patch 15: gfc_trans_array_bound_check (follow-up).
Patch 16: gfc_trans_create_temp_array.
Patch 17: gfc_set_vector_loop_bounds.
Patch 18: get_array_ref_dim.
Patch 19: dim_ok.
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [54..61/66] inline sum and product: Prevent regressions.
2011-10-27 23:43 [Patch, fortran] [00/66] PR fortran/43829 Inline sum and product (AKA scalarization of reductions) Mikael Morin
` (5 preceding siblings ...)
2011-10-28 0:02 ` [Patch, fortran] [13..19/66] inline sum and product: Interfaces changes Mikael Morin
@ 2011-10-28 0:22 ` Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [55..56/66] inline sum and product: Prevent regressions: Fix gfc_conv_elemental_dependencies Mikael Morin
` (4 more replies)
2011-10-28 14:35 ` [Patch, fortran] [00/66] PR fortran/43829 Inline sum and product (AKA scalarization of reductions) Jack Howarth
2011-11-01 21:33 ` [Patch, fortran] [00/66] PR fortran/43829 Inline sum and product " Paul Richard Thomas
8 siblings, 5 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-28 0:22 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 482 bytes --]
This is a collection of changes not directly related, but made necessary by
the emergence of regressions in the testsuite without them.
Combined patch not attached, as the separate patches being largely independant,
it is the concatenation of them.
Patch 54 : Enable dependency checking for inline functions.
Patch 55..56: Fix gfc_conv_elemental_dependencies.
Patch 57..59: Fix {min,max}{loc,val}.
Patch 60 : Fix error markers.
Patch 61 : Disable frontend optimizations.
^ permalink raw reply [flat|nested] 69+ messages in thread
* [Patch, fortran] [62/66] inline sum and product: Inline sum: Change conditions.
2011-10-27 23:36 ` [Patch, fortran] [62..66/66] inline sum and product: Inline sum Mikael Morin
` (3 preceding siblings ...)
2011-10-27 23:36 ` [Patch, fortran] [63/66] inline sum and product: Inline sum: Change argument handling Mikael Morin
@ 2011-10-28 0:29 ` Mikael Morin
4 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-28 0:29 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 146 bytes --]
This makes the convention that all conditions are based on arguments presence
and their rank. In the hope that it makes code easier to read.
OK?
[-- Attachment #2: pr43829-62.CL --]
[-- Type: text/plain, Size: 116 bytes --]
2011-10-19 Mikael Morin <mikael@gcc.gnu.org>
* trans-intrinsic.c (gfc_conv_intrinsic_arith): Update conditions.
[-- Attachment #3: pr43829-62.patch --]
[-- Type: text/x-diff, Size: 2003 bytes --]
diff --git a/trans-intrinsic.c b/trans-intrinsic.c
index 3cdc1e0..342d2cb 100644
--- a/trans-intrinsic.c
+++ b/trans-intrinsic.c
@@ -2624,7 +2624,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
maskexpr = actual->expr;
}
- if (maskexpr && maskexpr->rank != 0)
+ if (maskexpr && maskexpr->rank > 0)
{
maskss = gfc_walk_expr (maskexpr);
gcc_assert (maskss != gfc_ss_terminator);
@@ -2635,7 +2635,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
/* Initialize the scalarizer. */
gfc_init_loopinfo (&loop);
gfc_add_ss_to_loop (&loop, arrayss);
- if (maskss)
+ if (maskexpr && maskexpr->rank > 0)
gfc_add_ss_to_loop (&loop, maskss);
/* Initialize the loop. */
@@ -2643,13 +2643,13 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
gfc_conv_loop_setup (&loop, &expr->where);
gfc_mark_ss_chain_used (arrayss, 1);
- if (maskss)
+ if (maskexpr && maskexpr->rank > 0)
gfc_mark_ss_chain_used (maskss, 1);
/* Generate the loop body. */
gfc_start_scalarized_body (&loop, &body);
/* If we have a mask, only add this element if the mask is set. */
- if (maskss)
+ if (maskexpr && maskexpr->rank > 0)
{
gfc_init_se (&maskse, NULL);
gfc_copy_loopinfo_to_se (&maskse, &loop);
@@ -2740,7 +2740,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
gfc_add_block_to_block (&block, &arrayse.post);
- if (maskss)
+ if (maskexpr && maskexpr->rank > 0)
{
/* We enclose the above in if (mask) {...} . */
@@ -2755,7 +2755,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
gfc_trans_scalarizing_loops (&loop, &body);
/* For a scalar mask, enclose the loop in an if statement. */
- if (maskexpr && maskss == NULL)
+ if (maskexpr && maskexpr->rank == 0)
{
gfc_init_se (&maskse, NULL);
gfc_conv_expr_val (&maskse, maskexpr);
^ permalink raw reply [flat|nested] 69+ messages in thread
* Re: [Patch, fortran] [00/66] PR fortran/43829 Inline sum and product (AKA scalarization of reductions)
2011-10-27 23:43 [Patch, fortran] [00/66] PR fortran/43829 Inline sum and product (AKA scalarization of reductions) Mikael Morin
` (6 preceding siblings ...)
2011-10-28 0:22 ` [Patch, fortran] [54..61/66] inline sum and product: Prevent regressions Mikael Morin
@ 2011-10-28 14:35 ` Jack Howarth
2011-10-28 17:25 ` Mikael Morin
2011-11-01 21:33 ` [Patch, fortran] [00/66] PR fortran/43829 Inline sum and product " Paul Richard Thomas
8 siblings, 1 reply; 69+ messages in thread
From: Jack Howarth @ 2011-10-28 14:35 UTC (permalink / raw)
To: Mikael Morin; +Cc: gfortran, GCC patches
Mikael,
The complete patch bootstraps current FSF gcc trunk on x86_64-apple-darwin11 and the resulting
gfortran compiler can compile the Polyhedron 2005 benchmarks using...
Compile Command : gfortran-fsf-4.7 -O3 -ffast-math -funroll-loops -flto -fwhole-program %n.f90 -o %n
without runtime regressions. However I don't seem to see any particular performance improvements with
your patches applied. In fact, a few benchmarks including nf and test_fpu seem to show slower runtimes
(~8-11%). Have you done any benchmarking with and without the proposed patches?
Jack
^ permalink raw reply [flat|nested] 69+ messages in thread
* Re: [Patch, fortran] [00/66] PR fortran/43829 Inline sum and product (AKA scalarization of reductions)
2011-10-28 14:35 ` [Patch, fortran] [00/66] PR fortran/43829 Inline sum and product (AKA scalarization of reductions) Jack Howarth
@ 2011-10-28 17:25 ` Mikael Morin
2011-10-29 16:04 ` [Patch, fortran] [00/66] PR fortran/43829 Inline sum and?product " Jack Howarth
0 siblings, 1 reply; 69+ messages in thread
From: Mikael Morin @ 2011-10-28 17:25 UTC (permalink / raw)
To: fortran; +Cc: Jack Howarth, GCC patches
[-- Attachment #1: Type: text/plain, Size: 1813 bytes --]
On Friday 28 October 2011 15:56:36 Jack Howarth wrote:
> Mikael,
> The complete patch bootstraps current FSF gcc trunk on
> x86_64-apple-darwin11 and the resulting gfortran compiler can compile the
> Polyhedron 2005 benchmarks using...
>
> Compile Command : gfortran-fsf-4.7 -O3 -ffast-math -funroll-loops -flto
> -fwhole-program %n.f90 -o %n
>
> without runtime regressions. However I don't seem to see any particular
> performance improvements with your patches applied. In fact, a few
> benchmarks including nf and test_fpu seem to show slower runtimes
> (~8-11%). Have you done any benchmarking with and without the proposed
> patches? Jack
Not myself, but the previous versions of the patch have been reported to give
sensitive improvement on "tonto" here:
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=43829#c26
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=43829#c35
Since those versions, the array constructor handling has been improved, and a
few mostly cosmetic changes have been applied, so I expect the posted patch to
be on par with the previous ones, possibly slightly better.
Now regarding your regressions, it is quite a lot worse, and quite unexpected.
I have just looked at test_fpu.f90 and nf.f90 from a polyhedron source I have
found at http://www.polyhedron.com/web_images/documents/pb05.zip.
There is no call to product in them, and both use only single-argument sum
calls, which are not (or shouldn't be) impacted by my patch (scalar cases).
Indeed, if I compare the code produced using -fdump-tree-original, there is
zero difference in nf.f90, and in test_fpu.f90 only slight variations which
are very very unlikely to cause the regression you see (see attached diff).
Could you double check your figures, and/or that the regressions are really
caused by my patch?
Mikael
[-- Attachment #2: test_fpu.f90.003t.original.diff --]
[-- Type: text/x-patch, Size: 4850 bytes --]
--- test_fpu.f90.003t.original.master 2011-10-28 18:08:53.000000000 +0200
+++ test_fpu.f90.003t.original.patched 2011-10-28 18:22:28.000000000 +0200
@@ -1929,6 +1929,7 @@
D.2297 = offset.65 + -1;
atmp.64.dim[0].ubound = D.2297;
pos.61 = D.2297 >= 0 ? 1 : 0;
+ offset.62 = 1;
{
integer(kind=8) S.67;
@@ -1936,7 +1937,6 @@
while (1)
{
if (S.67 > D.2297) goto L.133;
- offset.62 = 1;
if (ABS_EXPR <(*(real(kind=8)[0] * restrict) atmp.64.data)[S.67]> > limit.63)
{
limit.63 = ABS_EXPR <(*(real(kind=8)[0] * restrict) atmp.64.data)[S.67]>;
@@ -2406,14 +2406,14 @@
integer(kind=8) D.2457;
integer(kind=8) S.104;
- D.2457 = D.2436 + D.2442;
- D.2458 = stride.45;
+ D.2457 = stride.45;
+ D.2458 = D.2436 + D.2442;
D.2459 = D.2443 * stride.45 + D.2439;
S.104 = 0;
while (1)
{
if (S.104 > D.2444) goto L.149;
- (*(real(kind=8)[0:] * restrict) atmp.103.data)[S.104] = (*b)[(S.104 + D.2454) * D.2458 + D.2457];
+ (*(real(kind=8)[0:] * restrict) atmp.103.data)[S.104] = (*b)[(S.104 + D.2454) * D.2457 + D.2458];
S.104 = S.104 + 1;
}
L.149:;
@@ -2486,13 +2486,13 @@
integer(kind=8) D.2479;
integer(kind=8) S.106;
- D.2479 = D.2473 + D.2476;
- D.2480 = stride.45;
+ D.2479 = stride.45;
+ D.2480 = D.2473 + D.2476;
S.106 = D.2471;
while (1)
{
if (S.106 > D.2472) goto L.152;
- (*b)[(S.106 + D.2477) * D.2480 + D.2479] = (*temp)[S.106 + -1];
+ (*b)[(S.106 + D.2477) * D.2479 + D.2480] = (*temp)[S.106 + -1];
S.106 = S.106 + 1;
}
L.152:;
@@ -2756,13 +2756,13 @@
integer(kind=8) D.2549;
integer(kind=8) S.112;
- D.2549 = D.2543 + D.2546;
- D.2550 = stride.45;
+ D.2549 = stride.45;
+ D.2550 = D.2543 + D.2546;
S.112 = 1;
while (1)
{
if (S.112 > D.2542) goto L.168;
- (*b)[(S.112 + D.2547) * D.2550 + D.2549] = (*temp)[S.112 + -1];
+ (*b)[(S.112 + D.2547) * D.2549 + D.2550] = (*temp)[S.112 + -1];
S.112 = S.112 + 1;
}
L.168:;
@@ -2885,13 +2885,13 @@
integer(kind=8) D.2582;
integer(kind=8) S.115;
- D.2582 = D.2575 + D.2579;
- D.2583 = stride.45;
+ D.2582 = stride.45;
+ D.2583 = D.2575 + D.2579;
S.115 = 1;
while (1)
{
if (S.115 > D.2578) goto L.176;
- (*temp)[S.115 + -1] = (*b)[(S.115 + D.2580) * D.2583 + D.2582];
+ (*temp)[S.115 + -1] = (*b)[(S.115 + D.2580) * D.2582 + D.2583];
S.115 = S.115 + 1;
}
L.176:;
@@ -3348,6 +3348,7 @@
D.2733 = (integer(kind=8)) *n;
D.2734 = (integer(kind=8)) k;
pos.146 = D.2732 <= D.2733 ? 1 : 0;
+ offset.147 = 1 - D.2732;
{
integer(kind=8) D.2736;
integer(kind=8) S.149;
@@ -3357,7 +3358,6 @@
while (1)
{
if (S.149 > D.2733) goto L.191;
- offset.147 = 1 - D.2732;
if (ABS_EXPR <(*b)[S.149 + D.2736]> > limit.148)
{
limit.148 = ABS_EXPR <(*b)[S.149 + D.2736]>;
^ permalink raw reply [flat|nested] 69+ messages in thread
* Re: [Patch, fortran] [00/66] PR fortran/43829 Inline sum and?product (AKA scalarization of reductions)
2011-10-28 17:25 ` Mikael Morin
@ 2011-10-29 16:04 ` Jack Howarth
0 siblings, 0 replies; 69+ messages in thread
From: Jack Howarth @ 2011-10-29 16:04 UTC (permalink / raw)
To: Mikael Morin; +Cc: fortran, GCC patches
On Fri, Oct 28, 2011 at 06:30:35PM +0200, Mikael Morin wrote:
> On Friday 28 October 2011 15:56:36 Jack Howarth wrote:
> > Mikael,
> > The complete patch bootstraps current FSF gcc trunk on
> > x86_64-apple-darwin11 and the resulting gfortran compiler can compile the
> > Polyhedron 2005 benchmarks using...
> >
> > Compile Command : gfortran-fsf-4.7 -O3 -ffast-math -funroll-loops -flto
> > -fwhole-program %n.f90 -o %n
> >
> > without runtime regressions. However I don't seem to see any particular
> > performance improvements with your patches applied. In fact, a few
> > benchmarks including nf and test_fpu seem to show slower runtimes
> > (~8-11%). Have you done any benchmarking with and without the proposed
> > patches? Jack
>
> Not myself, but the previous versions of the patch have been reported to give
> sensitive improvement on "tonto" here:
> http://gcc.gnu.org/bugzilla/show_bug.cgi?id=43829#c26
> http://gcc.gnu.org/bugzilla/show_bug.cgi?id=43829#c35
>
> Since those versions, the array constructor handling has been improved, and a
> few mostly cosmetic changes have been applied, so I expect the posted patch to
> be on par with the previous ones, possibly slightly better.
>
> Now regarding your regressions, it is quite a lot worse, and quite unexpected.
> I have just looked at test_fpu.f90 and nf.f90 from a polyhedron source I have
> found at http://www.polyhedron.com/web_images/documents/pb05.zip.
> There is no call to product in them, and both use only single-argument sum
> calls, which are not (or shouldn't be) impacted by my patch (scalar cases).
> Indeed, if I compare the code produced using -fdump-tree-original, there is
> zero difference in nf.f90, and in test_fpu.f90 only slight variations which
> are very very unlikely to cause the regression you see (see attached diff).
>
> Could you double check your figures, and/or that the regressions are really
> caused by my patch?
Mikeal,
The problem was the quick.par testing with the patch applied. Full standard.par
testing suggests that identical binaries are produced for pb05 (by size anyway)...
Using built-in specs.
COLLECT_GCC=gcc-fsf-4.7
COLLECT_LTO_WRAPPER=/sw/lib/gcc4.7/libexec/gcc/x86_64-apple-darwin11.2.0/4.7.0/lto-wrapper
Target: x86_64-apple-darwin11.2.0
Configured with: ../gcc-4.7-20111028/configure --prefix=/sw --prefix=/sw/lib/gcc4.7 --mandir=/sw/share/man --infodir=/sw/lib/gcc4.7/info --with-build-config=bootstrap-lto --enable-stage1-languages=c,lto --enable-languages=c,c++,fortran,lto,objc,obj-c++,java --with-gmp=/sw --with-libiconv-prefix=/sw --with-ppl=/sw --with-cloog=/sw --with-mpc=/sw --with-system-zlib --x-includes=/usr/X11R6/include --x-libraries=/usr/X11R6/lib --program-suffix=-fsf-4.7 --enable-checking=yes --enable-cloog-backend=isl
Thread model: posix
gcc version 4.7.0 20111028 (experimental) (GCC)
prepatch at r180613
Date & Time : 28 Oct 2011 13:47:42
Test Name : gfortran_lin_O3_wholeprogram
Compile Command : gfortran-fsf-4.7 -O3 -ffast-math -funroll-loops -flto -fwhole-program %n.f90 -o %n
Benchmarks : ac aermod air capacita channel doduc fatigue gas_dyn induct linpk mdbx nf protein rnflow test_fpu tfft
Maximum Times : 2000.0
Target Error % : 0.100
Minimum Repeats : 10
Maximum Repeats : 100
Benchmark Compile Executable Ave Run Number Estim
Name (secs) (bytes) (secs) Repeats Err %
--------- ------- ---------- ------- ------- ------
ac 6.75 55000 8.16 10 0.0522
aermod 119.95 1237720 16.83 13 0.0956
air 18.38 106960 5.77 33 0.0949
capacita 6.48 77240 32.61 17 0.0903
channel 2.21 34904 2.05 19 0.0493
doduc 20.19 196496 25.98 17 0.0978
fatigue 7.20 81616 5.98 16 0.0998
gas_dyn 13.58 119824 4.11 44 0.0854
induct 12.90 145096 12.86 13 0.0936
linpk 1.90 26104 15.51 22 0.0667
mdbx 6.52 81104 11.32 23 0.0995
nf 6.66 71872 27.17 38 0.0891
protein 21.47 127264 31.24 15 0.0726
rnflow 19.51 131056 24.42 19 0.0776
test_fpu 12.09 97272 7.89 22 0.0399
tfft 1.63 22464 1.87 21 0.0169
Geometric Mean Execution Time = 10.54 seconds
postpatch at r180613
Date & Time : 28 Oct 2011 16:42:27
Test Name : gfortran_lin_O3_wholeprogram
Compile Command : gfortran-fsf-4.7 -O3 -ffast-math -funroll-loops -flto -fwhole-program %n.f90 -o %n
Benchmarks : ac aermod air capacita channel doduc fatigue gas_dyn induct linpk mdbx nf protein rnflow test_fpu tfft
Maximum Times : 2000.0
Target Error % : 0.100
Minimum Repeats : 10
Maximum Repeats : 100
Benchmark Compile Executable Ave Run Number Estim
Name (secs) (bytes) (secs) Repeats Err %
--------- ------- ---------- ------- ------- ------
ac 6.44 55000 8.16 10 0.0304
aermod 120.51 1237720 16.88 14 0.0968
air 19.54 106960 5.78 16 0.0774
capacita 6.40 77240 32.58 22 0.0796
channel 2.16 34904 2.05 43 0.0893
doduc 22.76 196496 25.61 18 0.0407
fatigue 6.99 81616 5.99 16 0.0852
gas_dyn 12.92 119824 4.08 28 0.0866
induct 14.28 145096 12.85 12 0.0829
linpk 1.97 26104 15.50 14 0.0722
mdbx 6.52 81104 11.12 20 0.0151
nf 6.44 71872 27.51 39 0.0935
protein 20.86 127264 31.21 12 0.0603
rnflow 20.45 131056 24.40 14 0.0828
test_fpu 12.10 97272 7.89 24 0.0780
tfft 1.63 22464 1.87 18 0.0878
Geometric Mean Execution Time = 10.53 seconds
>
> Mikael
> --- test_fpu.f90.003t.original.master 2011-10-28 18:08:53.000000000 +0200
> +++ test_fpu.f90.003t.original.patched 2011-10-28 18:22:28.000000000 +0200
> @@ -1929,6 +1929,7 @@
> D.2297 = offset.65 + -1;
> atmp.64.dim[0].ubound = D.2297;
> pos.61 = D.2297 >= 0 ? 1 : 0;
> + offset.62 = 1;
> {
> integer(kind=8) S.67;
>
> @@ -1936,7 +1937,6 @@
> while (1)
> {
> if (S.67 > D.2297) goto L.133;
> - offset.62 = 1;
> if (ABS_EXPR <(*(real(kind=8)[0] * restrict) atmp.64.data)[S.67]> > limit.63)
> {
> limit.63 = ABS_EXPR <(*(real(kind=8)[0] * restrict) atmp.64.data)[S.67]>;
> @@ -2406,14 +2406,14 @@
> integer(kind=8) D.2457;
> integer(kind=8) S.104;
>
> - D.2457 = D.2436 + D.2442;
> - D.2458 = stride.45;
> + D.2457 = stride.45;
> + D.2458 = D.2436 + D.2442;
> D.2459 = D.2443 * stride.45 + D.2439;
> S.104 = 0;
> while (1)
> {
> if (S.104 > D.2444) goto L.149;
> - (*(real(kind=8)[0:] * restrict) atmp.103.data)[S.104] = (*b)[(S.104 + D.2454) * D.2458 + D.2457];
> + (*(real(kind=8)[0:] * restrict) atmp.103.data)[S.104] = (*b)[(S.104 + D.2454) * D.2457 + D.2458];
> S.104 = S.104 + 1;
> }
> L.149:;
> @@ -2486,13 +2486,13 @@
> integer(kind=8) D.2479;
> integer(kind=8) S.106;
>
> - D.2479 = D.2473 + D.2476;
> - D.2480 = stride.45;
> + D.2479 = stride.45;
> + D.2480 = D.2473 + D.2476;
> S.106 = D.2471;
> while (1)
> {
> if (S.106 > D.2472) goto L.152;
> - (*b)[(S.106 + D.2477) * D.2480 + D.2479] = (*temp)[S.106 + -1];
> + (*b)[(S.106 + D.2477) * D.2479 + D.2480] = (*temp)[S.106 + -1];
> S.106 = S.106 + 1;
> }
> L.152:;
> @@ -2756,13 +2756,13 @@
> integer(kind=8) D.2549;
> integer(kind=8) S.112;
>
> - D.2549 = D.2543 + D.2546;
> - D.2550 = stride.45;
> + D.2549 = stride.45;
> + D.2550 = D.2543 + D.2546;
> S.112 = 1;
> while (1)
> {
> if (S.112 > D.2542) goto L.168;
> - (*b)[(S.112 + D.2547) * D.2550 + D.2549] = (*temp)[S.112 + -1];
> + (*b)[(S.112 + D.2547) * D.2549 + D.2550] = (*temp)[S.112 + -1];
> S.112 = S.112 + 1;
> }
> L.168:;
> @@ -2885,13 +2885,13 @@
> integer(kind=8) D.2582;
> integer(kind=8) S.115;
>
> - D.2582 = D.2575 + D.2579;
> - D.2583 = stride.45;
> + D.2582 = stride.45;
> + D.2583 = D.2575 + D.2579;
> S.115 = 1;
> while (1)
> {
> if (S.115 > D.2578) goto L.176;
> - (*temp)[S.115 + -1] = (*b)[(S.115 + D.2580) * D.2583 + D.2582];
> + (*temp)[S.115 + -1] = (*b)[(S.115 + D.2580) * D.2582 + D.2583];
> S.115 = S.115 + 1;
> }
> L.176:;
> @@ -3348,6 +3348,7 @@
> D.2733 = (integer(kind=8)) *n;
> D.2734 = (integer(kind=8)) k;
> pos.146 = D.2732 <= D.2733 ? 1 : 0;
> + offset.147 = 1 - D.2732;
> {
> integer(kind=8) D.2736;
> integer(kind=8) S.149;
> @@ -3357,7 +3358,6 @@
> while (1)
> {
> if (S.149 > D.2733) goto L.191;
> - offset.147 = 1 - D.2732;
> if (ABS_EXPR <(*b)[S.149 + D.2736]> > limit.148)
> {
> limit.148 = ABS_EXPR <(*b)[S.149 + D.2736]>;
^ permalink raw reply [flat|nested] 69+ messages in thread
* Re: [Patch, fortran] [06/66] inline sum and product: Prepare gfc_trans_preloop_setup
2011-10-27 23:30 ` [Patch, fortran] [06/66] " Mikael Morin
@ 2011-10-30 9:52 ` Paul Richard Thomas
2011-10-30 21:57 ` Mikael Morin
0 siblings, 1 reply; 69+ messages in thread
From: Paul Richard Thomas @ 2011-10-30 9:52 UTC (permalink / raw)
To: Mikael Morin; +Cc: gfortran, GCC patches
Dear Mikael,
I intend to work my way through your patches, starting this evening.
I'll give you feedback as I go along and will OK the whole package,
rather than bits. Is that alright with you?
Cheers
Paul
On Fri, Oct 28, 2011 at 1:29 AM, Mikael Morin <mikael.morin@sfr.fr> wrote:
>
--
The knack of flying is learning how to throw yourself at the ground and miss.
--Hitchhikers Guide to the Galaxy
^ permalink raw reply [flat|nested] 69+ messages in thread
* Re: [Patch, fortran] [06/66] inline sum and product: Prepare gfc_trans_preloop_setup
2011-10-30 9:52 ` Paul Richard Thomas
@ 2011-10-30 21:57 ` Mikael Morin
0 siblings, 0 replies; 69+ messages in thread
From: Mikael Morin @ 2011-10-30 21:57 UTC (permalink / raw)
To: Paul Richard Thomas; +Cc: gfortran, GCC patches
On Sunday 30 October 2011 09:16:09 Paul Richard Thomas wrote:
> Dear Mikael,
>
> I intend to work my way through your patches, starting this evening.
> I'll give you feedback as I go along and will OK the whole package,
> rather than bits. Is that alright with you?
Sure.
Mikael
^ permalink raw reply [flat|nested] 69+ messages in thread
* Re: [Patch, fortran] [00/66] PR fortran/43829 Inline sum and product (AKA scalarization of reductions)
2011-10-27 23:43 [Patch, fortran] [00/66] PR fortran/43829 Inline sum and product (AKA scalarization of reductions) Mikael Morin
` (7 preceding siblings ...)
2011-10-28 14:35 ` [Patch, fortran] [00/66] PR fortran/43829 Inline sum and product (AKA scalarization of reductions) Jack Howarth
@ 2011-11-01 21:33 ` Paul Richard Thomas
2011-11-04 3:51 ` Mikael Morin
8 siblings, 1 reply; 69+ messages in thread
From: Paul Richard Thomas @ 2011-11-01 21:33 UTC (permalink / raw)
To: Mikael Morin; +Cc: gfortran, GCC patches
Dear Mikael,
> PS: I hereby confess my failure to not split the patch too much. :-(
I hereby confess my failure to find anything to which I could gripe,
let alone object!
The patch can only be described as a tour de force. Not only is there
a lot of it - 6160 lines with context on - but it is well commented
and well structured. I cannot see any whitespace out of place or even
minor transgressions in respect of gnu coding style. Bah humbug!
On top of all that, it even does what is promised! Also, other
testers have run it through various benchmarks, as recent threads
attest.
The only, slight worry that I have is that it is going to make Richi's
middle end scalarization nearly impossible to use for gfortran.
However, the enhanced capability that this patch brings makes it a
worthy addition to gfortran.
I bootstrapped and regtested on FC9/x86_64, just for the record.
OK for trunk.
Many, many thanks for the patch.
Paul
^ permalink raw reply [flat|nested] 69+ messages in thread
* Re: [Patch, fortran] [00/66] PR fortran/43829 Inline sum and product (AKA scalarization of reductions)
2011-11-01 21:33 ` [Patch, fortran] [00/66] PR fortran/43829 Inline sum and product " Paul Richard Thomas
@ 2011-11-04 3:51 ` Mikael Morin
2011-11-04 9:39 ` Richard Guenther
0 siblings, 1 reply; 69+ messages in thread
From: Mikael Morin @ 2011-11-04 3:51 UTC (permalink / raw)
To: fortran; +Cc: Paul Richard Thomas, GCC patches
On Tuesday 01 November 2011 22:07:48 Paul Richard Thomas wrote:
> The only, slight worry that I have is that it is going to make Richi's
> middle end scalarization nearly impossible to use for gfortran.
> However, the enhanced capability that this patch brings makes it a
> worthy addition to gfortran.
>
I think that Richi's middle-end arrays and gfortran's scalarizer are more or
less incompatible, regardless of this patch. And if they are made to coexist
side by side at some point, this patch won't make it either better/easier or
worse/harder IMHO.
> OK for trunk.
>
Thanks for the review!
Committed as follows.
Mikael
patch revision
============
01 180842
02 180843
03 180844
04 180846
05 180847
06 180848
08 180849
07 180850
09 180851
10 180852
11 180853
12 180855
13 180856
14 180857
15 180858
16 180859
17 180860
18 180861
19 180862
20 180864
21 180865
22 180866
23 180867
24 180868
25 180869
26 180870
27 180872
28 180873
29 180875
30 180877
31 180880
32 180881
33 180882
34 180883
35 180884
36 180885
37 180886
38 180887
39 180888
40 180889
41 180890
42 180891
43 480892
44 180893
45 180894
46 180895
47 180897
48 180898
49 180899
50 180900
51 180901
52 180902
53 180903
54 180904
55 180905
56 180906
57 180907
58 180908
59 180909
60 180910
61 180911
62 180913
63 180917
64 180918
65 180919
66 180920
tests 180922
^ permalink raw reply [flat|nested] 69+ messages in thread
* Re: [Patch, fortran] [00/66] PR fortran/43829 Inline sum and product (AKA scalarization of reductions)
2011-11-04 3:51 ` Mikael Morin
@ 2011-11-04 9:39 ` Richard Guenther
0 siblings, 0 replies; 69+ messages in thread
From: Richard Guenther @ 2011-11-04 9:39 UTC (permalink / raw)
To: Mikael Morin; +Cc: fortran, Paul Richard Thomas, GCC patches
On Fri, Nov 4, 2011 at 2:02 AM, Mikael Morin <mikael.morin@sfr.fr> wrote:
> On Tuesday 01 November 2011 22:07:48 Paul Richard Thomas wrote:
>> The only, slight worry that I have is that it is going to make Richi's
>> middle end scalarization nearly impossible to use for gfortran.
>> However, the enhanced capability that this patch brings makes it a
>> worthy addition to gfortran.
>>
> I think that Richi's middle-end arrays and gfortran's scalarizer are more or
> less incompatible, regardless of this patch. And if they are made to coexist
> side by side at some point, this patch won't make it either better/easier or
> worse/harder IMHO.
Indeed. In the ideal form the current scalarizer could defer scalarizing
innermost loop (nests) to the middle-end, my hackish patches from earlier
this year of course were just hacks (to eventually get some interest from
you folks). But of course not even the middle-end parts are completely
ready (partly also due to lack of good test coverage possibility - a chicken
and egg problem :/).
So I think improving the Fortran scalarizer is time that is very well spent.
Thanks,
Richard.
>
>> OK for trunk.
>>
> Thanks for the review!
> Committed as follows.
>
> Mikael
>
> patch revision
> ============
> 01 180842
> 02 180843
> 03 180844
> 04 180846
> 05 180847
> 06 180848
> 08 180849
> 07 180850
> 09 180851
> 10 180852
> 11 180853
> 12 180855
> 13 180856
> 14 180857
> 15 180858
> 16 180859
> 17 180860
> 18 180861
> 19 180862
> 20 180864
> 21 180865
> 22 180866
> 23 180867
> 24 180868
> 25 180869
> 26 180870
> 27 180872
> 28 180873
> 29 180875
> 30 180877
> 31 180880
> 32 180881
> 33 180882
> 34 180883
> 35 180884
> 36 180885
> 37 180886
> 38 180887
> 39 180888
> 40 180889
> 41 180890
> 42 180891
> 43 480892
> 44 180893
> 45 180894
> 46 180895
> 47 180897
> 48 180898
> 49 180899
> 50 180900
> 51 180901
> 52 180902
> 53 180903
> 54 180904
> 55 180905
> 56 180906
> 57 180907
> 58 180908
> 59 180909
> 60 180910
> 61 180911
> 62 180913
> 63 180917
> 64 180918
> 65 180919
> 66 180920
> tests 180922
>
^ permalink raw reply [flat|nested] 69+ messages in thread
end of thread, other threads:[~2011-11-04 9:23 UTC | newest]
Thread overview: 69+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2011-10-27 23:43 [Patch, fortran] [00/66] PR fortran/43829 Inline sum and product (AKA scalarization of reductions) Mikael Morin
2011-10-27 23:32 ` [Patch, fortran] [20..30/66] inline sum and product: Update core structs Mikael Morin
2011-10-27 23:32 ` [Patch, fortran] [20/66] inline sum and product: Update core structs: Rename gfc_ss_info Mikael Morin
2011-10-27 23:32 ` [Patch, fortran] [25/66] inline sum and product: Update core structs: Move string_length Mikael Morin
2011-10-27 23:32 ` [Patch, fortran] [29/66] inline sum and product: Update core structs: Move useflags flag Mikael Morin
2011-10-27 23:33 ` [Patch, fortran] [22/66] inline sum and product: Update core structs: Move shape Mikael Morin
2011-10-27 23:33 ` [Patch, fortran] [26/66] inline sum and product: Update core structs: Move scalar struct Mikael Morin
2011-10-27 23:33 ` [Patch, fortran] [23/66] inline sum and product: Update core structs: Move type Mikael Morin
2011-10-27 23:34 ` [Patch, fortran] [27/66] inline sum and product: Update core structs: Move temp struct Mikael Morin
2011-10-27 23:35 ` [Patch, fortran] [24/66] inline sum and product: Update core structs: Move expr Mikael Morin
2011-10-27 23:35 ` [Patch, fortran] [21/66] inline sum and product: Update core structs: Move dim and dimen Mikael Morin
2011-10-27 23:35 ` [Patch, fortran] [30/66] inline sum and product: Update core structs: Move where flag Mikael Morin
2011-10-27 23:43 ` [Patch, fortran] [28/66] inline sum and product: Update core structs: Move info struct Mikael Morin
2011-10-27 23:35 ` [Patch, fortran] [07..12/66] inline sum and product: Preliminary cleanups Mikael Morin
2011-10-27 23:31 ` [Patch, fortran] [07/66] inline sum and product: Preliminary cleanups: Useless coarray code removal Mikael Morin
2011-10-27 23:31 ` [Patch, fortran] [10/66] inline sum and product: Preliminary cleanups: Use array's instead of loop's dimensions Mikael Morin
2011-10-27 23:32 ` [Patch, fortran] [08/66] inline sum and product: Preliminary cleanups: Remove redundant condition Mikael Morin
2011-10-27 23:32 ` [Patch, fortran] [12/66] inline sum and product: Preliminary cleanups: Stop loop before end marker Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [09/66] inline sum and product: Preliminary cleanups: Assertify condition Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [11/66] inline sum and product: Preliminary cleanups: Skip temporary case Mikael Morin
2011-10-27 23:35 ` [Patch, fortran] [31..53/66] inline sum and product: Update the scalarizer Mikael Morin
2011-10-27 23:34 ` [Patch, fortran] [31/66] inline sum and product: Update the scalarizer: Split gfc_conv_loop_setup Mikael Morin
2011-10-27 23:34 ` [Patch, fortran] [32/66] inline sum and product: Update the scalarizer: clear specloop in gfc_trans_create_temp_arrays Mikael Morin
2011-10-27 23:35 ` [Patch, fortran] [45/66] inline sum and product: Update the scalarizer: Update dimension mapping inversion functions Mikael Morin
2011-10-27 23:35 ` [Patch, fortran] [33/66] inline sum and product: Update the scalarizer Mikael Morin
2011-10-27 23:35 ` [Patch, fortran] [47..48/66] inline sum and product: Update the scalarizer: New gfc_loopinfo::nested_loop field Mikael Morin
2011-10-27 23:35 ` [Patch, fortran] [44/66] inline sum and product: Update the scalarizer: New gfc_ss::nested_ss field Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [35..39/66] inline sum and product: Update the scalarizer: New gfc_ss::loop field Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [34/66] inline sum and product: Update the scalarizer: gfc_ss_info refcounting Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [46/66] inline sum and product: Update the scalarizer: Update gfc_trans_create_temp_array Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [40..43/66] inline sum and product: Update the scalarizer: New gfc_ss::parent field Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [52/66] inline sum and product: Update the scalarizer: New outermost_loop function Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [53/66] inline sum and product: Update the scalarizer: Update gfc_trans_preloop_setup Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [49..51/66] inline sum and product: Update the scalarizer: New parent loop Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [62..66/66] inline sum and product: Inline sum Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [64/66] inline sum and product: Inline sum: Change loop use Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [66/66] inline sum and product: Inline sum: The end Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [65/66] inline sum and product: Inline sum: Change se initialization Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [63/66] inline sum and product: Inline sum: Change argument handling Mikael Morin
2011-10-28 0:29 ` [Patch, fortran] [62/66] inline sum and product: Inline sum: Change conditions Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [01..06/66] inline sum and product: Prepare gfc_trans_preloop_setup Mikael Morin
2011-10-27 23:30 ` [Patch, fortran] [01/66] " Mikael Morin
2011-10-27 23:30 ` [Patch, fortran] [06/66] " Mikael Morin
2011-10-30 9:52 ` Paul Richard Thomas
2011-10-30 21:57 ` Mikael Morin
2011-10-27 23:31 ` [Patch, fortran] [03/66] " Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [05/66] " Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [02/66] " Mikael Morin
2011-10-27 23:38 ` [Patch, fortran] [04/66] " Mikael Morin
2011-10-28 0:02 ` [Patch, fortran] [13..19/66] inline sum and product: Interfaces changes Mikael Morin
2011-10-27 23:31 ` [Patch, fortran] [14/66] inline sum and product: Interfaces changes: gfc_trans_array_bound_check, gfc_conv_array_index_offset Mikael Morin
2011-10-27 23:32 ` [Patch, fortran] [17/66] inline sum and product: Interfaces changes: gfc_set_vector_loop_bounds Mikael Morin
2011-10-27 23:32 ` [Patch, fortran] [15/66] inline sum and product: Interfaces changes: obtain name more simply Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [13/66] inline sum and product: Interfaces changes: gfc_trans_array_constructor Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [16/66] inline sum and product: Interfaces changes: gfc_trans_create_temp_array Mikael Morin
2011-10-27 23:43 ` [Patch, fortran] [18/66] inline sum and product: Interfaces changes: get_array_ref_dim Mikael Morin
2011-10-27 23:44 ` [Patch, fortran] [19/66] inline sum and product: Interfaces changes: dim_ok Mikael Morin
2011-10-28 0:22 ` [Patch, fortran] [54..61/66] inline sum and product: Prevent regressions Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [55..56/66] inline sum and product: Prevent regressions: Fix gfc_conv_elemental_dependencies Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [60/66] inline sum and product: Update the scalarizer: Fix error markers Mikael Morin
2011-10-27 23:36 ` [Patch, fortran] [57..59/66] inline sum and product: Prevent regressions: Fix {min, max}{loc, val} Mikael Morin
2011-10-27 23:43 ` [Patch, fortran] [54/66] inline sum and product: Prevent regressions: Add dependency checking Mikael Morin
2011-10-28 0:01 ` [Patch, fortran] [61/66] inline sum and product: Prevent regressions: Disable frontend optimizations Mikael Morin
2011-10-28 14:35 ` [Patch, fortran] [00/66] PR fortran/43829 Inline sum and product (AKA scalarization of reductions) Jack Howarth
2011-10-28 17:25 ` Mikael Morin
2011-10-29 16:04 ` [Patch, fortran] [00/66] PR fortran/43829 Inline sum and?product " Jack Howarth
2011-11-01 21:33 ` [Patch, fortran] [00/66] PR fortran/43829 Inline sum and product " Paul Richard Thomas
2011-11-04 3:51 ` Mikael Morin
2011-11-04 9:39 ` Richard Guenther
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).