From: Thomas Koenig Date: Thu, 21 May 2015 19:00:45 +0000 (+0000) Subject: re PR fortran/66176 (Handle conjg() in inline matmul) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=c39d5e4a6a900227a279e5cadfb52168eb2397c0;p=gcc.git re PR fortran/66176 (Handle conjg() in inline matmul) 2015-05-21 Thomas Koenig 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 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 fa9edb5cf8a..860f8f9160d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2015-05-21 Thomas Koenig + + 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 PR fortran/65548 diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index a6b57860a20..aeee73e0489 100644 --- 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 df8d64cede9..73a3e569210 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2015-05-21 Thomas Koenig + + PR fortran/66176 + * gfortran.dg/inline_matmul_11.f90: New test. + 2015-05-21 Andreas Tobler * 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 index 00000000000..c3733bac427 --- /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" } }