further speeding up of is_utf8_string()

Message-ID: <42A1850F.4040109@gmail.com>

p4raw-id: //depot/perl@24706

1 files changed, 67 insertions, 37 deletions

diff --git a/utf8.c b/utf8.c
index ecc77c009e..53983cbeae 100644
--- a/utf8.c
+++ b/utf8.c
@@ -173,6 +173,60 @@ Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv)
     return Perl_uvuni_to_utf8_flags(aTHX_ d, uv, 0);
 }
 
+/*
+
+Tests if some arbitrary number of bytes begins in a valid UTF-8
+character.  Note that an INVARIANT (i.e. ASCII) character is a valid
+UTF-8 character.  The actual number of bytes in the UTF-8 character
+will be returned if it is valid, otherwise 0.
+
+This is the "slow" version as opposed to the "fast" version which is
+the "unrolled" IS_UTF8_CHAR().  E.g. for t/uni/class.t the speed
+difference is a factor of 2 to 3.  For lengths (UTF8SKIP(s)) of four
+or less you should use the IS_UTF8_CHAR(), for lengths of five or more
+you should use the _slow().  In practice this means that the _slow()
+will be used very rarely, since the maximum Unicode code point (as of
+Unicode 4.1) is U+10FFFF, which encodes in UTF-8 to four bytes.  Only
+the "Perl extended UTF-8" (the infamous 'v-strings') will encode into
+five bytes or more.
+
+=cut */
+STRLEN
+S_is_utf8_char_slow(pTHX_ const U8 *s, const STRLEN len)
+{
+    U8 u = *s;
+    STRLEN slen;
+    UV uv, ouv;
+
+    if (UTF8_IS_INVARIANT(u))
+	return 1;
+
+    if (!UTF8_IS_START(u))
+	return 0;
+
+    if (len < 2 || !UTF8_IS_CONTINUATION(s[1]))
+	return 0;
+
+    slen = len - 1;
+    s++;
+    u &= UTF_START_MASK(len);
+    uv  = u;
+    ouv = uv;
+    while (slen--) {
+	if (!UTF8_IS_CONTINUATION(*s))
+	    return 0;
+	uv = UTF8_ACCUMULATE(uv, *s);
+	if (uv < ouv) 
+	    return 0;
+	ouv = uv;
+	s++;
+    }
+
+    if ((STRLEN)UNISKIP(uv) < len)
+	return 0;
+
+    return len;
+}
 
 /*
 =for apidoc A|STRLEN|is_utf8_char|const U8 *s
@@ -192,42 +246,7 @@ Perl_is_utf8_char(pTHX_ const U8 *s)
     if (len <= 4)
         return IS_UTF8_CHAR(s, len) ? len : 0;
 #endif /* #ifdef IS_UTF8_CHAR */
-    {
-	U8 u = *s;
-        STRLEN slen;
-        UV uv, ouv;
-
-        if (UTF8_IS_INVARIANT(u))
-            return 1;
-
-        if (!UTF8_IS_START(u))
-            return 0;
-
-        len = UTF8SKIP(s);
-
-        if (len < 2 || !UTF8_IS_CONTINUATION(s[1]))
-            return 0;
-
-        slen = len - 1;
-        s++;
-        u &= UTF_START_MASK(len);
-        uv  = u;
-        ouv = uv;
-        while (slen--) {
-            if (!UTF8_IS_CONTINUATION(*s))
-                return 0;
-            uv = UTF8_ACCUMULATE(uv, *s);
-            if (uv < ouv) 
-                return 0;
-            ouv = uv;
-            s++;
-        }
-
-        if ((STRLEN)UNISKIP(uv) < len)
-            return 0;
-
-        return len;
-    }
+    return S_is_utf8_char_slow(s, len);
 }
 
 /*
@@ -260,7 +279,18 @@ Perl_is_utf8_string(pTHX_ const U8 *s, STRLEN len)
 	      return FALSE;
 	 else {
 	      /* ... and call is_utf8_char() only if really needed. */
-	      c = is_utf8_char(x);
+#ifdef IS_UTF8_CHAR
+	     c = UTF8SKIP(x);
+	     if (c <= 4) {
+		 if (!IS_UTF8_CHAR(x, c))
+		     return FALSE;
+	     } else {
+		 if (!S_is_utf8_char_slow(x, c))
+		     return FALSE;
+	     }
+#else
+	     c = is_utf8_char(x);
+#endif /* #ifdef IS_UTF8_CHAR */
 	      if (!c)
 		   return FALSE;
 	 }