Hello world,
the recent discussion has convinced me that there is no way to
mix OMP workshares and common function elimination as practiced by
frontend-passes.c. This patch therefore disables that
particular optimization within workshares.
Regression-tested. OK for trunk?
Thomas
2011-12-02 Thomas Koenig <[email protected]>
PR fortran/50690
* frontend-passes.c (workshare_level): New variable.
(cfe_expr_0): Don't eliminiat common functions within
workshares.
(gfc_code_walker): Keep track of workshare level.
2011-12-02 Thomas Koenig <[email protected]>
PR fortran/50690
* gfortran.dg/gomp/workshare2.f90: New test.
! { dg-do compile }
! { dg-options "-ffrontend-optimize" }
! PR 50690 - this used to ICE because workshare could not handle
! BLOCKs.
! To test for correct execution, run this program (but don't forget
! to unset the stack limit).
program foo
implicit none
integer, parameter :: n = 100000000
real, parameter :: eps = 3e-7
integer :: i,j
real :: A(n), B(5), C(n)
real :: tmp
B(1) = 3.344
tmp = B(1)
do i=1,10
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
end do
c = c*tmp + c*tmp
do j=1,n
if (abs(a(j)-c(j)) > eps) then
print *,1,j,a(j), c(j)
call abort
end if
end do
do i=1,10
call random_number(a)
c = a
!$omp parallel workshare default(shared)
A(:) = A(:)*cos(B(1))+A(:)*cos(B(1))
!$omp end parallel workshare
end do
c = c*tmp + c*tmp
do j=1,n
if (abs(a(j)-c(j)) > eps) then
print *,2,j,a(j), c(j)
call abort
end if
end do
end program foo
Index: frontend-passes.c
===================================================================
--- frontend-passes.c (Revision 181809)
+++ 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. */
@@ -367,6 +371,13 @@ cfe_expr_0 (gfc_expr **e, int *walk_subtrees,
int i,j;
gfc_expr *newvar;
+ /* Don't do this optimization within WORKSHARES. */
+ if (workshare_level > 0)
+ {
+ *walk_subtrees = 0;
+ return 0;
+ }
+
expr_count = 0;
gfc_expr_walker (e, cfe_register_funcs, NULL);
@@ -505,6 +516,7 @@ optimize_namespace (gfc_namespace *ns)
current_ns = ns;
forall_level = 0;
+ workshare_level = 0;
gfc_code_walker (&ns->code, convert_do_while, dummy_expr_callback, NULL);
gfc_code_walker (&ns->code, cfe_code, cfe_expr_0, NULL);
@@ -1330,14 +1342,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)
@@ -1366,6 +1382,10 @@ 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;
