From patchwork Tue Jul 13 20:33:46 2010
Content-Type: text/plain; charset="utf-8"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Subject: Optimize 'a ' as single char string too
From: Jakub Jelinek <jakub@redhat.com>
X-Patchwork-Id: 58817
Message-Id: <20100713203346.GF20208@tyan-ft48-01.lab.bos.redhat.com>
To: gcc-patches@gcc.gnu.org, fortran@gcc.gnu.org
Date: Tue, 13 Jul 2010 22:33:46 +0200

Hi!

On:

subroutine foo (c)
  character :: c
  if (c .eq. 'a') call abort
  if (c .eq. 'ab') call abort
  if (c .eq. 'a ') call abort
end subroutine

only the first test is optimized into c == 'a' comparison, the other
two call _gfortran_compare_string.  This patch optimizes the last,
when the char is followed only by spaces, it can be treated as single
character too.  The gfc_trans_string_copy change just removes redundancy
I found while looking for string_to_single_character callers -
string_to_single_character in that function is called two times with the
same arguments (well, due to a bug in one case with wrong one), and the
result of the first calls is thrown away, just to call it again immediately.

Bootstrapped/regtested on x86_64-linux and i686-linux.
Ok for trunk?

2010-07-13  Jakub Jelinek  <jakub@redhat.com>

	* trans-expr.c (string_to_single_character): Also optimize
	string literals containing a single char followed only by spaces.
	(gfc_trans_string_copy): Remove redundant string_to_single_character
	calls.


	Jakub


--- gcc/fortran/trans-expr.c.jj	2010-07-13 15:56:30.000000000 +0200
+++ gcc/fortran/trans-expr.c	2010-07-13 17:13:59.000000000 +0200
@@ -1393,12 +1393,40 @@ string_to_single_character (tree len, tr
 {
   gcc_assert (POINTER_TYPE_P (TREE_TYPE (str)));
 
-  if (INTEGER_CST_P (len) && TREE_INT_CST_LOW (len) == 1
-      && TREE_INT_CST_HIGH (len) == 0)
+  if (!INTEGER_CST_P (len) || TREE_INT_CST_HIGH (len) != 0)
+    return NULL_TREE;
+
+  if (TREE_INT_CST_LOW (len) == 1)
     {
       str = fold_convert (gfc_get_pchar_type (kind), str);
-      return build_fold_indirect_ref_loc (input_location,
-				      str);
+      return build_fold_indirect_ref_loc (input_location, str);
+    }
+
+  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 ret = fold_convert (gfc_get_pchar_type (kind), str);
+      ret = build_fold_indirect_ref_loc (input_location, ret);
+      if (TREE_CODE (ret) == INTEGER_CST)
+	{
+	  tree string_cst = TREE_OPERAND (TREE_OPERAND (str, 0), 0);
+	  int i, len = TREE_STRING_LENGTH (string_cst);
+	  const char *ptr = TREE_STRING_POINTER (string_cst);
+
+	  for (i = 1; i < len; i++)
+	    if (ptr[i] != ' ')
+	      return NULL_TREE;
+
+	  return ret;
+	}
     }
 
   return NULL_TREE;
@@ -3556,7 +3584,7 @@ gfc_trans_string_copy (stmtblock_t * blo
   if (dlength != NULL_TREE)
     {
       dlen = fold_convert (size_type_node, gfc_evaluate_now (dlength, block));
-      dsc = string_to_single_character (slen, dest, dkind);
+      dsc = string_to_single_character (dlen, dest, dkind);
     }
   else
     {
@@ -3564,12 +3592,6 @@ gfc_trans_string_copy (stmtblock_t * blo
       dsc =  dest;
     }
 
-  if (slength != NULL_TREE && POINTER_TYPE_P (TREE_TYPE (src)))
-    ssc = string_to_single_character (slen, src, skind);
-  if (dlength != NULL_TREE && POINTER_TYPE_P (TREE_TYPE (dest)))
-    dsc = string_to_single_character (dlen, dest, dkind);
-
-
   /* Assign directly if the types are compatible.  */
   if (dsc != NULL_TREE && ssc != NULL_TREE
       && TREE_TYPE (dsc) == TREE_TYPE (ssc))