re PR fortran/66176 (Handle conjg() in inline matmul)

2015-05-21  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/66176
	* frontend-passes.c (check_conjg_variable):  New function.
	(inline_matmul_assign):  Use it to keep track of conjugated
	variables.

2015-05-21  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/66176
	* gfortran.dg/inline_matmul_11.f90:  New test

From-SVN: r223499

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index fa9edb5cf8ab522c57b2d12f026cd43cc3963139..860f8f9160de6481bb211e934c8e14067a23eb57 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2015-05-21  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR fortran/66176
+       * frontend-passes.c (check_conjg_variable):  New function.
+       (inline_matmul_assign):  Use it to keep track of conjugated
+       variables.
+
 2015-05-20  Andre Vehreschild  <vehre@gmx.de>
 
        PR fortran/65548

diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index a6b57860a20eb72740cb99d0aa0cf3e7c649c3fe..aeee73e048900ab6798888056358048128719b4d 100644 (file)
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -2700,6 +2700,45 @@ has_dimen_vector_ref (gfc_expr *e)
   return false;
 }
 
+/* If handed an expression of the form
+
+   CONJG(A)
+
+   check if A can be handled by matmul and return if there is an uneven number
+   of CONJG calls.  Return a pointer to the array when everything is OK, NULL
+   otherwise. The caller has to check for the correct rank.  */
+
+static gfc_expr*
+check_conjg_variable (gfc_expr *e, bool *conjg)
+{
+  *conjg = false;
+
+  do
+    {
+      if (e->expr_type == EXPR_VARIABLE)
+       {
+         gcc_assert (e->rank == 1 || e->rank == 2);
+         return e;
+       }
+      else if (e->expr_type == EXPR_FUNCTION)
+       {
+         if (e->value.function.isym == NULL)
+           return NULL;
+
+         if (e->value.function.isym->id == GFC_ISYM_CONJG)
+           *conjg = !*conjg;
+         else return NULL;
+       }
+      else
+       return NULL;
+
+      e = e->value.function.actual->expr;
+    }
+  while(1);
+
+  return NULL;
+}
+
 /* Inline assignments of the form c = matmul(a,b).
    Handle only the cases currently where b and c are rank-two arrays.
 
@@ -2744,6 +2783,7 @@ inline_matmul_assign (gfc_code **c, int *walk_subtrees,
   int i;
   gfc_code *if_limit = NULL;
   gfc_code **next_code_point;
+  bool conjg_a, conjg_b;
 
   if (co->op != EXEC_ASSIGN)
     return 0;
@@ -2760,30 +2800,29 @@ inline_matmul_assign (gfc_code **c, int *walk_subtrees,
   changed_statement = NULL;
 
   a = expr2->value.function.actual;
-  matrix_a = a->expr;
-  b = a->next;
-  matrix_b = b->expr;
-
-  /* Currently only handling direct variables.  Transpose etc. will come
-     later.  */
+  matrix_a = check_conjg_variable (a->expr, &conjg_a);
+  if (matrix_a == NULL)
+    return 0;
 
-  if (matrix_a->expr_type != EXPR_VARIABLE
-      || matrix_b->expr_type != EXPR_VARIABLE)
+  b = a->next;
+  matrix_b = check_conjg_variable (b->expr, &conjg_b);
+  if (matrix_b == NULL)
     return 0;
 
   if (has_dimen_vector_ref (expr1) || has_dimen_vector_ref (matrix_a)
       || has_dimen_vector_ref (matrix_b))
     return 0;
 
+  /* We do not handle data dependencies yet.  */
+  if (gfc_check_dependency (expr1, matrix_a, true)
+      || gfc_check_dependency (expr1, matrix_b, true))
+    return 0;
+
   if (matrix_a->rank == 2)
     m_case = matrix_b->rank == 1 ? A2B1 : A2B2;
   else
     m_case = A1B2;
 
-  /* We do not handle data dependencies yet.  */
-  if (gfc_check_dependency (expr1, matrix_a, true)
-      || gfc_check_dependency (expr1, matrix_b, true))
-    return 0;
 
   ns = insert_block ();
 
@@ -3056,6 +3095,14 @@ inline_matmul_assign (gfc_code **c, int *walk_subtrees,
       gcc_unreachable();
     }
 
+  if (conjg_a)
+    ascalar = gfc_build_intrinsic_call (ns, GFC_ISYM_CONJG, "conjg",
+                                       matrix_a->where, 1, ascalar);
+
+  if (conjg_b)
+    bscalar = gfc_build_intrinsic_call (ns, GFC_ISYM_CONJG, "conjg", 
+                                       matrix_b->where, 1, bscalar);
+
   /* First loop comes after the zero assignment.  */
   assign_zero->next = do_1;
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index df8d64cede9acdc257e3fc5393e521ed1b010748..73a3e569210a523af4e7a9368d8be76a714927f3 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2015-05-21  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR fortran/66176
+       * gfortran.dg/inline_matmul_11.f90:  New test.
+
 2015-05-21  Andreas Tobler  <andreast@gcc.gnu.org>
 
        * gcc.target/i386/pr32219-1.c: Use 'dg-require-effective-target pie'

diff --git a/gcc/testsuite/gfortran.dg/inline_matmul_11.f90 b/gcc/testsuite/gfortran.dg/inline_matmul_11.f90
new file mode 100644 (file)
index 0000000..c3733ba
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/inline_matmul_11.f90
@@ -0,0 +1,33 @@
+! { dg-do  run }
+! { dg-additional-options "-ffrontend-optimize -fdump-tree-original" }
+! PR fortran/66176 - inline conjg for matml.
+program main
+  complex, dimension(3,2) :: a
+  complex, dimension(2,4) :: b, b2
+  complex, dimension(3,4) :: c,c2
+  complex, dimension(3,4) :: res1, res2, res3
+
+  data a/(2.,-3.),(-5.,-7.),(11.,-13.),(-17.,-19.),(23.,-29.),(-31.,-37.) /
+  data b/(41.,-43.),(-47.,-53.),(59.,-61.),(-67.,-71.),(73.,-79.),&
+       & (-83.,-89.),(97.,-101.), (-103.,-107.)/
+
+  data res1 /  (-255.,1585.),(-3124.,72.),(-612.,2376.),(-275.,2181.), &
+       & (-4322.,202.),(-694.,3242.),(-371.,2713.),( -5408.,244.),(-944.,4012.),&
+       & (-391.,3283.),(-6664.,352.),(-1012.,4756.)/
+
+  data res2 / (2017.,-45.),(552.,2080.),(4428.,36.),(2789.,11.),(650.,2858.),&
+       & (6146.,182.),(3485.,3.),(860.,3548.),(7696.,232.),(4281.,49.),&
+       & (956.,4264.),(9532.,344.)/
+
+  c = matmul(a,b)
+  if (any(res1 /= c)) call abort
+  b2 = conjg(b)
+  c = matmul(a,conjg(b2))
+  if (any(res1 /= c)) call abort
+  c = matmul(a,conjg(b))
+  if (any(res2 /= c)) call abort
+  c = matmul(conjg(a), b)
+  if (any(conjg(c) /= res2)) call abort
+end program main
+! { dg-final { scan-tree-dump-times "_gfortran_matmul" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }