re PR fortran/37131 (inline matmul for small matrix sizes)

2017-05-29  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/37131
	* frontend-passes.c (check_conjg_transpose_variable):
	Add prototype.
	(has_dimen_vector_ref):  Likewise
	(matmul_temp_args):  New function. Add prototype.
	(optimize_namespace):  Call matmul_temp_args.

2017-05-29  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/37131
	* gfortran.dg/promotion_2.f90: Add -finline-matmul-limit=0 to
	flags.
	* gfortran.dg/transpose_optimization_1.f90: Likewise.
	* gfortran.dg/inline_matmul_17.f90:  New test.

From-SVN: r248553

6 files changed, 161 insertions, 4 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c9c6a02..093c36c 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2017-05-29  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/37131
+	* frontend-passes.c (check_conjg_transpose_variable):
+	Add prototype.
+	(has_dimen_vector_ref):  Likewise
+	(matmul_temp_args):  New function. Add prototype.
+	(optimize_namespace):  Call matmul_temp_args.
+
 2017-05-28  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	* frontend-passes.c (matmul_lhs_realloc):  Correct
diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index 62cccc8..be02dce 100644
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -49,6 +49,10 @@ static int inline_matmul_assign (gfc_code **, int *, void *);
 static gfc_code * create_do_loop (gfc_expr *, gfc_expr *, gfc_expr *,
 				  locus *, gfc_namespace *,
 				  char *vname=NULL);
+static gfc_expr* check_conjg_transpose_variable (gfc_expr *, bool *,
+						 bool *);
+static bool has_dimen_vector_ref (gfc_expr *);
+static int matmul_temp_args (gfc_code **, int *,void *data);
 
 #ifdef CHECKING_P
 static void check_locus (gfc_namespace *);
@@ -1087,11 +1091,13 @@ optimize_namespace (gfc_namespace *ns)
 			   (void *) &found);
 	}
       while (found);
-	
+
+      gfc_code_walker (&ns->code, matmul_temp_args, dummy_expr_callback,
+		       NULL);
       gfc_code_walker (&ns->code, inline_matmul_assign, dummy_expr_callback,
 		       NULL);
     }
