From 1372ec9a4daa00eac74c0a23c95ca828dbbb6912 Mon Sep 17 00:00:00 2001 From: sayle Date: Fri, 5 Jan 2007 21:27:16 +0000 Subject: [PATCH] * trans-expr.c (gfc_trans_assignment_1): New subroutine to scalarize array assignments split out from gfc_trans_assignment. (gfc_trans_array_copy): New function to implement array to array copies via calls to __builtin_memcpy. (copyable_array_p): New helper function to identify an array of simple/POD types, that may be copied/assigned using memcpy. (gfc_trans_assignment): Use gfc_trans_array_copy to handle simple whole array assignments considered suitable by copyable_array_p. Invoke gfc_trans_assignment_1 to perform the fallback scalarization. * gfortran.dg/array_memcpy_1.f90: New test case. * gfortran.dg/array_memcpy_2.f90: Likewise. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@120503 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 12 ++ gcc/fortran/trans-expr.c | 165 +++++++++++++++++++++++---- gcc/testsuite/ChangeLog | 5 + gcc/testsuite/gfortran.dg/array_memcpy_1.f90 | 28 +++++ gcc/testsuite/gfortran.dg/array_memcpy_2.f90 | 20 ++++ 5 files changed, 206 insertions(+), 24 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/array_memcpy_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/array_memcpy_2.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a6d2223..005d4b3 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,17 @@ 2007-01-05 Roger Sayle + * trans-expr.c (gfc_trans_assignment_1): New subroutine to scalarize + array assignments split out from gfc_trans_assignment. + (gfc_trans_array_copy): New function to implement array to array + copies via calls to __builtin_memcpy. + (copyable_array_p): New helper function to identify an array of + simple/POD types, that may be copied/assigned using memcpy. + (gfc_trans_assignment): Use gfc_trans_array_copy to handle simple + whole array assignments considered suitable by copyable_array_p. + Invoke gfc_trans_assignment_1 to perform the fallback scalarization. + +2007-01-05 Roger Sayle + * trans-array.c (gfc_trans_array_constructor_value): Make the static const "data" array as TREE_READONLY. * trans-stmt.c (gfc_trans_character_select): Likewise. diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index e534aff..c6ebf3e 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -3579,11 +3579,76 @@ gfc_trans_zero_assign (gfc_expr * expr) return fold_convert (void_type_node, tmp); } -/* Translate an assignment. Most of the code is concerned with - setting up the scalarizer. */ +/* Try to efficiently translate dst(:) = src(:). Return NULL if this + can't be done. EXPR1 is the destination/lhs and EXPR2 is the + source/rhs, both are gfc_full_array_ref_p which have been checked for + dependencies. */ -tree -gfc_trans_assignment (gfc_expr * expr1, gfc_expr * expr2, bool init_flag) +static tree +gfc_trans_array_copy (gfc_expr * expr1, gfc_expr * expr2) +{ + tree dst, dlen, dtype; + tree src, slen, stype; + tree tmp, args; + + dst = gfc_get_symbol_decl (expr1->symtree->n.sym); + src = gfc_get_symbol_decl (expr2->symtree->n.sym); + + dtype = TREE_TYPE (dst); + if (POINTER_TYPE_P (dtype)) + dtype = TREE_TYPE (dtype); + stype = TREE_TYPE (src); + if (POINTER_TYPE_P (stype)) + stype = TREE_TYPE (stype); + + if (!GFC_ARRAY_TYPE_P (dtype) || !GFC_ARRAY_TYPE_P (stype)) + return NULL_TREE; + + /* Determine the lengths of the arrays. */ + dlen = GFC_TYPE_ARRAY_SIZE (dtype); + if (!dlen || TREE_CODE (dlen) != INTEGER_CST) + return NULL_TREE; + dlen = fold_build2 (MULT_EXPR, gfc_array_index_type, dlen, + TYPE_SIZE_UNIT (gfc_get_element_type (dtype))); + + slen = GFC_TYPE_ARRAY_SIZE (stype); + if (!slen || TREE_CODE (slen) != INTEGER_CST) + return NULL_TREE; + slen = fold_build2 (MULT_EXPR, gfc_array_index_type, slen, + TYPE_SIZE_UNIT (gfc_get_element_type (stype))); + + /* Sanity check that they are the same. This should always be + the case, as we should already have checked for conformance. */ + if (!tree_int_cst_equal (slen, dlen)) + return NULL_TREE; + + /* Convert arguments to the correct types. */ + if (!POINTER_TYPE_P (TREE_TYPE (dst))) + dst = gfc_build_addr_expr (pvoid_type_node, dst); + else + dst = fold_convert (pvoid_type_node, dst); + + if (!POINTER_TYPE_P (TREE_TYPE (src))) + src = gfc_build_addr_expr (pvoid_type_node, src); + else + src = fold_convert (pvoid_type_node, src); + + dlen = fold_convert (size_type_node, dlen); + + /* Construct call to __builtin_memcpy. */ + args = build_tree_list (NULL_TREE, dlen); + args = tree_cons (NULL_TREE, src, args); + args = tree_cons (NULL_TREE, dst, args); + tmp = build_function_call_expr (built_in_decls[BUILT_IN_MEMCPY], args); + return fold_convert (void_type_node, tmp); +} + + +/* Subroutine of gfc_trans_assignment that actually scalarizes the + assignment. EXPR1 is the destination/RHS and EXPR2 is the source/LHS. */ + +static tree +gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag) { gfc_se lse; gfc_se rse; @@ -3596,26 +3661,6 @@ gfc_trans_assignment (gfc_expr * expr1, gfc_expr * expr2, bool init_flag) stmtblock_t body; bool l_is_temp; - /* Special case a single function returning an array. */ - if (expr2->expr_type == EXPR_FUNCTION && expr2->rank > 0) - { - tmp = gfc_trans_arrayfunc_assign (expr1, expr2); - if (tmp) - 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); @@ -3751,6 +3796,78 @@ gfc_trans_assignment (gfc_expr * expr1, gfc_expr * expr2, bool init_flag) return gfc_finish_block (&block); } + +/* Check whether EXPR, which is an EXPR_VARIABLE, is a copyable array. */ + +static bool +copyable_array_p (gfc_expr * expr) +{ + /* First check it's an array. */ + if (expr->rank < 1 || !expr->ref) + return false; + + /* Next check that it's of a simple enough type. */ + switch (expr->ts.type) + { + case BT_INTEGER: + case BT_REAL: + case BT_COMPLEX: + case BT_LOGICAL: + return true; + + default: + break; + } + + return false; +} + +/* Translate an assignment. */ + +tree +gfc_trans_assignment (gfc_expr * expr1, gfc_expr * expr2, bool init_flag) +{ + tree tmp; + + /* Special case a single function returning an array. */ + if (expr2->expr_type == EXPR_FUNCTION && expr2->rank > 0) + { + tmp = gfc_trans_arrayfunc_assign (expr1, expr2); + if (tmp) + 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; + } + + /* Special case copying one array to another. */ + if (expr1->expr_type == EXPR_VARIABLE + && copyable_array_p (expr1) + && gfc_full_array_ref_p (expr1->ref) + && expr2->expr_type == EXPR_VARIABLE + && copyable_array_p (expr2) + && gfc_full_array_ref_p (expr2->ref) + && gfc_compare_types (&expr1->ts, &expr2->ts) + && !gfc_check_dependency (expr1, expr2, 0)) + { + tmp = gfc_trans_array_copy (expr1, expr2); + if (tmp) + return tmp; + } + + /* Fallback to the scalarizer to generate explicit loops. */ + return gfc_trans_assignment_1 (expr1, expr2, init_flag); +} + tree gfc_trans_init_assign (gfc_code * code) { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 817846a..1890965 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2007-01-05 Roger Sayle + + * gfortran.dg/array_memcpy_1.f90: New test case. + * gfortran.dg/array_memcpy_2.f90: Likewise. + 2007-01-05 Richard Guenther PR middle-end/27826 diff --git a/gcc/testsuite/gfortran.dg/array_memcpy_1.f90 b/gcc/testsuite/gfortran.dg/array_memcpy_1.f90 new file mode 100644 index 0000000..2d2f8f7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_memcpy_1.f90 @@ -0,0 +1,28 @@ +! { dg-do compile } +! { dg-options "-O2 -fdump-tree-original" } +subroutine testi(a,b) + integer :: a(20) + integer :: b(20) + a = b; +end subroutine + +subroutine testr(a,b) + real :: a(20) + real :: b(20) + a = b; +end subroutine + +subroutine testz(a,b) + complex :: a(20) + complex :: b(20) + a = b; +end subroutine + +subroutine testl(a,b) + logical :: a(20) + logical :: b(20) + a = b; +end subroutine + +! { dg-final { scan-tree-dump-times "memcpy" 4 "original" } } +! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/array_memcpy_2.f90 b/gcc/testsuite/gfortran.dg/array_memcpy_2.f90 new file mode 100644 index 0000000..be8f00d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_memcpy_2.f90 @@ -0,0 +1,20 @@ +! This checks that the "z = y" assignment is not considered copyable, as the +! array is of a derived type containing allocatable components. Hence, we +! we should expand the scalarized loop, which contains *two* memcpy calls. +! { dg-do compile } +! { dg-options "-O2 -fdump-tree-original" } + + type :: a + integer, allocatable :: i(:) + end type a + + type :: b + type (a), allocatable :: at(:) + end type b + + type(b) :: y(2), z(2) + + z = y +end +! { dg-final { scan-tree-dump-times "memcpy" 2 "original" } } +! { dg-final { cleanup-tree-dump "original" } } -- 2.7.4