trans-expr.c (is_zero_initializer_p): Determine whether a given constant expression is a zero initializer.
* trans-expr.c (is_zero_initializer_p): Determine whether a given constant expression is a zero initializer. (gfc_trans_zero_assign): New function to attempt to optimize "a(:) = 0.0" as a call to __builtin_memset (a, 0, sizeof(a)); (gfc_trans_assignment): Special case array assignments to a zero initializer constant, using gfc_trans_zero_assign. * gfortran.dg/array_memset_1.f90: New test case. From-SVN: r120078
This commit is contained in:
parent
f1f4e530a5
commit
6822a10d9d
@ -1,3 +1,12 @@
|
||||
2006-12-20 Roger Sayle <roger@eyesopen.com>
|
||||
|
||||
* trans-expr.c (is_zero_initializer_p): Determine whether a given
|
||||
constant expression is a zero initializer.
|
||||
(gfc_trans_zero_assign): New function to attempt to optimize
|
||||
"a(:) = 0.0" as a call to __builtin_memset (a, 0, sizeof(a));
|
||||
(gfc_trans_assignment): Special case array assignments to a
|
||||
zero initializer constant, using gfc_trans_zero_assign.
|
||||
|
||||
2006-12-20 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
PR fortran/29992
|
||||
|
@ -3449,6 +3449,82 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2)
|
||||
return gfc_finish_block (&se.pre);
|
||||
}
|
||||
|
||||
/* Determine whether the given EXPR_CONSTANT is a zero initializer. */
|
||||
|
||||
static bool
|
||||
is_zero_initializer_p (gfc_expr * expr)
|
||||
{
|
||||
if (expr->expr_type != EXPR_CONSTANT)
|
||||
return false;
|
||||
/* We ignore Hollerith constants for the time being. */
|
||||
if (expr->from_H)
|
||||
return false;
|
||||
|
||||
switch (expr->ts.type)
|
||||
{
|
||||
case BT_INTEGER:
|
||||
return mpz_cmp_si (expr->value.integer, 0) == 0;
|
||||
|
||||
case BT_REAL:
|
||||
return mpfr_zero_p (expr->value.real)
|
||||
&& MPFR_SIGN (expr->value.real) >= 0;
|
||||
|
||||
case BT_LOGICAL:
|
||||
return expr->value.logical == 0;
|
||||
|
||||
case BT_COMPLEX:
|
||||
return mpfr_zero_p (expr->value.complex.r)
|
||||
&& MPFR_SIGN (expr->value.complex.r) >= 0
|
||||
&& mpfr_zero_p (expr->value.complex.i)
|
||||
&& MPFR_SIGN (expr->value.complex.i) >= 0;
|
||||
|
||||
default:
|
||||
break;
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
/* Try to efficiently translate array(:) = 0. Return NULL if this
|
||||
can't be done. */
|
||||
|
||||
static tree
|
||||
gfc_trans_zero_assign (gfc_expr * expr)
|
||||
{
|
||||
tree dest, len, type;
|
||||
tree tmp, args;
|
||||
gfc_symbol *sym;
|
||||
|
||||
sym = expr->symtree->n.sym;
|
||||
dest = gfc_get_symbol_decl (sym);
|
||||
|
||||
type = TREE_TYPE (dest);
|
||||
if (POINTER_TYPE_P (type))
|
||||
type = TREE_TYPE (type);
|
||||
if (!GFC_ARRAY_TYPE_P (type))
|
||||
return NULL_TREE;
|
||||
|
||||
/* Determine the length of the array. */
|
||||
len = GFC_TYPE_ARRAY_SIZE (type);
|
||||
if (!len || TREE_CODE (len) != INTEGER_CST)
|
||||
return NULL_TREE;
|
||||
|
||||
len = fold_build2 (MULT_EXPR, gfc_array_index_type, len,
|
||||
TYPE_SIZE_UNIT (gfc_get_element_type (type)));
|
||||
|
||||
/* Convert arguments to the correct types. */
|
||||
if (!POINTER_TYPE_P (TREE_TYPE (dest)))
|
||||
dest = gfc_build_addr_expr (pvoid_type_node, dest);
|
||||
else
|
||||
dest = fold_convert (pvoid_type_node, dest);
|
||||
len = fold_convert (size_type_node, len);
|
||||
|
||||
/* Construct call to __builtin_memset. */
|
||||
args = build_tree_list (NULL_TREE, len);
|
||||
args = tree_cons (NULL_TREE, integer_zero_node, args);
|
||||
args = tree_cons (NULL_TREE, dest, args);
|
||||
tmp = build_function_call_expr (built_in_decls[BUILT_IN_MEMSET], args);
|
||||
return fold_convert (void_type_node, tmp);
|
||||
}
|
||||
|
||||
/* Translate an assignment. Most of the code is concerned with
|
||||
setting up the scalarizer. */
|
||||
@ -3475,6 +3551,18 @@ gfc_trans_assignment (gfc_expr * expr1, gfc_expr * expr2, bool init_flag)
|
||||
return tmp;
|
||||
}
|
||||
|
||||
/* Special case assigning an array to zero. */
|
||||
if (expr1->expr_type == EXPR_VARIABLE
|
||||
&& expr1->rank > 0
|
||||
&& expr1->ref
|
||||
&& gfc_full_array_ref_p (expr1->ref)
|
||||
&& is_zero_initializer_p (expr2))
|
||||
{
|
||||
tmp = gfc_trans_zero_assign (expr1);
|
||||
if (tmp)
|
||||
return tmp;
|
||||
}
|
||||
|
||||
/* Assignment of the form lhs = rhs. */
|
||||
gfc_start_block (&block);
|
||||
|
||||
|
@ -1,3 +1,7 @@
|
||||
2006-12-20 Roger Sayle <roger@eyesopen.com>
|
||||
|
||||
* gfortran.dg/array_memset_1.f90: New test case.
|
||||
|
||||
2006-12-20 Dorit Nuzman <dorit@il.ibm.com>
|
||||
|
||||
* lib/target-supports.exp: Add spu to
|
||||
|
64
gcc/testsuite/gfortran.dg/array_memset_1.f90
Normal file
64
gcc/testsuite/gfortran.dg/array_memset_1.f90
Normal file
@ -0,0 +1,64 @@
|
||||
! { dg-do compile }
|
||||
! { dg-options "-O2 -fdump-tree-original" }
|
||||
subroutine i1(a)
|
||||
integer :: a(20)
|
||||
a = 0;
|
||||
end subroutine
|
||||
|
||||
subroutine i2(a)
|
||||
integer :: a(20)
|
||||
a(:) = 0;
|
||||
end subroutine
|
||||
|
||||
subroutine i3(a)
|
||||
integer :: a(20)
|
||||
a(1:20) = 0;
|
||||
end subroutine
|
||||
|
||||
subroutine r1(a)
|
||||
real :: a(20)
|
||||
a = 0.0;
|
||||
end subroutine
|
||||
|
||||
subroutine r2(a)
|
||||
real :: a(20)
|
||||
a(:) = 0.0;
|
||||
end subroutine
|
||||
|
||||
subroutine r3(a)
|
||||
real :: a(20)
|
||||
a(1:20) = 0.0;
|
||||
end subroutine
|
||||
|
||||
subroutine z1(a)
|
||||
complex :: a(20)
|
||||
a = 0;
|
||||
end subroutine
|
||||
|
||||
subroutine z2(a)
|
||||
complex :: a(20)
|
||||
a(:) = 0;
|
||||
end subroutine
|
||||
|
||||
subroutine z3(a)
|
||||
complex :: a(20)
|
||||
a(1:20) = 0;
|
||||
end subroutine
|
||||
|
||||
subroutine l1(a)
|
||||
logical :: a(20)
|
||||
a = .false.;
|
||||
end subroutine
|
||||
|
||||
subroutine l2(a)
|
||||
logical :: a(20)
|
||||
a(:) = .false.;
|
||||
end subroutine
|
||||
|
||||
subroutine l3(a)
|
||||
logical :: a(20)
|
||||
a(1:20) = .false.;
|
||||
end subroutine
|
||||
|
||||
! { dg-final { scan-tree-dump-times "memset" 12 "original" } }
|
||||
! { dg-final { cleanup-tree-dump "original" } }
|
Loading…
Reference in New Issue
Block a user