Re: [Patch, Fortran] Experimental LEN_TRIM and TRIM patch

[Daniel Kraft <d at domob dot eu>]

Jerry DeLisle wrote:
> Daniel Kraft wrote:
> > Slightly improved patch and ChangeLog.
> This is OK for 4.5.  I think the case of short strings is not very 
> likely.  I suppose even for that we could special case it.

Here's the final version, doing the (hopefully) right thing for 32 and 
64 bit longs.  I'll post this on the patch tracker.

It would be cool if anyone with access to a 64 bit system could check it 
actually works there!

Thanks,
Daniel

--
Done:  Arc-Bar-Cav-Ran-Rog-Sam-Tou-Val-Wiz
To go: Hea-Kni-Mon-Pri

2009-02-12  Daniel Kraft  <d@domob.eu>

	* intrinsics/string_intrinsics.c: #include <assert.h>
	* 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-02-12  Daniel Kraft  <d@domob.eu>

	* gfortran.dg/trim_1.f90: New test.

Index: libgfortran/intrinsics/string_intrinsics_inc.c
===================================================================
--- libgfortran/intrinsics/string_intrinsics_inc.c	(revision 144104)
+++ libgfortran/intrinsics/string_intrinsics_inc.c	(working copy)
@@ -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, CHAR
 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--)
-    {
-      if (s[i] != ' ')
-        break;
+  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)
+    {
+      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;
 }
 
Index: libgfortran/intrinsics/string_intrinsics.c
===================================================================
--- libgfortran/intrinsics/string_intrinsics.c	(revision 144104)
+++ libgfortran/intrinsics/string_intrinsics.c	(working copy)
@@ -39,6 +39,7 @@ Boston, MA 02110-1301, USA.  */
 
 #include <stdlib.h>
 #include <string.h>
+#include <assert.h>
 
 
 /* Helper function to set parts of wide strings to a constant (usually
Index: gcc/testsuite/gfortran.dg/trim_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/trim_1.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/trim_1.f90	(revision 0)
@@ -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