-  
+
   /* BLOCKs are handled in the expression walker below.  */
   for (ns = ns->contained; ns; ns = ns->sibling)
     {
@@ -2157,6 +2163,92 @@ matmul_to_var_code (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED,
 }
 
 
+/* Take a statement of the shape c = matmul(a,b) and create temporaries
+   for a and b if there is a dependency between the arguments and the
+   result variable or if a or b are the result of calculations that cannot
+   be handled by the inliner.  */
+
+static int
+matmul_temp_args (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED,
+		  void *data ATTRIBUTE_UNUSED)
+{
+  gfc_expr *expr1, *expr2;
+  gfc_code *co;
+  gfc_actual_arglist *a, *b;
+  bool a_tmp, b_tmp;
+  gfc_expr *matrix_a, *matrix_b;
+  bool conjg_a, conjg_b, transpose_a, transpose_b;
+  
+  co = *c;
+
+  if (co->op != EXEC_ASSIGN)
+    return 0;
+
+  if (forall_level > 0 || iterator_level > 0 || in_omp_workshare
+      || in_where)
+    return 0;
+
+  /* This has some duplication with inline_matmul_assign.  This
+     is because the creation of temporary variables could still fail,
+     and inline_matmul_assign still needs to be able to handle these
+     cases.  */
+  expr1 = co->expr1;
+  expr2 = co->expr2;
+
+  if (expr2->expr_type != EXPR_FUNCTION
+      || expr2->value.function.isym == NULL
+      || expr2->value.function.isym->id != GFC_ISYM_MATMUL)
+    return 0;
+
+  a_tmp = false;
+  a = expr2->value.function.actual;
+  matrix_a = check_conjg_transpose_variable (a->expr, &conjg_a, &transpose_a);
+  if (matrix_a != NULL)
+    {
+      if (matrix_a->expr_type == EXPR_VARIABLE
+	  && (gfc_check_dependency (matrix_a, expr1, true)
+	      || has_dimen_vector_ref (matrix_a)))
+	a_tmp = true;
+    }
+  else
+    a_tmp = true;
+
+  b_tmp = false;
+  b = a->next;
+  matrix_b = check_conjg_transpose_variable (b->expr, &conjg_b, &transpose_b);
+  if (matrix_b != NULL)
+    {
+      if (matrix_b->expr_type == EXPR_VARIABLE
+	  && (gfc_check_dependency (matrix_b, expr1, true)
+	      || has_dimen_vector_ref (matrix_b)))
+	b_tmp = true;
+    }
+  else
+    b_tmp = true;
+
+  if (!a_tmp && !b_tmp)
+    return 0;
+  
+  current_code = c;
+  inserted_block = NULL;
+  changed_statement = NULL;
+  if (a_tmp)
+    {
+      gfc_expr *at;
+      at = create_var (a->expr,"mma");
+      if (at)
+	a->expr = at;
+    }
+  if (b_tmp)
+    {
+      gfc_expr *bt;
+      bt = create_var (b->expr,"mmb");
+      if (bt)
+	b->expr = bt;
+    }
+  return 0;
+}
+
 /* Auxiliary function to build and simplify an array inquiry function.
    dim is zero-based.  */
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index bdad067..accf635 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2017-05-29  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/37131
+	* gfortran.dg/promotion_2.f90: Add -finline-matmul-limit=0 to
+	flags.
+	* gfortran.dg/transpose_optimization_1.f90: Likewise.
+	* gfortran.dg/inline_matmul_17.f90:  New test.
+
 2017-05-28  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	* gfortran.dg/matmul_bounds_12.f90:  New test.
diff --git a/gcc/testsuite/gfortran.dg/inline_matmul_17.f90 b/gcc/testsuite/gfortran.dg/inline_matmul_17.f90
new file mode 100644
index 0000000..053dc38
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/inline_matmul_17.f90
@@ -0,0 +1,48 @@
+! { dg-do  run }
+! { dg-options "-O -fdump-tree-optimized -finline-matmul-limit=1000" }
+module x
+  implicit none
+contains
+  function afunc()
+    real, dimension(3,3) :: afunc
+    afunc = reshape([ 2., 3., 5., 7., 11., 13., 17., 19., 23. ], [3,3])
+  end function afunc
+  
+  function bfunc()
+    real, dimension(3,3) :: bfunc
+    bfunc = reshape([29., 31., 37., 41., 43., 47., 53., 59., 61., 67.],[3,3])
+  end function bfunc
+end module x
+
+program main
+  use x
+  implicit none
+  real, dimension(3,3), parameter :: &
+       & aval = reshape([ 2., 3., 5., 7., 11., 13., 17., 19., 23. ], [3,3]), &
+       & bval = reshape([29., 31., 37., 41., 43., 47., 53., 59., 61., 67.],[3,3])
+  integer, dimension(3) :: ind
+  real, dimension(3,3) :: a, b,c,d, ri
+  data ri /120430., 187861., 151737., 161022., 251139., 202847., 212566., 331537., 267781./
+  data d/904., 1131., 1399., 1182., 1489., 1845., 1556., 1967., 2435. /
+  a = aval
+  b = bval
+  c = matmul(a,b)
+  a = matmul(a,b)
+  if (any(a-c /= 0)) call abort
+  a = aval
+  b = bval
+  b = matmul(a,b)
+  if (any(b-c /= 0)) call abort
+  b = bval
+  a = matmul(aval, b)
+  if (any(a-c /= 0)) call abort
+  ind = [1, 3, 2]
+  c = matmul(a(ind,:),b)
+  if (any(c-ri /= 0)) call abort
+  c = matmul(afunc(),b)
+  if (any(c-d /= 0)) call abort
+  a = afunc()
+  c = matmul(a, bfunc())
+  if (any(c-d /= 0)) call abort
+end program main
+! { dg-final { scan-tree-dump-times "matmul_r4" 2 "optimized" } }
diff --git a/gcc/testsuite/gfortran.dg/promotion_2.f90 b/gcc/testsuite/gfortran.dg/promotion_2.f90
index e536509..7e3c6c9 100644
--- a/gcc/testsuite/gfortran.dg/promotion_2.f90
+++ b/gcc/testsuite/gfortran.dg/promotion_2.f90
@@ -1,5 +1,5 @@
 ! { dg-do compile }
-! { dg-options "-fdefault-real-8 -fexternal-blas -fdump-tree-original" }
+! { dg-options "-fdefault-real-8 -fexternal-blas -fdump-tree-original -finline-matmul-limit=0" }
 !
 ! PR fortran/54463
 !
diff --git a/gcc/testsuite/gfortran.dg/transpose_optimization_1.f90 b/gcc/testsuite/gfortran.dg/transpose_optimization_1.f90
index 82116e7..f1f5832 100644
--- a/gcc/testsuite/gfortran.dg/transpose_optimization_1.f90
+++ b/gcc/testsuite/gfortran.dg/transpose_optimization_1.f90
@@ -1,5 +1,5 @@
 ! { dg-do compile }
-! { dg-options "-Warray-temporaries -fdump-tree-original" }
+! { dg-options "-Warray-temporaries -fdump-tree-original -finline-matmul-limit=0" }
 !
 ! PR fortran/45648
 ! Non-copying descriptor transpose optimization (for function call args).