Move isUTF8_CHAR helper function, and reimplement it

[perl5.git] / utf8.c

diff --git a/utf8.c b/utf8.c
index bf5a36e..f24402d 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -31,11 +31,14 @@
 #include "EXTERN.h"
 #define PERL_IN_UTF8_C
 #include "perl.h"
 #include "EXTERN.h"
 #define PERL_IN_UTF8_C
 #include "perl.h"

-#include "inline_invlist.c"
-#include "charclass_invlists.h"
+#include "invlist_inline.h"

 
 static const char unees[] =
     "Malformed UTF-8 character (unexpected end of string)";
 
 static const char unees[] =
     "Malformed UTF-8 character (unexpected end of string)";

+static const char cp_above_legal_max[] =
+ "Use of code point 0x%"UVXf" is deprecated; the permissible max is 0x%"UVXf"";
+
+#define MAX_NON_DEPRECATED_CP ((UV) (IV_MAX))

 
 /*
 =head1 Unicode Support
 
 /*
 =head1 Unicode Support


@@ -49,42 +52,6 @@ within non-zero characters.
 */
 
 /*
 */
 
 /*

-=for apidoc is_invariant_string
-
-Returns true iff the first C<len> bytes of the string C<s> are the same
-regardless of the UTF-8 encoding of the string (or UTF-EBCDIC encoding on
-EBCDIC machines).  That is, if they are UTF-8 invariant.  On ASCII-ish
-machines, all the ASCII characters and only the ASCII characters fit this
-definition.  On EBCDIC machines, the ASCII-range characters are invariant, but
-so also are the C1 controls and C<\c?> (which isn't in the ASCII range on
-EBCDIC).
-
-If C<len> is 0, it will be calculated using C<strlen(s)>, (which means if you
-use this option, that C<s> can't have embedded C<NUL> characters and has to
-have a terminating C<NUL> byte).
-
-See also L</is_utf8_string>(), L</is_utf8_string_loclen>(), and L</is_utf8_string_loc>().
-
-=cut
-*/
-
-bool
-Perl_is_invariant_string(const U8 *s, STRLEN len)
-{
-    const U8* const send = s + (len ? len : strlen((const char *)s));
-    const U8* x = s;
-
-    PERL_ARGS_ASSERT_IS_INVARIANT_STRING;
-
-    for (; x < send; ++x) {
-       if (!UTF8_IS_INVARIANT(*x))
-           break;
-    }
-
-    return x == send;
-}
-
-/*

 =for apidoc uvoffuni_to_utf8_flags
 
 THIS FUNCTION SHOULD BE USED IN ONLY VERY SPECIALIZED CIRCUMSTANCES.
 =for apidoc uvoffuni_to_utf8_flags
 
 THIS FUNCTION SHOULD BE USED IN ONLY VERY SPECIALIZED CIRCUMSTANCES.


@@ -95,153 +62,172 @@ This function is like them, but the input is a strict Unicode
 (as opposed to native) code point.  Only in very rare circumstances should code
 not be using the native code point.
 
 (as opposed to native) code point.  Only in very rare circumstances should code
 not be using the native code point.
 

-For details, see the description for L</uvchr_to_utf8_flags>>.
+For details, see the description for L</uvchr_to_utf8_flags>.

 
 =cut
 */
 
 
 =cut
 */
 

+#define HANDLE_UNICODE_SURROGATE(uv, flags)                         \
+    STMT_START {                                                    \
+        if (flags & UNICODE_WARN_SURROGATE) {                       \
+            Perl_ck_warner_d(aTHX_ packWARN(WARN_SURROGATE),        \
+                                "UTF-16 surrogate U+%04"UVXf, uv);  \
+        }                                                           \
+        if (flags & UNICODE_DISALLOW_SURROGATE) {                   \
+            return NULL;                                            \
+        }                                                           \
+    } STMT_END;
+
+#define HANDLE_UNICODE_NONCHAR(uv, flags)                           \
+    STMT_START {                                                    \
+        if (flags & UNICODE_WARN_NONCHAR) {                         \
+            Perl_ck_warner_d(aTHX_ packWARN(WARN_NONCHAR),          \
+                "Unicode non-character U+%04"UVXf" is not "        \
+                 "recommended for open interchange", uv);           \
+        }                                                           \
+        if (flags & UNICODE_DISALLOW_NONCHAR) {                     \
+            return NULL;                                            \
+        }                                                           \
+    } STMT_END;
+
+/*  Use shorter names internally in this file */
+#define SHIFT   UTF_ACCUMULATION_SHIFT
+#undef  MARK
+#define MARK    UTF_CONTINUATION_MARK
+#define MASK    UTF_CONTINUATION_MASK
+

 U8 *
 Perl_uvoffuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags)
 {
     PERL_ARGS_ASSERT_UVOFFUNI_TO_UTF8_FLAGS;
 
 U8 *
 Perl_uvoffuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags)
 {
     PERL_ARGS_ASSERT_UVOFFUNI_TO_UTF8_FLAGS;
 

-    if (UNI_IS_INVARIANT(uv)) {
-       *d++ = (U8) LATIN1_TO_NATIVE(uv);
+    if (OFFUNI_IS_INVARIANT(uv)) {
+       *d++ = LATIN1_TO_NATIVE(uv);

        return d;
     }
 
        return d;
     }
 

-#ifdef EBCDIC
-    /* Not representable in UTF-EBCDIC */
-    flags |= UNICODE_DISALLOW_FE_FF;
+    if (uv <= MAX_UTF8_TWO_BYTE) {
+        *d++ = I8_TO_NATIVE_UTF8(( uv >> SHIFT) | UTF_START_MARK(2));
+        *d++ = I8_TO_NATIVE_UTF8(( uv           & MASK) |   MARK);
+        return d;
+    }
+
+    /* Not 2-byte; test for and handle 3-byte result.   In the test immediately
+     * below, the 16 is for start bytes E0-EF (which are all the possible ones
+     * for 3 byte characters).  The 2 is for 2 continuation bytes; these each
+     * contribute SHIFT bits.  This yields 0x4000 on EBCDIC platforms, 0x1_0000
+     * on ASCII; so 3 bytes covers the range 0x400-0x3FFF on EBCDIC;
+     * 0x800-0xFFFF on ASCII */
+    if (uv < (16 * (1U << (2 * SHIFT)))) {
+       *d++ = I8_TO_NATIVE_UTF8(( uv >> ((3 - 1) * SHIFT)) | UTF_START_MARK(3));
+       *d++ = I8_TO_NATIVE_UTF8(((uv >> ((2 - 1) * SHIFT)) & MASK) |   MARK);
+       *d++ = I8_TO_NATIVE_UTF8(( uv  /* (1 - 1) */        & MASK) |   MARK);
+
+#ifndef EBCDIC  /* These problematic code points are 4 bytes on EBCDIC, so
+                   aren't tested here */
+        /* The most likely code points in this range are below the surrogates.
+         * Do an extra test to quickly exclude those. */
+        if (UNLIKELY(uv >= UNICODE_SURROGATE_FIRST)) {
+            if (UNLIKELY(   UNICODE_IS_32_CONTIGUOUS_NONCHARS(uv)
+                         || UNICODE_IS_END_PLANE_NONCHAR_GIVEN_NOT_SUPER(uv)))
+            {
+                HANDLE_UNICODE_NONCHAR(uv, flags);
+            }
+            else if (UNLIKELY(UNICODE_IS_SURROGATE(uv))) {
+                HANDLE_UNICODE_SURROGATE(uv, flags);
+            }
+        }

 #endif
 #endif

+       return d;
+    }

 
 

-    /* The first problematic code point is the first surrogate */
-    if (uv >= UNICODE_SURROGATE_FIRST
-        && ckWARN3_d(WARN_SURROGATE, WARN_NON_UNICODE, WARN_NONCHAR))
-    {
-       if (UNICODE_IS_SURROGATE(uv)) {
-           if (flags & UNICODE_WARN_SURROGATE) {
-               Perl_ck_warner_d(aTHX_ packWARN(WARN_SURROGATE),
-                                           "UTF-16 surrogate U+%04"UVXf, uv);
-           }
-           if (flags & UNICODE_DISALLOW_SURROGATE) {
-               return NULL;
-           }
-       }
-       else if (UNICODE_IS_SUPER(uv)) {
-           if (flags & UNICODE_WARN_SUPER
-               || (UNICODE_IS_FE_FF(uv) && (flags & UNICODE_WARN_FE_FF)))
-           {
-               Perl_ck_warner_d(aTHX_ packWARN(WARN_NON_UNICODE),
-                         "Code point 0x%04"UVXf" is not Unicode, may not be portable", uv);
-           }
-           if (flags & UNICODE_DISALLOW_SUPER
-               || (UNICODE_IS_FE_FF(uv) && (flags & UNICODE_DISALLOW_FE_FF)))
-           {
-#ifdef EBCDIC
-                Perl_die(aTHX_ "Can't represent character for Ox%"UVXf" on this platform", uv);
-                NOT_REACHED;
+    /* Not 3-byte; that means the code point is at least 0x1_0000 on ASCII
+     * platforms, and 0x4000 on EBCDIC.  There are problematic cases that can
+     * happen starting with 4-byte characters on ASCII platforms.  We unify the
+     * code for these with EBCDIC, even though some of them require 5-bytes on
+     * those, because khw believes the code saving is worth the very slight
+     * performance hit on these high EBCDIC code points. */
+
+    if (UNLIKELY(UNICODE_IS_SUPER(uv))) {
+        if (   UNLIKELY(uv > MAX_NON_DEPRECATED_CP)
+            && ckWARN_d(WARN_DEPRECATED))
+        {
+            Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
+                        cp_above_legal_max, uv, MAX_NON_DEPRECATED_CP);
+        }
+        if (   (flags & UNICODE_WARN_SUPER)
+            || (   UNICODE_IS_ABOVE_31_BIT(uv)
+                && (flags & UNICODE_WARN_ABOVE_31_BIT)))
+        {
+            Perl_ck_warner_d(aTHX_ packWARN(WARN_NON_UNICODE),
+
+              /* Choose the more dire applicable warning */
+              (UNICODE_IS_ABOVE_31_BIT(uv))
+              ? "Code point 0x%"UVXf" is not Unicode, and not portable"
+              : "Code point 0x%"UVXf" is not Unicode, may not be portable",
+             uv);
+        }
+        if (flags & UNICODE_DISALLOW_SUPER
+            || (   UNICODE_IS_ABOVE_31_BIT(uv)
+                && (flags & UNICODE_DISALLOW_ABOVE_31_BIT)))
+        {
+            return NULL;
+        }
+    }
+    else if (UNLIKELY(UNICODE_IS_END_PLANE_NONCHAR_GIVEN_NOT_SUPER(uv))) {
+        HANDLE_UNICODE_NONCHAR(uv, flags);
+    }
+
+    /* Test for and handle 4-byte result.   In the test immediately below, the
+     * 8 is for start bytes F0-F7 (which are all the possible ones for 4 byte
+     * characters).  The 3 is for 3 continuation bytes; these each contribute
+     * SHIFT bits.  This yields 0x4_0000 on EBCDIC platforms, 0x20_0000 on
+     * ASCII, so 4 bytes covers the range 0x4000-0x3_FFFF on EBCDIC;
+     * 0x1_0000-0x1F_FFFF on ASCII */
+    if (uv < (8 * (1U << (3 * SHIFT)))) {
+       *d++ = I8_TO_NATIVE_UTF8(( uv >> ((4 - 1) * SHIFT)) | UTF_START_MARK(4));
+       *d++ = I8_TO_NATIVE_UTF8(((uv >> ((3 - 1) * SHIFT)) & MASK) |   MARK);
+       *d++ = I8_TO_NATIVE_UTF8(((uv >> ((2 - 1) * SHIFT)) & MASK) |   MARK);
+       *d++ = I8_TO_NATIVE_UTF8(( uv  /* (1 - 1) */        & MASK) |   MARK);
+
+#ifdef EBCDIC   /* These were handled on ASCII platforms in the code for 3-byte
+                   characters.  The end-plane non-characters for EBCDIC were
+                   handled just above */
+        if (UNLIKELY(UNICODE_IS_32_CONTIGUOUS_NONCHARS(uv))) {
+            HANDLE_UNICODE_NONCHAR(uv, flags);
+        }
+        else if (UNLIKELY(UNICODE_IS_SURROGATE(uv))) {
+            HANDLE_UNICODE_SURROGATE(uv, flags);
+        }

 #endif
 #endif

-               return NULL;
-           }
-       }
-       else if (UNICODE_IS_NONCHAR(uv)) {
-           if (flags & UNICODE_WARN_NONCHAR) {
-               Perl_ck_warner_d(aTHX_ packWARN(WARN_NONCHAR),
-                "Unicode non-character U+%04"UVXf" is illegal for open interchange",
-                uv);
-           }
-           if (flags & UNICODE_DISALLOW_NONCHAR) {
-               return NULL;
-           }
-       }
+
+       return d;

     }
 
     }
 

-#if defined(EBCDIC)
+    /* Not 4-byte; that means the code point is at least 0x20_0000 on ASCII
+     * platforms, and 0x4000 on EBCDIC.  At this point we switch to a loop
+     * format.  The unrolled version above turns out to not save all that much
+     * time, and at these high code points (well above the legal Unicode range
+     * on ASCII platforms, and well above anything in common use in EBCDIC),
+     * khw believes that less code outweighs slight performance gains. */
+

     {
        STRLEN len  = OFFUNISKIP(uv);
        U8 *p = d+len-1;
        while (p > d) {
     {
        STRLEN len  = OFFUNISKIP(uv);
        U8 *p = d+len-1;
        while (p > d) {

-           *p-- = (U8) I8_TO_NATIVE_UTF8((uv & UTF_CONTINUATION_MASK) | UTF_CONTINUATION_MARK);
+           *p-- = I8_TO_NATIVE_UTF8((uv & UTF_CONTINUATION_MASK) | UTF_CONTINUATION_MARK);

            uv >>= UTF_ACCUMULATION_SHIFT;
        }
            uv >>= UTF_ACCUMULATION_SHIFT;
        }

-       *p = (U8) I8_TO_NATIVE_UTF8((uv & UTF_START_MASK(len)) | UTF_START_MARK(len));
+       *p = I8_TO_NATIVE_UTF8((uv & UTF_START_MASK(len)) | UTF_START_MARK(len));

        return d+len;
     }
        return d+len;
     }

