mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-05 08:00:26 +08:00
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
This commit is contained in:
Thomas Koenig
parent
2aa3880198
commit
c39d5e4a6a
@ -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
|
||||
|
||||
@ -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;
|
||||
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)
|
||||
|| 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;
|
||||
|
||||
|
||||
@ -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'
|
||||
|
||||
33
gcc/testsuite/gfortran.dg/inline_matmul_11.f90
Normal file
33
gcc/testsuite/gfortran.dg/inline_matmul_11.f90
Normal file
@ -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" } }
|
||||
Loading…
x
Reference in New Issue
Block a user