From patchwork Sun Jun 12 22:24:02 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 100119 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 55452B709B for ; Mon, 13 Jun 2011 08:24:24 +1000 (EST) Received: (qmail 5662 invoked by alias); 12 Jun 2011 22:24:22 -0000 Received: (qmail 5647 invoked by uid 22791); 12 Jun 2011 22:24:20 -0000 X-SWARE-Spam-Status: No, hits=-0.2 required=5.0 tests=AWL, BAYES_00, KAM_STOCKGEN, 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; Sun, 12 Jun 2011 22:24:05 +0000 Received: from cc-smtpin3.netcologne.de (cc-smtpin3.netcologne.de [89.1.8.203]) by cc-smtpout2.netcologne.de (Postfix) with ESMTP id 525BC12502; Mon, 13 Jun 2011 00:24:04 +0200 (CEST) Received: from [192.168.0.197] (xdsl-78-35-151-205.netcologne.de [78.35.151.205]) by cc-smtpin3.netcologne.de (Postfix) with ESMTPSA id 1390E11E84; Mon, 13 Jun 2011 00:24:02 +0200 (CEST) Message-ID: <4DF53C82.1030202@netcologne.de> Date: Mon, 13 Jun 2011 00:24:02 +0200 From: Thomas Koenig User-Agent: Mozilla/5.0 (X11; U; Linux x86_64; de; rv:1.9.2.17) Gecko/20110414 SUSE/3.1.10 Thunderbird/3.1.10 MIME-Version: 1.0 To: "fortran@gcc.gnu.org" , gcc-patches Subject: [patch, fortran] Final TRIM optimizations 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, this is the last round of TRIM optimizations. This patch extends the treatment of trailing TRIMs in concatenations to comparisions. It also does a bit of code cleanup by removing some duplication, and by not changing the rhs in optimize_assignment. OK for trunk? Thomas 2011-06-13 Thomas Koenig * frontend-passes.c (remove_trim): New function. (optimize_assignment): Use it. (optimize_comparison): Likewise. Return correct status for previous change. 2011-06-13 Thomas Koenig * gfortran.dg/trim_optimize_8.f90: New test case. ! { dg-do compile } ! { dg-options "-O -fdump-tree-original" } ! Check that trailing trims are also removed from assignment of ! expressions involving concatenations of strings . program main character(2) :: a,b character(8) :: d a = 'a ' b = 'b ' if (trim(a // trim(b)) /= 'a b ') call abort if (trim (trim(a) // trim(b)) /= 'ab ') call abort end ! { dg-final { scan-tree-dump-times "string_len_trim" 1 "original" } } ! { dg-final { cleanup-tree-dump "original" } } Index: frontend-passes.c =================================================================== --- frontend-passes.c (Revision 174958) +++ frontend-passes.c (Arbeitskopie) @@ -486,6 +486,35 @@ optimize_binop_array_assignment (gfc_code *c, gfc_ return false; } +/* Remove unneeded TRIMs at the end of expressions. */ + +static bool +remove_trim (gfc_expr *rhs) +{ + bool ret; + + ret = false; + + /* Check for a // b // trim(c). Looping is probably not + necessary because the parser usually generates + (// (// a b ) trim(c) ) , but better safe than sorry. */ + + while (rhs->expr_type == EXPR_OP + && rhs->value.op.op == INTRINSIC_CONCAT) + rhs = rhs->value.op.op2; + + while (rhs->expr_type == EXPR_FUNCTION && rhs->value.function.isym + && rhs->value.function.isym->id == GFC_ISYM_TRIM) + { + strip_function_call (rhs); + /* Recursive call to catch silly stuff like trim ( a // trim(b)). */ + remove_trim (rhs); + ret = true; + } + + return ret; +} + /* Optimizations for an assignment. */ static void @@ -499,25 +528,8 @@ optimize_assignment (gfc_code * c) /* Optimize away a = trim(b), where a is a character variable. */ if (lhs->ts.type == BT_CHARACTER) - { - /* Check for a // b // trim(c). Looping is probably not - necessary because the parser usually generates - (// (// a b ) trim(c) ) , but better safe than sorry. */ + remove_trim (rhs); - while (rhs->expr_type == EXPR_OP - && rhs->value.op.op == INTRINSIC_CONCAT) - rhs = rhs->value.op.op2; - - if (rhs->expr_type == EXPR_FUNCTION && - rhs->value.function.isym && - rhs->value.function.isym->id == GFC_ISYM_TRIM) - { - strip_function_call (rhs); - optimize_assignment (c); - return; - } - } - if (lhs->rank > 0 && gfc_check_dependency (lhs, rhs, true) == 0) optimize_binop_array_assignment (c, &rhs, false); } @@ -639,36 +651,17 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op /* Strip off unneeded TRIM calls from string comparisons. */ - change = false; + change = remove_trim (op1); - if (op1->expr_type == EXPR_FUNCTION - && op1->value.function.isym - && op1->value.function.isym->id == GFC_ISYM_TRIM) - { - strip_function_call (op1); - change = true; - } + if (remove_trim (op2)) + change = true; - if (op2->expr_type == EXPR_FUNCTION - && op2->value.function.isym - && op2->value.function.isym->id == GFC_ISYM_TRIM) - { - strip_function_call (op2); - change = true; - } - - if (change) - { - optimize_comparison (e, op); - return true; - } - /* An expression of type EXPR_CONSTANT is only valid for scalars. */ /* TODO: A scalar constant may be acceptable in some cases (the scalarizer handles them well). However, there are also cases that need a non-scalar argument. For example the any intrinsic. See PR 45380. */ if (e->rank > 0) - return false; + return change; /* Don't compare REAL or COMPLEX expressions when honoring NaNs. */ @@ -698,7 +691,7 @@ 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 false; + return change; else { free (op1_left); @@ -787,7 +780,7 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op } } - return false; + return change; } /* Optimize a trim function by replacing it with an equivalent substring