Change 24706 by [EMAIL PROTECTED] on 2005/06/04 16:55:27
Subject: [PATCH] further speeding up of is_utf8_string()
From: Jarkko Hietaniemi <[EMAIL PROTECTED]>
Date: Sat, 04 Jun 2005 13:40:15 +0300
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/MANIFEST#1260 edit
... //depot/perl/embed.fnc#188 edit
... //depot/perl/embed.h#480 edit
... //depot/perl/global.sym#274 edit
... //depot/perl/proto.h#539 edit
... //depot/perl/t/op/chr.t#1 add
... //depot/perl/utf8.c#234 edit
Differences ...
==== //depot/perl/MANIFEST#1260 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#1259~24680~ Thu Jun 2 09:40:58 2005
+++ perl/MANIFEST Sat Jun 4 09:55:27 2005
@@ -2756,6 +2756,7 @@
t/op/chars.t See if character escapes work
t/op/chdir.t See if chdir works
t/op/chop.t See if chop works
+t/op/chr.t See if chr works
t/op/closure.t See if closures work
t/op/cmp.t See if the various string and numeric compare
work
t/op/concat.t See if string concatenation works
==== //depot/perl/embed.fnc#188 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#187~24696~ Fri Jun 3 03:03:21 2005
+++ perl/embed.fnc Sat Jun 4 09:55:27 2005
@@ -1344,6 +1344,10 @@
sn |NV|mulexp10 |NV value|I32 exponent
#endif
+#if defined(PERL_IN_UTF8_C) || defined(PERL_DECL_PROT)
+s |STRLEN |is_utf8_char_slow|NN const U8 *s|const STRLEN len
+#endif
+
START_EXTERN_C
Apd |void |sv_setsv_flags |NN SV* dsv|SV* ssv|I32 flags
==== //depot/perl/embed.h#480 (text+w) ====
Index: perl/embed.h
--- perl/embed.h#479~24696~ Fri Jun 3 03:03:21 2005
+++ perl/embed.h Sat Jun 4 09:55:27 2005
@@ -1417,6 +1417,11 @@
#define mulexp10 S_mulexp10
#endif
#endif
+#if defined(PERL_IN_UTF8_C) || defined(PERL_DECL_PROT)
+#ifdef PERL_CORE
+#define is_utf8_char_slow S_is_utf8_char_slow
+#endif
+#endif
#define sv_setsv_flags Perl_sv_setsv_flags
#define sv_catpvn_flags Perl_sv_catpvn_flags
#define sv_catsv_flags Perl_sv_catsv_flags
@@ -3397,6 +3402,11 @@
#if defined(PERL_IN_NUMERIC_C) || defined(PERL_DECL_PROT)
#ifdef PERL_CORE
#define mulexp10 S_mulexp10
+#endif
+#endif
+#if defined(PERL_IN_UTF8_C) || defined(PERL_DECL_PROT)
+#ifdef PERL_CORE
+#define is_utf8_char_slow(a,b) S_is_utf8_char_slow(aTHX_ a,b)
#endif
#endif
#define sv_setsv_flags(a,b,c) Perl_sv_setsv_flags(aTHX_ a,b,c)
==== //depot/perl/global.sym#274 (text+w) ====
Index: perl/global.sym
--- perl/global.sym#273~24692~ Fri Jun 3 02:37:21 2005
+++ perl/global.sym Sat Jun 4 09:55:27 2005
@@ -315,7 +315,7 @@
Perl_newSVnv
Perl_newSVpv
Perl_newSVpvn
-Perl_newSVpv_hek
+Perl_newSVhek
Perl_newSVpvn_share
Perl_newSVpvf
Perl_vnewSVpvf
==== //depot/perl/proto.h#539 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#538~24696~ Fri Jun 3 03:03:21 2005
+++ perl/proto.h Sat Jun 4 09:55:27 2005
@@ -2492,6 +2492,12 @@
STATIC NV S_mulexp10(NV value, I32 exponent);
#endif
+#if defined(PERL_IN_UTF8_C) || defined(PERL_DECL_PROT)
+STATIC STRLEN S_is_utf8_char_slow(pTHX_ const U8 *s, const STRLEN len)
+ __attribute__nonnull__(pTHX_1);
+
+#endif
+
START_EXTERN_C
PERL_CALLCONV void Perl_sv_setsv_flags(pTHX_ SV* dsv, SV* ssv, I32 flags)
==== //depot/perl/t/op/chr.t#1 (text) ====
Index: perl/t/op/chr.t
--- /dev/null Tue May 5 13:32:27 1998
+++ perl/t/op/chr.t Sat Jun 4 09:55:27 2005
@@ -0,0 +1,50 @@
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = qw(. ../lib); # ../lib needed for test.deparse
+ require "test.pl";
+}
+
+plan tests => 26;
+
+# Note that t/op/ord.t already tests for chr() <-> ord() rountripping.
+
+# Don't assume ASCII.
+
+is(chr(ord("A")), "A");
+
+is(chr( 0), "\x00");
+is(chr(127), "\x7F");
+is(chr(128), "\x80");
+is(chr(255), "\xFF");
+
+# is(chr(-1), undef); # Shouldn't it be?
+
+# Check UTF-8.
+
+sub hexes { join(" ",map{sprintf"%02x",$_}unpack("C*",chr($_[0]))) }
+
+# The following code points are some interesting steps in UTF-8.
+is(hexes( 0x100), "c4 80");
+is(hexes( 0x7FF), "df bf");
+is(hexes( 0x800), "e0 a0 80");
+is(hexes( 0xFFF), "e0 bf bf");
+is(hexes( 0x1000), "e1 80 80");
+is(hexes( 0xCFFF), "ec bf bf");
+is(hexes( 0xD000), "ed 80 80");
+is(hexes( 0xD7FF), "ed 9f bf");
+is(hexes( 0xD800), "ed a0 80"); # not strict utf-8 (surrogate area begin)
+is(hexes( 0xDFFF), "ed bf bf"); # not strict utf-8 (surrogate area end)
+is(hexes( 0xE000), "ee 80 80");
+is(hexes( 0xFFFF), "ef bf bf");
+is(hexes( 0x10000), "f0 90 80 80");
+is(hexes( 0x3FFFF), "f0 bf bf bf");
+is(hexes( 0x40000), "f1 80 80 80");
+is(hexes( 0xFFFFF), "f3 bf bf bf");
+is(hexes(0x100000), "f4 80 80 80");
+is(hexes(0x10FFFF), "f4 8f bf bf"); # Unicode (4.1) last code point
+is(hexes(0x110000), "f4 90 80 80");
+is(hexes(0x1FFFFF), "f7 bf bf bf"); # last four byte encoding
+is(hexes(0x200000), "f8 88 80 80 80");
+
==== //depot/perl/utf8.c#234 (text) ====
Index: perl/utf8.c
--- perl/utf8.c#233~24687~ Fri Jun 3 01:08:25 2005
+++ perl/utf8.c Sat Jun 4 09:55:27 2005
@@ -173,6 +173,60 @@
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 @@
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 @@
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;
}
End of Patch.
