From patchwork Wed Jul 14 22:55:21 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Jakub Jelinek X-Patchwork-Id: 58937 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 A2547B6F11 for ; Thu, 15 Jul 2010 08:53:52 +1000 (EST) Received: (qmail 24494 invoked by alias); 14 Jul 2010 22:53:49 -0000 Received: (qmail 24477 invoked by uid 22791); 14 Jul 2010 22:53:47 -0000 X-SWARE-Spam-Status: No, hits=-6.1 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_HI, SPF_HELO_PASS, TW_FN, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mx1.redhat.com (HELO mx1.redhat.com) (209.132.183.28) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Wed, 14 Jul 2010 22:53:40 +0000 Received: from int-mx01.intmail.prod.int.phx2.redhat.com (int-mx01.intmail.prod.int.phx2.redhat.com [10.5.11.11]) by mx1.redhat.com (8.13.8/8.13.8) with ESMTP id o6EMrckP009659 (version=TLSv1/SSLv3 cipher=DHE-RSA-AES256-SHA bits=256 verify=OK); Wed, 14 Jul 2010 18:53:39 -0400 Received: from tyan-ft48-01.lab.bos.redhat.com (tyan-ft48-01.lab.bos.redhat.com [10.16.42.4]) by int-mx01.intmail.prod.int.phx2.redhat.com (8.13.8/8.13.8) with ESMTP id o6EMrcbl024211 (version=TLSv1/SSLv3 cipher=DHE-RSA-AES256-SHA bits=256 verify=NO); Wed, 14 Jul 2010 18:53:38 -0400 Received: from tyan-ft48-01.lab.bos.redhat.com (tyan-ft48-01.lab.bos.redhat.com [127.0.0.1]) by tyan-ft48-01.lab.bos.redhat.com (8.14.4/8.14.4) with ESMTP id o6EMtMCe007556; Thu, 15 Jul 2010 00:55:22 +0200 Received: (from jakub@localhost) by tyan-ft48-01.lab.bos.redhat.com (8.14.4/8.14.4/Submit) id o6EMtL9p007555; Thu, 15 Jul 2010 00:55:21 +0200 Date: Thu, 15 Jul 2010 00:55:21 +0200 From: Jakub Jelinek To: gcc-patches@gcc.gnu.org, fortran@gcc.gnu.org Subject: [PATCH] Optimize character :: c ... (c .ne. 'ab') Message-ID: <20100714225521.GK20208@tyan-ft48-01.lab.bos.redhat.com> Reply-To: Jakub Jelinek MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-12-10) X-IsSubscribed: yes 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! As has been discussed yesterday, if LEN_TRIM of a string literal is longer than the other string length, the strings are known to compare unequal (it isn't known whether they are < or > at compile time though). The following patch optimizes that. Bootstrapped/regtested on x86_64-linux and i686-linux, ok for trunk? 2010-07-15 Jakub Jelinek * trans.h (gfc_build_compare_string): Add CODE argument. * trans-intrinsic.c (gfc_conv_intrinsic_strcmp): Pass OP to gfc_build_compare_string. * trans-expr.c (gfc_conv_expr_op): Pass CODE to gfc_build_compare_string. (string_to_single_character): Rename len variable to length. (gfc_optimize_len_trim): New function. (gfc_build_compare_string): Add CODE argument. If it is EQ_EXPR or NE_EXPR and one of the strings is string literal with LEN_TRIM bigger than the length of the other string, they compare unequal. Jakub --- gcc/fortran/trans.h.jj 2010-07-07 14:25:47.000000000 +0200 +++ gcc/fortran/trans.h 2010-07-14 11:34:20.000000000 +0200 @@ -279,7 +279,7 @@ void gfc_make_safe_expr (gfc_se * se); void gfc_conv_string_parameter (gfc_se * se); /* Compare two strings. */ -tree gfc_build_compare_string (tree, tree, tree, tree, int); +tree gfc_build_compare_string (tree, tree, tree, tree, int, enum tree_code); /* Add an item to the end of TREE_LIST. */ tree gfc_chainon_list (tree, tree); --- gcc/fortran/trans-intrinsic.c.jj 2010-07-09 13:44:02.000000000 +0200 +++ gcc/fortran/trans-intrinsic.c 2010-07-14 11:38:09.000000000 +0200 @@ -3998,7 +3998,8 @@ gfc_conv_intrinsic_strcmp (gfc_se * se, se->expr = gfc_build_compare_string (args[0], args[1], args[2], args[3], - expr->value.function.actual->expr->ts.kind); + expr->value.function.actual->expr->ts.kind, + op); se->expr = fold_build2 (op, gfc_typenode_for_spec (&expr->ts), se->expr, build_int_cst (TREE_TYPE (se->expr), 0)); } --- gcc/fortran/trans-expr.c.jj 2010-07-13 19:34:36.000000000 +0200 +++ gcc/fortran/trans-expr.c 2010-07-14 12:20:34.000000000 +0200 @@ -1365,7 +1365,8 @@ gfc_conv_expr_op (gfc_se * se, gfc_expr lse.expr = gfc_build_compare_string (lse.string_length, lse.expr, rse.string_length, rse.expr, - expr->value.op.op1->ts.kind); + expr->value.op.op1->ts.kind, + code); rse.expr = build_int_cst (TREE_TYPE (lse.expr), 0); gfc_add_block_to_block (&lse.post, &rse.post); } @@ -1418,10 +1419,10 @@ string_to_single_character (tree len, tr if (TREE_CODE (ret) == INTEGER_CST) { tree string_cst = TREE_OPERAND (TREE_OPERAND (str, 0), 0); - int i, len = TREE_STRING_LENGTH (string_cst); + int i, length = TREE_STRING_LENGTH (string_cst); const char *ptr = TREE_STRING_POINTER (string_cst); - for (i = 1; i < len; i++) + for (i = 1; i < length; i++) if (ptr[i] != ' ') return NULL_TREE; @@ -1494,16 +1495,51 @@ gfc_conv_scalar_char_value (gfc_symbol * } } +/* Helper function for gfc_build_compare_string. Return LEN_TRIM value + if STR is a string literal, otherwise return -1. */ + +static int +gfc_optimize_len_trim (tree len, tree str, int kind) +{ + if (kind == 1 + && TREE_CODE (str) == ADDR_EXPR + && TREE_CODE (TREE_OPERAND (str, 0)) == ARRAY_REF + && TREE_CODE (TREE_OPERAND (TREE_OPERAND (str, 0), 0)) == STRING_CST + && array_ref_low_bound (TREE_OPERAND (str, 0)) + == TREE_OPERAND (TREE_OPERAND (str, 0), 1) + && TREE_INT_CST_LOW (len) >= 1 + && TREE_INT_CST_LOW (len) + == (unsigned HOST_WIDE_INT) + TREE_STRING_LENGTH (TREE_OPERAND (TREE_OPERAND (str, 0), 0))) + { + tree folded = fold_convert (gfc_get_pchar_type (kind), str); + folded = build_fold_indirect_ref_loc (input_location, folded); + if (TREE_CODE (folded) == INTEGER_CST) + { + tree string_cst = TREE_OPERAND (TREE_OPERAND (str, 0), 0); + int length = TREE_STRING_LENGTH (string_cst); + const char *ptr = TREE_STRING_POINTER (string_cst); + + for (; length > 0; length--) + if (ptr[length - 1] != ' ') + break; + + return length; + } + } + return -1; +} /* Compare two strings. If they are all single characters, the result is the subtraction of them. Otherwise, we build a library call. */ tree -gfc_build_compare_string (tree len1, tree str1, tree len2, tree str2, int kind) +gfc_build_compare_string (tree len1, tree str1, tree len2, tree str2, int kind, + enum tree_code code) { tree sc1; tree sc2; - tree tmp; + tree fndecl; gcc_assert (POINTER_TYPE_P (TREE_TYPE (str1))); gcc_assert (POINTER_TYPE_P (TREE_TYPE (str2))); @@ -1516,25 +1552,34 @@ gfc_build_compare_string (tree len1, tre /* Deal with single character specially. */ sc1 = fold_convert (integer_type_node, sc1); sc2 = fold_convert (integer_type_node, sc2); - tmp = fold_build2 (MINUS_EXPR, integer_type_node, sc1, sc2); + return fold_build2 (MINUS_EXPR, integer_type_node, sc1, sc2); } - else - { - /* Build a call for the comparison. */ - tree fndecl; - if (kind == 1) - fndecl = gfor_fndecl_compare_string; - else if (kind == 4) - fndecl = gfor_fndecl_compare_string_char4; - else - gcc_unreachable (); - - tmp = build_call_expr_loc (input_location, - fndecl, 4, len1, str1, len2, str2); - } + if ((code == EQ_EXPR || code == NE_EXPR) + && optimize + && INTEGER_CST_P (len1) && INTEGER_CST_P (len2)) + { + /* If one string is a string literal with LEN_TRIM longer + than the length of the second string, the strings + compare unequal. */ + int len = gfc_optimize_len_trim (len1, str1, kind); + if (len > 0 && compare_tree_int (len2, len) < 0) + return integer_one_node; + len = gfc_optimize_len_trim (len2, str2, kind); + if (len > 0 && compare_tree_int (len1, len) < 0) + return integer_one_node; + } + + /* Build a call for the comparison. */ + if (kind == 1) + fndecl = gfor_fndecl_compare_string; + else if (kind == 4) + fndecl = gfor_fndecl_compare_string_char4; + else + gcc_unreachable (); - return tmp; + return build_call_expr_loc (input_location, fndecl, 4, + len1, str1, len2, str2); }