From patchwork Sun May 1 09:49:49 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 93541 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id A9B0FB6F18 for ; Sun, 1 May 2011 19:50:14 +1000 (EST) Received: (qmail 17348 invoked by alias); 1 May 2011 09:50:09 -0000 Received: (qmail 17329 invoked by uid 22791); 1 May 2011 09:50:07 -0000 X-SWARE-Spam-Status: No, hits=-0.8 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from cc-smtpout1.netcologne.de (HELO cc-smtpout1.netcologne.de) (89.1.8.211) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Sun, 01 May 2011 09:49:52 +0000 Received: from cc-smtpin3.netcologne.de (cc-smtpin3.netcologne.de [89.1.8.203]) by cc-smtpout1.netcologne.de (Postfix) with ESMTP id 512C41262C; Sun, 1 May 2011 11:49:51 +0200 (CEST) Received: from [192.168.0.197] (xdsl-78-35-158-188.netcologne.de [78.35.158.188]) by cc-smtpin3.netcologne.de (Postfix) with ESMTPSA id 2B48411E9B; Sun, 1 May 2011 11:49:50 +0200 (CEST) Message-ID: <4DBD2CBD.2040502@netcologne.de> Date: Sun, 01 May 2011 11:49:49 +0200 From: Thomas Koenig User-Agent: Mozilla/5.0 (X11; U; Linux x86_64; de; rv:1.9.2.14) Gecko/20110221 SUSE/3.1.8 Thunderbird/3.1.8 MIME-Version: 1.0 To: "fortran@gcc.gnu.org" , gcc-patches Subject: [patch, fortran] Eliminate duplicate function calls with rank>0 and unknown shape Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Hello world, after Paul's fix for allocate on assignment (thanks Paul!), here is a patch for the original test case from PR 22572, where the bounds of the function are unknown at compile time. This uses an allocatable temporary. In the long run, another option is to use interface mapping to evaluate the bounds of intrinsics and explicit-shape functions. For this, it would be necessary to write a front-end-only version of gfc_evaluate_now, which would be complicated by the desire not to disturb common function elimination, so I've put that on the back burner for now. Regression-tested. OK for trunk? Thomas 2011-05-01 Thomas Koenig PR fortran/22572 * frontend-passes.c (cfe_register_funcs): Also register functions for potential elimination if the rank is > 0, the shape is unknown and reallocate on assignment is active. (create_var): For rank > 0 functions with unknown shape, create an allocatable temporary. 2011-05-01 Thomas Koenig PR fortran/22572 * function_optimize_7.f90: New test case. ! { dg-do compile } ! { dg-options "-O -fdump-tree-original -Warray-temporaries" } subroutine xx(n, m, a, b, c, d, x, z, i, s_in, s_out) implicit none integer, intent(in) :: n, m real, intent(in), dimension(n,n) :: a, b, c real, intent(out), dimension(n,n) :: d real, intent(in), dimension(n,m) :: s_in real, intent(out), dimension(m) :: s_out integer, intent(out) :: i real, intent(inout) :: x real, intent(out) :: z character(60) :: line real, external :: ext_func interface elemental function element(x) real, intent(in) :: x real :: elem end function element pure function mypure(x) real, intent(in) :: x integer :: mypure end function mypure elemental impure function elem_impure(x) real, intent(in) :: x real :: elem_impure end function elem_impure end interface d = matmul(a,b) + matmul(a,b) ! { dg-warning "Creating array temporary" } z = sin(x) + cos(x) + sin(x) + cos(x) x = ext_func(a) + 23 + ext_func(a) z = element(x) + element(x) i = mypure(x) - mypure(x) z = elem_impure(x) - elem_impure(x) s_out = sum(s_in,1) + 3.14 / sum(s_in,1) ! { dg-warning "Creating array temporary" } end subroutine xx ! { dg-final { scan-tree-dump-times "matmul_r4" 1 "original" } } ! { dg-final { scan-tree-dump-times "__builtin_sinf" 1 "original" } } ! { dg-final { scan-tree-dump-times "__builtin_cosf" 1 "original" } } ! { dg-final { scan-tree-dump-times "ext_func" 2 "original" } } ! { dg-final { scan-tree-dump-times "element" 1 "original" } } ! { dg-final { scan-tree-dump-times "mypure" 1 "original" } } ! { dg-final { scan-tree-dump-times "elem_impure" 2 "original" } } ! { dg-final { scan-tree-dump-times "sum_r4" 1 "original" } } ! { dg-final { cleanup-tree-dump "original" } } Index: frontend-passes.c =================================================================== --- frontend-passes.c (Revision 173214) +++ frontend-passes.c (Arbeitskopie) @@ -152,11 +152,11 @@ cfe_register_funcs (gfc_expr **e, int *walk_subtre if ((*e)->ts.type == BT_CHARACTER) return 0; - /* If we don't know the shape at compile time, we do not create a temporary - variable to hold the intermediate result. FIXME: Change this later when - allocation on assignment works for intrinsics. */ + /* If we don't know the shape at compile time, we create an allocatable + temporary variable to hold the intermediate result, but only if + allocation on assignment is active. */ - if ((*e)->rank > 0 && (*e)->shape == NULL) + if ((*e)->rank > 0 && (*e)->shape == NULL && !gfc_option.flag_realloc_lhs) return 0; /* Skip the test for pure functions if -faggressive-function-elimination @@ -250,22 +250,38 @@ create_var (gfc_expr * e) symbol = symtree->n.sym; symbol->ts = e->ts; - symbol->as = gfc_get_array_spec (); - symbol->as->rank = e->rank; - symbol->as->type = AS_EXPLICIT; - for (i=0; irank; i++) + + if (e->rank > 0) { - gfc_expr *p, *q; + symbol->as = gfc_get_array_spec (); + symbol->as->rank = e->rank; + + if (e->shape == NULL) + { + /* We don't know the shape at compile time, so we use an + allocatable. */ + symbol->as->type = AS_DEFERRED; + symbol->attr.allocatable = 1; + } + else + { + symbol->as->type = AS_EXPLICIT; + /* Copy the shape. */ + for (i=0; irank; i++) + { + gfc_expr *p, *q; - p = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind, - &(e->where)); - mpz_set_si (p->value.integer, 1); - symbol->as->lower[i] = p; - - q = gfc_get_constant_expr (BT_INTEGER, gfc_index_integer_kind, - &(e->where)); - mpz_set (q->value.integer, e->shape[i]); - symbol->as->upper[i] = q; + p = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind, + &(e->where)); + mpz_set_si (p->value.integer, 1); + symbol->as->lower[i] = p; + + q = gfc_get_constant_expr (BT_INTEGER, gfc_index_integer_kind, + &(e->where)); + mpz_set (q->value.integer, e->shape[i]); + symbol->as->upper[i] = q; + } + } } symbol->attr.flavor = FL_VARIABLE;