[Patch, fortran] [3/5] PR 45648: Inline transpose part 2: Enable transpose optimization

Mikael Morin mikael.morin@sfr.fr
Tue Sep 21 00:01:00 GMT 2010


With this, the transpose optimization is back.
The two previous patches permitted to call gfc_conv_expr_descriptor on transpose's arg, so now we just have to bypass the temporary generation in the transpose case. 
I don't add the testcase from the original commit as there is a wrong code regression introduced by this patch (uncaught by the testsuite) to be fixed in patch 5/5. 

OK for trunk ?


-------------- next part --------------
2010-09-20  Mikael Morin  <mikael@gcc.gnu.org>

	PR fortran/45648
	* trans-array.c (gfc_conv_expr_descriptor): Special case noncopying
	intrinsic function call. 

-------------- next part --------------
diff --git a/trans-array.c b/trans-array.c
index 52e6d2a..9171183 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -5175,6 +5175,7 @@ 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;
 
   gcc_assert (ss != gfc_ss_terminator);
 
@@ -5253,6 +5254,19 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
       break;
       
     case EXPR_FUNCTION:
+
+      /* We don't need to copy data in some cases.  */
+      arg = gfc_get_noncopying_intrinsic_argument (expr);
+      if (arg)
+	{
+	  /* This is a call to transpose...  */
+	  gcc_assert (expr->value.function.isym->id == GFC_ISYM_TRANSPOSE);
+	  /* ... which has already been handled by the scalarizer, so
+	     that we just need to get its argument's descriptor.  */
+	  gfc_conv_expr_descriptor (se, expr->value.function.actual->expr, ss);
+	  return;
+	}
+
       /* A transformational function return value will be a temporary
 	 array descriptor.  We still need to go through the scalarizer
 	 to create the descriptor.  Elemental functions ar handled as
-------------- next part --------------
2010-09-20  Mikael Morin  <mikael@gcc.gnu.org>

	PR fortran/45648
	* gfortran.dg/inline_transpose_1.f90: Update temporary's locations
	and counts. Add non-elemental function call check.
-------------- next part --------------
diff --git a/inline_transpose_1.f90 b/inline_transpose_1.f90
index 50290c6..36198f8 100644
--- a/inline_transpose_1.f90
+++ b/inline_transpose_1.f90
@@ -61,10 +61,10 @@
   if (u /= v) call abort
 
 
-  a = foo(transpose(c)) ! Unnecessary { dg-warning "Creating array temporary" }
+  a = foo(transpose(c))
   if (any(a /= p+1)) call abort
 
-  write(u,*) foo(transpose(c))    ! 2 temps, should be 1 { dg-warning "Creating array temporary" }
+  write(u,*) foo(transpose(c))    ! { dg-warning "Creating array temporary" }
   write(v,*) p+1
   if (u /= v) call abort
 
@@ -77,10 +77,10 @@
   if (u /= v) call abort
 
 
-  e = foo(transpose(e))     ! 2 temps, should be 1 { dg-warning "Creating array temporary" }
+  e = foo(transpose(e))     ! { dg-warning "Creating array temporary" }
   if (any(e /= 2*s+1)) call abort
 
-  write(u,*) transpose(foo(transpose(e))-1)     ! 2 temps, should be 1 { dg-warning "Creating array temporary" }
+  write(u,*) transpose(foo(transpose(e))-1)     ! { dg-warning "Creating array temporary" }
   write(v,*) 2*s+1
   if (u /= v) call abort
 
@@ -141,27 +141,32 @@
   if (u /= v) call abort
 
 
-  if (any(transpose(matmul(a,c)) /= matmul(transpose(c), transpose(a)))) call abort      ! 4 temps, should be 2 { dg-warning "Creating array temporary" }
+  if (any(transpose(matmul(a,c)) /= matmul(transpose(c), transpose(a)))) call abort      ! 2 temps { dg-warning "Creating array temporary" }
 
   write(u,*) transpose(matmul(a,c))     ! { dg-warning "Creating array temporary" }
-  write(v,*) matmul(transpose(c), transpose(a))     ! 3 temps, should be 1 { dg-warning "Creating array temporary" }
+  write(v,*) matmul(transpose(c), transpose(a))     ! { dg-warning "Creating array temporary" }
   if (u /= v) call abort
 
 
-  if (any(transpose(matmul(e,a)) /= matmul(transpose(a), transpose(e)))) call abort     ! 4 temps, should be 2 { dg-warning "Creating array temporary" }
+  if (any(transpose(matmul(e,a)) /= matmul(transpose(a), transpose(e)))) call abort     ! 2 temps { dg-warning "Creating array temporary" }
 
   write(u,*) transpose(matmul(e,a))     ! { dg-warning "Creating array temporary" }
-  write(v,*) matmul(transpose(a), transpose(e))     ! 3 temps, should be 1 { dg-warning "Creating array temporary" }
+  write(v,*) matmul(transpose(a), transpose(e))     ! { dg-warning "Creating array temporary" }
   if (u /= v) call abort
 
 
-  call baz (transpose(a))       ! Unnecessary { dg-warning "Creating array temporary" }
+  call baz (transpose(a))
 
-  call toto (f, transpose (e))
-  if (any (f /= 4 * s + 12)) call abort
 
-  call toto (f, transpose (f))          ! { dg-warning "Creating array temporary" }
-  if (any (f /= 8 * r + 24)) call abort
+  call toto1 (a, transpose (c))
+  if (any (a /= 2 * p + 12)) call abort
+
+  call toto1 (e, transpose (e))          ! { dg-warning "Creating array temporary" }
+  if (any (e /= 4 * s + 12)) call abort
+
+
+  call toto2 (c, transpose (a))
+  if (any (c /= 2 * q + 13)) call abort
 
 
   contains
@@ -182,23 +187,30 @@
     integer, intent(in) :: x(:,:)
   end subroutine baz
 
-  elemental subroutine toto (x, y)
+  elemental subroutine toto1 (x, y)
     integer, intent(out) :: x
     integer, intent(in)  :: y
     x = y + y
-  end subroutine toto
+  end subroutine toto1
+
+  subroutine toto2 (x, y)
+    integer, dimension(:,:), intent(out) :: x
+    integer, dimension(:,:), intent(in)  :: y
+    x = y + 1
+  end subroutine toto2
 
 end
+
 ! No call to transpose
 ! { dg-final { scan-tree-dump-times "_gfortran_transpose" 0 "original" } }
 !
-! 34 temporaries
-! { dg-final { scan-tree-dump-times "struct\[^\\n\]*atmp" 34 "original" } }
+! 21 temporaries
+! { dg-final { scan-tree-dump-times "struct\[^\\n\]*atmp" 21 "original" } }
 !
 ! 2 tests optimized out
-! { dg-final { scan-tree-dump-times "_gfortran_abort" 34 "original" } }
-! { # Commented out as failing at -O0: dg-final { scan-tree-dump-times "_gfortran_abort" 32 "optimized" } }
+! { dg-final { scan-tree-dump-times "_gfortran_abort" 35 "original" } }
+! { # Commented out as failing at -O0: dg-final { scan-tree-dump-times "_gfortran_abort" 33 "optimized" } }
 !
 ! cleanup
-! { #dg-final { cleanup-tree-dump "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
 ! { dg-final { cleanup-tree-dump "optimized" } }


More information about the Gcc-patches mailing list