From patchwork Mon Mar 28 18:50:17 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 88656 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 2047A1007D1 for ; Tue, 29 Mar 2011 05:50:33 +1100 (EST) Received: (qmail 9666 invoked by alias); 28 Mar 2011 18:50:32 -0000 Received: (qmail 9646 invoked by uid 22791); 28 Mar 2011 18:50:30 -0000 X-SWARE-Spam-Status: No, hits=-0.4 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from cc-smtpout2.netcologne.de (HELO cc-smtpout2.netcologne.de) (89.1.8.212) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Mon, 28 Mar 2011 18:50:21 +0000 Received: from cc-smtpin1.netcologne.de (cc-smtpin1.netcologne.de [89.1.8.201]) by cc-smtpout2.netcologne.de (Postfix) with ESMTP id 644C1125F8; Mon, 28 Mar 2011 20:50:19 +0200 (CEST) Received: from [192.168.0.197] (xdsl-78-35-179-17.netcologne.de [78.35.179.17]) by cc-smtpin1.netcologne.de (Postfix) with ESMTPSA id 36D2511E9A; Mon, 28 Mar 2011 20:50:17 +0200 (CEST) Message-ID: <4D90D869.40503@netcologne.de> Date: Mon, 28 Mar 2011 20:50:17 +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] Extend character optimization to LLE and friends 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, the attached patch extends the character optimizations to the lexical comparison functions (LLE and friends). Regression-tested. OK for trunk? Thomas 2010-03-28 Thomas Koenig * frontend-passes (optimize_lexical_comparison): New function. (optimize_expr): Call it. (optimize_comparison): Also handle lexical comparison functions. Return false instad of -2 for unequal comparison. 2010-03-28 Thomas Koenig * gfortran.dg/character_comparison_8.f90: New test. ! { dg-do run } ! { dg-options "-O -fdump-tree-original" } ! Check for compile-time optimization of LLE and friends. program main character(3) :: a a = 'ab' if (.not. LLE(a,a)) call abort if (LLT(a,a)) call abort if (.not. LGE(a,a)) call abort if (LGT(a,a)) call abort end program main ! { dg-final { scan-tree-dump-times "gfortran_compare_string" 0 "original" } } ! { dg-final { cleanup-tree-dump "original" } } Index: frontend-passes.c =================================================================== --- frontend-passes.c (Revision 171618) +++ frontend-passes.c (Arbeitskopie) @@ -35,6 +35,7 @@ static void optimize_assignment (gfc_code *); static bool optimize_op (gfc_expr *); static bool optimize_comparison (gfc_expr *, gfc_intrinsic_op); static bool optimize_trim (gfc_expr *); +static bool optimize_lexical_comparison (gfc_expr *); /* How deep we are inside an argument list. */ @@ -119,6 +120,9 @@ optimize_expr (gfc_expr **e, int *walk_subtrees AT if (optimize_trim (*e)) gfc_simplify_expr (*e, 0); + if (optimize_lexical_comparison (*e)) + gfc_simplify_expr (*e, 0); + if ((*e)->expr_type == EXPR_OP && optimize_op (*e)) gfc_simplify_expr (*e, 0); @@ -474,6 +478,38 @@ strip_function_call (gfc_expr *e) } +/* Optimization of lexical comparison functions. */ + +static bool +optimize_lexical_comparison (gfc_expr *e) +{ + if (e->expr_type != EXPR_FUNCTION || e->value.function.isym == NULL) + return false; + + switch (e->value.function.isym->id) + { + case GFC_ISYM_LLE: + return optimize_comparison (e, INTRINSIC_LE); + break; + + case GFC_ISYM_LGE: + return optimize_comparison (e, INTRINSIC_GE); + break; + + case GFC_ISYM_LGT: + return optimize_comparison (e, INTRINSIC_GT); + break; + + case GFC_ISYM_LLT: + return optimize_comparison (e, INTRINSIC_LT); + break; + + default: + break; + } + return false; +} + /* Recursive optimization of operators. */ static bool @@ -513,9 +549,25 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op bool change; int eq; bool result; + gfc_actual_arglist *firstarg, *secondarg; - op1 = e->value.op.op1; - op2 = e->value.op.op2; + if (e->expr_type == EXPR_OP) + { + firstarg = NULL; + secondarg = NULL; + op1 = e->value.op.op1; + op2 = e->value.op.op2; + } + else if (e->expr_type == EXPR_FUNCTION) + { + /* One of the lexical comparision functions. */ + firstarg = e->value.function.actual; + secondarg = firstarg->next; + op1 = firstarg->expr; + op2 = secondarg->expr; + } + else + gcc_unreachable (); /* Strip off unneeded TRIM calls from string comparisons. */ @@ -578,13 +630,21 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op && op2_left->expr_type == EXPR_CONSTANT && op1_left->value.character.length != op2_left->value.character.length) - return -2; + return false; else { gfc_free (op1_left); gfc_free (op2_left); - e->value.op.op1 = op1_right; - e->value.op.op2 = op2_right; + if (firstarg) + { + firstarg->expr = op1_right; + secondarg->expr = op2_right; + } + else + { + e->value.op.op1 = op1_right; + e->value.op.op2 = op2_right; + } optimize_comparison (e, op); return true; } @@ -593,8 +653,17 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op { gfc_free (op1_right); gfc_free (op2_right); - e->value.op.op1 = op1_left; - e->value.op.op2 = op2_left; + if (firstarg) + { + firstarg->expr = op1_left; + secondarg->expr = op2_left; + } + else + { + e->value.op.op1 = op1_left; + e->value.op.op2 = op2_left; + } + optimize_comparison (e, op); return true; }