[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