From patchwork Sun Jan 13 22:14:32 2013 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 211657 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 1DD3E2C00FC for ; Mon, 14 Jan 2013 09:14:53 +1100 (EST) Comment: DKIM? See http://www.dkim.org DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d=gcc.gnu.org; s=default; x=1358720094; h=Comment: DomainKey-Signature:Received:Received:Received:Received:Received: Message-ID:Date:From:User-Agent:MIME-Version:To:CC:Subject: References:In-Reply-To:Content-Type:Mailing-List:Precedence: List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender: Delivered-To; bh=9BUnj5ii2To9nlKnCfXrDfgBle4=; b=bOjWMAhZcuCrN9U C0XlRCfzJ3NrDu+yBEP0tcZoKOXowTJ7/Jk+bybuAcvm9asarzhCDagqY188ac5L gaHTxrZlmPAZlMJhjIm2+WrtPKJGtqm88utlxIQ4Xf+w3BIYaNoI4iVUfDCq1TXC 5rI3vmfgzkMwjkqj0vTwXZOf7pzI= Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:Received:Message-ID:Date:From:User-Agent:MIME-Version:To:CC:Subject:References:In-Reply-To:Content-Type:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=D3/4Wl3+5OP75AcPPcMQ8aS8ZpkMhMveElD9Ej7OQttGd51ikO8TA9DvROxSS1 +ex+KyQ+kQ2kop8KVw/+lQRGl2kOkJMpd89AOCsYZZd5ZMuNjWBoTBSpGVr/tpk3 /lTSTNNEXMZBsyi6UBFaynGN+ZWThRz7cTBLXbCJWtKB4=; Received: (qmail 21339 invoked by alias); 13 Jan 2013 22:14:48 -0000 Received: (qmail 21325 invoked by uid 22791); 13 Jan 2013 22:14:48 -0000 X-SWARE-Spam-Status: No, hits=-0.5 required=5.0 tests=AWL, BAYES_50, KAM_STOCKGEN, KHOP_RCVD_UNTRUST, KHOP_THREADED, RCVD_IN_DNSWL_LOW, RCVD_IN_HOSTKARMA_NO, RP_MATCHES_RCVD, TW_FC 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, 13 Jan 2013 22:14:38 +0000 Received: from cc-smtpin2.netcologne.de (cc-smtpin2.netcologne.de [89.1.8.202]) by cc-smtpout1.netcologne.de (Postfix) with ESMTP id 50D3312482; Sun, 13 Jan 2013 23:14:36 +0100 (CET) Received: from [192.168.0.104] (xdsl-87-79-255-248.netcologne.de [87.79.255.248]) by cc-smtpin2.netcologne.de (Postfix) with ESMTPSA id 032AE11DBB; Sun, 13 Jan 2013 23:14:33 +0100 (CET) Message-ID: <50F331C8.2000200@netcologne.de> Date: Sun, 13 Jan 2013 23:14:32 +0100 From: Thomas Koenig User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:17.0) Gecko/20130105 Thunderbird/17.0.2 MIME-Version: 1.0 To: Mikael Morin CC: "fortran@gcc.gnu.org" , gcc-patches Subject: Re: [patch, Fortran] PR 55806 - Inefficient ANY with array constructors References: <50E344A6.1000802@netcologne.de> <50F06DB9.40102@sfr.fr> In-Reply-To: <50F06DB9.40102@sfr.fr> 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 Hi Mikael, thanks a lot for your comments! >> + actual_arglist->expr = gfc_copy_expr (e); >> + actual_arglist->next = gfc_get_actual_arglist (); > Another one is needed. I get a segmentation fault with SUM. Fixed by using gfc_build_intrisic_call. I have also put SUM into the test case. >> + if (dim != NULL) >> + { > Minor, but I think you can assume dim != NULL. Same for mask. Fixed. >> + /* We changed things from under the expression walker. Walking the >> + old tree would mess up things, so let's not do that. */ >> + return 1; > I think this prevents any further reduction optimization. The following > variant of your test case doesn't avoid the temporary: You're right; I also could not come up with a test case where this didn't work. I have put this > do i=1,3 > if (any([abs(a(i,1) - b(i,1)) > acc, & > (j==i+1,j=3,8)])) cycle > if (any([abs(a(i,2) - b(i,2)) > acc, & > abs(a(i,3) - b(i,3)) > acc, lo(i,:)])) cycle > c = c + i > end do into the test case. Updated test case and patch attached. OK for trunk? Thomas 2013-01-13 Thomas Koenig PR fortran/55806 * frontend-passes.c (optimize_reduction): New function, including prototype. (callback_reduction): Likewise. (gfc_run_passes): Also run optimize_reduction. (copy_walk_reduction_arg): New function. (dummy_code_callback): New function. 2013-01-13 Thomas Koenig PR fortran/55806 * gfortran.dg/array_constructor_40.f90: New test. Index: frontend-passes.c =================================================================== --- frontend-passes.c (Revision 195136) +++ frontend-passes.c (Arbeitskopie) @@ -40,6 +40,8 @@ static bool optimize_lexical_comparison (gfc_expr static void optimize_minmaxloc (gfc_expr **); static bool is_empty_string (gfc_expr *e); static void doloop_warn (gfc_namespace *); +static void optimize_reduction (gfc_namespace *); +static int callback_reduction (gfc_expr **, int *, void *); /* How deep we are inside an argument list. */ @@ -107,6 +109,7 @@ gfc_run_passes (gfc_namespace *ns) expr_array = XNEWVEC(gfc_expr **, expr_size); optimize_namespace (ns); + optimize_reduction (ns); if (gfc_option.dump_fortran_optimized) gfc_dump_parse_tree (ns, stdout); @@ -180,7 +183,144 @@ optimize_expr (gfc_expr **e, int *walk_subtrees AT return 0; } +/* Auxiliary function to handle the arguments to reduction intrnisics. If the + function is a scalar, just copy it; otherwise returns the new element, the + old one can be freed. */ +static gfc_expr * +copy_walk_reduction_arg (gfc_expr *e, gfc_expr *fn) +{ + gfc_expr *fcn; + gfc_isym_id id; + + if (e->rank == 0 || e->expr_type == EXPR_FUNCTION) + fcn = gfc_copy_expr (e); + else + { + id = fn->value.function.isym->id; + + if (id == GFC_ISYM_SUM || id == GFC_ISYM_PRODUCT) + fcn = gfc_build_intrinsic_call (current_ns, + fn->value.function.isym->id, + fn->value.function.isym->name, + fn->where, 3, gfc_copy_expr (e), + NULL, NULL); + else if (id == GFC_ISYM_ANY || id == GFC_ISYM_ALL) + fcn = gfc_build_intrinsic_call (current_ns, + fn->value.function.isym->id, + fn->value.function.isym->name, + fn->where, 2, gfc_copy_expr (e), + NULL); + else + gfc_error ("Illegal id in copy_walk_reduction_arg"); + + fcn->symtree->n.sym->attr.access = ACCESS_PRIVATE; + } + + (void) gfc_expr_walker (&fcn, callback_reduction, NULL); + + return fcn; +} + +/* Callback function for optimzation of reductions to scalars. Transform ANY + ([f1,f2,f3, ...]) to f1 .or. f2 .or. f3 .or. ..., with ANY, SUM and PRODUCT + correspondingly. Handly only the simple cases without MASK and DIM. */ + +static int +callback_reduction (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, + void *data ATTRIBUTE_UNUSED) +{ + gfc_expr *fn, *arg; + gfc_intrinsic_op op; + gfc_isym_id id; + gfc_actual_arglist *a; + gfc_actual_arglist *dim; + gfc_constructor *c; + gfc_expr *res, *new_expr; + gfc_actual_arglist *mask; + + fn = *e; + + if (fn->rank != 0 || fn->expr_type != EXPR_FUNCTION + || fn->value.function.isym == NULL) + return 0; + + id = fn->value.function.isym->id; + + if (id != GFC_ISYM_SUM && id != GFC_ISYM_PRODUCT + && id != GFC_ISYM_ANY && id != GFC_ISYM_ALL) + return 0; + + a = fn->value.function.actual; + + /* Don't handle MASK or DIM. */ + + dim = a->next; + + if (dim->expr != NULL) + return 0; + + mask = dim->next; + if (mask != NULL) + if ( mask->expr != NULL) + return 0; + + arg = a->expr; + + if (arg->expr_type != EXPR_ARRAY) + return 0; + + switch (id) + { + case GFC_ISYM_SUM: + op = INTRINSIC_PLUS; + break; + + case GFC_ISYM_PRODUCT: + op = INTRINSIC_TIMES; + break; + + case GFC_ISYM_ANY: + op = INTRINSIC_OR; + break; + + case GFC_ISYM_ALL: + op = INTRINSIC_AND; + break; + + default: + return 0; + } + + c = gfc_constructor_first (arg->value.constructor); + + if (c == NULL) + return 0; + + res = copy_walk_reduction_arg (c->expr, fn); + + c = gfc_constructor_next (c); + while (c) + { + new_expr = gfc_get_expr (); + new_expr->ts = fn->ts; + new_expr->expr_type = EXPR_OP; + new_expr->rank = fn->rank; + new_expr->where = fn->where; + new_expr->value.op.op = op; + new_expr->value.op.op1 = res; + new_expr->value.op.op2 = copy_walk_reduction_arg (c->expr, fn); + res = new_expr; + c = gfc_constructor_next (c); + } + + gfc_simplify_expr (res, 0); + *e = res; + gfc_free_expr (fn); + + return 0; +} + /* Callback function for common function elimination, called from cfe_expr_0. Put all eligible function expressions into expr_array. */ @@ -484,6 +624,16 @@ dummy_expr_callback (gfc_expr **e ATTRIBUTE_UNUSED return 0; } +/* Dummy function for code callback, for use when we really + don't want to do anything. */ +static int +dummy_code_callback (gfc_code **e ATTRIBUTE_UNUSED, + int *walk_subtrees ATTRIBUTE_UNUSED, + void *data ATTRIBUTE_UNUSED) +{ + return 0; +} + /* Code callback function for converting do while(a) end do @@ -639,6 +789,20 @@ optimize_namespace (gfc_namespace *ns) } } +static void +optimize_reduction (gfc_namespace *ns) +{ + current_ns = ns; + gfc_code_walker (&ns->code, dummy_code_callback, callback_reduction, NULL); + +/* BLOCKs are handled in the expression walker below. */ + for (ns = ns->contained; ns; ns = ns->sibling) + { + if (ns->code == NULL || ns->code->op != EXEC_BLOCK) + optimize_reduction (ns); + } +} + /* Replace code like a = matmul(b,c) + d with