-#else /* Non loop style */
-    if (uv < 0x800) {
-       *d++ = (U8)(( uv >>  6)         | 0xc0);
-       *d++ = (U8)(( uv        & 0x3f) | 0x80);
-       return d;
-    }
-    if (uv < 0x10000) {
-       *d++ = (U8)(( uv >> 12)         | 0xe0);
-       *d++ = (U8)(((uv >>  6) & 0x3f) | 0x80);
-       *d++ = (U8)(( uv        & 0x3f) | 0x80);
-       return d;
-    }
-    if (uv < 0x200000) {
-       *d++ = (U8)(( uv >> 18)         | 0xf0);
-       *d++ = (U8)(((uv >> 12) & 0x3f) | 0x80);
-       *d++ = (U8)(((uv >>  6) & 0x3f) | 0x80);
-       *d++ = (U8)(( uv        & 0x3f) | 0x80);
-       return d;
-    }
-    if (uv < 0x4000000) {
-       *d++ = (U8)(( uv >> 24)         | 0xf8);
-       *d++ = (U8)(((uv >> 18) & 0x3f) | 0x80);
-       *d++ = (U8)(((uv >> 12) & 0x3f) | 0x80);
-       *d++ = (U8)(((uv >>  6) & 0x3f) | 0x80);
-       *d++ = (U8)(( uv        & 0x3f) | 0x80);
-       return d;
-    }
-    if (uv < 0x80000000) {
-       *d++ = (U8)(( uv >> 30)         | 0xfc);
-       *d++ = (U8)(((uv >> 24) & 0x3f) | 0x80);
-       *d++ = (U8)(((uv >> 18) & 0x3f) | 0x80);
-       *d++ = (U8)(((uv >> 12) & 0x3f) | 0x80);
-       *d++ = (U8)(((uv >>  6) & 0x3f) | 0x80);
-       *d++ = (U8)(( uv        & 0x3f) | 0x80);
-       return d;
-    }
-#ifdef UTF8_QUAD_MAX
-    if (uv < UTF8_QUAD_MAX)
-#endif
-    {
-       *d++ =                            0xfe; /* Can't match U+FEFF! */
-       *d++ = (U8)(((uv >> 30) & 0x3f) | 0x80);
-       *d++ = (U8)(((uv >> 24) & 0x3f) | 0x80);
-       *d++ = (U8)(((uv >> 18) & 0x3f) | 0x80);
-       *d++ = (U8)(((uv >> 12) & 0x3f) | 0x80);
-       *d++ = (U8)(((uv >>  6) & 0x3f) | 0x80);
-       *d++ = (U8)(( uv        & 0x3f) | 0x80);
-       return d;
-    }
-#ifdef UTF8_QUAD_MAX
-    {
-       *d++ =                            0xff;         /* Can't match U+FFFE! */
-       *d++ =                            0x80;         /* 6 Reserved bits */
-       *d++ = (U8)(((uv >> 60) & 0x0f) | 0x80);        /* 2 Reserved bits */
-       *d++ = (U8)(((uv >> 54) & 0x3f) | 0x80);
-       *d++ = (U8)(((uv >> 48) & 0x3f) | 0x80);
-       *d++ = (U8)(((uv >> 42) & 0x3f) | 0x80);
-       *d++ = (U8)(((uv >> 36) & 0x3f) | 0x80);
-       *d++ = (U8)(((uv >> 30) & 0x3f) | 0x80);
-       *d++ = (U8)(((uv >> 24) & 0x3f) | 0x80);
-       *d++ = (U8)(((uv >> 18) & 0x3f) | 0x80);
-       *d++ = (U8)(((uv >> 12) & 0x3f) | 0x80);
-       *d++ = (U8)(((uv >>  6) & 0x3f) | 0x80);
-       *d++ = (U8)(( uv        & 0x3f) | 0x80);
-       return d;
-    }
-#endif
-#endif /* Non loop style */

 }
 }

+

 /*
 =for apidoc uvchr_to_utf8
 
 Adds the UTF-8 representation of the native code point C<uv> to the end
 /*
 =for apidoc uvchr_to_utf8
 
 Adds the UTF-8 representation of the native code point C<uv> to the end

-of the string C<d>; C<d> should have at least C<UNISKIP(uv)+1> (up to
+of the string C<d>; C<d> should have at least C<UVCHR_SKIP(uv)+1> (up to

 C<UTF8_MAXBYTES+1>) free bytes available.  The return value is the pointer to
 the byte after the end of the new character.  In other words,
 
 C<UTF8_MAXBYTES+1>) free bytes available.  The return value is the pointer to
 the byte after the end of the new character.  In other words,
 


@@ -251,8 +237,12 @@ is the recommended wide native character-aware way of saying
 
     *(d++) = uv;
 
 
     *(d++) = uv;
 

-This function accepts any UV as input.  To forbid or warn on non-Unicode code
-points, or those that may be problematic, see L</uvchr_to_utf8_flags>.
+This function accepts any UV as input, but very high code points (above
+C<IV_MAX> on the platform)  will raise a deprecation warning.  This is
+typically 0x7FFF_FFFF in a 32-bit word.
+
+It is possible to forbid or warn on non-Unicode code points, or those that may
+be problematic by using L</uvchr_to_utf8_flags>.

 
 =cut
 */
 
 =cut
 */


@@ -270,7 +260,7 @@ Perl_uvchr_to_utf8(pTHX_ U8 *d, UV uv)
 =for apidoc uvchr_to_utf8_flags
 
 Adds the UTF-8 representation of the native code point C<uv> to the end
 =for apidoc uvchr_to_utf8_flags
 
 Adds the UTF-8 representation of the native code point C<uv> to the end

-of the string C<d>; C<d> should have at least C<UNISKIP(uv)+1> (up to
+of the string C<d>; C<d> should have at least C<UVCHR_SKIP(uv)+1> (up to

 C<UTF8_MAXBYTES+1>) free bytes available.  The return value is the pointer to
 the byte after the end of the new character.  In other words,
 
 C<UTF8_MAXBYTES+1>) free bytes available.  The return value is the pointer to
 the byte after the end of the new character.  In other words,
 


@@ -284,27 +274,54 @@ This is the Unicode-aware way of saying
 
     *(d++) = uv;
 
 
     *(d++) = uv;
 

-This function will convert to UTF-8 (and not warn) even code points that aren't
-legal Unicode or are problematic, unless C<flags> contains one or more of the
-following flags:
-
-If C<uv> is a Unicode surrogate code point and UNICODE_WARN_SURROGATE is set,
-the function will raise a warning, provided UTF8 warnings are enabled.  If instead
-UNICODE_DISALLOW_SURROGATE is set, the function will fail and return NULL.
-If both flags are set, the function will both warn and return NULL.
-
-The UNICODE_WARN_NONCHAR and UNICODE_DISALLOW_NONCHAR flags
-affect how the function handles a Unicode non-character.  And likewise, the
-UNICODE_WARN_SUPER and UNICODE_DISALLOW_SUPER flags affect the handling of
-code points that are
-above the Unicode maximum of 0x10FFFF.  Code points above 0x7FFF_FFFF (which are
-even less portable) can be warned and/or disallowed even if other above-Unicode
-code points are accepted, by the UNICODE_WARN_FE_FF and UNICODE_DISALLOW_FE_FF
-flags.
-
-And finally, the flag UNICODE_WARN_ILLEGAL_INTERCHANGE selects all four of the
-above WARN flags; and UNICODE_DISALLOW_ILLEGAL_INTERCHANGE selects all four
-DISALLOW flags.
+If C<flags> is 0, this function accepts any UV as input, but very high code
+points (above C<IV_MAX> for the platform)  will raise a deprecation warning.
+This is typically 0x7FFF_FFFF in a 32-bit word.
+
+Specifying C<flags> can further restrict what is allowed and not warned on, as
+follows:
+
+If C<uv> is a Unicode surrogate code point and C<UNICODE_WARN_SURROGATE> is set,
+the function will raise a warning, provided UTF8 warnings are enabled.  If
+instead C<UNICODE_DISALLOW_SURROGATE> is set, the function will fail and return
+NULL.  If both flags are set, the function will both warn and return NULL.
+
+Similarly, the C<UNICODE_WARN_NONCHAR> and C<UNICODE_DISALLOW_NONCHAR> flags
+affect how the function handles a Unicode non-character.
+
+And likewise, the C<UNICODE_WARN_SUPER> and C<UNICODE_DISALLOW_SUPER> flags
+affect the handling of code points that are above the Unicode maximum of
+0x10FFFF.  Languages other than Perl may not be able to accept files that
+contain these.
+
+The flag C<UNICODE_WARN_ILLEGAL_INTERCHANGE> selects all three of
+the above WARN flags; and C<UNICODE_DISALLOW_ILLEGAL_INTERCHANGE> selects all
+three DISALLOW flags.
+
+Code points above 0x7FFF_FFFF (2**31 - 1) were never specified in any standard,
+so using them is more problematic than other above-Unicode code points.  Perl
+invented an extension to UTF-8 to represent the ones above 2**36-1, so it is
+likely that non-Perl languages will not be able to read files that contain
+these that written by the perl interpreter; nor would Perl understand files
+written by something that uses a different extension.  For these reasons, there
+is a separate set of flags that can warn and/or disallow these extremely high
+code points, even if other above-Unicode ones are accepted.  These are the
+C<UNICODE_WARN_ABOVE_31_BIT> and C<UNICODE_DISALLOW_ABOVE_31_BIT> flags.  These
+are entirely independent from the deprecation warning for code points above
+C<IV_MAX>.  On 32-bit machines, it will eventually be forbidden to have any
+code point that needs more than 31 bits to represent.  When that happens,
+effectively the C<UNICODE_DISALLOW_ABOVE_31_BIT> flag will always be set on
+32-bit machines.  (Of course C<UNICODE_DISALLOW_SUPER> will treat all
+above-Unicode code points, including these, as malformations; and
+C<UNICODE_WARN_SUPER> warns on these.)
+
+On EBCDIC platforms starting in Perl v5.24, the Perl extension for representing
+extremely high code points kicks in at 0x3FFF_FFFF (2**30 -1), which is lower
+than on ASCII.  Prior to that, code points 2**31 and higher were simply
+unrepresentable, and a different, incompatible method was used to represent
+code points between 2**30 and 2**31 - 1.  The flags C<UNICODE_WARN_ABOVE_31_BIT>
+and C<UNICODE_DISALLOW_ABOVE_31_BIT> have the same function as on ASCII
+platforms, warning and disallowing 2**31 and higher.

 
 =cut
 */
 
 =cut
 */


@@ -319,86 +336,115 @@ Perl_uvchr_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags)
 }
 
 /*
 }
 
 /*

-=for apidoc is_utf8_string

 
 

-Returns true if the first C<len> bytes of string C<s> form a valid
-UTF-8 string, false otherwise.  If C<len> is 0, it will be calculated
-using C<strlen(s)> (which means if you use this option, that C<s> can't have
-embedded C<NUL> characters and has to have a terminating C<NUL> byte).  Note
-that all characters being ASCII constitute 'a valid UTF-8 string'.
+A helper function for the macro isUTF8_CHAR(), which should be used instead of
+this function.  The macro will handle smaller code points directly saving time,
+using this function as a fall-back for higher code points.  This function
+assumes that it is not called with an invariant character, and that
+'s + len - 1' is within bounds of the string 's'.

 
 

-See also L</is_invariant_string>(), L</is_utf8_string_loclen>(), and L</is_utf8_string_loc>().
+Tests if the string C<s> of at least length 'len' is a valid variant UTF-8
+character.  0 is returned if not, otherwise, 'len' is returned.

 
 

-=cut

 */
 
 */
 

