===================================================================
@@ -33,6 +33,7 @@ along with GCC; see the file COPYING3. If not see
static void strip_function_call (gfc_expr *);
static void optimize_namespace (gfc_namespace *);
static void optimize_assignment (gfc_code *);
+static void optimize_forall_header (gfc_code *);
static bool optimize_op (gfc_expr *);
static bool optimize_comparison (gfc_expr *, gfc_intrinsic_op);
static bool optimize_trim (gfc_expr *);
@@ -145,6 +146,10 @@ optimize_code (gfc_code **c, int *walk_subtrees AT
if (op == EXEC_ASSIGN)
optimize_assignment (*c);
+
+ if (op == EXEC_DO_CONCURRENT || op == EXEC_FORALL)
+ optimize_forall_header (*c);
+
return 0;
}
@@ -980,6 +985,70 @@ remove_trim (gfc_expr *rhs)
return ret;
}
+/* Callback function to check if there is a reference
+ to one of the concurrent iterators in the expression. */
+
+static int
+concurrent_iterator_check (gfc_expr **e,
+ int *walk_subtrees ATTRIBUTE_UNUSED,
+ void *data ATTRIBUTE_UNUSED)
+{
+ gfc_symtree *se;
+ gfc_forall_iterator *fa;
+
+ if ((*e)->expr_type != EXPR_VARIABLE)
+ return 0;
+
+ se = (*e)->symtree;
+
+ if (se == NULL)
+ return 0;
+
+ for (fa = (*current_code)->ext.forall_iterator; fa;
+ fa = fa->next)
+ {
+ if (se == fa->var->symtree)
+ return 1;
+ }
+ return 0;
+}
+
+/* Callback helper function for optimizing the header of
+ FORALL and DO CONCURRENT. */
+
+static int
+forall_header_varmove (gfc_expr **e,
+ int *walk_subtrees,
+ void *data ATTRIBUTE_UNUSED)
+{
+ if ((*e)->expr_type == EXPR_VARIABLE && (*e)->ref == NULL)
+ return 0;
+
+ if ((*e)->expr_type == EXPR_CONSTANT)
+ return 0;
+
+ if (gfc_expr_walker (e, concurrent_iterator_check, NULL) == 0)
+ {
+ gfc_expr *ex;
+
+ ex = create_var (*e);
+ (*e) = ex;
+ *walk_subtrees = 1;
+ }
+ return 0;
+}
+
+/* Optimization for FORALL and DO CONCURRENT masks. */
+
+static void
+optimize_forall_header (gfc_code *c)
+{
+ if (c->expr1 == NULL)
+ return;
+
+ gfc_expr_walker (&(c->expr1), forall_header_varmove, NULL);
+}
+
/* Optimizations for an assignment. */
static void
Hello world, this patch moves expressions which do not depend on the index variable(s) from FORALL headers (which also includes DO CONCURRENT). For the test case in do_concurrent_4.f90, do concurrent(i=1:n, a(i)>sum(a)/n) a(i) = a(i) * 0.5 end do Without the patch, this gets translated in a straightforward manner to DO CONCURRENT main:i 1:10:1(> main:a(main:i) (/ _gfortran_sum_r4[[((main:a(FULL)) ((arg not-present)) ((arg not-present)))]] 1.00000000e1)) ASSIGN main:a(main:i) (* main:a(main:i) 5.00000000e-1) END DO With the patch and with front-end optimization on, this becomes ASSIGN block@7:__var_1 (/ _gfortran_sum_r4[[((main:a(FULL)) ((arg not-present)) ((arg not-present)))]] 1.00000000e1) DO CONCURRENT main:i 1:10:1(> main:a(main:i) block@7:__var_1) ASSIGN main:a(main:i) (* main:a(main:i) 5.00000000e-1) END DO There is one fine point regarding the part of the patch used to check if an expression is identical to the loop variable: + se = (*e)->symtree; + + if (se == NULL) + return 0; + + for (fa = (*current_code)->ext.forall_iterator; fa; + fa = fa->next) + { + if (se == fa->var->symtree) + return 1; + } + return 0; Originally, this was + se = (*e)->symtree->n.sym; + + for (fa = (*current_code)->ext.forall_iterator; fa; fa = fa->next) + { + si = fa->var->symtree->n.sym; + if (si == se) + return 1; + } + but this caused a regression in forall_5.f90 when fa->var->symtree held the address 0x04 (which only occurred when running the test suite). I could not figure out where this strange value was being generated, so I setteled for comparing the symtree address instead (and adding a NULL check just in case :-) Regression-tested. OK for trunk? Regards Thomas 2014-08-17 Thomas Koenig <tkoeng@gcc.gnu.org> PR fortran/60661 * frontend-passes.c (optimize_forall_header): Add prototype, new function. (optimize_code): Call optimize_forall_header. (concurrent_iterator_check): New function. (forall_header_varmove): New function. 2014-08-17 Thomas Koenig <tkoeng@gcc.gnu.org> PR fortran/60661 * gfortran.dg/do_concurrent_4.f90: New test. * gfortran.dg/do_concurrent_5.f90: New test.