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" } }