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:
Roger Sayle 2006-12-20 17:23:43 +00:00 committed by Roger Sayle
parent f1f4e530a5
commit 6822a10d9d
4 changed files with 165 additions and 0 deletions

View File

@ -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

View File

@ -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);

View File

@ -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

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