Am 29.03.2013 15:56, schrieb Tobias Burnus:
Thus, how about using memcmp for kind=4 for == and /= only - and for
kind=1 also for <, > etc.?
OK, there is the updated patch.
2013-03-25 Thomas Koenig <tkoe...@gcc.gnu.org>
* trans-expr.c (build_memcmp_call): New function.
(gfc_build_compare_string): If the strings
compared have constant and equal lengths and
the strings are kind=1, or (for kind=4) strings,
the test is for (in)equality, use memcmp().
2013-03-25 Thomas Koenig <tkoe...@gcc.gnu.org>
* gfortran.dg/character_comparison_3.f90: Adjust for use of memcmp
for constant and equal string lengths.
* gfortran.dg/character_comparison_5.f90: Likewise.
* gfortran.dg/character_comparison_9.f90: New test.
Regerssion-tested. OK for trunk?
Thomas
Index: fortran/trans-expr.c
===================================================================
--- fortran/trans-expr.c (Revision 197233)
+++ fortran/trans-expr.c (Arbeitskopie)
@@ -2665,6 +2665,32 @@
return -1;
}
+/* Helper to build a call to memcmp. */
+
+static tree
+build_memcmp_call (tree s1, tree s2, tree n)
+{
+ tree tmp;
+
+ if (!POINTER_TYPE_P (TREE_TYPE (s1)))
+ s1 = gfc_build_addr_expr (pvoid_type_node, s1);
+ else
+ s1 = fold_convert (pvoid_type_node, s1);
+
+ if (!POINTER_TYPE_P (TREE_TYPE (s2)))
+ s2 = gfc_build_addr_expr (pvoid_type_node, s2);
+ else
+ s2 = fold_convert (pvoid_type_node, s2);
+
+ n = fold_convert (size_type_node, n);
+
+ tmp = build_call_expr_loc (input_location,
+ builtin_decl_explicit (BUILT_IN_MEMCMP),
+ 3, s1, s2, n);
+
+ return fold_convert (integer_type_node, tmp);
+}
+
/* Compare two strings. If they are all single characters, the result is the
subtraction of them. Otherwise, we build a library call. */
@@ -2706,6 +2732,26 @@
return integer_one_node;
}
+ /* We can compare via memcpy if the strings are known to be equal
+ in length and they are
+ - kind=1
+ - kind=4 and the comparision is for (in)equality. */
+
+ if (INTEGER_CST_P (len1) && INTEGER_CST_P (len2)
+ && tree_int_cst_equal (len1, len2)
+ && (kind == 1 || code == EQ_EXPR || code == NE_EXPR))
+ {
+ tree tmp;
+ tree chartype;
+
+ chartype = gfc_get_char_type (kind);
+ tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE(len1),
+ fold_convert (TREE_TYPE(len1),
+ TYPE_SIZE_UNIT(chartype)),
+ len1);
+ return build_memcmp_call (str1, str2, tmp);
+ }
+
/* Build a call for the comparison. */
if (kind == 1)
fndecl = gfor_fndecl_compare_string;
Index: testsuite/gfortran.dg/character_comparison_3.f90
===================================================================
--- testsuite/gfortran.dg/character_comparison_3.f90 (Revision 197233)
+++ testsuite/gfortran.dg/character_comparison_3.f90 (Arbeitskopie)
@@ -25,6 +25,7 @@
if (c(:k3) == c(:k44)) call abort
end program main
-! { dg-final { scan-tree-dump-times "gfortran_compare_string" 8 "original" } }
+! { dg-final { scan-tree-dump-times "gfortran_compare_string" 6 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_memcmp" 2 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
Index: testsuite/gfortran.dg/character_comparison_5.f90
===================================================================
--- testsuite/gfortran.dg/character_comparison_5.f90 (Revision 197233)
+++ testsuite/gfortran.dg/character_comparison_5.f90 (Arbeitskopie)
@@ -16,6 +16,6 @@
end program main
! { dg-final { scan-tree-dump-times "gfortran_concat_string" 0 "original" } }
-! { dg-final { scan-tree-dump-times "gfortran_compare_string" 2 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_memcmp" 2 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
! { dg-do run }
! { dg-options "-fdump-tree-original" }
program main
character (len=2) :: a, b
character (kind=4,len=4) :: c,d
a = 'ab'
b = 'aa'
if (a < b) call abort
c = 4_"aaaa"
d = 4_"aaab"
if (c == d) call abort
if (c > d) call abort
end program main
! { dg-final { scan-tree-dump-times "_gfortran_compare_string_char4" 1 "original" } }
! { dg-final { scan-tree-dump-times "__builtin_memcmp" 2 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
