| Message ID | 20100713203346.GF20208@tyan-ft48-01.lab.bos.redhat.com |
|---|---|
| State | New |
| Headers | show |
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 ...
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
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.
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.
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
--- 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))