Jakub Jelinek wrote:
Though, what could be done is just special case OpenMP workshare regions,
insert everything into BLOCK local vars unless in OpenMP workshare, in that
case put the BLOCK with the temporary around the workshare rather than
inside of it. In the case of omp parallel workshare it would need
to go in between omp parallel and omp workshare.
Well, here's a patch which implements this concept. I chose to insert
the BLOCK in a separate pass because it was the cleanest way to avoid
infinite recursion when inserting a block.
Regression-tested. OK for trunk?
Thomas
2011-10-21 Thomas Koenig <tkoe...@gcc.gnu.org>
PR fortran/50690
* frontend-passes.c (workshare_level): New variable.
(create_var): Put the newly created variable into the block
around the WORKSHARE.
(enclose_workshare): New callback function to enclose
WORKSHAREs in blocks.
(optimize_namespace): Use it.
(gfc_code_walker): Save/restore current namespace when
following a BLOCK. Keep track of workshare level.
2011-10-21 Thomas Koenig <tkoe...@gcc.gnu.org>
PR fortran/50690
* gfortran.dg/gomp/workshare2.f90: New test.
Index: frontend-passes.c
===================================================================
--- frontend-passes.c (Revision 180063)
+++ frontend-passes.c (Arbeitskopie)
@@ -66,6 +66,10 @@ static gfc_namespace *current_ns;
static int forall_level;
+/* If we are within an OMP WORKSHARE or OMP PARALLEL WORKSHARE. */
+
+static int workshare_level;
+
/* Entry point - run all passes for a namespace. So far, only an
optimization pass is run. */
@@ -245,8 +249,16 @@ create_var (gfc_expr * e)
gfc_namespace *ns;
int i;
+ /* Special treatment for WORKSHARE: The variable goes into the block
+ created by the earlier pass around it. */
+
+ if (workshare_level > 0)
+ {
+ ns = current_ns;
+ changed_statement = current_code;
+ }
/* If the block hasn't already been created, do so. */
- if (inserted_block == NULL)
+ else if (inserted_block == NULL)
{
inserted_block = XCNEW (gfc_code);
inserted_block->op = EXEC_BLOCK;
@@ -497,6 +509,38 @@ convert_do_while (gfc_code **c, int *walk_subtrees
return 0;
}
+/* Callback function to enclose OMP workshares into BLOCKs. This is done
+ so that later front end optimization can insert temporary variables into
+ the outer block scope. */
+
+static int
+enclose_workshare (gfc_code **c, int *walk_subtrees,
+ void *data ATTRIBUTE_UNUSED)
+{
+ gfc_code *co;
+ gfc_code *new_block;
+ gfc_namespace *ns;
+
+ co = *c;
+
+ if (co->op != EXEC_OMP_WORKSHARE && co->op != EXEC_OMP_PARALLEL_WORKSHARE)
+ return 0;
+
+ /* Create the block. */
+ new_block = XCNEW (gfc_code);
+ new_block->op = EXEC_BLOCK;
+ new_block->loc = co->loc;
+ ns = gfc_build_block_ns (current_ns);
+ new_block->ext.block.ns = ns;
+ new_block->ext.block.assoc = NULL;
+ ns->code = co;
+
+ /* Insert the BLOCK at the right position. */
+ *c = new_block;
+ *walk_subtrees = false;
+ return 0;
+}
+
/* Optimize a namespace, including all contained namespaces. */
static void
@@ -507,6 +551,12 @@ optimize_namespace (gfc_namespace *ns)
forall_level = 0;
gfc_code_walker (&ns->code, convert_do_while, dummy_expr_callback, NULL);
+ if (gfc_option.gfc_flag_openmp)
+ {
+ workshare_level = 0;
+ gfc_code_walker (&ns->code, enclose_workshare, dummy_expr_callback, NULL);
+ }
+
gfc_code_walker (&ns->code, cfe_code, cfe_expr_0, NULL);
gfc_code_walker (&ns->code, optimize_code, optimize_expr, NULL);
@@ -1148,6 +1198,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code
gfc_code *b;
gfc_actual_arglist *a;
gfc_code *co;
+ gfc_namespace *save_ns;
gfc_association_list *alist;
/* There might be statement insertions before the current code,
@@ -1159,7 +1210,11 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code
{
case EXEC_BLOCK:
+ save_ns = current_ns;
+ current_ns = co->ext.block.ns;
WALK_SUBCODE (co->ext.block.ns->code);
+ current_ns = save_ns;
+
for (alist = co->ext.block.assoc; alist; alist = alist->next)
WALK_SUBEXPR (alist->target);
break;
@@ -1329,14 +1384,18 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code
WALK_SUBEXPR (co->ext.dt->extra_comma);
break;
+ case EXEC_OMP_PARALLEL_WORKSHARE:
+ case EXEC_OMP_WORKSHARE:
+ workshare_level ++;
+
+ /* Fall through. */
+
case EXEC_OMP_DO:
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
case EXEC_OMP_PARALLEL_SECTIONS:
- case EXEC_OMP_PARALLEL_WORKSHARE:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SINGLE:
- case EXEC_OMP_WORKSHARE:
case EXEC_OMP_END_SINGLE:
case EXEC_OMP_TASK:
if (co->ext.omp_clauses)
@@ -1365,6 +1424,9 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code
if (co->op == EXEC_FORALL)
forall_level --;
+ if (co->op == EXEC_OMP_WORKSHARE
+ || co->op == EXEC_OMP_PARALLEL_WORKSHARE)
+ workshare_level --;
}
}
return 0;
! { dg-do run }
! { dg-options "-ffrontend-optimize" }
! PR 50690 - this used to ICE because workshare could not handle
! BLOCKs.
program foo
implicit none
real, parameter :: eps = 3e-7
integer :: i
real :: A(10), B(5), C(10)
B(1) = 3.344
call random_number(a)
c = a
!$omp parallel default(shared)
!$omp workshare
A(:) = A(:)*cos(B(1))+A(:)*cos(B(1))
!$omp end workshare nowait
!$omp end parallel ! sync is implied here
! c = c*cos(b(1)) + c*cos(b(1))
! if (any(abs(a-c) > eps)) call abort
end program foo
