Patchwork [fortran] Fix PR 50690

login
register
mail settings
Submitter Thomas Koenig
Date Dec. 11, 2011, 10:11 a.m.
Message ID <4EE481D0.4020408@netcologne.de>
Download mbox | patch
Permalink /patch/130596/
State New
Headers show

Comments

Thomas Koenig - Dec. 11, 2011, 10:11 a.m.
Am 08.12.2011 22:57, schrieb Jakub Jelinek:

> Reading it again, isn't it overkill to keep the
> vector?  All you need is a bool and a way to restore its previous state.

Good catch. The vector was a leftover from the time when I was searching
up the call chain to check for any enclosing workshare.

Updated patch attached.  I put a goto in there to simulate a double
"fall through", as you'll see in the patch.  If anybody has strong
negative feelings about this, I will replace it with a switch within a
switch.

Regression-tested.  OK for trunk (finally)?

	Thomas

2011-12-11  Thomas Koenig  <tkoenig@gcc.gnu.org>

         PR fortran/50690
         * frontend-passes.c (in_omp_workshare):  New variable.
         (cfe_expr_0):  Don't eliminiate common function if it would put
         the variable immediately into a WORKSHARE construct.
         (optimize_namespace):  Set in_omp_workshare.
         (gfc_code_walker):  Keep track of OMP PARALLEL and OMP WORKSHARE
         constructs.

2011-12-11  Thomas Koenig  <tkoenig@gcc.gnu.org>

         PR fortran/50690
         * gfortran.dg/gomp/workshare2.f90:  New test.
         * gfortran.dg/gomp/workshare3.f90:  New test.
! { dg-do compile }
! { dg-options "-ffrontend-optimize -fdump-tree-original" }
! Test that common function elimination is done within the OMP parallel
! blocks even if there is a workshare around it.
program foo
  implicit none
  integer, parameter :: n = 10000000
  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 workshare
     !$omp parallel default(shared)
     !$omp do
     do j=1,n
       A(j) = A(j)*cos(B(1))+A(j)*cos(B(1))
     end do
     !$omp end do
     !$omp end parallel
     !$omp end parallel workshare
  end do

  c = c*cos(b(1))+ c*cos(b(1))

  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

end program foo
! { dg-final { scan-tree-dump-times "__builtin_cosf" 2 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
! { dg-do compile }
! { dg-options "-ffrontend-optimize -fdump-tree-original" }
! 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 = 10000000
  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
! { dg-final { scan-tree-dump-times "__var" 0 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
Jakub Jelinek - Dec. 11, 2011, 10:29 a.m.
On Sun, Dec 11, 2011 at 11:11:28AM +0100, Thomas Koenig wrote:
> @@ -1330,16 +1345,38 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code
>  	      WALK_SUBEXPR (co->ext.dt->extra_comma);
>  	      break;
>  
> -	    case EXEC_OMP_DO:
> +	      in_omp_workshare = true;
> +
> +	      break;
> +

What is the above hunk?  Looks like unreachable code:

	break;
	in_omp_workshare = true;
	break;

Other than that looks good to me.


	Jakub
Tobias Burnus - Dec. 11, 2011, 12:50 p.m.
Thomas Koenig wrote:
> Regression-tested.  OK for trunk (finally)?

Looks also OK from my side - except for the left over which Jakub has 
already noticed. I think the following lines can be simply removed:

-	    case EXEC_OMP_DO:
+	      in_omp_workshare = true;
+
+	      break;
+


Tobias

PS: If you have time, can you also backport the patch for PR 51338 to 
the 4.6 branch?

Patch

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;
 
+/* Keep track of whether we are within an OMP workshare.  */
+
+static bool in_omp_workshare;
+
 /* Entry point - run all passes for a namespace.  So far, only an
    optimization pass is run.  */
 
@@ -367,6 +371,14 @@  cfe_expr_0 (gfc_expr **e, int *walk_subtrees,
   int i,j;
   gfc_expr *newvar;
 
+  /* Don't do this optimization within OMP workshare. */
+
+  if (in_omp_workshare)
+    {
+      *walk_subtrees = 0;
+      return 0;
+    }
+
   expr_count = 0;
 
   gfc_expr_walker (e, cfe_register_funcs, NULL);
@@ -505,6 +517,7 @@  optimize_namespace (gfc_namespace *ns)
 
   current_ns = ns;
   forall_level = 0;
+  in_omp_workshare = false;
 
   gfc_code_walker (&ns->code, convert_do_while, dummy_expr_callback, NULL);
   gfc_code_walker (&ns->code, cfe_code, cfe_expr_0, NULL);
@@ -1150,11 +1163,13 @@  gfc_code_walker (gfc_code **c, walk_code_fn_t code
 	  gfc_actual_arglist *a;
 	  gfc_code *co;
 	  gfc_association_list *alist;
+	  bool saved_in_omp_workshare;
 
 	  /* There might be statement insertions before the current code,
 	     which must not affect the expression walker.  */
 
 	  co = *c;
+	  saved_in_omp_workshare = in_omp_workshare;
 
 	  switch (co->op)
 	    {
@@ -1330,16 +1345,38 @@  gfc_code_walker (gfc_code **c, walk_code_fn_t code
 	      WALK_SUBEXPR (co->ext.dt->extra_comma);
 	      break;
 
-	    case EXEC_OMP_DO:
+	      in_omp_workshare = true;
+
+	      break;
+
 	    case EXEC_OMP_PARALLEL:
 	    case EXEC_OMP_PARALLEL_DO:
 	    case EXEC_OMP_PARALLEL_SECTIONS:
+
+	      in_omp_workshare = false;
+
+	      /* This goto serves as a shortcut to avoid code
+		 duplication or a larger if or switch statement.  */
+	      goto check_omp_clauses;
+	      
+	    case EXEC_OMP_WORKSHARE:
 	    case EXEC_OMP_PARALLEL_WORKSHARE:
+
+	      in_omp_workshare = true;
+
+	      /* Fall through  */
+	      
+	    case EXEC_OMP_DO:
 	    case EXEC_OMP_SECTIONS:
 	    case EXEC_OMP_SINGLE:
-	    case EXEC_OMP_WORKSHARE:
 	    case EXEC_OMP_END_SINGLE:
 	    case EXEC_OMP_TASK:
+
+	      /* Come to this label only from the
+		 EXEC_OMP_PARALLEL_* cases above.  */
+
+	    check_omp_clauses:
+
 	      if (co->ext.omp_clauses)
 		{
 		  WALK_SUBEXPR (co->ext.omp_clauses->if_expr);
@@ -1366,6 +1403,7 @@  gfc_code_walker (gfc_code **c, walk_code_fn_t code
 	  if (co->op == EXEC_FORALL)
 	    forall_level --;
 
+	  in_omp_workshare = saved_in_omp_workshare;
 	}
     }
   return 0;