Patchwork Optimize 'a ' as single char string too

login
register
mail settings
Submitter Jakub Jelinek
Date July 13, 2010, 8:33 p.m.
Message ID <20100713203346.GF20208@tyan-ft48-01.lab.bos.redhat.com>
Download mbox | patch
Permalink /patch/58817/
State New
Headers show

Comments

Jakub Jelinek - July 13, 2010, 8:33 p.m.
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
Toon Moene - July 13, 2010, 8:37 p.m.
Jakub Jelinek wrote:

> 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.

Strictly speaking, a single character (character string of length 1) can 
never be equal to 'ab', so that could be removed too - but that's 
probably a case for the Fortran Frontend ...
Jakub Jelinek - July 13, 2010, 8:48 p.m.
On Tue, Jul 13, 2010 at 10:37:53PM +0200, Toon Moene wrote:
> >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.
> 
> Strictly speaking, a single character (character string of length 1)
> can never be equal to 'ab', so that could be removed too - but
> that's probably a case for the Fortran Frontend ...

Sure, I've already noticed that too, but that's something for later.
There is a slight problem that gfc_build_compare_string returns < 0, 0, or >
0, so it would need to be told by an extra argument whether just
equality or unequality check is performed instead (in that case it
can try roughly compile time string_len_trim on the string literal
and if it is longer than the other operand, it is always unequal).

	Jakub
Steve Kargl - July 13, 2010, 10:50 p.m.
On Tue, Jul 13, 2010 at 10:33:46PM +0200, Jakub Jelinek wrote:
> 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.
> 

OK.
Steve Kargl - July 14, 2010, 6:07 a.m.
On Tue, Jul 13, 2010 at 10:33:46PM +0200, Jakub Jelinek wrote:
> 
> 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,

If you haven't committed your patch based on my OK,
can you hold off a bit?  I have received a query about
whether trailing whitespace in a string needs to be
omitted by a TRIM call.
Jakub Jelinek - July 14, 2010, 8 a.m.
On Tue, Jul 13, 2010 at 11:07:15PM -0700, Steve Kargl wrote:
> On Tue, Jul 13, 2010 at 10:33:46PM +0200, Jakub Jelinek wrote:
> > 
> > 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.
> > 
> 
> If you haven't committed your patch based on my OK,
> can you hold off a bit?  I have received a query about
> whether trailing whitespace in a string needs to be
> omitted by a TRIM call.

It is already committed.  If needed, this optimization could be guarded by
an extra flag passed to the function, I think both uses in
gfc_build_compare_string and the first use in gfc_trans_string_copy
definitely don't care about the trailing whitespace, the second case in
gfc_trans_string_copy shouldn't hit that (you can't assign into a string
literal).  In gfc_conv_scalar_char_value I'm not 100% sure (but we certainly
should have testcases in the testsuite covering that if there are issues)...

	Jakub

Patch

--- 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))