From 6822a10d9d8a0f9635e88624fb12ff34653e47a2 Mon Sep 17 00:00:00 2001 From: Roger Sayle Date: Wed, 20 Dec 2006 17:23:43 +0000 Subject: [PATCH] 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 --- gcc/fortran/ChangeLog | 9 ++ gcc/fortran/trans-expr.c | 88 ++++++++++++++++++++ gcc/testsuite/ChangeLog | 4 + gcc/testsuite/gfortran.dg/array_memset_1.f90 | 64 ++++++++++++++ 4 files changed, 165 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/array_memset_1.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d283671cb0c..0eb5dc5d75e 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2006-12-20 Roger Sayle + + * 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 PR fortran/29992 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 04736d5a1da..bd7983487c4 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -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); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 34255c46c49..d666489aa3e 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2006-12-20 Roger Sayle + + * gfortran.dg/array_memset_1.f90: New test case. + 2006-12-20 Dorit Nuzman * lib/target-supports.exp: Add spu to diff --git a/gcc/testsuite/gfortran.dg/array_memset_1.f90 b/gcc/testsuite/gfortran.dg/array_memset_1.f90 new file mode 100644 index 00000000000..cd6cb0d6d5d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_memset_1.f90 @@ -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" } }