-bool
-Perl_is_utf8_string(const U8 *s, STRLEN len)
+STRLEN
+Perl__is_utf8_char_slow(const U8 * const s, const STRLEN len)

 {
 {

-    const U8* const send = s + (len ? len : strlen((const char *)s));
-    const U8* x = s;
+    const U8 *e;
+    const U8 *x, *y;

 
 

-    PERL_ARGS_ASSERT_IS_UTF8_STRING;
+    PERL_ARGS_ASSERT__IS_UTF8_CHAR_SLOW;

 
 

-    while (x < send) {
-        STRLEN len = isUTF8_CHAR(x, send);
-        if (UNLIKELY(! len)) {
-            return FALSE;
+    if (UNLIKELY(! UTF8_IS_START(*s))) {
+        return 0;
+    }
+
+    e = s + len;
+
+    for (x = s + 1; x < e; x++) {
+        if (UNLIKELY(! UTF8_IS_CONTINUATION(*x))) {
+            return 0;

         }
         }

-        x += len;

     }
 
     }
 

-    return TRUE;
-}
+#ifndef EBCDIC

 
 

-/*
-Implemented as a macro in utf8.h
+    /* Here is syntactically valid.  Make sure this isn't the start of an
+     * overlong.  These values were found by manually inspecting the UTF-8
+     * patterns.  See the tables in utf8.h and utfebcdic.h */

 
 

-=for apidoc is_utf8_string_loc
+    /* This is not needed on modern perls where C0 and C1 are not considered
+     * start bytes. */
+#if 0
+    if (UNLIKELY(*s < 0xC2)) {
+        return 0;
+    }
+#endif

 
 

-Like L</is_utf8_string> but stores the location of the failure (in the
-case of "utf8ness failure") or the location C<s>+C<len> (in the case of
-"utf8ness success") in the C<ep>.
+    if (len > 1) {
+        if (   (*s == 0xE0 && UNLIKELY(s[1] < 0xA0))
+            || (*s == 0xF0 && UNLIKELY(s[1] < 0x90))
+            || (*s == 0xF8 && UNLIKELY(s[1] < 0x88))
+            || (*s == 0xFC && UNLIKELY(s[1] < 0x84))
+            || (*s == 0xFE && UNLIKELY(s[1] < 0x82)))
+        {
+            return 0;
+        }
+        if ((len > 6 && UNLIKELY(*s == 0xFF) && UNLIKELY(s[6] < 0x81))) {
+            return 0;
+        }
+    }

 
 

-See also L</is_utf8_string_loclen>() and L</is_utf8_string>().
+#else   /* For EBCDIC, we use I8, which is the same on all code pages */
+    {
+        const U8 s0 = NATIVE_UTF8_TO_I8(*s);

 
 

-=for apidoc is_utf8_string_loclen
+        /* On modern perls C0-C4 aren't considered start bytes */
+        if ( /* s0 < 0xC5 || */ s0 == 0xE0) {
+            return 0;
+        }

 
 

-Like L</is_utf8_string>() but stores the location of the failure (in the
-case of "utf8ness failure") or the location C<s>+C<len> (in the case of
-"utf8ness success") in the C<ep>, and the number of UTF-8
-encoded characters in the C<el>.
+        if (len >= 1) {
+            const U8 s1 = NATIVE_UTF8_TO_I8(s[1]);

 
 

-See also L</is_utf8_string_loc>() and L</is_utf8_string>().
+            if (   (s0 == 0xF0 && UNLIKELY(s1 < 0xB0))
+                || (s0 == 0xF8 && UNLIKELY(s1 < 0xA8))
+                || (s0 == 0xFC && UNLIKELY(s1 < 0xA4))
+                || (s0 == 0xFE && UNLIKELY(s1 < 0x82)))
+            {
+                return 0;
+            }
+            if ((len > 7 && UNLIKELY(s0 == 0xFF) && UNLIKELY(s[7] < 0xA1))) {
+                return 0;
+            }
+        }
+    }

 
 

-=cut
-*/
+#endif

 
 

-bool
-Perl_is_utf8_string_loclen(const U8 *s, STRLEN len, const U8 **ep, STRLEN *el)
-{
-    const U8* const send = s + (len ? len : strlen((const char *)s));
-    const U8* x = s;
-    STRLEN outlen = 0;
+    /* Now see if this would overflow a UV on this platform.  See if the UTF8
+     * for this code point is larger than that for the highest representable
+     * code point */
+    y = (const U8 *) HIGHEST_REPRESENTABLE_UTF8;

 
 

-    PERL_ARGS_ASSERT_IS_UTF8_STRING_LOCLEN;
+    for (x = s; x < e; x++, y++) {

 
 

-    while (x < send) {
-        STRLEN len = isUTF8_CHAR(x, send);
-        if (UNLIKELY(! len)) {
-            goto out;
+        /* If the same at this byte, go on to the next */
+        if (UNLIKELY(NATIVE_UTF8_TO_I8(*x) == *y)) {
+            continue;

         }
         }

-        x += len;
-        outlen++;
-    }

 
 

- out:
-    if (el)
-        *el = outlen;
+        /* If this is larger, it overflows */
+        if (UNLIKELY(NATIVE_UTF8_TO_I8(*x) > *y)) {
+            return 0;
+        }
+
+        /* But if smaller, it won't */
+        break;
+    }

 
 

-    if (ep)
-        *ep = x;
-    return (x == send);
+    return len;

 }
 
 /*
 }
 
 /*


@@ -431,13 +477,13 @@ overlong sequences, the computed code point is returned; for all other allowed
 malformations, the Unicode REPLACEMENT CHARACTER is returned, as these have no
 determinable reasonable value.
 
 malformations, the Unicode REPLACEMENT CHARACTER is returned, as these have no
 determinable reasonable value.
 

-The UTF8_CHECK_ONLY flag overrides the behavior when a non-allowed (by other
+The C<UTF8_CHECK_ONLY> flag overrides the behavior when a non-allowed (by other

 flags) malformation is found.  If this flag is set, the routine assumes that
 the caller will raise a warning, and this function will silently just set
 C<retlen> to C<-1> (cast to C<STRLEN>) and return zero.
 
 Note that this API requires disambiguation between successful decoding a C<NUL>
 flags) malformation is found.  If this flag is set, the routine assumes that
 the caller will raise a warning, and this function will silently just set
 C<retlen> to C<-1> (cast to C<STRLEN>) and return zero.
 
 Note that this API requires disambiguation between successful decoding a C<NUL>

-character, and an error return (unless the UTF8_CHECK_ONLY flag is set), as
+character, and an error return (unless the C<UTF8_CHECK_ONLY> flag is set), as

 in both cases, 0 is returned.  To disambiguate, upon a zero return, see if the
 first byte of C<s> is 0 as well.  If so, the input was a C<NUL>; if not, the
 input had an error.
 in both cases, 0 is returned.  To disambiguate, upon a zero return, see if the
 first byte of C<s> is 0 as well.  If so, the input was a C<NUL>; if not, the
 input had an error.


@@ -446,34 +492,48 @@ Certain code points are considered problematic.  These are Unicode surrogates,
 Unicode non-characters, and code points above the Unicode maximum of 0x10FFFF.
 By default these are considered regular code points, but certain situations
 warrant special handling for them.  If C<flags> contains
 Unicode non-characters, and code points above the Unicode maximum of 0x10FFFF.
 By default these are considered regular code points, but certain situations
 warrant special handling for them.  If C<flags> contains

-UTF8_DISALLOW_ILLEGAL_INTERCHANGE, all three classes are treated as
-malformations and handled as such.  The flags UTF8_DISALLOW_SURROGATE,
-UTF8_DISALLOW_NONCHAR, and UTF8_DISALLOW_SUPER (meaning above the legal Unicode
-maximum) can be set to disallow these categories individually.
-
-The flags UTF8_WARN_ILLEGAL_INTERCHANGE, UTF8_WARN_SURROGATE,
-UTF8_WARN_NONCHAR, and UTF8_WARN_SUPER will cause warning messages to be raised
-for their respective categories, but otherwise the code points are considered
-valid (not malformations).  To get a category to both be treated as a
-malformation and raise a warning, specify both the WARN and DISALLOW flags.
+C<UTF8_DISALLOW_ILLEGAL_INTERCHANGE>, all three classes are treated as
+malformations and handled as such.  The flags C<UTF8_DISALLOW_SURROGATE>,
+C<UTF8_DISALLOW_NONCHAR>, and C<UTF8_DISALLOW_SUPER> (meaning above the legal
+Unicode maximum) can be set to disallow these categories individually.
+
+The flags C<UTF8_WARN_ILLEGAL_INTERCHANGE>, C<UTF8_WARN_SURROGATE>,
+C<UTF8_WARN_NONCHAR>, and C<UTF8_WARN_SUPER> will cause warning messages to be
+raised for their respective categories, but otherwise the code points are
+considered valid (not malformations).  To get a category to both be treated as
+a malformation and raise a warning, specify both the WARN and DISALLOW flags.

 (But note that warnings are not raised if lexically disabled nor if
 (But note that warnings are not raised if lexically disabled nor if

-UTF8_CHECK_ONLY is also specified.)
-
-Very large code points (above 0x7FFF_FFFF) are considered more problematic than
-the others that are above the Unicode legal maximum.  There are several
-reasons: they requre at least 32 bits to represent them on ASCII platforms, are
-not representable at all on EBCDIC platforms, and the original UTF-8
-specification never went above this number (the current 0x10FFFF limit was
-imposed later).  (The smaller ones, those that fit into 32 bits, are
-representable by a UV on ASCII platforms, but not by an IV, which means that
-the number of operations that can be performed on them is quite restricted.)
-The UTF-8 encoding on ASCII platforms for these large code points begins with a
-byte containing 0xFE or 0xFF.  The UTF8_DISALLOW_FE_FF flag will cause them to
-be treated as malformations, while allowing smaller above-Unicode code points.
-(Of course UTF8_DISALLOW_SUPER will treat all above-Unicode code points,
-including these, as malformations.)
-Similarly, UTF8_WARN_FE_FF acts just like
-the other WARN flags, but applies just to these code points.
+C<UTF8_CHECK_ONLY> is also specified.)
+
+It is now deprecated to have very high code points (above C<IV_MAX> on the
+platforms) and this function will raise a deprecation warning for these (unless
+such warnings are turned off).  This value, is typically 0x7FFF_FFFF (2**31 -1)
+in a 32-bit word.
+
+Code points above 0x7FFF_FFFF (2**31 - 1) were never specified in any standard,
+so using them is more problematic than other above-Unicode code points.  Perl
+invented an extension to UTF-8 to represent the ones above 2**36-1, so it is
+likely that non-Perl languages will not be able to read files that contain
+these that written by the perl interpreter; nor would Perl understand files
+written by something that uses a different extension.  For these reasons, there
+is a separate set of flags that can warn and/or disallow these extremely high
+code points, even if other above-Unicode ones are accepted.  These are the
+C<UTF8_WARN_ABOVE_31_BIT> and C<UTF8_DISALLOW_ABOVE_31_BIT> flags.  These
+are entirely independent from the deprecation warning for code points above
+C<IV_MAX>.  On 32-bit machines, it will eventually be forbidden to have any
+code point that needs more than 31 bits to represent.  When that happens,
+effectively the C<UTF8_DISALLOW_ABOVE_31_BIT> flag will always be set on
+32-bit machines.  (Of course C<UTF8_DISALLOW_SUPER> will treat all
+above-Unicode code points, including these, as malformations; and
+C<UTF8_WARN_SUPER> warns on these.)
+
+On EBCDIC platforms starting in Perl v5.24, the Perl extension for representing
+extremely high code points kicks in at 0x3FFF_FFFF (2**30 -1), which is lower
+than on ASCII.  Prior to that, code points 2**31 and higher were simply
+unrepresentable, and a different, incompatible method was used to represent
+code points between 2**30 and 2**31 - 1.  The flags C<UTF8_WARN_ABOVE_31_BIT>
+and C<UTF8_DISALLOW_ABOVE_31_BIT> have the same function as on ASCII
+platforms, warning and disallowing 2**31 and higher.

 
 All other code points corresponding to Unicode characters, including private
 use and those yet to be assigned, are never considered malformed and never
 
 All other code points corresponding to Unicode characters, including private
 use and those yet to be assigned, are never considered malformed and never


@@ -571,14 +631,10 @@ Perl_utf8n_to_uvchr(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
     /* Here is not a continuation byte, nor an invariant.  The only thing left
      * is a start byte (possibly for an overlong) */
 
     /* Here is not a continuation byte, nor an invariant.  The only thing left
      * is a start byte (possibly for an overlong) */
 

-#ifdef EBCDIC
-    uv = NATIVE_UTF8_TO_I8(uv);
-#endif
-
-    /* Remove the leading bits that indicate the number of bytes in the
-     * character's whole UTF-8 sequence, leaving just the bits that are part of
-     * the value */
-    uv &= UTF_START_MASK(expectlen);
+    /* Convert to I8 on EBCDIC (no-op on ASCII), then remove the leading bits
+     * that indicate the number of bytes in the character's whole UTF-8
+     * sequence, leaving just the bits that are part of the value.  */
+    uv = NATIVE_UTF8_TO_I8(uv) & UTF_START_MASK(expectlen);

 
     /* Now, loop through the remaining bytes in the character's sequence,
      * accumulating each into the working value as we go.  Be sure to not look
 
     /* Now, loop through the remaining bytes in the character's sequence,
      * accumulating each into the working value as we go.  Be sure to not look


@@ -587,7 +643,6 @@ Perl_utf8n_to_uvchr(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
 
     for (s = s0 + 1; s < send; s++) {
        if (LIKELY(UTF8_IS_CONTINUATION(*s))) {
 
     for (s = s0 + 1; s < send; s++) {
        if (LIKELY(UTF8_IS_CONTINUATION(*s))) {

-#ifndef EBCDIC /* Can't overflow in EBCDIC */

            if (uv & UTF_ACCUMULATION_OVERFLOW_MASK) {
 
                /* The original implementors viewed this malformation as more
            if (uv & UTF_ACCUMULATION_OVERFLOW_MASK) {
 
                /* The original implementors viewed this malformation as more


@@ -599,7 +654,6 @@ Perl_utf8n_to_uvchr(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
                overflowed = TRUE;
                overflow_byte = *s; /* Save for warning message's use */
            }
                overflowed = TRUE;
                overflow_byte = *s; /* Save for warning message's use */
            }

-#endif

            uv = UTF8_ACCUMULATE(uv, *s);
        }
        else {
            uv = UTF8_ACCUMULATE(uv, *s);
        }
        else {


@@ -666,12 +720,10 @@ Perl_utf8n_to_uvchr(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
        }
     }
 
        }
     }
 

-#ifndef EBCDIC /* EBCDIC can't overflow */

     if (UNLIKELY(overflowed)) {
        sv = sv_2mortal(Perl_newSVpvf(aTHX_ "%s (overflow at byte 0x%02x, after start byte 0x%02x)", malformed_text, overflow_byte, *s0));
        goto malformed;
     }
     if (UNLIKELY(overflowed)) {
        sv = sv_2mortal(Perl_newSVpvf(aTHX_ "%s (overflow at byte 0x%02x, after start byte 0x%02x)", malformed_text, overflow_byte, *s0));
        goto malformed;
     }

