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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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