From 8876d8a8b8f21fdfa1450242307a3336747ee329 Mon Sep 17 00:00:00 2001 From: domob Date: Sat, 28 Mar 2009 15:18:59 +0000 Subject: [PATCH] 2009-03-28 Daniel Kraft * intrinsics/string_intrinsics.c: #include * intrinsics/string_intrinsics_inc.c (string_trim): Use string_len_trim instead of calculating the length directly. (string_len_trim): For KIND=1, speed search up. 2009-03-28 Daniel Kraft * gfortran.dg/trim_1.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@145192 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/testsuite/ChangeLog | 4 ++ gcc/testsuite/gfortran.dg/trim_1.f90 | 41 ++++++++++++++++++ libgfortran/ChangeLog | 7 +++ libgfortran/intrinsics/string_intrinsics.c | 1 + libgfortran/intrinsics/string_intrinsics_inc.c | 60 ++++++++++++++++++++------ 5 files changed, 101 insertions(+), 12 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/trim_1.f90 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 23f3ce1f765..bbc57f7dd65 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2009-03-28 Daniel Kraft + + * gfortran.dg/trim_1.f90: New test. + 2009-03-28 Richard Guenther * gcc.dg/Warray-bounds.c: Do not use redundant stores. diff --git a/gcc/testsuite/gfortran.dg/trim_1.f90 b/gcc/testsuite/gfortran.dg/trim_1.f90 new file mode 100644 index 00000000000..ac1e1f2032d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/trim_1.f90 @@ -0,0 +1,41 @@ +! { dg-do run } + +! Torture-test TRIM and LEN_TRIM for correctness. + + +! Given a total string length and a trimmed length, construct an +! appropriate string and check gfortran gets it right. + +SUBROUTINE check_trim (full_len, trimmed_len) + IMPLICIT NONE + INTEGER, INTENT(IN) :: full_len, trimmed_len + CHARACTER(LEN=full_len) :: string + + string = "" + IF (trimmed_len > 0) THEN + string(trimmed_len:trimmed_len) = "x" + END IF + + IF (LEN (string) /= full_len & + .OR. LEN_TRIM (string) /= trimmed_len & + .OR. LEN (TRIM (string)) /= trimmed_len & + .OR. TRIM (string) /= string (1:trimmed_len)) THEN + PRINT *, full_len, trimmed_len + PRINT *, LEN (string), LEN_TRIM (string) + CALL abort () + END IF +END SUBROUTINE check_trim + + +! The main program, check with various combinations. + +PROGRAM main + IMPLICIT NONE + INTEGER :: i, j + + DO i = 0, 20 + DO j = 0, i + CALL check_trim (i, j) + END DO + END DO +END PROGRAM main diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 500280604f0..45779d673fd 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,10 @@ +2009-03-28 Daniel Kraft + + * intrinsics/string_intrinsics.c: #include + * intrinsics/string_intrinsics_inc.c (string_trim): Use string_len_trim + instead of calculating the length directly. + (string_len_trim): For KIND=1, speed search up. + 2009-03-24 Jerry DeLisle PR libfortran/39528 diff --git a/libgfortran/intrinsics/string_intrinsics.c b/libgfortran/intrinsics/string_intrinsics.c index f6d9663f0ba..491b45e21df 100644 --- a/libgfortran/intrinsics/string_intrinsics.c +++ b/libgfortran/intrinsics/string_intrinsics.c @@ -39,6 +39,7 @@ Boston, MA 02110-1301, USA. */ #include #include +#include /* Helper function to set parts of wide strings to a constant (usually diff --git a/libgfortran/intrinsics/string_intrinsics_inc.c b/libgfortran/intrinsics/string_intrinsics_inc.c index 0008db5b2fc..5497991c76b 100644 --- a/libgfortran/intrinsics/string_intrinsics_inc.c +++ b/libgfortran/intrinsics/string_intrinsics_inc.c @@ -165,15 +165,7 @@ void string_trim (gfc_charlen_type *len, CHARTYPE **dest, gfc_charlen_type slen, const CHARTYPE *src) { - gfc_charlen_type i; - - /* Determine length of result string. */ - for (i = slen - 1; i >= 0; i--) - { - if (src[i] != ' ') - break; - } - *len = i + 1; + *len = string_len_trim (slen, src); if (*len == 0) *dest = &zero_length_string; @@ -193,13 +185,57 @@ string_trim (gfc_charlen_type *len, CHARTYPE **dest, gfc_charlen_type slen, gfc_charlen_type string_len_trim (gfc_charlen_type len, const CHARTYPE *s) { + const gfc_charlen_type long_len = (gfc_charlen_type) sizeof (unsigned long); gfc_charlen_type i; - for (i = len - 1; i >= 0; i--) + i = len - 1; + + /* If we've got the standard (KIND=1) character type, we scan the string in + long word chunks to speed it up (until a long word is hit that does not + consist of ' 's). */ + if (sizeof (CHARTYPE) == 1 && i >= long_len) { - if (s[i] != ' ') - break; + int starting; + unsigned long blank_longword; + + /* Handle the first characters until we're aligned on a long word + boundary. Actually, s + i + 1 must be properly aligned, because + s + i will be the last byte of a long word read. */ + starting = ((unsigned long) (s + i + 1)) % long_len; + i -= starting; + for (; starting > 0; --starting) + if (s[i + starting] != ' ') + return i + starting + 1; + + /* Handle the others in a batch until first non-blank long word is + found. Here again, s + i is the last byte of the current chunk, + to it starts at s + i - sizeof (long) + 1. */ + +#if __SIZEOF_LONG__ == 4 + blank_longword = 0x20202020L; +#elif __SIZEOF_LONG__ == 8 + blank_longword = 0x2020202020202020L; +#else + #error Invalid size of long! +#endif + + while (i >= long_len) + { + i -= long_len; + if (*((unsigned long*) (s + i + 1)) != blank_longword) + { + i += long_len; + break; + } + } + + /* Now continue for the last characters with naive approach below. */ + assert (i >= 0); } + + /* Simply look for the first non-blank character. */ + while (i >= 0 && s[i] == ' ') + --i; return i + 1; } -- 2.11.0