From: Karl Williamson Date: Thu, 28 Jun 2018 03:52:47 +0000 (-0600) Subject: Inline dfa for translating from UTF-8 X-Git-Tag: v5.29.1~57^2~3 X-Git-Url: https://perl5.git.perl.org/perl5.git/commitdiff_plain/e6a4ffc3f7aa69cbf3e5e83518e40e529a34b75b Inline dfa for translating from UTF-8 This commit inlines the simple portion of the dfa that translates from UTF-8 to code points, used in functions like utf8_to_uvchr_buf. This dfa has been changed in previous commits so that it is small, and punts on any problematic input, plus 18% of the Hangul syllable code points. (These still come out faster than blead.) The smallness allows it to be inlined, adding <2000 total bytes to the perl text space. The inlined part never calls anything that needs thread context, so that parameter can be removed. I decided to remove it also from the Perl_utf8_to_uvchr_buf() and Perl_utf8n_to_uvchr_error() functions. There is a small risk that someone is actually using those functions instead of the documented macros utf8_to_uvchr_buf() and utf8n_to_uvchr_error(). If so, this can be added back in. Perl_utf8_to_uvchr_msgs() is entirely removed, but the macro utf8_to_uvchr_msgs() which is the normal interface to it is retained unchanged, and it is marked as unstable anyway. This change decreases the number of conditional branches in the Perl statement my $a = ord("\x{foo}") where foo is a non-problematic code point by about 11%, except for ASCII characters, where it is 4%, and those Hangul syllables mentioned above, where it is 7%. Problematic code points fare much worse here than in blead. These are the surrogates, non-characters, and non-Unicode code points. We don't care very much about the speed of handling these code points, which are mostly considered illegal by Unicode anyway. The percentage decrease is higher for the just the function itself, as the measured Perl statement has unchanged overhead. Here are the annotated benchmarks: Key: Ir Instruction read Dr Data read Dw Data write COND conditional branches IND indirect branches _m branch predict miss _m1 level 1 cache miss _mm last cache (e.g. L3) miss - indeterminate percentage (e.g. 1/0) The numbers represent raw counts per loop iteration. translate_utf8_to_uv_007f my $a = ord("\x{007f}") blead dfa Ratio % ----- ----- ------- Ir 395.0 370.0 106.8 Dr 122.0 115.0 106.1 Dw 71.0 61.0 116.4 COND 49.0 47.0 104.3 IND 5.0 5.0 100.0 In all the measurements, the indirect numbers were all zeros and unchanged, and are omitted in this message. translate_utf8_to_uv_07ff my $a = ord("\x{07ff}") blead dfa Ratio % ----- ----- ------- Ir 438.0 390.0 112.3 Dr 128.0 118.0 108.5 Dw 71.0 61.0 116.4 COND 57.0 51.0 111.8 IND 5.0 5.0 100.0 translate_utf8_to_uv_cfff my $a = ord("\x{cfff}") This is the highest Hangul syllable that gets the full reduction. blead dfa Ratio % ----- ----- ------- Ir 457.0 410.0 111.5 Dr 131.0 121.0 108.3 Dw 71.0 61.0 116.4 COND 61.0 55.0 110.9 IND 5.0 5.0 100.0 translate_utf8_to_uv_d000 my $a = ord("\x{d000}") This is the lowest affected Hangul syllable blead dfa Ratio % ----- ----- ------- Ir 457.0 443.0 103.2 Dr 131.0 132.0 99.2 Dw 71.0 71.0 100.0 COND 61.0 57.0 107.0 IND 5.0 5.0 100.0 translate_utf8_to_uv_d7ff my $a = ord("\x{d7ff}") This is the highest affected Hangul syllable blead dfa Ratio % ----- ----- ------- Ir 457.0 443.0 103.2 Dr 131.0 132.0 99.2 Dw 71.0 71.0 100.0 COND 61.0 57.0 107.0 IND 5.0 5.0 100.0 translate_utf8_to_uv_d800 my $a = ord("\x{d800}") This is a surrogate, showing much worse performance, but we don't care blead dfa Ratio % ----- ----- ------- Ir 457.0 515.0 88.7 Dr 131.0 134.0 97.8 Dw 71.0 73.0 97.3 COND 61.0 75.0 81.3 IND 5.0 5.0 100.0 translate_utf8_to_uv_fdd0 my $a = ord("\x{fdd0}") This is a non-char, showing much worse performance, but we don't care blead dfa Ratio % ----- ----- ------- Ir 457.0 548.0 83.4 Dr 131.0 139.0 94.2 Dw 71.0 73.0 97.3 COND 61.0 81.0 75.3 IND 5.0 5.0 100.0 translate_utf8_to_uv_fffd my $a = ord("\x{fffd}") blead dfa Ratio % ----- ----- ------- Ir 457.0 410.0 111.5 Dr 131.0 121.0 108.3 Dw 71.0 61.0 116.4 COND 61.0 55.0 110.9 IND 5.0 5.0 100.0 translate_utf8_to_uv_ffff my $a = ord("\x{ffff}") This is another non-char, showing much worse performance, but we don't care blead dfa Ratio % ----- ----- ------- Ir 457.0 548.0 83.4 Dr 131.0 139.0 94.2 Dw 71.0 73.0 97.3 COND 61.0 81.0 75.3 IND 5.0 5.0 100.0 translate_utf8_to_uv_1fffd my $a = ord("\x{1fffd}") blead dfa Ratio % ----- ----- ------- Ir 476.0 430.0 110.7 Dr 134.0 124.0 108.1 Dw 71.0 61.0 116.4 COND 65.0 59.0 110.2 IND 5.0 5.0 100.0 translate_utf8_to_uv_10fffd my $a = ord("\x{10fffd}") blead dfa Ratio % ----- ----- ------- Ir 476.0 430.0 110.7 Dr 134.0 124.0 108.1 Dw 71.0 61.0 116.4 COND 65.0 59.0 110.2 IND 5.0 5.0 100.0 translate_utf8_to_uv_110000 my $a = ord("\x{110000}") This is a non-Unicode code point, showing much worse performance, but we don't care blead dfa Ratio % ----- ----- ------- Ir 476.0 544.0 87.5 Dr 134.0 137.0 97.8 Dw 71.0 73.0 97.3 COND 65.0 81.0 80.2 IND 5.0 5.0 100.0 --- diff --git a/embed.fnc b/embed.fnc index 39d99f9..1e1c629 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1842,16 +1842,23 @@ Aopd |UV |utf8_to_uvchr_buf |NN const U8 *s|NN const U8 *send|NULLOK STRLEN *ret ApdD |UV |utf8_to_uvuni_buf |NN const U8 *s|NN const U8 *send|NULLOK STRLEN *retlen pM |bool |check_utf8_print |NN const U8 *s|const STRLEN len -Adop |UV |utf8n_to_uvchr |NN const U8 *s \ +Adnop |UV |utf8n_to_uvchr |NN const U8 *s \ |STRLEN curlen \ |NULLOK STRLEN *retlen \ |const U32 flags -Adop |UV |utf8n_to_uvchr_error|NN const U8 *s \ +Adnop |UV |utf8n_to_uvchr_error|NN const U8 *s \ |STRLEN curlen \ |NULLOK STRLEN *retlen \ |const U32 flags \ |NULLOK U32 * errors -AMdp |UV |utf8n_to_uvchr_msgs|NN const U8 *s \ +AMndi |UV |utf8n_to_uvchr_msgs|NN const U8 *s \ + |STRLEN curlen \ + |NULLOK STRLEN *retlen \ + |const U32 flags \ + |NULLOK U32 * errors \ + |NULLOK AV ** msgs +AMnpd |UV |_utf8n_to_uvchr_msgs_helper \ + |NN const U8 *s \ |STRLEN curlen \ |NULLOK STRLEN *retlen \ |const U32 flags \ diff --git a/embed.h b/embed.h index bd83b7a..97bf5b5 100644 --- a/embed.h +++ b/embed.h @@ -46,6 +46,7 @@ #define _to_utf8_lower_flags(a,b,c,d,e,f,g) Perl__to_utf8_lower_flags(aTHX_ a,b,c,d,e,f,g) #define _to_utf8_title_flags(a,b,c,d,e,f,g) Perl__to_utf8_title_flags(aTHX_ a,b,c,d,e,f,g) #define _to_utf8_upper_flags(a,b,c,d,e,f,g) Perl__to_utf8_upper_flags(aTHX_ a,b,c,d,e,f,g) +#define _utf8n_to_uvchr_msgs_helper Perl__utf8n_to_uvchr_msgs_helper #define amagic_call(a,b,c,d) Perl_amagic_call(aTHX_ a,b,c,d) #define amagic_deref_call(a,b) Perl_amagic_deref_call(aTHX_ a,b) #define apply_attrs_string(a,b,c,d) Perl_apply_attrs_string(aTHX_ a,b,c,d) @@ -824,7 +825,7 @@ #define utf8_to_uvuni(a,b) Perl_utf8_to_uvuni(aTHX_ a,b) #endif #define utf8_to_uvuni_buf(a,b,c) Perl_utf8_to_uvuni_buf(aTHX_ a,b,c) -#define utf8n_to_uvchr_msgs(a,b,c,d,e,f) Perl_utf8n_to_uvchr_msgs(aTHX_ a,b,c,d,e,f) +#define utf8n_to_uvchr_msgs S_utf8n_to_uvchr_msgs #define utf8n_to_uvuni(a,b,c,d) Perl_utf8n_to_uvuni(aTHX_ a,b,c,d) #define uvoffuni_to_utf8_flags_msgs(a,b,c,d) Perl_uvoffuni_to_utf8_flags_msgs(aTHX_ a,b,c,d) #define uvuni_to_utf8(a,b) Perl_uvuni_to_utf8(aTHX_ a,b) diff --git a/inline.h b/inline.h index 78a162c..0087389 100644 --- a/inline.h +++ b/inline.h @@ -1654,6 +1654,69 @@ S_is_utf8_fixed_width_buf_loclen_flags(const U8 * const s, || is_utf8_valid_partial_char_flags(*ep, s + len, flags); } +PERL_STATIC_INLINE UV +S_utf8n_to_uvchr_msgs(const U8 *s, + STRLEN curlen, + STRLEN *retlen, + const U32 flags, + U32 * errors, + AV ** msgs) +{ + /* This is the inlined portion of utf8n_to_uvchr_msgs. It handles the + * simple cases, and, if necessary calls a helper function to deal with the + * more complex ones. Almost all well-formed non-problematic code points + * are considered simple, so that it's unlikely that the helper function + * will need to be called. + * + * This is an adaptation of the tables and algorithm given in + * http://bjoern.hoehrmann.de/utf-8/decoder/dfa/, which provides + * comprehensive documentation of the original version. A copyright notice + * for the original version is given at the beginning of this file. The + * Perl adapation is documented at the definition of strict_utf8_dfa_tab[]. + */ + + const U8 * const s0 = s; + const U8 * send = s0 + curlen; + UV uv; + UV state = 0; + + PERL_ARGS_ASSERT_UTF8N_TO_UVCHR_MSGS; + + /* This dfa is fast. If it accepts the input, it was for a well-formed, + * non-problematic code point, which can be returned immediately. + * Otherwise we call a helper function to figure out the more complicated + * cases. */ + + while (s < send && LIKELY(state != 1)) { + UV type = strict_utf8_dfa_tab[*s]; + + uv = (state == 0) + ? ((0xff >> type) & NATIVE_UTF8_TO_I8(*s)) + : UTF8_ACCUMULATE(uv, *s); + state = strict_utf8_dfa_tab[256 + state + type]; + + if (state != 0) { + s++; + continue; + } + + if (retlen) { + *retlen = s - s0 + 1; + } + if (errors) { + *errors = 0; + } + if (msgs) { + *msgs = NULL; + } + + return uv; + } + + /* Here is potentially problematic. Use the full mechanism */ + return _utf8n_to_uvchr_msgs_helper(s0, curlen, retlen, flags, errors, msgs); +} + /* ------------------------------- perl.h ----------------------------- */ /* diff --git a/proto.h b/proto.h index 7b6cd20..c9d47ff 100644 --- a/proto.h +++ b/proto.h @@ -143,6 +143,9 @@ PERL_CALLCONV UV Perl__to_utf8_title_flags(pTHX_ const U8 *p, const U8* e, U8* u PERL_CALLCONV UV Perl__to_utf8_upper_flags(pTHX_ const U8 *p, const U8 *e, U8* ustrp, STRLEN *lenp, bool flags, const char * const file, const int line); #define PERL_ARGS_ASSERT__TO_UTF8_UPPER_FLAGS \ assert(p); assert(ustrp); assert(file) +PERL_CALLCONV UV Perl__utf8n_to_uvchr_msgs_helper(const U8 *s, STRLEN curlen, STRLEN *retlen, const U32 flags, U32 * errors, AV ** msgs); +#define PERL_ARGS_ASSERT__UTF8N_TO_UVCHR_MSGS_HELPER \ + assert(s) PERL_CALLCONV void Perl__warn_problematic_locale(void); PERL_CALLCONV_NO_RET void Perl_abort_execution(pTHX_ const char * const msg, const char * const name) __attribute__noreturn__; @@ -3627,15 +3630,17 @@ PERL_CALLCONV UV Perl_utf8_to_uvuni_buf(pTHX_ const U8 *s, const U8 *send, STRLE #define PERL_ARGS_ASSERT_UTF8_TO_UVUNI_BUF \ assert(s); assert(send) -PERL_CALLCONV UV Perl_utf8n_to_uvchr(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, const U32 flags); +PERL_CALLCONV UV Perl_utf8n_to_uvchr(const U8 *s, STRLEN curlen, STRLEN *retlen, const U32 flags); #define PERL_ARGS_ASSERT_UTF8N_TO_UVCHR \ assert(s) -PERL_CALLCONV UV Perl_utf8n_to_uvchr_error(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, const U32 flags, U32 * errors); +PERL_CALLCONV UV Perl_utf8n_to_uvchr_error(const U8 *s, STRLEN curlen, STRLEN *retlen, const U32 flags, U32 * errors); #define PERL_ARGS_ASSERT_UTF8N_TO_UVCHR_ERROR \ assert(s) -PERL_CALLCONV UV Perl_utf8n_to_uvchr_msgs(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, const U32 flags, U32 * errors, AV ** msgs); +#ifndef PERL_NO_INLINE_FUNCTIONS +PERL_STATIC_INLINE UV S_utf8n_to_uvchr_msgs(const U8 *s, STRLEN curlen, STRLEN *retlen, const U32 flags, U32 * errors, AV ** msgs); #define PERL_ARGS_ASSERT_UTF8N_TO_UVCHR_MSGS \ assert(s) +#endif PERL_CALLCONV UV Perl_utf8n_to_uvuni(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags); #define PERL_ARGS_ASSERT_UTF8N_TO_UVUNI \ assert(s) diff --git a/utf8.c b/utf8.c index 8920982..5ca462e 100644 --- a/utf8.c +++ b/utf8.c @@ -1275,10 +1275,10 @@ Also implemented as a macro in utf8.h */ UV -Perl_utf8n_to_uvchr(pTHX_ const U8 *s, - STRLEN curlen, - STRLEN *retlen, - const U32 flags) +Perl_utf8n_to_uvchr(const U8 *s, + STRLEN curlen, + STRLEN *retlen, + const U32 flags) { PERL_ARGS_ASSERT_UTF8N_TO_UVCHR; @@ -1404,7 +1404,7 @@ Also implemented as a macro in utf8.h */ UV -Perl_utf8n_to_uvchr_error(pTHX_ const U8 *s, +Perl_utf8n_to_uvchr_error(const U8 *s, STRLEN curlen, STRLEN *retlen, const U32 flags, @@ -1468,7 +1468,7 @@ The caller, of course, is responsible for freeing any returned AV. */ UV -Perl_utf8n_to_uvchr_msgs(pTHX_ const U8 *s, +Perl__utf8n_to_uvchr_msgs_helper(const U8 *s, STRLEN curlen, STRLEN *retlen, const U32 flags, @@ -1492,39 +1492,9 @@ Perl_utf8n_to_uvchr_msgs(pTHX_ const U8 *s, U8 temp_char_buf[UTF8_MAXBYTES + 1]; /* Used to avoid a Newx in this routine; see [perl #130921] */ UV uv_so_far; - UV state = 0; - - PERL_ARGS_ASSERT_UTF8N_TO_UVCHR_MSGS; - - /* Measurements show that this dfa is somewhat faster than the regular code - * below, so use it first, dropping down for the non-normal cases. */ - -#define PERL_UTF8_DECODE_REJECT 1 - - while (s < send && LIKELY(state != PERL_UTF8_DECODE_REJECT)) { - UV type = strict_utf8_dfa_tab[*s]; - - uv = (state == 0) - ? ((0xff >> type) & NATIVE_UTF8_TO_I8(*s)) - : UTF8_ACCUMULATE(uv, *s); - state = strict_utf8_dfa_tab[256 + state + type]; - - if (state == 0) { - if (retlen) { - *retlen = s - s0 + 1; - } - if (errors) { - *errors = 0; - } - if (msgs) { - *msgs = NULL; - } + dTHX; - return uv; - } - - s++; - } + PERL_ARGS_ASSERT__UTF8N_TO_UVCHR_MSGS_HELPER; /* Here, is one of: a) malformed; b) a problematic code point (surrogate, * non-unicode, or nonchar); or c) on ASCII platforms, one of the Hangul