-#endif

 
     if (do_overlong_test
        && expectlen > (STRLEN) OFFUNISKIP(uv)
 
     if (do_overlong_test
        && expectlen > (STRLEN) OFFUNISKIP(uv)


@@ -690,8 +742,16 @@ Perl_utf8n_to_uvchr(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
     /* Here, the input is considered to be well-formed, but it still could be a
      * problematic code point that is not allowed by the input parameters. */
     if (uv >= UNICODE_SURROGATE_FIRST /* isn't problematic if < this */
     /* Here, the input is considered to be well-formed, but it still could be a
      * problematic code point that is not allowed by the input parameters. */
     if (uv >= UNICODE_SURROGATE_FIRST /* isn't problematic if < this */

-       && (flags & (UTF8_DISALLOW_ILLEGAL_INTERCHANGE
-                    |UTF8_WARN_ILLEGAL_INTERCHANGE)))
+       && ((flags & ( UTF8_DISALLOW_NONCHAR
+                      |UTF8_DISALLOW_SURROGATE
+                      |UTF8_DISALLOW_SUPER
+                      |UTF8_DISALLOW_ABOVE_31_BIT
+                     |UTF8_WARN_NONCHAR
+                      |UTF8_WARN_SURROGATE
+                      |UTF8_WARN_SUPER
+                      |UTF8_WARN_ABOVE_31_BIT))
+            || (   UNLIKELY(uv > MAX_NON_DEPRECATED_CP)
+                && ckWARN_d(WARN_DEPRECATED))))

     {
        if (UNICODE_IS_SURROGATE(uv)) {
 
     {
        if (UNICODE_IS_SURROGATE(uv)) {
 


@@ -711,39 +771,76 @@ Perl_utf8n_to_uvchr(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
            if ((flags & (UTF8_WARN_SUPER|UTF8_CHECK_ONLY)) == UTF8_WARN_SUPER
                 && ckWARN_d(WARN_NON_UNICODE))
            {
            if ((flags & (UTF8_WARN_SUPER|UTF8_CHECK_ONLY)) == UTF8_WARN_SUPER
                 && ckWARN_d(WARN_NON_UNICODE))
            {

-               sv = sv_2mortal(Perl_newSVpvf(aTHX_ "Code point 0x%04"UVXf" is not Unicode, may not be portable", uv));
+               sv = sv_2mortal(Perl_newSVpvf(aTHX_
+                   "Code point 0x%04"UVXf" is not Unicode, may not be portable",
+                   uv));

                pack_warn = packWARN(WARN_NON_UNICODE);
            }
                pack_warn = packWARN(WARN_NON_UNICODE);
            }

-#ifndef EBCDIC /* EBCDIC always allows FE, FF */
-
-            /* The first byte being 0xFE or 0xFF is a subset of the SUPER code
-             * points.  We test for these after the regular SUPER ones, and
-             * before possibly bailing out, so that the more dire warning
-             * overrides the regular one, if applicable */
-            if ((*s0 & 0xFE) == 0xFE   /* matches both FE, FF */
-                && (flags & (UTF8_WARN_FE_FF|UTF8_DISALLOW_FE_FF)))
+
+            /* The maximum code point ever specified by a standard was
+             * 2**31 - 1.  Anything larger than that is a Perl extension that
+             * very well may not be understood by other applications (including
+             * earlier perl versions on EBCDIC platforms).  On ASCII platforms,
+             * these code points are indicated by the first UTF-8 byte being
+             * 0xFE or 0xFF.  We test for these after the regular SUPER ones,
+             * and before possibly bailing out, so that the slightly more dire
+             * warning will override the regular one. */
+            if (
+#ifndef EBCDIC
+                (*s0 & 0xFE) == 0xFE   /* matches both FE, FF */
+#else
+                 /* The I8 for 2**31 (U+80000000) is
+                  *   \xFF\xA0\xA0\xA0\xA0\xA0\xA0\xA2\xA0\xA0\xA0\xA0\xA0\xA0
+                  * and it turns out that on all EBCDIC pages recognized that
+                  * the UTF-EBCDIC for that code point is
+                  *   \xFE\x41\x41\x41\x41\x41\x41\x43\x41\x41\x41\x41\x41\x41
+                  * For the next lower code point, the 1047 UTF-EBCDIC is
+                  *   \xFE\x41\x41\x41\x41\x41\x41\x42\x73\x73\x73\x73\x73\x73
+                  * The other code pages differ only in the bytes following
+                  * \x42.  Thus the following works (the minimum continuation
+                  * byte is \x41). */
+                *s0 == 0xFE && send - s0 > 7 && (   s0[1] > 0x41
+                                                 || s0[2] > 0x41
+                                                 || s0[3] > 0x41
+                                                 || s0[4] > 0x41
+                                                 || s0[5] > 0x41
+                                                 || s0[6] > 0x41
+                                                 || s0[7] > 0x42)
+#endif
+                && (flags & (UTF8_WARN_ABOVE_31_BIT|UTF8_WARN_SUPER
+                            |UTF8_DISALLOW_ABOVE_31_BIT)))

             {
             {

-                if ((flags & (UTF8_WARN_FE_FF|UTF8_CHECK_ONLY))
-                                                            == UTF8_WARN_FE_FF
-                    && ckWARN_d(WARN_UTF8))
+                if (  ! (flags & UTF8_CHECK_ONLY)
+                    &&  (flags & (UTF8_WARN_ABOVE_31_BIT|UTF8_WARN_SUPER))
+                    &&  ckWARN_d(WARN_UTF8))

                 {
                 {

-                    sv = sv_2mortal(Perl_newSVpvf(aTHX_ "Code point 0x%"UVXf" is not Unicode, and not portable", uv));
+                    sv = sv_2mortal(Perl_newSVpvf(aTHX_
+                        "Code point 0x%"UVXf" is not Unicode, and not portable",
+                        uv));

                     pack_warn = packWARN(WARN_UTF8);
                 }
                     pack_warn = packWARN(WARN_UTF8);
                 }

-                if (flags & UTF8_DISALLOW_FE_FF) {
+                if (flags & UTF8_DISALLOW_ABOVE_31_BIT) {

                     goto disallowed;
                 }
             }
                     goto disallowed;
                 }
             }

-#endif
+

            if (flags & UTF8_DISALLOW_SUPER) {
                goto disallowed;
            }
            if (flags & UTF8_DISALLOW_SUPER) {
                goto disallowed;
            }

+
+            /* The deprecated warning overrides any non-deprecated one */
+            if (UNLIKELY(uv > MAX_NON_DEPRECATED_CP) && ckWARN_d(WARN_DEPRECATED))
+            {
+                sv = sv_2mortal(Perl_newSVpvf(aTHX_ cp_above_legal_max,
+                                              uv, MAX_NON_DEPRECATED_CP));
+                pack_warn = packWARN(WARN_DEPRECATED);
+            }

        }
        else if (UNICODE_IS_NONCHAR(uv)) {
            if ((flags & (UTF8_WARN_NONCHAR|UTF8_CHECK_ONLY)) == UTF8_WARN_NONCHAR
                && ckWARN_d(WARN_NONCHAR))
            {
        }
        else if (UNICODE_IS_NONCHAR(uv)) {
            if ((flags & (UTF8_WARN_NONCHAR|UTF8_CHECK_ONLY)) == UTF8_WARN_NONCHAR
                && ckWARN_d(WARN_NONCHAR))
            {

-               sv = sv_2mortal(Perl_newSVpvf(aTHX_ "Unicode non-character U+%04"UVXf" is illegal for open interchange", uv));
+               sv = sv_2mortal(Perl_newSVpvf(aTHX_ "Unicode non-character U+%04"UVXf" is not recommended for open interchange", uv));

                pack_warn = packWARN(WARN_NONCHAR);
            }
            if (flags & UTF8_DISALLOW_NONCHAR) {
                pack_warn = packWARN(WARN_NONCHAR);
            }
            if (flags & UTF8_DISALLOW_NONCHAR) {


@@ -832,13 +929,16 @@ C<*retlen> will be set to the length, in bytes, of that character.
 
 If C<s> does not point to a well-formed UTF-8 character and UTF8 warnings are
 enabled, zero is returned and C<*retlen> is set (if C<retlen> isn't
 
 If C<s> does not point to a well-formed UTF-8 character and UTF8 warnings are
 enabled, zero is returned and C<*retlen> is set (if C<retlen> isn't

-NULL) to -1.  If those warnings are off, the computed value, if well-defined
+C<NULL>) to -1.  If those warnings are off, the computed value, if well-defined

 (or the Unicode REPLACEMENT CHARACTER if not), is silently returned, and
 (or the Unicode REPLACEMENT CHARACTER if not), is silently returned, and

-C<*retlen> is set (if C<retlen> isn't NULL) so that (S<C<s> + C<*retlen>>) is
+C<*retlen> is set (if C<retlen> isn't C<NULL>) so that (S<C<s> + C<*retlen>>) is

 the next possible position in C<s> that could begin a non-malformed character.
 See L</utf8n_to_uvchr> for details on when the REPLACEMENT CHARACTER is
 returned.
 
 the next possible position in C<s> that could begin a non-malformed character.
 See L</utf8n_to_uvchr> for details on when the REPLACEMENT CHARACTER is
 returned.
 

+Code points above the platform's C<IV_MAX> will raise a deprecation warning,
+unless those are turned off.
+

 =cut
 */
 
 =cut
 */
 


@@ -852,48 +952,6 @@ Perl_utf8_to_uvchr_buf(pTHX_ const U8 *s, const U8 *send, STRLEN *retlen)
                          ckWARN_d(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
 }
 
                          ckWARN_d(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
 }
 

-/* Like L</utf8_to_uvchr_buf>(), but should only be called when it is known that
- * there are no malformations in the input UTF-8 string C<s>.  surrogates,
- * non-character code points, and non-Unicode code points are allowed. */
-
-UV
-Perl_valid_utf8_to_uvchr(pTHX_ const U8 *s, STRLEN *retlen)
-{
-    UV expectlen = UTF8SKIP(s);
-    const U8* send = s + expectlen;
-    UV uv = *s;
-
-    PERL_ARGS_ASSERT_VALID_UTF8_TO_UVCHR;
-    PERL_UNUSED_CONTEXT;
-
-    if (retlen) {
-        *retlen = expectlen;
-    }
-
-    /* An invariant is trivially returned */
-    if (expectlen == 1) {
-       return uv;
-    }
-
-#ifdef EBCDIC
-    uv = NATIVE_UTF8_TO_I8(uv);
-#endif
-
-    /* Remove the leading bits that indicate the number of bytes, leaving just
-     * the bits that are part of the value */
-    uv &= UTF_START_MASK(expectlen);
-
-    /* Now, loop through the remaining bytes, accumulating each into the
-     * working total as we go.  (I khw tried unrolling the loop for up to 4
-     * bytes, but there was no performance improvement) */
-    for (++s; s < send; s++) {
-        uv = UTF8_ACCUMULATE(uv, *s);
-    }
-
-    return UNI_TO_NATIVE(uv);
-
-}
-

 /*
 =for apidoc utf8_to_uvuni_buf
 
 /*
 =for apidoc utf8_to_uvuni_buf
 


@@ -914,6 +972,9 @@ is set (if C<retlen> isn't NULL) so that (S<C<s> + C<*retlen>>) is the
 next possible position in C<s> that could begin a non-malformed character.
 See L</utf8n_to_uvchr> for details on when the REPLACEMENT CHARACTER is returned.
 
 next possible position in C<s> that could begin a non-malformed character.
 See L</utf8n_to_uvchr> for details on when the REPLACEMENT CHARACTER is returned.
 

+Code points above the platform's C<IV_MAX> will raise a deprecation warning,
+unless those are turned off.
+

 =cut
 */
 
 =cut
 */
 


@@ -924,9 +985,8 @@ Perl_utf8_to_uvuni_buf(pTHX_ const U8 *s, const U8 *send, STRLEN *retlen)
 
     assert(send > s);
 
 
     assert(send > s);
 

-    /* Call the low level routine asking for checks */
-    return NATIVE_TO_UNI(Perl_utf8n_to_uvchr(aTHX_ s, send -s, retlen,
-                              ckWARN_d(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY));
+    /* Call the low level routine, asking for checks */
+    return NATIVE_TO_UNI(utf8_to_uvchr_buf(s, send, retlen));

 }
 
 /*
 }
 
 /*


@@ -971,62 +1031,6 @@ Perl_utf8_length(pTHX_ const U8 *s, const U8 *e)
 }
 
 /*
 }
 
 /*

-=for apidoc utf8_distance
-
-Returns the number of UTF-8 characters between the UTF-8 pointers C<a>
-and C<b>.
-
-WARNING: use only if you *know* that the pointers point inside the
-same UTF-8 buffer.
-
-=cut
-*/
-
-IV
-Perl_utf8_distance(pTHX_ const U8 *a, const U8 *b)
-{
-    PERL_ARGS_ASSERT_UTF8_DISTANCE;
-
-    return (a < b) ? -1 * (IV) utf8_length(a, b) : (IV) utf8_length(b, a);
-}
-
-/*
-=for apidoc utf8_hop
-
-Return the UTF-8 pointer C<s> displaced by C<off> characters, either
-forward or backward.
-
-WARNING: do not use the following unless you *know* C<off> is within
-the UTF-8 data pointed to by C<s> *and* that on entry C<s> is aligned
-on the first byte of character or just after the last byte of a character.
-
-=cut
-*/
-
-U8 *
-Perl_utf8_hop(const U8 *s, I32 off)
-{
-    PERL_ARGS_ASSERT_UTF8_HOP;
-
-    /* Note: cannot use UTF8_IS_...() too eagerly here since e.g
-     * the bitops (especially ~) can create illegal UTF-8.
-     * In other words: in Perl UTF-8 is not just for Unicode. */
-
-    if (off >= 0) {
-       while (off--)
-           s += UTF8SKIP(s);
-    }
-    else {
-       while (off++) {
-           s--;
-           while (UTF8_IS_CONTINUATION(*s))
-               s--;
-       }
-    }
-    return (U8 *)s;
-}
-
-/*

 =for apidoc bytes_cmp_utf8
 
 Compares the sequence of characters (stored as octets) in C<b>, C<blen> with the
 =for apidoc bytes_cmp_utf8
 
 Compares the sequence of characters (stored as octets) in C<b>, C<blen> with the


@@ -1058,7 +1062,7 @@ Perl_bytes_cmp_utf8(pTHX_ const U8 *b, STRLEN blen, const U8 *u, STRLEN ulen)
                if (u < uend) {
                    U8 c1 = *u++;
                    if (UTF8_IS_CONTINUATION(c1)) {
                if (u < uend) {
                    U8 c1 = *u++;
                    if (UTF8_IS_CONTINUATION(c1)) {

-                       c = TWO_BYTE_UTF8_TO_NATIVE(c, c1);
+                       c = EIGHT_BIT_UTF8_TO_NATIVE(c, c1);

                    } else {
                        Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8),
                                         "Malformed UTF-8 character "
                    } else {
                        Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8),
                                         "Malformed UTF-8 character "


@@ -1134,7 +1138,7 @@ Perl_utf8_to_bytes(pTHX_ U8 *s, STRLEN *len)
        U8 c = *s++;
        if (! UTF8_IS_INVARIANT(c)) {
            /* Then it is two-byte encoded */
        U8 c = *s++;
        if (! UTF8_IS_INVARIANT(c)) {
            /* Then it is two-byte encoded */

-           c = TWO_BYTE_UTF8_TO_NATIVE(c, *s);
+           c = EIGHT_BIT_UTF8_TO_NATIVE(c, *s);

             s++;
        }
        *d++ = c;
             s++;
        }
        *d++ = c;


@@ -1153,7 +1157,7 @@ the newly-created string, and updates C<len> to contain the new
 length.  Returns the original string if no conversion occurs, C<len>
 is unchanged.  Do nothing if C<is_utf8> points to 0.  Sets C<is_utf8> to
 0 if C<s> is converted or consisted entirely of characters that are invariant
 length.  Returns the original string if no conversion occurs, C<len>
 is unchanged.  Do nothing if C<is_utf8> points to 0.  Sets C<is_utf8> to
 0 if C<s> is converted or consisted entirely of characters that are invariant

-in utf8 (i.e., US-ASCII on non-EBCDIC machines).
+in UTF-8 (i.e., US-ASCII on non-EBCDIC machines).

 
 =cut
 */
 
 =cut
 */


@@ -1191,7 +1195,7 @@ Perl_bytes_from_utf8(pTHX_ const U8 *s, STRLEN *len, bool *is_utf8)
        U8 c = *s++;
        if (! UTF8_IS_INVARIANT(c)) {
            /* Then it is two-byte encoded */
        U8 c = *s++;
        if (! UTF8_IS_INVARIANT(c)) {
            /* Then it is two-byte encoded */

-           c = TWO_BYTE_UTF8_TO_NATIVE(c, *s);
+           c = EIGHT_BIT_UTF8_TO_NATIVE(c, *s);

             s++;
        }
        *d++ = c;
             s++;
        }
        *d++ = c;


@@ -1265,7 +1269,7 @@ Perl_utf16_to_utf8(pTHX_ U8* p, U8* d, I32 bytelen, I32 *newlen)
     while (p < pend) {
        UV uv = (p[0] << 8) + p[1]; /* UTF-16BE */
        p += 2;
     while (p < pend) {
        UV uv = (p[0] << 8) + p[1]; /* UTF-16BE */
        p += 2;

-       if (UNI_IS_INVARIANT(uv)) {
+       if (OFFUNI_IS_INVARIANT(uv)) {

            *d++ = LATIN1_TO_NATIVE((U8) uv);
            continue;
        }
            *d++ = LATIN1_TO_NATIVE((U8) uv);
            continue;
        }


@@ -1278,19 +1282,26 @@ Perl_utf16_to_utf8(pTHX_ U8* p, U8* d, I32 bytelen, I32 *newlen)
 #define LAST_HIGH_SURROGATE  0xDBFF
 #define FIRST_LOW_SURROGATE  0xDC00
 #define LAST_LOW_SURROGATE   UNICODE_SURROGATE_LAST
 #define LAST_HIGH_SURROGATE  0xDBFF
 #define FIRST_LOW_SURROGATE  0xDC00
 #define LAST_LOW_SURROGATE   UNICODE_SURROGATE_LAST

-       if (uv >= FIRST_HIGH_SURROGATE && uv <= LAST_HIGH_SURROGATE) {
-           if (p >= pend) {
-               Perl_croak(aTHX_ "Malformed UTF-16 surrogate");
-           } else {
+
+        /* This assumes that most uses will be in the first Unicode plane, not
+         * needing surrogates */
+       if (UNLIKELY(uv >= UNICODE_SURROGATE_FIRST
+                  && uv <= UNICODE_SURROGATE_LAST))
+        {
+            if (UNLIKELY(p >= pend) || UNLIKELY(uv > LAST_HIGH_SURROGATE)) {
+                Perl_croak(aTHX_ "Malformed UTF-16 surrogate");
+            }
+           else {

                UV low = (p[0] << 8) + p[1];
                UV low = (p[0] << 8) + p[1];

-               p += 2;
-               if (low < FIRST_LOW_SURROGATE || low > LAST_LOW_SURROGATE)
+               if (   UNLIKELY(low < FIRST_LOW_SURROGATE)
+                    || UNLIKELY(low > LAST_LOW_SURROGATE))
+                {

                    Perl_croak(aTHX_ "Malformed UTF-16 surrogate");
                    Perl_croak(aTHX_ "Malformed UTF-16 surrogate");

+                }
+               p += 2;

                uv = ((uv - FIRST_HIGH_SURROGATE) << 10)
                                        + (low - FIRST_LOW_SURROGATE) + 0x10000;
            }
                uv = ((uv - FIRST_HIGH_SURROGATE) << 10)
                                        + (low - FIRST_LOW_SURROGATE) + 0x10000;
            }

-       } else if (uv >= FIRST_LOW_SURROGATE && uv <= LAST_LOW_SURROGATE) {
-           Perl_croak(aTHX_ "Malformed UTF-16 surrogate");

        }
 #ifdef EBCDIC
         d = uvoffuni_to_utf8_flags(d, uv, 0);
        }
 #ifdef EBCDIC
         d = uvoffuni_to_utf8_flags(d, uv, 0);


@@ -1378,7 +1389,7 @@ UV
 Perl__to_upper_title_latin1(pTHX_ const U8 c, U8* p, STRLEN *lenp, const char S_or_s)
 {
     /* We have the latin1-range values compiled into the core, so just use
 Perl__to_upper_title_latin1(pTHX_ const U8 c, U8* p, STRLEN *lenp, const char S_or_s)
 {
     /* We have the latin1-range values compiled into the core, so just use

-     * those, converting the result to utf8.  The only difference between upper
+     * those, converting the result to UTF-8.  The only difference between upper

      * and title case in this range is that LATIN_SMALL_LETTER_SHARP_S is
      * either "SS" or "Ss".  Which one to use is passed into the routine in
      * 'S_or_s' to avoid a test */
      * and title case in this range is that LATIN_SMALL_LETTER_SHARP_S is
      * either "SS" or "Ss".  Which one to use is passed into the routine in
      * 'S_or_s' to avoid a test */


@@ -1407,11 +1418,15 @@ Perl__to_upper_title_latin1(pTHX_ const U8 c, U8* p, STRLEN *lenp, const char S_
            case MICRO_SIGN:
                converted = GREEK_CAPITAL_LETTER_MU;
                break;
            case MICRO_SIGN:
                converted = GREEK_CAPITAL_LETTER_MU;
                break;

+#if    UNICODE_MAJOR_VERSION > 2                                        \
+   || (UNICODE_MAJOR_VERSION == 2 && UNICODE_DOT_VERSION >= 1           \
+                                  && UNICODE_DOT_DOT_VERSION >= 8)

            case LATIN_SMALL_LETTER_SHARP_S:
                *(p)++ = 'S';
                *p = S_or_s;
                *lenp = 2;
                return 'S';
            case LATIN_SMALL_LETTER_SHARP_S:
                *(p)++ = 'S';
                *p = S_or_s;
                *lenp = 2;
                return 'S';

+#endif

            default:
                Perl_croak(aTHX_ "panic: to_upper_title_latin1 did not expect '%c' to map to '%c'", c, LATIN_SMALL_LETTER_Y_WITH_DIAERESIS);
                NOT_REACHED; /* NOTREACHED */
            default:
                Perl_croak(aTHX_ "panic: to_upper_title_latin1 did not expect '%c' to map to '%c'", c, LATIN_SMALL_LETTER_Y_WITH_DIAERESIS);
                NOT_REACHED; /* NOTREACHED */


@@ -1433,14 +1448,14 @@ Perl__to_upper_title_latin1(pTHX_ const U8 c, U8* p, STRLEN *lenp, const char S_
  * LENP will be set to the length in bytes of the string of changed characters
  *
  * The functions return the ordinal of the first character in the string of OUTP */
  * LENP will be set to the length in bytes of the string of changed characters
  *
  * The functions return the ordinal of the first character in the string of OUTP */

-#define CALL_UPPER_CASE(INP, OUTP, LENP) Perl_to_utf8_case(aTHX_ INP, OUTP, LENP, &PL_utf8_toupper, "ToUc", "")
-#define CALL_TITLE_CASE(INP, OUTP, LENP) Perl_to_utf8_case(aTHX_ INP, OUTP, LENP, &PL_utf8_totitle, "ToTc", "")
-#define CALL_LOWER_CASE(INP, OUTP, LENP) Perl_to_utf8_case(aTHX_ INP, OUTP, LENP, &PL_utf8_tolower, "ToLc", "")
+#define CALL_UPPER_CASE(uv, s, d, lenp) _to_utf8_case(uv, s, d, lenp, &PL_utf8_toupper, "ToUc", "")
+#define CALL_TITLE_CASE(uv, s, d, lenp) _to_utf8_case(uv, s, d, lenp, &PL_utf8_totitle, "ToTc", "")
+#define CALL_LOWER_CASE(uv, s, d, lenp) _to_utf8_case(uv, s, d, lenp, &PL_utf8_tolower, "ToLc", "")

 
 

-/* This additionally has the input parameter SPECIALS, which if non-zero will
- * cause this to use the SPECIALS hash for folding (meaning get full case
+/* This additionally has the input parameter 'specials', which if non-zero will
+ * cause this to use the specials hash for folding (meaning get full case

  * folding); otherwise, when zero, this implies a simple case fold */
  * folding); otherwise, when zero, this implies a simple case fold */

-#define CALL_FOLD_CASE(INP, OUTP, LENP, SPECIALS) Perl_to_utf8_case(aTHX_ INP, OUTP, LENP, &PL_utf8_tofold, "ToCf", (SPECIALS) ? "" : NULL)
+#define CALL_FOLD_CASE(uv, s, d, lenp, specials) _to_utf8_case(uv, s, d, lenp, &PL_utf8_tofold, "ToCf", (specials) ? "" : NULL)

 
 UV
 Perl_to_uni_upper(pTHX_ UV c, U8* p, STRLEN *lenp)
 
 UV
 Perl_to_uni_upper(pTHX_ UV c, U8* p, STRLEN *lenp)


@@ -1460,7 +1475,7 @@ Perl_to_uni_upper(pTHX_ UV c, U8* p, STRLEN *lenp)
     }
 
     uvchr_to_utf8(p, c);
     }
 
     uvchr_to_utf8(p, c);

-    return CALL_UPPER_CASE(p, p, lenp);
+    return CALL_UPPER_CASE(c, p, p, lenp);

 }
 
 UV
 }
 
 UV


@@ -1473,14 +1488,14 @@ Perl_to_uni_title(pTHX_ UV c, U8* p, STRLEN *lenp)
     }
 
     uvchr_to_utf8(p, c);
     }
 
     uvchr_to_utf8(p, c);

-    return CALL_TITLE_CASE(p, p, lenp);
+    return CALL_TITLE_CASE(c, p, p, lenp);

 }
 
 STATIC U8
 S_to_lower_latin1(const U8 c, U8* p, STRLEN *lenp)
 {
     /* We have the latin1-range values compiled into the core, so just use
 }
 
 STATIC U8
 S_to_lower_latin1(const U8 c, U8* p, STRLEN *lenp)
 {
     /* We have the latin1-range values compiled into the core, so just use

-     * those, converting the result to utf8.  Since the result is always just
+     * those, converting the result to UTF-8.  Since the result is always just

      * one character, we allow <p> to be NULL */
 
     U8 converted = toLOWER_LATIN1(c);
      * one character, we allow <p> to be NULL */
 
     U8 converted = toLOWER_LATIN1(c);


@@ -1511,7 +1526,7 @@ Perl_to_uni_lower(pTHX_ UV c, U8* p, STRLEN *lenp)
     }
 
     uvchr_to_utf8(p, c);
     }
 
     uvchr_to_utf8(p, c);

-    return CALL_LOWER_CASE(p, p, lenp);
+    return CALL_LOWER_CASE(c, p, p, lenp);

 }
 
 UV
 }
 
 UV


@@ -1531,11 +1546,15 @@ Perl__to_fold_latin1(pTHX_ const U8 c, U8* p, STRLEN *lenp, const unsigned int f
 
     assert (! (flags & FOLD_FLAGS_LOCALE));
 
 
     assert (! (flags & FOLD_FLAGS_LOCALE));
 

-    if (c == MICRO_SIGN) {
+    if (UNLIKELY(c == MICRO_SIGN)) {

        converted = GREEK_SMALL_LETTER_MU;
     }
        converted = GREEK_SMALL_LETTER_MU;
     }

-    else if ((flags & FOLD_FLAGS_FULL) && c == LATIN_SMALL_LETTER_SHARP_S) {
-
+#if    UNICODE_MAJOR_VERSION > 3 /* no multifolds in early Unicode */   \
+   || (UNICODE_MAJOR_VERSION == 3 && (   UNICODE_DOT_VERSION > 0)       \
+                                      || UNICODE_DOT_DOT_VERSION > 0)
+    else if (   (flags & FOLD_FLAGS_FULL)
+             && UNLIKELY(c == LATIN_SMALL_LETTER_SHARP_S))
+    {

         /* If can't cross 127/128 boundary, can't return "ss"; instead return
          * two U+017F characters, as fc("\df") should eq fc("\x{17f}\x{17f}")
          * under those circumstances. */
         /* If can't cross 127/128 boundary, can't return "ss"; instead return
          * two U+017F characters, as fc("\df") should eq fc("\x{17f}\x{17f}")
          * under those circumstances. */


@@ -1552,6 +1571,7 @@ Perl__to_fold_latin1(pTHX_ const U8 c, U8* p, STRLEN *lenp, const unsigned int f
             return 's';
         }
     }
             return 's';
         }
     }

+#endif

     else { /* In this range the fold of all other characters is their lower
               case */
        converted = toLOWER_LATIN1(c);
     else { /* In this range the fold of all other characters is their lower
               case */
        converted = toLOWER_LATIN1(c);


@@ -1603,7 +1623,7 @@ Perl__to_uni_fold_flags(pTHX_ UV c, U8* p, STRLEN *lenp, U8 flags)
     /* Here, above 255.  If no special needs, just use the macro */
     if ( ! (flags & (FOLD_FLAGS_LOCALE|FOLD_FLAGS_NOMIX_ASCII))) {
        uvchr_to_utf8(p, c);
     /* Here, above 255.  If no special needs, just use the macro */
     if ( ! (flags & (FOLD_FLAGS_LOCALE|FOLD_FLAGS_NOMIX_ASCII))) {
        uvchr_to_utf8(p, c);

-       return CALL_FOLD_CASE(p, p, lenp, flags & FOLD_FLAGS_FULL);
+       return CALL_FOLD_CASE(c, p, p, lenp, flags & FOLD_FLAGS_FULL);

     }
     else {  /* Otherwise, _to_utf8_fold_flags has the intelligence to deal with
               the special flags. */
     }
     else {  /* Otherwise, _to_utf8_fold_flags has the intelligence to deal with
               the special flags. */


@@ -1740,6 +1760,11 @@ Perl__is_utf8_mark(pTHX_ const U8 *p)
 /*
 =for apidoc to_utf8_case
 
 /*
 =for apidoc to_utf8_case
 

+Instead use the appropriate one of L</toUPPER_utf8>,
+L</toTITLE_utf8>,
+L</toLOWER_utf8>,
+or L</toFOLD_utf8>.
+

 C<p> contains the pointer to the UTF-8 string encoding
 the character that is being converted.  This routine assumes that the character
 at C<p> is well-formed.
 C<p> contains the pointer to the UTF-8 string encoding
 the character that is being converted.  This routine assumes that the character
 at C<p> is well-formed.


@@ -1751,7 +1776,7 @@ of the result.
 C<swashp> is a pointer to the swash to use.
 
 Both the special and normal mappings are stored in F<lib/unicore/To/Foo.pl>,
 C<swashp> is a pointer to the swash to use.
 
 Both the special and normal mappings are stored in F<lib/unicore/To/Foo.pl>,

-and loaded by SWASHNEW, using F<lib/utf8_heavy.pl>.  C<special> (usually,
+and loaded by C<SWASHNEW>, using F<lib/utf8_heavy.pl>.  C<special> (usually,

 but not always, a multicharacter mapping), is tried first.
 
 C<special> is a string, normally C<NULL> or C<"">.  C<NULL> means to not use
 but not always, a multicharacter mapping), is tried first.
 
 C<special> is a string, normally C<NULL> or C<"">.  C<NULL> means to not use


@@ -1759,8 +1784,11 @@ any special mappings; C<""> means to use the special mappings.  Values other
 than these two are treated as the name of the hash containing the special
 mappings, like C<"utf8::ToSpecLower">.
 
 than these two are treated as the name of the hash containing the special
 mappings, like C<"utf8::ToSpecLower">.
 

-C<normal> is a string like "ToLower" which means the swash
-%utf8::ToLower.
+C<normal> is a string like C<"ToLower"> which means the swash
+C<%utf8::ToLower>.
+
+Code points above the platform's C<IV_MAX> will raise a deprecation warning,
+unless those are turned off.

 
 =cut */
 
 
 =cut */
 


@@ -1768,31 +1796,114 @@ UV
 Perl_to_utf8_case(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp,
                        SV **swashp, const char *normal, const char *special)
 {
 Perl_to_utf8_case(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp,
                        SV **swashp, const char *normal, const char *special)
 {

+    PERL_ARGS_ASSERT_TO_UTF8_CASE;
+
+    return _to_utf8_case(valid_utf8_to_uvchr(p, NULL), p, ustrp, lenp, swashp, normal, special);
+}
+
+    /* change namve uv1 to 'from' */
+STATIC UV
+S__to_utf8_case(pTHX_ const UV uv1, const U8 *p, U8* ustrp, STRLEN *lenp,
+               SV **swashp, const char *normal, const char *special)
+{

     STRLEN len = 0;
     STRLEN len = 0;

-    const UV uv1 = valid_utf8_to_uvchr(p, NULL);

 
 

-    PERL_ARGS_ASSERT_TO_UTF8_CASE;
+    PERL_ARGS_ASSERT__TO_UTF8_CASE;
+
+    /* For code points that don't change case, we already know that the output
+     * of this function is the unchanged input, so we can skip doing look-ups
+     * for them.  Unfortunately the case-changing code points are scattered
+     * around.  But there are some long consecutive ranges where there are no
+     * case changing code points.  By adding tests, we can eliminate the lookup
+     * for all the ones in such ranges.  This is currently done here only for
+     * just a few cases where the scripts are in common use in modern commerce
+     * (and scripts adjacent to those which can be included without additional
+     * tests). */
+
+    if (uv1 >= 0x0590) {
+        /* This keeps from needing further processing the code points most
+         * likely to be used in the following non-cased scripts: Hebrew,
+         * Arabic, Syriac, Thaana, NKo, Samaritan, Mandaic, Devanagari,
+         * Bengali, Gurmukhi, Gujarati, Oriya, Tamil, Telugu, Kannada,
+         * Malayalam, Sinhala, Thai, Lao, Tibetan, Myanmar */
+        if (uv1 < 0x10A0) {
+            goto cases_to_self;
+        }

 
 

-    /* Note that swash_fetch() doesn't output warnings for these because it
-     * assumes we will */
-    if (uv1 >= UNICODE_SURROGATE_FIRST) {
-       if (uv1 <= UNICODE_SURROGATE_LAST) {
-           if (ckWARN_d(WARN_SURROGATE)) {
-               const char* desc = (PL_op) ? OP_DESC(PL_op) : normal;
-               Perl_warner(aTHX_ packWARN(WARN_SURROGATE),
-                   "Operation \"%s\" returns its argument for UTF-16 surrogate U+%04"UVXf"", desc, uv1);
-           }
-       }
-       else if (UNICODE_IS_SUPER(uv1)) {
-           if (ckWARN_d(WARN_NON_UNICODE)) {
-               const char* desc = (PL_op) ? OP_DESC(PL_op) : normal;
-               Perl_warner(aTHX_ packWARN(WARN_NON_UNICODE),
-                   "Operation \"%s\" returns its argument for non-Unicode code point 0x%04"UVXf"", desc, uv1);
-           }
-       }
+        /* The following largish code point ranges also don't have case
+         * changes, but khw didn't think they warranted extra tests to speed
+         * them up (which would slightly slow down everything else above them):
+         * 1100..139F   Hangul Jamo, Ethiopic
+         * 1400..1CFF   Unified Canadian Aboriginal Syllabics, Ogham, Runic,
+         *              Tagalog, Hanunoo, Buhid, Tagbanwa, Khmer, Mongolian,
+         *              Limbu, Tai Le, New Tai Lue, Buginese, Tai Tham,
+         *              Combining Diacritical Marks Extended, Balinese,
+         *              Sundanese, Batak, Lepcha, Ol Chiki
+         * 2000..206F   General Punctuation
+         */
+
+        if (uv1 >= 0x2D30) {
+
+            /* This keeps the from needing further processing the code points
+             * most likely to be used in the following non-cased major scripts:
+             * CJK, Katakana, Hiragana, plus some less-likely scripts.
+             *
+             * (0x2D30 above might have to be changed to 2F00 in the unlikely
+             * event that Unicode eventually allocates the unused block as of
+             * v8.0 2FE0..2FEF to code points that are cased.  khw has verified
+             * that the test suite will start having failures to alert you
+             * should that happen) */
+            if (uv1 < 0xA640) {
+                goto cases_to_self;
+            }
+
+            if (uv1 >= 0xAC00) {
+                if (UNLIKELY(UNICODE_IS_SURROGATE(uv1))) {
+                    if (ckWARN_d(WARN_SURROGATE)) {
+                        const char* desc = (PL_op) ? OP_DESC(PL_op) : normal;
+                        Perl_warner(aTHX_ packWARN(WARN_SURROGATE),
+                            "Operation \"%s\" returns its argument for UTF-16 surrogate U+%04"UVXf"", desc, uv1);
+                    }
+                    goto cases_to_self;
+                }
+
+                /* AC00..FAFF Catches Hangul syllables and private use, plus
+                 * some others */
+                if (uv1 < 0xFB00) {
+                    goto cases_to_self;
+
+                }
+
+                if (UNLIKELY(UNICODE_IS_SUPER(uv1))) {
+                    if (   UNLIKELY(uv1 > MAX_NON_DEPRECATED_CP)
+                        && ckWARN_d(WARN_DEPRECATED))
+                    {
+                        Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
+                                cp_above_legal_max, uv1, MAX_NON_DEPRECATED_CP);
+                    }
+                    if (ckWARN_d(WARN_NON_UNICODE)) {
+                        const char* desc = (PL_op) ? OP_DESC(PL_op) : normal;
+                        Perl_warner(aTHX_ packWARN(WARN_NON_UNICODE),
+                            "Operation \"%s\" returns its argument for non-Unicode code point 0x%04"UVXf"", desc, uv1);
+                    }
+                    goto cases_to_self;
+                }
+#ifdef HIGHEST_CASE_CHANGING_CP_FOR_USE_ONLY_BY_UTF8_DOT_C
+                if (UNLIKELY(uv1
+                    > HIGHEST_CASE_CHANGING_CP_FOR_USE_ONLY_BY_UTF8_DOT_C))
+                {
+
+                    /* As of this writing, this means we avoid swash creation
+                     * for anything beyond low Plane 1 */
+                    goto cases_to_self;
+                }
+#endif
+            }
+        }

 
        /* Note that non-characters are perfectly legal, so no warning should
 
        /* Note that non-characters are perfectly legal, so no warning should

-        * be given */
+         * be given.  There are so few of them, that it isn't worth the extra
+         * tests to avoid swash creation */

     }
 
     if (!*swashp) /* load on-demand */
     }
 
     if (!*swashp) /* load on-demand */


@@ -1817,7 +1928,7 @@ Perl_to_utf8_case(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp,
         }
 
         if (hv
         }
 
         if (hv

-             && (svp = hv_fetch(hv, (const char*)p, UNISKIP(uv1), FALSE))
+             && (svp = hv_fetch(hv, (const char*)p, UVCHR_SKIP(uv1), FALSE))

              && (*svp))
          {
             const char *s;
              && (*svp))
          {
             const char *s;


@@ -1833,7 +1944,7 @@ Perl_to_utf8_case(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp,
     }
 
     if (!len && *swashp) {
     }
 
     if (!len && *swashp) {

-       const UV uv2 = swash_fetch(*swashp, p, TRUE /* => is utf8 */);
+       const UV uv2 = swash_fetch(*swashp, p, TRUE /* => is UTF-8 */);

 
         if (uv2) {
              /* It was "normal" (a single character mapping). */
 
         if (uv2) {
              /* It was "normal" (a single character mapping). */


@@ -1850,6 +1961,7 @@ Perl_to_utf8_case(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp,
 
     /* Here, there was no mapping defined, which means that the code point maps
      * to itself.  Return the inputs */
 
     /* Here, there was no mapping defined, which means that the code point maps
      * to itself.  Return the inputs */

+  cases_to_self:

     len = UTF8SKIP(p);
     if (p != ustrp) {   /* Don't copy onto itself */
         Copy(p, ustrp, len, U8);
     len = UTF8SKIP(p);
     if (p != ustrp) {   /* Don't copy onto itself */
         Copy(p, ustrp, len, U8);


@@ -1865,7 +1977,7 @@ Perl_to_utf8_case(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp,
 STATIC UV
 S_check_locale_boundary_crossing(pTHX_ const U8* const p, const UV result, U8* const ustrp, STRLEN *lenp)
 {
 STATIC UV
 S_check_locale_boundary_crossing(pTHX_ const U8* const p, const UV result, U8* const ustrp, STRLEN *lenp)
 {

-    /* This is called when changing the case of a utf8-encoded character above
+    /* This is called when changing the case of a UTF-8-encoded character above

      * the Latin1 range, and the operation is in a non-UTF-8 locale.  If the
      * result contains a character that crosses the 255/256 boundary, disallow
      * the change, and return the original code point.  See L<perlfunc/lc> for
      * the Latin1 range, and the operation is in a non-UTF-8 locale.  If the
      * result contains a character that crosses the 255/256 boundary, disallow
      * the change, and return the original code point.  See L<perlfunc/lc> for


@@ -1957,16 +2069,16 @@ Perl__to_utf8_upper_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, bool flags
     }
     else if UTF8_IS_DOWNGRADEABLE_START(*p) {
        if (flags) {
     }
     else if UTF8_IS_DOWNGRADEABLE_START(*p) {
        if (flags) {

-            U8 c = TWO_BYTE_UTF8_TO_NATIVE(*p, *(p+1));
+            U8 c = EIGHT_BIT_UTF8_TO_NATIVE(*p, *(p+1));

            result = toUPPER_LC(c);
        }
        else {
            result = toUPPER_LC(c);
        }
        else {

-           return _to_upper_title_latin1(TWO_BYTE_UTF8_TO_NATIVE(*p, *(p+1)),
+           return _to_upper_title_latin1(EIGHT_BIT_UTF8_TO_NATIVE(*p, *(p+1)),

                                          ustrp, lenp, 'S');
        }
     }
                                          ustrp, lenp, 'S');
        }
     }

-    else {  /* utf8, ord above 255 */
-       result = CALL_UPPER_CASE(p, ustrp, lenp);
+    else {  /* UTF-8, ord above 255 */
+       result = CALL_UPPER_CASE(valid_utf8_to_uvchr(p, NULL), p, ustrp, lenp);

 
        if (flags) {
            result = check_locale_boundary_crossing(p, result, ustrp, lenp);
 
        if (flags) {
            result = check_locale_boundary_crossing(p, result, ustrp, lenp);


@@ -1974,7 +2086,7 @@ Perl__to_utf8_upper_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, bool flags
        return result;
     }
 
        return result;
     }
 

-    /* Here, used locale rules.  Convert back to utf8 */
+    /* Here, used locale rules.  Convert back to UTF-8 */

     if (UTF8_IS_INVARIANT(result)) {
        *ustrp = (U8) result;
        *lenp = 1;
     if (UTF8_IS_INVARIANT(result)) {
        *ustrp = (U8) result;
        *lenp = 1;


@@ -2028,16 +2140,16 @@ Perl__to_utf8_title_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, bool flags
     }
     else if UTF8_IS_DOWNGRADEABLE_START(*p) {
        if (flags) {
     }
     else if UTF8_IS_DOWNGRADEABLE_START(*p) {
        if (flags) {

-            U8 c = TWO_BYTE_UTF8_TO_NATIVE(*p, *(p+1));
+            U8 c = EIGHT_BIT_UTF8_TO_NATIVE(*p, *(p+1));

            result = toUPPER_LC(c);
        }
        else {
            result = toUPPER_LC(c);
        }
        else {

-           return _to_upper_title_latin1(TWO_BYTE_UTF8_TO_NATIVE(*p, *(p+1)),
+           return _to_upper_title_latin1(EIGHT_BIT_UTF8_TO_NATIVE(*p, *(p+1)),

                                          ustrp, lenp, 's');
        }
     }
                                          ustrp, lenp, 's');
        }
     }

-    else {  /* utf8, ord above 255 */
-       result = CALL_TITLE_CASE(p, ustrp, lenp);
+    else {  /* UTF-8, ord above 255 */
+       result = CALL_TITLE_CASE(valid_utf8_to_uvchr(p, NULL), p, ustrp, lenp);

 
        if (flags) {
            result = check_locale_boundary_crossing(p, result, ustrp, lenp);
 
        if (flags) {
            result = check_locale_boundary_crossing(p, result, ustrp, lenp);


@@ -2045,7 +2157,7 @@ Perl__to_utf8_title_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, bool flags
        return result;
     }
 
        return result;
     }
 

-    /* Here, used locale rules.  Convert back to utf8 */
+    /* Here, used locale rules.  Convert back to UTF-8 */

     if (UTF8_IS_INVARIANT(result)) {
        *ustrp = (U8) result;
        *lenp = 1;
     if (UTF8_IS_INVARIANT(result)) {
        *ustrp = (U8) result;
        *lenp = 1;


@@ -2098,16 +2210,16 @@ Perl__to_utf8_lower_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, bool flags
     }
     else if UTF8_IS_DOWNGRADEABLE_START(*p) {
        if (flags) {
     }
     else if UTF8_IS_DOWNGRADEABLE_START(*p) {
        if (flags) {

-            U8 c = TWO_BYTE_UTF8_TO_NATIVE(*p, *(p+1));
+            U8 c = EIGHT_BIT_UTF8_TO_NATIVE(*p, *(p+1));

            result = toLOWER_LC(c);
        }
        else {
            result = toLOWER_LC(c);
        }
        else {

-           return to_lower_latin1(TWO_BYTE_UTF8_TO_NATIVE(*p, *(p+1)),
+           return to_lower_latin1(EIGHT_BIT_UTF8_TO_NATIVE(*p, *(p+1)),

                                   ustrp, lenp);
        }
     }
                                   ustrp, lenp);
        }
     }

-    else {  /* utf8, ord above 255 */
-       result = CALL_LOWER_CASE(p, ustrp, lenp);
+    else {  /* UTF-8, ord above 255 */
+       result = CALL_LOWER_CASE(valid_utf8_to_uvchr(p, NULL), p, ustrp, lenp);

 
        if (flags) {
            result = check_locale_boundary_crossing(p, result, ustrp, lenp);
 
        if (flags) {
            result = check_locale_boundary_crossing(p, result, ustrp, lenp);


@@ -2116,7 +2228,7 @@ Perl__to_utf8_lower_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, bool flags
        return result;
     }
 
        return result;
     }
 

-    /* Here, used locale rules.  Convert back to utf8 */
+    /* Here, used locale rules.  Convert back to UTF-8 */

     if (UTF8_IS_INVARIANT(result)) {
        *ustrp = (U8) result;
        *lenp = 1;
     if (UTF8_IS_INVARIANT(result)) {
        *ustrp = (U8) result;
        *lenp = 1;


@@ -2180,25 +2292,27 @@ Perl__to_utf8_fold_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, U8 flags)
     }
     else if UTF8_IS_DOWNGRADEABLE_START(*p) {
        if (flags & FOLD_FLAGS_LOCALE) {
     }
     else if UTF8_IS_DOWNGRADEABLE_START(*p) {
        if (flags & FOLD_FLAGS_LOCALE) {

-            U8 c = TWO_BYTE_UTF8_TO_NATIVE(*p, *(p+1));
+            U8 c = EIGHT_BIT_UTF8_TO_NATIVE(*p, *(p+1));

            result = toFOLD_LC(c);
        }
        else {
            result = toFOLD_LC(c);
        }
        else {

-           return _to_fold_latin1(TWO_BYTE_UTF8_TO_NATIVE(*p, *(p+1)),
+           return _to_fold_latin1(EIGHT_BIT_UTF8_TO_NATIVE(*p, *(p+1)),

                             ustrp, lenp,
                             flags & (FOLD_FLAGS_FULL | FOLD_FLAGS_NOMIX_ASCII));
        }
     }
                             ustrp, lenp,
                             flags & (FOLD_FLAGS_FULL | FOLD_FLAGS_NOMIX_ASCII));
        }
     }

-    else {  /* utf8, ord above 255 */
-       result = CALL_FOLD_CASE(p, ustrp, lenp, flags & FOLD_FLAGS_FULL);
+    else {  /* UTF-8, ord above 255 */
+       result = CALL_FOLD_CASE(valid_utf8_to_uvchr(p, NULL), p, ustrp, lenp, flags & FOLD_FLAGS_FULL);

 
        if (flags & FOLD_FLAGS_LOCALE) {
 
 
        if (flags & FOLD_FLAGS_LOCALE) {
 

-#           define CAP_SHARP_S   LATIN_CAPITAL_LETTER_SHARP_S_UTF8

 #           define LONG_S_T      LATIN_SMALL_LIGATURE_LONG_S_T_UTF8
 #           define LONG_S_T      LATIN_SMALL_LIGATURE_LONG_S_T_UTF8

+            const unsigned int long_s_t_len    = sizeof(LONG_S_T) - 1;
+
+#         ifdef LATIN_CAPITAL_LETTER_SHARP_S_UTF8
+#           define CAP_SHARP_S   LATIN_CAPITAL_LETTER_SHARP_S_UTF8

 
             const unsigned int cap_sharp_s_len = sizeof(CAP_SHARP_S) - 1;
 
             const unsigned int cap_sharp_s_len = sizeof(CAP_SHARP_S) - 1;

-            const unsigned int long_s_t_len    = sizeof(LONG_S_T) - 1;

 
             /* Special case these two characters, as what normally gets
              * returned under locale doesn't work */
 
             /* Special case these two characters, as what normally gets
              * returned under locale doesn't work */


@@ -2211,7 +2325,9 @@ Perl__to_utf8_fold_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, U8 flags)
                               "resolved to \"\\x{17F}\\x{17F}\".");
                 goto return_long_s;
             }
                               "resolved to \"\\x{17F}\\x{17F}\".");
                 goto return_long_s;
             }

-            else if (UTF8SKIP(p) == long_s_t_len
+            else
+#endif
+                 if (UTF8SKIP(p) == long_s_t_len

                      && memEQ((char *) p, LONG_S_T, long_s_t_len))
             {
                 /* diag_listed_as: Can't do %s("%s") on non-UTF-8 locale; resolved to "%s". */
                      && memEQ((char *) p, LONG_S_T, long_s_t_len))
             {
                 /* diag_listed_as: Can't do %s("%s") on non-UTF-8 locale; resolved to "%s". */


@@ -2220,13 +2336,35 @@ Perl__to_utf8_fold_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, U8 flags)
                               "resolved to \"\\x{FB06}\".");
                 goto return_ligature_st;
             }
                               "resolved to \"\\x{FB06}\".");
                 goto return_ligature_st;
             }

+
+#if    UNICODE_MAJOR_VERSION   == 3         \
+    && UNICODE_DOT_VERSION     == 0         \
+    && UNICODE_DOT_DOT_VERSION == 1
+#           define DOTTED_I   LATIN_CAPITAL_LETTER_I_WITH_DOT_ABOVE_UTF8
+
+            /* And special case this on this Unicode version only, for the same
+             * reaons the other two are special cased.  They would cross the
+             * 255/256 boundary which is forbidden under /l, and so the code
+             * wouldn't catch that they are equivalent (which they are only in
+             * this release) */
+            else if (UTF8SKIP(p) == sizeof(DOTTED_I) - 1
+                     && memEQ((char *) p, DOTTED_I, sizeof(DOTTED_I) - 1))
+            {
+                /* diag_listed_as: Can't do %s("%s") on non-UTF-8 locale; resolved to "%s". */
+                Perl_ck_warner(aTHX_ packWARN(WARN_LOCALE),
+                              "Can't do fc(\"\\x{0130}\") on non-UTF-8 locale; "
+                              "resolved to \"\\x{0131}\".");
+                goto return_dotless_i;
+            }
+#endif
+

            return check_locale_boundary_crossing(p, result, ustrp, lenp);
        }
        else if (! (flags & FOLD_FLAGS_NOMIX_ASCII)) {
            return result;
        }
        else {
            return check_locale_boundary_crossing(p, result, ustrp, lenp);
        }
        else if (! (flags & FOLD_FLAGS_NOMIX_ASCII)) {
            return result;
        }
        else {

-           /* This is called when changing the case of a utf8-encoded
+           /* This is called when changing the case of a UTF-8-encoded

              * character above the ASCII range, and the result should not
              * contain an ASCII character. */
 
              * character above the ASCII range, and the result should not
              * contain an ASCII character. */
 


@@ -2243,14 +2381,24 @@ Perl__to_utf8_fold_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, U8 flags)
 
                     /* But in these instances, there is an alternative we can
                      * return that is valid */
 
                     /* But in these instances, there is an alternative we can
                      * return that is valid */

-                    if (original == LATIN_CAPITAL_LETTER_SHARP_S
-                        || original == LATIN_SMALL_LETTER_SHARP_S)
-                    {
+                    if (original == LATIN_SMALL_LETTER_SHARP_S
+#ifdef LATIN_CAPITAL_LETTER_SHARP_S /* not defined in early Unicode releases */
+                        || original == LATIN_CAPITAL_LETTER_SHARP_S
+#endif
+                    ) {

                         goto return_long_s;
                     }
                     else if (original == LATIN_SMALL_LIGATURE_LONG_S_T) {
                         goto return_ligature_st;
                     }
                         goto return_long_s;
                     }
                     else if (original == LATIN_SMALL_LIGATURE_LONG_S_T) {
                         goto return_ligature_st;
                     }

+#if    UNICODE_MAJOR_VERSION   == 3         \
+    && UNICODE_DOT_VERSION     == 0         \
+    && UNICODE_DOT_DOT_VERSION == 1
+
+                    else if (original == LATIN_CAPITAL_LETTER_I_WITH_DOT_ABOVE) {
+                        goto return_dotless_i;
+                    }
+#endif

                    Copy(p, ustrp, *lenp, char);
                    return original;
                }
                    Copy(p, ustrp, *lenp, char);
                    return original;
                }


@@ -2262,7 +2410,7 @@ Perl__to_utf8_fold_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, U8 flags)
        }
     }
 
        }
     }
 

-    /* Here, used locale rules.  Convert back to utf8 */
+    /* Here, used locale rules.  Convert back to UTF-8 */

     if (UTF8_IS_INVARIANT(result)) {
        *ustrp = (U8) result;
        *lenp = 1;
     if (UTF8_IS_INVARIANT(result)) {
        *ustrp = (U8) result;
        *lenp = 1;


@@ -2294,6 +2442,18 @@ Perl__to_utf8_fold_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, U8 flags)
     *lenp = sizeof(LATIN_SMALL_LIGATURE_ST_UTF8) - 1;
     Copy(LATIN_SMALL_LIGATURE_ST_UTF8, ustrp, *lenp, U8);
     return LATIN_SMALL_LIGATURE_ST;
     *lenp = sizeof(LATIN_SMALL_LIGATURE_ST_UTF8) - 1;
     Copy(LATIN_SMALL_LIGATURE_ST_UTF8, ustrp, *lenp, U8);
     return LATIN_SMALL_LIGATURE_ST;

+
+#if    UNICODE_MAJOR_VERSION   == 3         \
+    && UNICODE_DOT_VERSION     == 0         \
+    && UNICODE_DOT_DOT_VERSION == 1
+
+  return_dotless_i:
+    *lenp = sizeof(LATIN_SMALL_LETTER_DOTLESS_I_UTF8) - 1;
+    Copy(LATIN_SMALL_LETTER_DOTLESS_I_UTF8, ustrp, *lenp, U8);
+    return LATIN_SMALL_LETTER_DOTLESS_I;
+
+#endif
+

 }
 
 /* Note:
 }
 
 /* Note:


@@ -2401,6 +2561,7 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m
        PUSHSTACKi(PERLSI_MAGIC);
        ENTER;
        SAVEHINTS();
        PUSHSTACKi(PERLSI_MAGIC);
        ENTER;
        SAVEHINTS();

+       save_re_context();

        /* We might get here via a subroutine signature which uses a utf8
         * parameter name, at which point PL_subname will have been set
         * but not yet used. */
        /* We might get here via a subroutine signature which uses a utf8
         * parameter name, at which point PL_subname will have been set
         * but not yet used. */


@@ -2408,13 +2569,17 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m
        if (PL_parser && PL_parser->error_count)
            SAVEI8(PL_parser->error_count), PL_parser->error_count = 0;
        method = gv_fetchmeth(stash, "SWASHNEW", 8, -1);
        if (PL_parser && PL_parser->error_count)
            SAVEI8(PL_parser->error_count), PL_parser->error_count = 0;
        method = gv_fetchmeth(stash, "SWASHNEW", 8, -1);

-       if (!method) {  /* demand load utf8 */
+       if (!method) {  /* demand load UTF-8 */

            ENTER;
            if ((errsv_save = GvSV(PL_errgv))) SAVEFREESV(errsv_save);
            GvSV(PL_errgv) = NULL;
 #ifndef NO_TAINT_SUPPORT
            /* It is assumed that callers of this routine are not passing in
             * any user derived data.  */
            ENTER;
            if ((errsv_save = GvSV(PL_errgv))) SAVEFREESV(errsv_save);
            GvSV(PL_errgv) = NULL;
 #ifndef NO_TAINT_SUPPORT
            /* It is assumed that callers of this routine are not passing in
             * any user derived data.  */

+           /* Need to do this after save_re_context() as it will set
+            * PL_tainted to 1 while saving $1 etc (see the code after getrx:
+            * in Perl_magic_get).  Even line to create errsv_save can turn on
+            * PL_tainted.  */

            SAVEBOOL(TAINT_get);
            TAINT_NOT;
 #endif
            SAVEBOOL(TAINT_get);
            TAINT_NOT;
 #endif


@@ -2465,7 +2630,7 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m
            CopHINTS_set(PL_curcop, PL_hints);
        }
        if (!SvROK(retval) || SvTYPE(SvRV(retval)) != SVt_PVHV) {
            CopHINTS_set(PL_curcop, PL_hints);
        }
        if (!SvROK(retval) || SvTYPE(SvRV(retval)) != SVt_PVHV) {

-           if (SvPOK(retval))
+           if (SvPOK(retval)) {

 
                /* If caller wants to handle missing properties, let them */
                if (flags_p && *flags_p & _CORE_SWASH_INIT_RETURN_IF_UNDEF) {
 
                /* If caller wants to handle missing properties, let them */
                if (flags_p && *flags_p & _CORE_SWASH_INIT_RETURN_IF_UNDEF) {


@@ -2475,6 +2640,7 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m
                           "Can't find Unicode property definition \"%"SVf"\"",
                           SVfARG(retval));
                 NOT_REACHED; /* NOTREACHED */
                           "Can't find Unicode property definition \"%"SVf"\"",
                           SVfARG(retval));
                 NOT_REACHED; /* NOTREACHED */

+            }

        }
     } /* End of calling the module to find the swash */
 
        }
     } /* End of calling the module to find the swash */
 


@@ -2581,13 +2747,13 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m
  * (see lib/unicore/SpecCase.txt) The SWASHGET in lib/utf8_heavy.pl is
  * the lower-level routine, and it is similarly broken for returning
  * multiple values.  --jhi
  * (see lib/unicore/SpecCase.txt) The SWASHGET in lib/utf8_heavy.pl is
  * the lower-level routine, and it is similarly broken for returning
  * multiple values.  --jhi

- * For those, you should use to_utf8_case() instead */
+ * For those, you should use S__to_utf8_case() instead */

 /* Now SWASHGET is recasted into S_swatch_get in this file. */
 
 /* Note:
  * Returns the value of property/mapping C<swash> for the first character
  * of the string C<ptr>. If C<do_utf8> is true, the string C<ptr> is
 /* Now SWASHGET is recasted into S_swatch_get in this file. */
 
 /* Note:
  * Returns the value of property/mapping C<swash> for the first character
  * of the string C<ptr>. If C<do_utf8> is true, the string C<ptr> is

- * assumed to be in well-formed utf8. If C<do_utf8> is false, the string C<ptr>
+ * assumed to be in well-formed UTF-8. If C<do_utf8> is false, the string C<ptr>

  * is assumed to be in native 8-bit encoding. Caches the swatch in C<swash>.
  *
  * A "swash" is a hash which contains initially the keys/values set up by
  * is assumed to be in native 8-bit encoding. Caches the swatch in C<swash>.
  *
  * A "swash" is a hash which contains initially the keys/values set up by


@@ -2612,7 +2778,7 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m
  *
  * Non-binary properties are stored in as many bits as necessary to represent
  * their values (32 currently, though the code is more general than that), not
  *
  * Non-binary properties are stored in as many bits as necessary to represent
  * their values (32 currently, though the code is more general than that), not

- * as single bits, but the principal is the same: the value for each key is a
+ * as single bits, but the principle is the same: the value for each key is a

  * vector that encompasses the property values for all code points whose UTF-8
  * representations are represented by the key.  That is, for all code points
  * whose UTF-8 representations are length N bytes, and the key is the first N-1
  * vector that encompasses the property values for all code points whose UTF-8
  * representations are represented by the key.  That is, for all code points
  * whose UTF-8 representations are length N bytes, and the key is the first N-1


@@ -2656,7 +2822,7 @@ Perl_swash_fetch(pTHX_ SV *swash, const U8 *ptr, bool do_utf8)
     else if (UTF8_IS_DOWNGRADEABLE_START(c)) {
         klen = 0;
        needents = 256;
     else if (UTF8_IS_DOWNGRADEABLE_START(c)) {
         klen = 0;
        needents = 256;

-        off = TWO_BYTE_UTF8_TO_NATIVE(c, *(ptr + 1));
+        off = EIGHT_BIT_UTF8_TO_NATIVE(c, *(ptr + 1));

     }
     else {
         klen = UTF8SKIP(ptr) - 1;
     }
     else {
         klen = UTF8SKIP(ptr) - 1;


@@ -2698,7 +2864,7 @@ Perl_swash_fetch(pTHX_ SV *swash, const U8 *ptr, bool do_utf8)
     }
 
     /*
     }
 
     /*

-     * This single-entry cache saves about 1/3 of the utf8 overhead in test
+     * This single-entry cache saves about 1/3 of the UTF-8 overhead in test

      * suite.  (That is, only 7-8% overall over just a hash cache.  Still,
      * it's nothing to sniff at.)  Pity we usually come through at least
      * two function calls to get here...
      * suite.  (That is, only 7-8% overall over just a hash cache.  Still,
      * it's nothing to sniff at.)  Pity we usually come through at least
      * two function calls to get here...


@@ -3215,10 +3381,10 @@ Perl__swash_inversion_hash(pTHX_ SV* const swash)
     * 004C             006C
     * 212A             006B
     *
     * 004C             006C
     * 212A             006B
     *

-    * The returned hash would have two keys, the utf8 for 006B and the utf8 for
+    * The returned hash would have two keys, the UTF-8 for 006B and the UTF-8 for

     * 006C.  The value for each key is an array.  For 006C, the array would
     * 006C.  The value for each key is an array.  For 006C, the array would

-    * have two elements, the utf8 for itself, and for 004C.  For 006B, there
-    * would be three elements in its array, the utf8 for 006B, 004B and 212A.
+    * have two elements, the UTF-8 for itself, and for 004C.  For 006B, there
+    * would be three elements in its array, the UTF-8 for 006B, 004B and 212A.

     *
     * Note that there are no elements in the hash for 004B, 004C, 212A.  The
     * keys are only code points that are folded-to, so it isn't a full closure.
     *
     * Note that there are no elements in the hash for 004B, 004C, 212A.  The
     * keys are only code points that are folded-to, so it isn't a full closure.


@@ -3232,7 +3398,7 @@ Perl__swash_inversion_hash(pTHX_ SV* const swash)
     *
     * The specials hash can be extra code points, and most likely consists of
     * maps from single code points to multiple ones (each expressed as a string
     *
     * The specials hash can be extra code points, and most likely consists of
     * maps from single code points to multiple ones (each expressed as a string

-    * of utf8 characters).   This function currently returns only 1-1 mappings.
+    * of UTF-8 characters).   This function currently returns only 1-1 mappings.

     * However consider this possible input in the specials hash:
     * "\xEF\xAC\x85" => "\x{0073}\x{0074}",         # U+FB05 => 0073 0074
     * "\xEF\xAC\x86" => "\x{0073}\x{0074}",         # U+FB06 => 0073 0074
     * However consider this possible input in the specials hash:
     * "\xEF\xAC\x85" => "\x{0073}\x{0074}",         # U+FB05 => 0073 0074
     * "\xEF\xAC\x86" => "\x{0073}\x{0074}",         # U+FB06 => 0073 0074


@@ -3241,7 +3407,24 @@ Perl__swash_inversion_hash(pTHX_ SV* const swash)
     * currently handle.  But it also means that FB05 and FB06 are equivalent in
     * a 1-1 mapping which we should handle, and this relationship may not be in
     * the main table.  Therefore this function examines all the multi-char
     * currently handle.  But it also means that FB05 and FB06 are equivalent in
     * a 1-1 mapping which we should handle, and this relationship may not be in
     * the main table.  Therefore this function examines all the multi-char

-    * sequences and adds the 1-1 mappings that come out of that.  */
+    * sequences and adds the 1-1 mappings that come out of that.
+    *
+    * XXX This function was originally intended to be multipurpose, but its
+    * only use is quite likely to remain for constructing the inversion of
+    * the CaseFolding (//i) property.  If it were more general purpose for
+    * regex patterns, it would have to do the FB05/FB06 game for simple folds,
+    * because certain folds are prohibited under /iaa and /il.  As an example,
+    * in Unicode 3.0.1 both U+0130 and U+0131 fold to 'i', and hence are both
+    * equivalent under /i.  But under /iaa and /il, the folds to 'i' are
+    * prohibited, so we would not figure out that they fold to each other.
+    * Code could be written to automatically figure this out, similar to the
+    * code that does this for multi-character folds, but this is the only case
+    * where something like this is ever likely to happen, as all the single
+    * char folds to the 0-255 range are now quite settled.  Instead there is a
+    * little special code that is compiled only for this Unicode version.  This
+    * is smaller and didn't require much coding time to do.  But this makes
+    * this routine strongly tied to being used just for CaseFolding.  If ever
+    * it should be generalized, this would have to be fixed */

 
     U8 *l, *lend;
     STRLEN lcur;
 
     U8 *l, *lend;
     STRLEN lcur;


@@ -3286,8 +3469,8 @@ Perl__swash_inversion_hash(pTHX_ SV* const swash)
 
        hv_iterinit(specials_hv);
 
 
        hv_iterinit(specials_hv);
 

-       /* The keys are the characters (in utf8) that map to the corresponding
-        * utf8 string value.  Iterate through the list creating the inverse
+       /* The keys are the characters (in UTF-8) that map to the corresponding
+        * UTF-8 string value.  Iterate through the list creating the inverse

         * list. */
        while ((sv_to = hv_iternextsv(specials_hv, &char_from, &from_len))) {
            SV** listp;
         * list. */
        while ((sv_to = hv_iternextsv(specials_hv, &char_from, &from_len))) {
            SV** listp;


@@ -3299,7 +3482,7 @@ Perl__swash_inversion_hash(pTHX_ SV* const swash)
            /*DEBUG_U(PerlIO_printf(Perl_debug_log, "Found mapping from %"UVXf", First char of to is %"UVXf"\n", valid_utf8_to_uvchr((U8*) char_from, 0), valid_utf8_to_uvchr((U8*) SvPVX(sv_to), 0)));*/
 
            /* Each key in the inverse list is a mapped-to value, and the key's
            /*DEBUG_U(PerlIO_printf(Perl_debug_log, "Found mapping from %"UVXf", First char of to is %"UVXf"\n", valid_utf8_to_uvchr((U8*) char_from, 0), valid_utf8_to_uvchr((U8*) SvPVX(sv_to), 0)));*/
 
            /* Each key in the inverse list is a mapped-to value, and the key's

-            * hash value is a list of the strings (each in utf8) that map to
+            * hash value is a list of the strings (each in UTF-8) that map to

             * it.  Those strings are all one character long */
            if ((listp = hv_fetch(specials_inverse,
                                    SvPVX(sv_to),
             * it.  Those strings are all one character long */
            if ((listp = hv_fetch(specials_inverse,
                                    SvPVX(sv_to),


@@ -3342,12 +3525,12 @@ Perl__swash_inversion_hash(pTHX_ SV* const swash)
        while ((from_list = (AV *) hv_iternextsv(specials_inverse,
                                                 &char_to, &to_len)))
        {
        while ((from_list = (AV *) hv_iternextsv(specials_inverse,
                                                 &char_to, &to_len)))
        {

-           if (av_tindex(from_list) > 0) {
+           if (av_tindex_nomg(from_list) > 0) {

                SSize_t i;
 
                /* We iterate over all combinations of i,j to place each code
                 * point on each list */
                SSize_t i;
 
                /* We iterate over all combinations of i,j to place each code
                 * point on each list */

-               for (i = 0; i <= av_tindex(from_list); i++) {
+               for (i = 0; i <= av_tindex_nomg(from_list); i++) {

                    SSize_t j;
                    AV* i_list = newAV();
                    SV** entryp = av_fetch(from_list, i, FALSE);
                    SSize_t j;
                    AV* i_list = newAV();
                    SV** entryp = av_fetch(from_list, i, FALSE);


@@ -3364,7 +3547,7 @@ Perl__swash_inversion_hash(pTHX_ SV* const swash)
                    }
 
                    /* For DEBUG_U: UV u = valid_utf8_to_uvchr((U8*) SvPVX(*entryp), 0);*/
                    }
 
                    /* For DEBUG_U: UV u = valid_utf8_to_uvchr((U8*) SvPVX(*entryp), 0);*/

-                   for (j = 0; j <= av_tindex(from_list); j++) {
+                   for (j = 0; j <= av_tindex_nomg(from_list); j++) {

                        entryp = av_fetch(from_list, j, FALSE);
                        if (entryp == NULL) {
                            Perl_croak(aTHX_ "panic: av_fetch() unexpectedly failed");
                        entryp = av_fetch(from_list, j, FALSE);
                        if (entryp == NULL) {
                            Perl_croak(aTHX_ "panic: av_fetch() unexpectedly failed");


@@ -3384,7 +3567,24 @@ Perl__swash_inversion_hash(pTHX_ SV* const swash)
     } /* End of specials */
 
     /* read $swash->{LIST} */
     } /* End of specials */
 
     /* read $swash->{LIST} */

+
+#if    UNICODE_MAJOR_VERSION   == 3         \
+    && UNICODE_DOT_VERSION     == 0         \
+    && UNICODE_DOT_DOT_VERSION == 1
+
+    /* For this version only U+130 and U+131 are equivalent under qr//i.  Add a
+     * rule so that things work under /iaa and /il */
+
+    SV * mod_listsv = sv_mortalcopy(*listsvp);
+    sv_catpv(mod_listsv, "130\t130\t131\n");
+    l = (U8*)SvPV(mod_listsv, lcur);
+
+#else
+

     l = (U8*)SvPV(*listsvp, lcur);
     l = (U8*)SvPV(*listsvp, lcur);

+
+#endif
+

     lend = l + lcur;
 
     /* Go through each input line */
     lend = l + lcur;
 
     /* Go through each input line */


@@ -3423,7 +3623,7 @@ Perl__swash_inversion_hash(pTHX_ SV* const swash)
 
            /* Look through list to see if this inverse mapping already is
             * listed, or if there is a mapping to itself already */
 
            /* Look through list to see if this inverse mapping already is
             * listed, or if there is a mapping to itself already */

-           for (i = 0; i <= av_tindex(list); i++) {
+           for (i = 0; i <= av_tindex_nomg(list); i++) {

                SV** entryp = av_fetch(list, i, FALSE);
                SV* entry;
                UV uv;
                SV** entryp = av_fetch(list, i, FALSE);
                SV* entry;
                UV uv;


@@ -3543,7 +3743,9 @@ Perl__swash_to_invlist(pTHX_ SV* const swash)
 
         /* The first number is a count of the rest */
         l++;
 
         /* The first number is a count of the rest */
         l++;

-        elements = grok_atou((const char *)l, &after_atou);
+        if (!grok_atoUV((const char *)l, &elements, &after_atou)) {
+            Perl_croak(aTHX_ "panic: Expecting a valid count of elements at start of inversion list");
+        }

         if (elements == 0) {
             invlist = _new_invlist(0);
         }
         if (elements == 0) {
             invlist = _new_invlist(0);
         }


@@ -3553,7 +3755,9 @@ Perl__swash_to_invlist(pTHX_ SV* const swash)
 
             /* Get the 0th element, which is needed to setup the inversion list */
             while (isSPACE(*l)) l++;
 
             /* Get the 0th element, which is needed to setup the inversion list */
             while (isSPACE(*l)) l++;

-            element0 = (UV) grok_atou((const char *)l, &after_atou);
+            if (!grok_atoUV((const char *)l, &element0, &after_atou)) {
+                Perl_croak(aTHX_ "panic: Expecting a valid 0th element for inversion list");
+            }

             l = (U8 *) after_atou;
             invlist = _setup_canned_invlist(elements, element0, &other_elements_ptr);
             elements--;
             l = (U8 *) after_atou;
             invlist = _setup_canned_invlist(elements, element0, &other_elements_ptr);
             elements--;


@@ -3564,7 +3768,9 @@ Perl__swash_to_invlist(pTHX_ SV* const swash)
                     Perl_croak(aTHX_ "panic: Expecting %"UVuf" more elements than available", elements);
                 }
                 while (isSPACE(*l)) l++;
                     Perl_croak(aTHX_ "panic: Expecting %"UVuf" more elements than available", elements);
                 }
                 while (isSPACE(*l)) l++;

-                *other_elements_ptr++ = (UV) grok_atou((const char *)l, &after_atou);
+                if (!grok_atoUV((const char *)l, other_elements_ptr++, &after_atou)) {
+                    Perl_croak(aTHX_ "panic: Expecting a valid element in inversion list");
+                }

                 l = (U8 *) after_atou;
             }
         }
                 l = (U8 *) after_atou;
             }
         }


@@ -3720,7 +3926,10 @@ Perl_check_utf8_print(pTHX_ const U8* s, const STRLEN len)
     /* May change: warns if surrogates, non-character code points, or
      * non-Unicode code points are in s which has length len bytes.  Returns
      * TRUE if none found; FALSE otherwise.  The only other validity check is
     /* May change: warns if surrogates, non-character code points, or
      * non-Unicode code points are in s which has length len bytes.  Returns
      * TRUE if none found; FALSE otherwise.  The only other validity check is

-     * to make sure that this won't exceed the string's length */
+     * to make sure that this won't exceed the string's length.
+     *
+     * Code points above the platform's C<IV_MAX> will raise a deprecation
+     * warning, unless those are turned off.  */

 
     const U8* const e = s + len;
     bool ok = TRUE;
 
     const U8* const e = s + len;
     bool ok = TRUE;


@@ -3733,31 +3942,51 @@ Perl_check_utf8_print(pTHX_ const U8* s, const STRLEN len)
                           "%s in %s", unees, PL_op ? OP_DESC(PL_op) : "print");
            return FALSE;
        }
                           "%s in %s", unees, PL_op ? OP_DESC(PL_op) : "print");
            return FALSE;
        }

-       if (UNLIKELY(*s >= UTF8_FIRST_PROBLEMATIC_CODE_POINT_FIRST_BYTE)) {
+       if (UNLIKELY(isUTF8_POSSIBLY_PROBLEMATIC(*s))) {

            STRLEN char_len;
            STRLEN char_len;

-           if (UTF8_IS_SUPER(s)) {
-               if (ckWARN_d(WARN_NON_UNICODE)) {
-                   UV uv = utf8_to_uvchr_buf(s, e, &char_len);
-                   Perl_warner(aTHX_ packWARN(WARN_NON_UNICODE),
-                       "Code point 0x%04"UVXf" is not Unicode, may not be portable", uv);
-                   ok = FALSE;
-               }
+           if (UTF8_IS_SUPER(s, e)) {
+                if (   ckWARN_d(WARN_NON_UNICODE)
+                    || (   ckWARN_d(WARN_DEPRECATED)
+#if defined(UV_IS_QUAD)
+                        /* 2**63 and up meet these conditions provided we have
+                         * a 64-bit word. */
+#   ifdef EBCDIC
+                        && *s == 0xFE && e - s >= UTF8_MAXBYTES
+                        && s[1] >= 0x49
+#   else
+                        && *s == 0xFF && e -s >= UTF8_MAXBYTES
+                        && s[2] >= 0x88
+#   endif
+#else   /* Below is 32-bit words */
+                        /* 2**31 and above meet these conditions on all EBCDIC
+                         * pages recognized for 32-bit platforms */
+#   ifdef EBCDIC
+                        && *s == 0xFE && e - s >= UTF8_MAXBYTES
+                        && s[6] >= 0x43
+#   else
+                        && *s >= 0xFE
+#   endif
+#endif
+                )) {
+                    /* A side effect of this function will be to warn */
+                    (void) utf8n_to_uvchr(s, e - s, &char_len, UTF8_WARN_SUPER);
+                    ok = FALSE;
+                }

            }
            }

-           else if (UTF8_IS_SURROGATE(s)) {
+           else if (UTF8_IS_SURROGATE(s, e)) {

                if (ckWARN_d(WARN_SURROGATE)) {
                if (ckWARN_d(WARN_SURROGATE)) {

+                    /* This has a different warning than the one the called
+                     * function would output, so can't just call it, unlike we
+                     * do for the non-chars and above-unicodes */

                    UV uv = utf8_to_uvchr_buf(s, e, &char_len);
                    Perl_warner(aTHX_ packWARN(WARN_SURROGATE),
                        "Unicode surrogate U+%04"UVXf" is illegal in UTF-8", uv);
                    ok = FALSE;
                }
            }
                    UV uv = utf8_to_uvchr_buf(s, e, &char_len);
                    Perl_warner(aTHX_ packWARN(WARN_SURROGATE),
                        "Unicode surrogate U+%04"UVXf" is illegal in UTF-8", uv);
                    ok = FALSE;
                }
            }

-           else if
-               ((UTF8_IS_NONCHAR_GIVEN_THAT_NON_SUPER_AND_GE_PROBLEMATIC(s))
-                && (ckWARN_d(WARN_NONCHAR)))
-           {
-               UV uv = utf8_to_uvchr_buf(s, e, &char_len);
-               Perl_warner(aTHX_ packWARN(WARN_NONCHAR),
-                   "Unicode non-character U+%04"UVXf" is illegal for open interchange", uv);
+           else if ((UTF8_IS_NONCHAR(s, e)) && (ckWARN_d(WARN_NONCHAR))) {
+                /* A side effect of this function will be to warn */
+                (void) utf8n_to_uvchr(s, e - s, &char_len, UTF8_WARN_NONCHAR);

                ok = FALSE;
            }
        }
                ok = FALSE;
            }
        }


@@ -3772,17 +4001,19 @@ Perl_check_utf8_print(pTHX_ const U8* s, const STRLEN len)
 
 Build to the scalar C<dsv> a displayable version of the string C<spv>,
 length C<len>, the displayable version being at most C<pvlim> bytes long
 
 Build to the scalar C<dsv> a displayable version of the string C<spv>,
 length C<len>, the displayable version being at most C<pvlim> bytes long

-(if longer, the rest is truncated and "..." will be appended).
+(if longer, the rest is truncated and C<"..."> will be appended).

 
 

-The C<flags> argument can have UNI_DISPLAY_ISPRINT set to display
-isPRINT()able characters as themselves, UNI_DISPLAY_BACKSLASH
-to display the \\[nrfta\\] as the backslashed versions (like '\n')
-(UNI_DISPLAY_BACKSLASH is preferred over UNI_DISPLAY_ISPRINT for \\).
-UNI_DISPLAY_QQ (and its alias UNI_DISPLAY_REGEX) have both
-UNI_DISPLAY_BACKSLASH and UNI_DISPLAY_ISPRINT turned on.
+The C<flags> argument can have C<UNI_DISPLAY_ISPRINT> set to display
+C<isPRINT()>able characters as themselves, C<UNI_DISPLAY_BACKSLASH>
+to display the C<\\[nrfta\\]> as the backslashed versions (like C<"\n">)
+(C<UNI_DISPLAY_BACKSLASH> is preferred over C<UNI_DISPLAY_ISPRINT> for C<"\\">).
+C<UNI_DISPLAY_QQ> (and its alias C<UNI_DISPLAY_REGEX>) have both
+C<UNI_DISPLAY_BACKSLASH> and C<UNI_DISPLAY_ISPRINT> turned on.

 
 The pointer to the PV of the C<dsv> is returned.
 
 
 The pointer to the PV of the C<dsv> is returned.
 

+See also L</sv_uni_display>.
+

 =cut */
 char *
 Perl_pv_uni_display(pTHX_ SV *dsv, const U8 *spv, STRLEN len, STRLEN pvlim, UV flags)
 =cut */
 char *
 Perl_pv_uni_display(pTHX_ SV *dsv, const U8 *spv, STRLEN len, STRLEN pvlim, UV flags)


@@ -3888,7 +4119,7 @@ scan will not be considered to be a match unless the goal is reached, and
 scanning won't continue past that goal.  Correspondingly for C<l2> with respect to
 C<s2>.
 
 scanning won't continue past that goal.  Correspondingly for C<l2> with respect to
 C<s2>.
 

-If C<pe1> is non-NULL and the pointer it points to is not NULL, that pointer is
+If C<pe1> is non-C<NULL> and the pointer it points to is not C<NULL>, that pointer is

 considered an end pointer to the position 1 byte past the maximum point
 in C<s1> beyond which scanning will not continue under any circumstances.
 (This routine assumes that UTF-8 encoded input strings are not malformed;
 considered an end pointer to the position 1 byte past the maximum point
 in C<s1> beyond which scanning will not continue under any circumstances.
 (This routine assumes that UTF-8 encoded input strings are not malformed;


@@ -3905,7 +4136,7 @@ reached for a successful match.   Also, if the fold of a character is multiple
 characters, all of them must be matched (see tr21 reference below for
 'folding').
 
 characters, all of them must be matched (see tr21 reference below for
 'folding').
 

-Upon a successful match, if C<pe1> is non-NULL,
+Upon a successful match, if C<pe1> is non-C<NULL>,

 it will be set to point to the beginning of the I<next> character of C<s1>
 beyond what was matched.  Correspondingly for C<pe2> and C<s2>.
 
 it will be set to point to the beginning of the I<next> character of C<s1>
 beyond what was matched.  Correspondingly for C<pe2> and C<s2>.
 


@@ -4053,7 +4284,7 @@ Perl_foldEQ_utf8_flags(pTHX_ const char *s1, char **pe1, UV l1, bool u1, const c
                 else if (u1) {
                     _to_utf8_fold_flags(p1, foldbuf1, &n1, flags_for_folder);
                 }
                 else if (u1) {
                     _to_utf8_fold_flags(p1, foldbuf1, &n1, flags_for_folder);
                 }

-                else {  /* Not utf8, get utf8 fold */
+                else {  /* Not UTF-8, get UTF-8 fold */

                     _to_uni_fold_flags(*p1, foldbuf1, &n1, flags_for_folder);
                 }
                 f1 = foldbuf1;
                     _to_uni_fold_flags(*p1, foldbuf1, &n1, flags_for_folder);
                 }
                 f1 = foldbuf1;


@@ -4086,7 +4317,7 @@ Perl_foldEQ_utf8_flags(pTHX_ const char *s1, char **pe1, UV l1, bool u1, const c
 
        /* Here f1 and f2 point to the beginning of the strings to compare.
         * These strings are the folds of the next character from each input
 
        /* Here f1 and f2 point to the beginning of the strings to compare.
         * These strings are the folds of the next character from each input

-        * string, stored in utf8. */
+        * string, stored in UTF-8. */

 
         /* While there is more to look for in both folds, see if they
         * continue to match */
 
         /* While there is more to look for in both folds, see if they
         * continue to match */


@@ -4175,7 +4406,7 @@ Perl_utf8n_to_uvuni(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
 =for apidoc uvuni_to_utf8_flags
 
 Instead you almost certainly want to use L</uvchr_to_utf8> or
 =for apidoc uvuni_to_utf8_flags
 
 Instead you almost certainly want to use L</uvchr_to_utf8> or

-L</uvchr_to_utf8_flags>>.
+L</uvchr_to_utf8_flags>.

 
 This function is a deprecated synonym for L</uvoffuni_to_utf8_flags>,
 which itself, while not deprecated, should be used only in isolated
 
 This function is a deprecated synonym for L</uvoffuni_to_utf8_flags>,
 which itself, while not deprecated, should be used only in isolated


@@ -4196,11 +4427,5 @@ Perl_uvuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags)
 }
 
 /*
 }
 
 /*

- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: nil
- * End:
- *

  * ex: set ts=8 sts=4 sw=4 et:
  */
  * ex: set ts=8 sts=4 sw=4 et:
  */