Hello world,
this patch extends the inline matmul functionality to conjugate
complex numbers.
Regression-tested. OK for trunk?
Regards
Thomas
2015-05-17 Thomas Koenig <tkoe...@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-17 Thomas Koenig <tkoe...@gcc.gnu.org>
PR fortran/66176
* gfortran.dg/inline_matmul_11.f90: New test.
Index: frontend-passes.c
===================================================================
--- frontend-passes.c (Revision 223202)
+++ frontend-passes.c (Arbeitskopie)
@@ -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_subt
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,15 +2800,13 @@ inline_matmul_assign (gfc_code **c, int *walk_subt
changed_statement = NULL;
a = expr2->value.function.actual;
- matrix_a = a->expr;
+ matrix_a = check_conjg_variable (a->expr, &conjg_a);
+ if (matrix_a == NULL)
+ return 0;
+
b = a->next;
- matrix_b = b->expr;
-
- /* Currently only handling direct variables. Transpose etc. will come
- later. */
-
- if (matrix_a->expr_type != EXPR_VARIABLE
- || matrix_b->expr_type != EXPR_VARIABLE)
+ 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)
@@ -2775,15 +2813,16 @@ inline_matmul_assign (gfc_code **c, int *walk_subt
|| 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_subt
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_a->where,
+ 1, bscalar);
+
/* First loop comes after the zero assignment. */
assign_zero->next = do_1;
! { 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" } }
