regcomp.c: Add code to compute edit distance (Damerau–Levenshtein)

[perl5.git] / utf8.c

diff --git a/utf8.c b/utf8.c
index ba1304e..2c2ef48 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -31,24 +31,19 @@
 #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"
-
-#ifndef EBCDIC
-/* Separate prototypes needed because in ASCII systems these are
- * usually macros but they still are compiled as code, too. */
-PERL_CALLCONV UV       Perl_utf8n_to_uvchr(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags);
-PERL_CALLCONV UV       Perl_valid_utf8_to_uvchr(pTHX_ const U8 *s, STRLEN *retlen);
-PERL_CALLCONV U8*      Perl_uvchr_to_utf8(pTHX_ U8 *d, UV uv);
-#endif
+#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

-
-This file contains various utility functions for manipulating UTF8-encoded
-strings. For the uninitiated, this is a method of representing arbitrary
+These are various utility functions for manipulating UTF8-encoded
+strings.  For the uninitiated, this is a method of representing arbitrary

 Unicode characters as a variable number of bytes, in such a way that
 characters in the ASCII range are unmodified, and a zero byte never appears
 within non-zero characters.
 Unicode characters as a variable number of bytes, in such a way that
 characters in the ASCII range are unmodified, and a zero byte never appears
 within non-zero characters.


@@ -57,14 +52,19 @@ within non-zero characters.
 */
 
 /*
 */
 
 /*

-=for apidoc is_ascii_string
+=for apidoc is_invariant_string

 
 

-Returns true if the first C<len> bytes of the string C<s> are the same whether
-or not the string is encoded in UTF-8 (or UTF-EBCDIC on EBCDIC machines).  That
-is, if they are invariant.  On ASCII-ish machines, only ASCII characters
-fit this definition, hence the function's name.
+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)>.  
+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>().
 
 
 See also L</is_utf8_string>(), L</is_utf8_string_loclen>(), and L</is_utf8_string_loc>().
 


@@ -72,12 +72,12 @@ See also L</is_utf8_string>(), L</is_utf8_string_loclen>(), and L</is_utf8_strin
 */
 
 bool
 */
 
 bool

-Perl_is_ascii_string(const U8 *s, STRLEN len)
+Perl_is_invariant_string(const U8 *s, STRLEN len)

 {
     const U8* const send = s + (len ? len : strlen((const char *)s));
     const U8* x = s;
 
 {
     const U8* const send = s + (len ? len : strlen((const char *)s));
     const U8* x = s;
 

-    PERL_ARGS_ASSERT_IS_ASCII_STRING;
+    PERL_ARGS_ASSERT_IS_INVARIANT_STRING;

 
     for (; x < send; ++x) {
        if (!UTF8_IS_INVARIANT(*x))
 
     for (; x < send; ++x) {
        if (!UTF8_IS_INVARIANT(*x))


@@ -88,289 +88,299 @@ Perl_is_ascii_string(const U8 *s, STRLEN len)
 }
 
 /*
 }
 
 /*

-=for apidoc uvuni_to_utf8_flags
-
-Adds the UTF-8 representation of the Unicode code point C<uv> to the end
-of the string C<d>; C<d> should have at least 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,
-
-    d = uvuni_to_utf8_flags(d, uv, flags);
+=for apidoc uvoffuni_to_utf8_flags

 
 

-or, in most cases,
-
-    d = uvuni_to_utf8(d, uv);
+THIS FUNCTION SHOULD BE USED IN ONLY VERY SPECIALIZED CIRCUMSTANCES.
+Instead, B<Almost all code should use L</uvchr_to_utf8> or
+L</uvchr_to_utf8_flags>>.

 
 

-(which is equivalent to)
+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.

 
 

-    d = uvuni_to_utf8_flags(d, uv, 0);
+For details, see the description for L</uvchr_to_utf8_flags>.

 
 

-This is the recommended Unicode-aware way of saying
+=cut
+*/

 
 

-    *(d++) = uv;
+#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

 
 

-where uv is a code point expressed in Latin-1 or above, not the platform's
-native character set.  B<Almost all code should instead use L</uvchr_to_utf8>
-or L</uvchr_to_utf8_flags>>.
+U8 *
+Perl_uvoffuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags)
+{
+    PERL_ARGS_ASSERT_UVOFFUNI_TO_UTF8_FLAGS;

 
 

-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 (OFFUNI_IS_INVARIANT(uv)) {
+       *d++ = LATIN1_TO_NATIVE(uv);
+       return d;
+    }

 
 

-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.
+    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
+       return d;
+    }

 
 

-The UNICODE_WARN_NONCHAR and UNICODE_DISALLOW_NONCHAR flags correspondingly
-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.
+    /* 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. */

 
 

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

 
 

-=cut
-*/
+       return d;
+    }

 
 

-U8 *
-Perl_uvuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags)
-{
-    PERL_ARGS_ASSERT_UVUNI_TO_UTF8_FLAGS;
+    /* 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. */

 
 

-    /* The first problematic code point is the first surrogate */
-    if (uv >= UNICODE_SURROGATE_FIRST
-        && ckWARN4_d(WARN_UTF8, 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)))
-           {
-               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;
-           }
-       }
-    }
-    if (UNI_IS_INVARIANT(uv)) {
-       *d++ = (U8)UTF_TO_NATIVE(uv);
-       return d;
-    }
-#if defined(EBCDIC)
-    else {
-       STRLEN len  = UNISKIP(uv);
+       STRLEN len  = OFFUNISKIP(uv);

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

-           *p-- = (U8)UTF_TO_NATIVE((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)UTF_TO_NATIVE((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 HAS_QUAD
-    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 HAS_QUAD
-    {
-       *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

 
 

-Tests if the first C<len> bytes of string C<s> form a valid UTF-8
-character.  Note that an INVARIANT (i.e. ASCII) character is a valid
-UTF-8 character.  The number of bytes in the UTF-8 character
-will be returned if it is valid, otherwise 0.
-
-This is the "slow" version as opposed to the "fast" version which is
-the "unrolled" IS_UTF8_CHAR().  E.g. for t/uni/class.t the speed
-difference is a factor of 2 to 3.  For lengths (UTF8SKIP(s)) of four
-or less you should use the IS_UTF8_CHAR(), for lengths of five or more
-you should use the _slow().  In practice this means that the _slow()
-will be used very rarely, since the maximum Unicode code point (as of
-Unicode 4.1) is U+10FFFF, which encodes in UTF-8 to four bytes.  Only
-the "Perl extended UTF-8" (e.g, the infamous 'v-strings') will encode into
-five bytes or more.
-
-=cut */
-PERL_STATIC_INLINE STRLEN
-S_is_utf8_char_slow(const U8 *s, const STRLEN len)
-{
-    dTHX;   /* The function called below requires thread context */
-
-    STRLEN actual_len;
+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<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,

 
 

-    PERL_ARGS_ASSERT_IS_UTF8_CHAR_SLOW;
+    d = uvchr_to_utf8(d, uv);

 
 

-    utf8n_to_uvuni(s, len, &actual_len, UTF8_CHECK_ONLY);
+is the recommended wide native character-aware way of saying

 
 

-    return (actual_len == (STRLEN) -1) ? 0 : actual_len;
-}
+    *(d++) = uv;

 
 

-/*
-=for apidoc is_utf8_char_buf
+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.

 
 

-Returns the number of bytes that comprise the first UTF-8 encoded character in
-buffer C<buf>.  C<buf_end> should point to one position beyond the end of the
-buffer.  0 is returned if C<buf> does not point to a complete, valid UTF-8
-encoded character.
+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>.

 
 

-Note that an INVARIANT character (i.e. ASCII on non-EBCDIC
-machines) is a valid UTF-8 character.
+=cut
+*/

 
 

-=cut */
+/* This is also a macro */
+PERL_CALLCONV U8*       Perl_uvchr_to_utf8(pTHX_ U8 *d, UV uv);

 
 

-STRLEN
-Perl_is_utf8_char_buf(const U8 *buf, const U8* buf_end)
+U8 *
+Perl_uvchr_to_utf8(pTHX_ U8 *d, UV uv)

 {
 {

+    return uvchr_to_utf8(d, uv);
+}

 
 

-    STRLEN len;
+/*
+=for apidoc uvchr_to_utf8_flags

 
 

-    PERL_ARGS_ASSERT_IS_UTF8_CHAR_BUF;
+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<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,

 
 

-    if (buf_end <= buf) {
-       return 0;
-    }
+    d = uvchr_to_utf8_flags(d, uv, flags);

 
 

-    len = buf_end - buf;
-    if (len > UTF8SKIP(buf)) {
-       len = UTF8SKIP(buf);
-    }
+or, in most cases,

 
 

-#ifdef IS_UTF8_CHAR
-    if (IS_UTF8_CHAR_FAST(len))
-        return IS_UTF8_CHAR(buf, len) ? len : 0;
-#endif /* #ifdef IS_UTF8_CHAR */
-    return is_utf8_char_slow(buf, len);
-}
+    d = uvchr_to_utf8_flags(d, uv, 0);

 
 

-/*
-=for apidoc is_utf8_char
+This is the Unicode-aware way of saying

 
 

-DEPRECATED!
+    *(d++) = uv;

 
 

-Tests if some arbitrary number of bytes begins in a valid UTF-8
-character.  Note that an INVARIANT (i.e. ASCII on non-EBCDIC machines)
-character is a valid UTF-8 character.  The actual number of bytes in the UTF-8
-character will be returned if it is valid, otherwise 0.
+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.

 
 

-This function is deprecated due to the possibility that malformed input could
-cause reading beyond the end of the input buffer.  Use L</is_utf8_char_buf>
-instead.
+=cut
+*/

 
 

-=cut */
+/* This is also a macro */
+PERL_CALLCONV U8*       Perl_uvchr_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags);

 
 

-STRLEN
-Perl_is_utf8_char(const U8 *s)
+U8 *
+Perl_uvchr_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags)

 {
 {

-    PERL_ARGS_ASSERT_IS_UTF8_CHAR;
-
-    /* Assumes we have enough space, which is why this is deprecated */
-    return is_utf8_char_buf(s, s + UTF8SKIP(s));
+    return uvchr_to_utf8_flags(d, 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
 /*
 =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> has to have a
-terminating NUL byte).  Note that all characters being ASCII constitute 'a
-valid UTF-8 string'.
+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'.

 
 

-See also L</is_ascii_string>(), L</is_utf8_string_loclen>(), and L</is_utf8_string_loc>().
+See also L</is_invariant_string>(), L</is_utf8_string_loclen>(), and L</is_utf8_string_loc>().

 
 =cut
 */
 
 =cut
 */


@@ -384,28 +394,11 @@ Perl_is_utf8_string(const U8 *s, STRLEN len)
     PERL_ARGS_ASSERT_IS_UTF8_STRING;
 
     while (x < send) {
     PERL_ARGS_ASSERT_IS_UTF8_STRING;
 
     while (x < send) {

-        /* Inline the easy bits of is_utf8_char() here for speed... */
-        if (UTF8_IS_INVARIANT(*x)) {
-           x++;
-        }
-        else {
-             /* ... and call is_utf8_char() only if really needed. */
-            const STRLEN c = UTF8SKIP(x);
-            const U8* const next_char_ptr = x + c;
-
-            if (next_char_ptr > send) {
-                return FALSE;
-            }
-
-            if (IS_UTF8_CHAR_FAST(c)) {
-                if (!IS_UTF8_CHAR(x, c))
-                    return FALSE;
-            }
-            else if (! is_utf8_char_slow(x, c)) {
-                return FALSE;
-            }
-            x = next_char_ptr;
-        }
+        STRLEN len = isUTF8_CHAR(x, send);
+        if (UNLIKELY(! len)) {
+            return FALSE;
+        }
+        x += len;

     }
 
     return TRUE;
     }
 
     return TRUE;


@@ -439,34 +432,17 @@ 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;
 {
     const U8* const send = s + (len ? len : strlen((const char *)s));
     const U8* x = s;

-    STRLEN c;

     STRLEN outlen = 0;
 
     PERL_ARGS_ASSERT_IS_UTF8_STRING_LOCLEN;
 
     while (x < send) {
     STRLEN outlen = 0;
 
     PERL_ARGS_ASSERT_IS_UTF8_STRING_LOCLEN;
 
     while (x < send) {

-        const U8* next_char_ptr;
-
-        /* Inline the easy bits of is_utf8_char() here for speed... */
-        if (UTF8_IS_INVARIANT(*x))
-            next_char_ptr = x + 1;
-        else {
-            /* ... and call is_utf8_char() only if really needed. */
-            c = UTF8SKIP(x);
-            next_char_ptr = c + x;
-            if (next_char_ptr > send) {
-                goto out;
-            }
-            if (IS_UTF8_CHAR_FAST(c)) {
-                if (!IS_UTF8_CHAR(x, c))
-                    c = 0;
-            } else
-                c = is_utf8_char_slow(x, c);
-            if (!c)
-                goto out;
-        }
-         x = next_char_ptr;
-        outlen++;
+        STRLEN len = isUTF8_CHAR(x, send);
+        if (UNLIKELY(! len)) {
+            goto out;
+        }
+        x += len;
+        outlen++;

     }
 
  out:
     }
 
  out:


@@ -480,10 +456,13 @@ Perl_is_utf8_string_loclen(const U8 *s, STRLEN len, const U8 **ep, STRLEN *el)
 
 /*
 
 
 /*
 

-=for apidoc utf8n_to_uvuni
+=for apidoc utf8n_to_uvchr
+
+THIS FUNCTION SHOULD BE USED IN ONLY VERY SPECIALIZED CIRCUMSTANCES.
+Most code should use L</utf8_to_uvchr_buf>() rather than call this directly.

 
 Bottom level UTF-8 decode routine.
 
 Bottom level UTF-8 decode routine.

-Returns the code point value of the first character in the string C<s>,
+Returns the native code point value of the first character in the string C<s>,

 which is assumed to be in UTF-8 (or UTF-EBCDIC) encoding, and no longer than
 C<curlen> bytes; C<*retlen> (if C<retlen> isn't NULL) will be set to
 the length, in bytes, of that character.
 which is assumed to be in UTF-8 (or UTF-EBCDIC) encoding, and no longer than
 C<curlen> bytes; C<*retlen> (if C<retlen> isn't NULL) will be set to
 the length, in bytes, of that character.


@@ -505,62 +484,74 @@ 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.
 
 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 NUL
-character, and an error return (unless the UTF8_CHECK_ONLY flag is set), as
+Note that this API requires disambiguation between successful decoding a C<NUL>
+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
 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 NUL; if not, the input
-had an error.
+first byte of C<s> is 0 as well.  If so, the input was a C<NUL>; if not, the
+input had an error.

 
 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
 
 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

-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
 warn.
 
 
 All other code points corresponding to Unicode characters, including private
 use and those yet to be assigned, are never considered malformed and never
 warn.
 

-Most code should use L</utf8_to_uvchr_buf>() rather than call this directly.
-

 =cut
 */
 
 UV
 =cut
 */
 
 UV

-Perl_utf8n_to_uvuni(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
+Perl_utf8n_to_uvchr(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)

 {
 {

-    dVAR;

     const U8 * const s0 = s;
     U8 overflow_byte = '\0';   /* Save byte in case of overflow */
     U8 * send;
     const U8 * const s0 = s;
     U8 overflow_byte = '\0';   /* Save byte in case of overflow */
     U8 * send;


@@ -576,7 +567,7 @@ Perl_utf8n_to_uvuni(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
 
     const char* const malformed_text = "Malformed UTF-8 character";
 
 
     const char* const malformed_text = "Malformed UTF-8 character";
 

-    PERL_ARGS_ASSERT_UTF8N_TO_UVUNI;
+    PERL_ARGS_ASSERT_UTF8N_TO_UVCHR;

 
     /* The order of malformation tests here is important.  We should consume as
      * few bytes as possible in order to not skip any valid character.  This is
 
     /* The order of malformation tests here is important.  We should consume as
      * few bytes as possible in order to not skip any valid character.  This is


@@ -593,7 +584,7 @@ Perl_utf8n_to_uvuni(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
      * We also should not consume too few bytes, otherwise someone could inject
      * things.  For example, an input could be deliberately designed to
      * overflow, and if this code bailed out immediately upon discovering that,
      * We also should not consume too few bytes, otherwise someone could inject
      * things.  For example, an input could be deliberately designed to
      * overflow, and if this code bailed out immediately upon discovering that,

-     * returning to the caller *retlen pointing to the very next byte (one
+     * returning to the caller C<*retlen> pointing to the very next byte (one

      * which is actually part of of the overflowing sequence), that could look
      * legitimate to the caller, which could discard the initial partial
      * sequence and process the rest, inappropriately */
      * which is actually part of of the overflowing sequence), that could look
      * legitimate to the caller, which could discard the initial partial
      * sequence and process the rest, inappropriately */


@@ -625,7 +616,7 @@ Perl_utf8n_to_uvuni(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
 
     /* An invariant is trivially well-formed */
     if (UTF8_IS_INVARIANT(uv)) {
 
     /* An invariant is trivially well-formed */
     if (UTF8_IS_INVARIANT(uv)) {

-       return (UV) (NATIVE_TO_UTF(*s));
+       return uv;

     }
 
     /* A continuation character can't start a valid sequence */
     }
 
     /* A continuation character can't start a valid sequence */


@@ -644,13 +635,13 @@ Perl_utf8n_to_uvuni(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
        goto malformed;
     }
 
        goto malformed;
     }
 

-#ifdef EBCDIC
-    uv = NATIVE_TO_UTF(uv);
-#endif
-

     /* 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 */
     /* 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 */


@@ -663,7 +654,6 @@ Perl_utf8n_to_uvuni(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


@@ -675,7 +665,6 @@ Perl_utf8n_to_uvuni(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 {


@@ -742,39 +731,13 @@ Perl_utf8n_to_uvuni(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
        }
     }
 
        }
     }
 

-#ifndef EBCDIC /* EBCDIC allows FE, FF, can't overflow */
-    if ((*s0 & 0xFE) == 0xFE   /* matches both FE, FF */
-       && (flags & (UTF8_WARN_FE_FF|UTF8_DISALLOW_FE_FF)))
-    {
-       /* By adding UTF8_CHECK_ONLY to the test, we avoid unnecessary
-        * generation of the sv, since no warnings are raised under CHECK */
-       if ((flags & (UTF8_WARN_FE_FF|UTF8_CHECK_ONLY)) == UTF8_WARN_FE_FF
-           && ckWARN_d(WARN_UTF8))
-       {
-           /* This message is deliberately not of the same syntax as the other
-            * messages for malformations, for backwards compatibility in the
-            * unlikely event that code is relying on its precise earlier text
-            */
-           sv = sv_2mortal(Perl_newSVpvf(aTHX_ "%s Code point beginning with byte 0x%02X is not Unicode, and not portable", malformed_text, *s0));
-           pack_warn = packWARN(WARN_UTF8);
-       }
-       if (flags & UTF8_DISALLOW_FE_FF) {
-           goto malformed;
-       }
-    }

     if (UNLIKELY(overflowed)) {
     if (UNLIKELY(overflowed)) {

-
-       /* If the first byte is FF, it will overflow a 32-bit word.  If the
-        * first byte is FE, it will overflow a signed 32-bit word.  The
-        * above preserves backward compatibility, since its message was used
-        * in earlier versions of this code in preference to overflow */

        sv = sv_2mortal(Perl_newSVpvf(aTHX_ "%s (overflow at byte 0x%02x, after start byte 0x%02x)", malformed_text, overflow_byte, *s0));
        goto malformed;
     }
        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
 
     if (do_overlong_test

-       && expectlen > (STRLEN)UNISKIP(uv)
+       && expectlen > (STRLEN) OFFUNISKIP(uv)

        && ! (flags & UTF8_ALLOW_LONG))
     {
        /* The overlong malformation has lower precedence than the others.
        && ! (flags & UTF8_ALLOW_LONG))
     {
        /* The overlong malformation has lower precedence than the others.


@@ -782,23 +745,34 @@ Perl_utf8n_to_uvuni(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
         * value, instead of the replacement character.  This is because this
         * value is actually well-defined. */
        if (! (flags & UTF8_CHECK_ONLY)) {
         * value, instead of the replacement character.  This is because this
         * value is actually well-defined. */
        if (! (flags & UTF8_CHECK_ONLY)) {

-           sv = sv_2mortal(Perl_newSVpvf(aTHX_ "%s (%d byte%s, need %d, after start byte 0x%02x)", malformed_text, (int)expectlen, expectlen == 1 ? "": "s", UNISKIP(uv), *s0));
+           sv = sv_2mortal(Perl_newSVpvf(aTHX_ "%s (%d byte%s, need %d, after start byte 0x%02x)", malformed_text, (int)expectlen, expectlen == 1 ? "": "s", OFFUNISKIP(uv), *s0));

        }
        goto malformed;
     }
 
        }
        goto malformed;
     }
 

-    /* Here, the input is considered to be well-formed , but could be a
+    /* 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 */
      * 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)) {

+
+            /* By adding UTF8_CHECK_ONLY to the test, we avoid unnecessary
+             * generation of the sv, since no warnings are raised under CHECK */

            if ((flags & (UTF8_WARN_SURROGATE|UTF8_CHECK_ONLY)) == UTF8_WARN_SURROGATE
            if ((flags & (UTF8_WARN_SURROGATE|UTF8_CHECK_ONLY)) == UTF8_WARN_SURROGATE

-               && ckWARN2_d(WARN_UTF8, WARN_SURROGATE))
+               && ckWARN_d(WARN_SURROGATE))

            {
                sv = sv_2mortal(Perl_newSVpvf(aTHX_ "UTF-16 surrogate U+%04"UVXf"", uv));
            {
                sv = sv_2mortal(Perl_newSVpvf(aTHX_ "UTF-16 surrogate U+%04"UVXf"", uv));

-               pack_warn = packWARN2(WARN_UTF8, WARN_SURROGATE);
+               pack_warn = packWARN(WARN_SURROGATE);

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


@@ -806,21 +780,79 @@ Perl_utf8n_to_uvuni(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
        }
        else if ((uv > PERL_UNICODE_MAX)) {
            if ((flags & (UTF8_WARN_SUPER|UTF8_CHECK_ONLY)) == UTF8_WARN_SUPER
        }
        else if ((uv > PERL_UNICODE_MAX)) {
            if ((flags & (UTF8_WARN_SUPER|UTF8_CHECK_ONLY)) == UTF8_WARN_SUPER

-               && ckWARN2_d(WARN_UTF8, WARN_NON_UNICODE))
+                && ckWARN_d(WARN_NON_UNICODE))

            {
            {

-               sv = sv_2mortal(Perl_newSVpvf(aTHX_ "Code point 0x%04"UVXf" is not Unicode, may not be portable", uv));
-               pack_warn = packWARN2(WARN_UTF8, WARN_NON_UNICODE);
+               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);

            }
            }

+
+            /* 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_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));
+                    pack_warn = packWARN(WARN_UTF8);
+                }
+                if (flags & UTF8_DISALLOW_ABOVE_31_BIT) {
+                    goto disallowed;
+                }
+            }
+

            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
        }
        else if (UNICODE_IS_NONCHAR(uv)) {
            if ((flags & (UTF8_WARN_NONCHAR|UTF8_CHECK_ONLY)) == UTF8_WARN_NONCHAR

-               && ckWARN2_d(WARN_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));
-               pack_warn = packWARN2(WARN_UTF8, WARN_NONCHAR);
+               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) {
                goto disallowed;
            }
            if (flags & UTF8_DISALLOW_NONCHAR) {
                goto disallowed;


@@ -828,7 +860,9 @@ Perl_utf8n_to_uvuni(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
        }
 
        if (sv) {
        }
 
        if (sv) {

-           outlier_ret = uv;
+            outlier_ret = uv;   /* Note we don't bother to convert to native,
+                                   as all the outlier code points are the same
+                                   in both ASCII and EBCDIC */

            goto do_warn;
        }
 
            goto do_warn;
        }
 


@@ -836,7 +870,7 @@ Perl_utf8n_to_uvuni(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
         * to return it */
     }
 
         * to return it */
     }
 

-    return uv;
+    return UNI_TO_NATIVE(uv);

 
     /* There are three cases which get to beyond this point.  In all 3 cases:
      * <sv>        if not null points to a string to print as a warning.
 
     /* There are three cases which get to beyond this point.  In all 3 cases:
      * <sv>        if not null points to a string to print as a warning.


@@ -864,13 +898,13 @@ Perl_utf8n_to_uvuni(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
      *     is the label <malformed>.
      */
 
      *     is the label <malformed>.
      */
 

-malformed:
+  malformed:

 
     if (sv && ckWARN_d(WARN_UTF8)) {
        pack_warn = packWARN(WARN_UTF8);
     }
 
 
     if (sv && ckWARN_d(WARN_UTF8)) {
        pack_warn = packWARN(WARN_UTF8);
     }
 

-disallowed:
+  disallowed:

 
     if (flags & UTF8_CHECK_ONLY) {
        if (retlen)
 
     if (flags & UTF8_CHECK_ONLY) {
        if (retlen)


@@ -878,7 +912,7 @@ disallowed:
        return 0;
     }
 
        return 0;
     }
 

-do_warn:
+  do_warn:

 
     if (pack_warn) {   /* <pack_warn> was initialized to 0, and changed only
                           if warnings are to be raised. */
 
     if (pack_warn) {   /* <pack_warn> was initialized to 0, and changed only
                           if warnings are to be raised. */


@@ -906,13 +940,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.
 the next possible position in C<s> that could begin a non-malformed character.

-See L</utf8n_to_uvuni> for details on when the REPLACEMENT CHARACTER is
+See L</utf8n_to_uvchr> for details on when the REPLACEMENT CHARACTER is

 returned.
 
 returned.
 

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

 =cut
 */
 
 =cut
 */
 


@@ -920,8 +957,6 @@ returned.
 UV
 Perl_utf8_to_uvchr_buf(pTHX_ const U8 *s, const U8 *send, STRLEN *retlen)
 {
 UV
 Perl_utf8_to_uvchr_buf(pTHX_ const U8 *s, const U8 *send, STRLEN *retlen)
 {

-    PERL_ARGS_ASSERT_UTF8_TO_UVCHR_BUF;
-

     assert(s < send);
 
     return utf8n_to_uvchr(s, send - s, retlen,
     assert(s < send);
 
     return utf8n_to_uvchr(s, send - s, retlen,


@@ -930,99 +965,20 @@ Perl_utf8_to_uvchr_buf(pTHX_ const U8 *s, const U8 *send, STRLEN *retlen)
 
 /* 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,
 
 /* 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.  A macro
- * in utf8.h is used to normally avoid this function wrapper */
+ * non-character code points, and non-Unicode code points are allowed. */

 
 UV
 Perl_valid_utf8_to_uvchr(pTHX_ const U8 *s, STRLEN *retlen)
 {
 
 UV
 Perl_valid_utf8_to_uvchr(pTHX_ const U8 *s, STRLEN *retlen)
 {

-    const UV uv = valid_utf8_to_uvuni(s, retlen);
-
-    PERL_ARGS_ASSERT_VALID_UTF8_TO_UVCHR;
-
-    return UNI_TO_NATIVE(uv);
-}
-
-/*
-=for apidoc utf8_to_uvchr
-
-DEPRECATED!
-
-Returns the native code point of the first character in the string C<s>
-which is assumed to be in UTF-8 encoding; C<retlen> will be set to the
-length, in bytes, of that character.
-
-Some, but not all, UTF-8 malformations are detected, and in fact, some
-malformed input could cause reading beyond the end of the input buffer, which
-is why this function is deprecated.  Use L</utf8_to_uvchr_buf> instead.
-
-If C<s> points to one of the detected malformations, 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 (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 the
-next possible position in C<s> that could begin a non-malformed character.
-See L</utf8n_to_uvuni> for details on when the REPLACEMENT CHARACTER is returned.
-
-=cut
-*/
-
-UV
-Perl_utf8_to_uvchr(pTHX_ const U8 *s, STRLEN *retlen)
-{
-    PERL_ARGS_ASSERT_UTF8_TO_UVCHR;
-
-    return utf8_to_uvchr_buf(s, s + UTF8_MAXBYTES, retlen);
-}
-
-/*
-=for apidoc utf8_to_uvuni_buf
-
-Returns the Unicode code point of the first character in the string C<s> which
-is assumed to be in UTF-8 encoding; C<send> points to 1 beyond the end of C<s>.
-C<retlen> will be set to the length, in bytes, of that character.
-
-This function should only be used when the returned UV is considered
-an index into the Unicode semantic tables (e.g. swashes).
-
-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 (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 the
-next possible position in C<s> that could begin a non-malformed character.
-See L</utf8n_to_uvuni> for details on when the REPLACEMENT CHARACTER is returned.
-
-=cut
-*/
-
-UV
-Perl_utf8_to_uvuni_buf(pTHX_ const U8 *s, const U8 *send, STRLEN *retlen)
-{
-    PERL_ARGS_ASSERT_UTF8_TO_UVUNI_BUF;
-
-    assert(send > s);
-
-    /* Call the low level routine asking for checks */
-    return Perl_utf8n_to_uvuni(aTHX_ s, send -s, retlen,
-                              ckWARN_d(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
-}
-
-/* Like L</utf8_to_uvuni_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_uvuni(pTHX_ const U8 *s, STRLEN *retlen)
-{

     UV expectlen = UTF8SKIP(s);
     const U8* send = s + expectlen;
     UV expectlen = UTF8SKIP(s);
     const U8* send = s + expectlen;

-    UV uv = NATIVE_TO_UTF(*s);
+    UV uv = *s;

 
 

-    PERL_ARGS_ASSERT_VALID_UTF8_TO_UVUNI;
+    PERL_ARGS_ASSERT_VALID_UTF8_TO_UVCHR;
+    PERL_UNUSED_CONTEXT;

 
     if (retlen) {
 
     if (retlen) {

-       *retlen = expectlen;
+        *retlen = expectlen;

     }
 
     /* An invariant is trivially returned */
     }
 
     /* An invariant is trivially returned */


@@ -1030,6 +986,10 @@ Perl_valid_utf8_to_uvuni(pTHX_ const U8 *s, STRLEN *retlen)
        return uv;
     }
 
        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);
     /* 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);


@@ -1038,45 +998,49 @@ Perl_valid_utf8_to_uvuni(pTHX_ const U8 *s, STRLEN *retlen)
      * 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++) {
      * 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);
+        uv = UTF8_ACCUMULATE(uv, *s);

     }
 
     }
 

-    return uv;
+    return UNI_TO_NATIVE(uv);
+

 }
 
 /*
 }
 
 /*

-=for apidoc utf8_to_uvuni
-
-DEPRECATED!
-
-Returns the Unicode code point of the first character in the string C<s>
-which is assumed to be in UTF-8 encoding; C<retlen> will be set to the
-length, in bytes, of that character.
+=for apidoc utf8_to_uvuni_buf

 
 

-This function should only be used when the returned UV is considered
-an index into the Unicode semantic tables (e.g. swashes).
+Only in very rare circumstances should code need to be dealing in Unicode
+(as opposed to native) code points.  In those few cases, use
+C<L<NATIVE_TO_UNI(utf8_to_uvchr_buf(...))|/utf8_to_uvchr_buf>> instead.

 
 

-Some, but not all, UTF-8 malformations are detected, and in fact, some
-malformed input could cause reading beyond the end of the input buffer, which
-is why this function is deprecated.  Use L</utf8_to_uvuni_buf> instead.
+Returns the Unicode (not-native) code point of the first character in the
+string C<s> which
+is assumed to be in UTF-8 encoding; C<send> points to 1 beyond the end of C<s>.
+C<retlen> will be set to the length, in bytes, of that character.

 
 

-If C<s> points to one of the detected malformations, and UTF8 warnings are
-enabled, zero is returned and C<*retlen> is set (if C<retlen> doesn't point to
+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 (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 the
 next possible position in C<s> that could begin a non-malformed character.
 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 C<*retlen>
 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_uvuni> for details on when the REPLACEMENT CHARACTER is returned.
+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
 */
 
 UV
 
 =cut
 */
 
 UV

-Perl_utf8_to_uvuni(pTHX_ const U8 *s, STRLEN *retlen)
+Perl_utf8_to_uvuni_buf(pTHX_ const U8 *s, const U8 *send, STRLEN *retlen)

 {
 {

-    PERL_ARGS_ASSERT_UTF8_TO_UVUNI;
+    PERL_ARGS_ASSERT_UTF8_TO_UVUNI_BUF;

 
 

-    return valid_utf8_to_uvuni(s, retlen);
+    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));

 }
 
 /*
 }
 
 /*


@@ -1092,7 +1056,6 @@ up past C<e>, croaks.
 STRLEN
 Perl_utf8_length(pTHX_ const U8 *s, const U8 *e)
 {
 STRLEN
 Perl_utf8_length(pTHX_ const U8 *s, const U8 *e)
 {

-    dVAR;

     STRLEN len = 0;
 
     PERL_ARGS_ASSERT_UTF8_LENGTH;
     STRLEN len = 0;
 
     PERL_ARGS_ASSERT_UTF8_LENGTH;


@@ -1155,11 +1118,10 @@ on the first byte of character or just after the last byte of a character.
 */
 
 U8 *
 */
 
 U8 *

-Perl_utf8_hop(pTHX_ const U8 *s, I32 off)
+Perl_utf8_hop(const U8 *s, I32 off)

 {
     PERL_ARGS_ASSERT_UTF8_HOP;
 
 {
     PERL_ARGS_ASSERT_UTF8_HOP;
 

-    PERL_UNUSED_CONTEXT;

     /* 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. */
     /* 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. */


@@ -1182,12 +1144,14 @@ Perl_utf8_hop(pTHX_ const U8 *s, I32 off)
 =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

-sequence of characters (stored as UTF-8) in C<u>, C<ulen>. Returns 0 if they are
+sequence of characters (stored as UTF-8)
+in C<u>, C<ulen>.  Returns 0 if they are

 equal, -1 or -2 if the first string is less than the second string, +1 or +2
 if the first string is greater than the second string.
 
 -1 or +1 is returned if the shorter string was identical to the start of the
 equal, -1 or -2 if the first string is less than the second string, +1 or +2
 if the first string is greater than the second string.
 
 -1 or +1 is returned if the shorter string was identical to the start of the

-longer string. -2 or +2 is returned if the was a difference between characters
+longer string.  -2 or +2 is returned if
+there was a difference between characters

 within the strings.
 
 =cut
 within the strings.
 
 =cut


@@ -1201,8 +1165,6 @@ Perl_bytes_cmp_utf8(pTHX_ const U8 *b, STRLEN blen, const U8 *u, STRLEN ulen)
 
     PERL_ARGS_ASSERT_BYTES_CMP_UTF8;
 
 
     PERL_ARGS_ASSERT_BYTES_CMP_UTF8;
 

-    PERL_UNUSED_CONTEXT;
-

     while (b < bend && u < uend) {
         U8 c = *u++;
        if (!UTF8_IS_INVARIANT(c)) {
     while (b < bend && u < uend) {
         U8 c = *u++;
        if (!UTF8_IS_INVARIANT(c)) {


@@ -1210,7 +1172,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 = UNI_TO_NATIVE(TWO_BYTE_UTF8_TO_UNI(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 "


@@ -1267,24 +1229,29 @@ Perl_utf8_to_bytes(pTHX_ U8 *s, STRLEN *len)
     U8 *d;
 
     PERL_ARGS_ASSERT_UTF8_TO_BYTES;
     U8 *d;
 
     PERL_ARGS_ASSERT_UTF8_TO_BYTES;

+    PERL_UNUSED_CONTEXT;

 
     /* ensure valid UTF-8 and chars < 256 before updating string */
     while (s < send) {
 
     /* ensure valid UTF-8 and chars < 256 before updating string */
     while (s < send) {

-        U8 c = *s++;
-
-        if (!UTF8_IS_INVARIANT(c) &&
-            (!UTF8_IS_DOWNGRADEABLE_START(c) || (s >= send)
-            || !(c = *s++) || !UTF8_IS_CONTINUATION(c))) {
-            *len = ((STRLEN) -1);
-            return 0;
+        if (! UTF8_IS_INVARIANT(*s)) {
+            if (! UTF8_IS_NEXT_CHAR_DOWNGRADEABLE(s, send)) {
+                *len = ((STRLEN) -1);
+                return 0;
+            }
+            s++;

         }
         }

+        s++;

     }
 
     d = s = save;
     while (s < send) {
     }
 
     d = s = save;
     while (s < send) {

-        STRLEN ulen;
-        *d++ = (U8)utf8_to_uvchr_buf(s, send, &ulen);
-        s += ulen;
+       U8 c = *s++;
+       if (! UTF8_IS_INVARIANT(c)) {
+           /* Then it is two-byte encoded */
+           c = EIGHT_BIT_UTF8_TO_NATIVE(c, *s);
+            s++;
+       }
+       *d++ = c;

     }
     *d = '\0';
     *len = d - save;
     }
     *d = '\0';
     *len = d - save;


@@ -1298,9 +1265,9 @@ Converts a string C<s> of length C<len> from UTF-8 into native byte encoding.
 Unlike L</utf8_to_bytes> but like L</bytes_to_utf8>, returns a pointer to
 the newly-created string, and updates C<len> to contain the new
 length.  Returns the original string if no conversion occurs, C<len>
 Unlike L</utf8_to_bytes> but like L</bytes_to_utf8>, returns a pointer to
 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
+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
 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
 */


@@ -1314,21 +1281,20 @@ Perl_bytes_from_utf8(pTHX_ const U8 *s, STRLEN *len, bool *is_utf8)
     I32 count = 0;
 
     PERL_ARGS_ASSERT_BYTES_FROM_UTF8;
     I32 count = 0;
 
     PERL_ARGS_ASSERT_BYTES_FROM_UTF8;

-

     PERL_UNUSED_CONTEXT;
     if (!*is_utf8)
         return (U8 *)start;
 
     /* ensure valid UTF-8 and chars < 256 before converting string */
     for (send = s + *len; s < send;) {
     PERL_UNUSED_CONTEXT;
     if (!*is_utf8)
         return (U8 *)start;
 
     /* ensure valid UTF-8 and chars < 256 before converting string */
     for (send = s + *len; s < send;) {

-        U8 c = *s++;
-       if (!UTF8_IS_INVARIANT(c)) {
-           if (UTF8_IS_DOWNGRADEABLE_START(c) && s < send &&
-                (c = *s++) && UTF8_IS_CONTINUATION(c))
-               count++;
-           else
+        if (! UTF8_IS_INVARIANT(*s)) {
+            if (! UTF8_IS_NEXT_CHAR_DOWNGRADEABLE(s, send)) {

                 return (U8 *)start;
                 return (U8 *)start;

+            }
+            count++;
+            s++;

        }
        }

+        s++;

     }
 
     *is_utf8 = FALSE;
     }
 
     *is_utf8 = FALSE;


@@ -1337,9 +1303,10 @@ Perl_bytes_from_utf8(pTHX_ const U8 *s, STRLEN *len, bool *is_utf8)
     s = start; start = d;
     while (s < send) {
        U8 c = *s++;
     s = start; start = d;
     while (s < send) {
        U8 c = *s++;

-       if (!UTF8_IS_INVARIANT(c)) {
+       if (! UTF8_IS_INVARIANT(c)) {

            /* Then it is two-byte encoded */
            /* Then it is two-byte encoded */

-           c = UNI_TO_NATIVE(TWO_BYTE_UTF8_TO_UNI(c, *s++));
+           c = EIGHT_BIT_UTF8_TO_NATIVE(c, *s);
+            s++;

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


@@ -1356,7 +1323,7 @@ UTF-8.
 Returns a pointer to the newly-created string, and sets C<len> to
 reflect the new length in bytes.
 
 Returns a pointer to the newly-created string, and sets C<len> to
 reflect the new length in bytes.
 

-A NUL character will be written after the end of the string.
+A C<NUL> character will be written after the end of the string.

 
 If you want to convert to UTF-8 from encodings other than
 the native (Latin1 or EBCDIC),
 
 If you want to convert to UTF-8 from encodings other than
 the native (Latin1 or EBCDIC),


@@ -1382,13 +1349,8 @@ Perl_bytes_to_utf8(pTHX_ const U8 *s, STRLEN *len)
     dst = d;
 
     while (s < send) {
     dst = d;
 
     while (s < send) {

-        const UV uv = NATIVE_TO_ASCII(*s++);
-        if (UNI_IS_INVARIANT(uv))
-            *d++ = (U8)UTF_TO_NATIVE(uv);
-        else {
-            *d++ = (U8)UTF8_EIGHT_BIT_HI(uv);
-            *d++ = (U8)UTF8_EIGHT_BIT_LO(uv);
-        }
+        append_utf8_from_native_byte(*s, &d);
+        s++;

     }
     *d = '\0';
     *len = d-dst;
     }
     *d = '\0';
     *len = d-dst;


@@ -1417,32 +1379,43 @@ 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 (uv < 0x80) {
-#ifdef EBCDIC
-           *d++ = UNI_TO_NATIVE(uv);
-#else
-           *d++ = (U8)uv;
-#endif
+       if (OFFUNI_IS_INVARIANT(uv)) {
+           *d++ = LATIN1_TO_NATIVE((U8) uv);

            continue;
        }
            continue;
        }

-       if (uv < 0x800) {
-           *d++ = (U8)(( uv >>  6)         | 0xc0);
-           *d++ = (U8)(( uv        & 0x3f) | 0x80);
+       if (uv <= MAX_UTF8_TWO_BYTE) {
+           *d++ = UTF8_TWO_BYTE_HI(UNI_TO_NATIVE(uv));
+           *d++ = UTF8_TWO_BYTE_LO(UNI_TO_NATIVE(uv));

            continue;
        }
            continue;
        }

-       if (uv >= 0xd800 && uv <= 0xdbff) {     /* surrogates */
-           if (p >= pend) {
-               Perl_croak(aTHX_ "Malformed UTF-16 surrogate");
-           } else {
+#define FIRST_HIGH_SURROGATE UNICODE_SURROGATE_FIRST
+#define LAST_HIGH_SURROGATE  0xDBFF
+#define FIRST_LOW_SURROGATE  0xDC00
+#define LAST_LOW_SURROGATE   UNICODE_SURROGATE_LAST
+
+        /* 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 < 0xdc00 || low > 0xdfff)
+               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");

-               uv = ((uv - 0xd800) << 10) + (low - 0xdc00) + 0x10000;
+                }
+               p += 2;
+               uv = ((uv - FIRST_HIGH_SURROGATE) << 10)
+                                       + (low - FIRST_LOW_SURROGATE) + 0x10000;

            }
            }

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

        }
        }

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

        if (uv < 0x10000) {
            *d++ = (U8)(( uv >> 12)         | 0xe0);
            *d++ = (U8)(((uv >>  6) & 0x3f) | 0x80);
        if (uv < 0x10000) {
            *d++ = (U8)(( uv >> 12)         | 0xe0);
            *d++ = (U8)(((uv >>  6) & 0x3f) | 0x80);


@@ -1456,6 +1429,7 @@ Perl_utf16_to_utf8(pTHX_ U8* p, U8* d, I32 bytelen, I32 *newlen)
            *d++ = (U8)(( uv        & 0x3f) | 0x80);
            continue;
        }
            *d++ = (U8)(( uv        & 0x3f) | 0x80);
            continue;
        }

+#endif

     }
     *newlen = d - dstart;
     return d;
     }
     *newlen = d - dstart;
     return d;


@@ -1492,44 +1466,17 @@ Perl__is_uni_FOO(pTHX_ const U8 classnum, const UV c)
     return _is_utf8_FOO(classnum, tmpbuf);
 }
 
     return _is_utf8_FOO(classnum, tmpbuf);
 }
 

-/* for now these are all defined (inefficiently) in terms of the utf8 versions.
- * Note that the macros in handy.h that call these short-circuit calling them
- * for Latin-1 range inputs */
-
-bool
-Perl_is_uni_alnum(pTHX_ UV c)
-{
-    U8 tmpbuf[UTF8_MAXBYTES+1];
-    uvchr_to_utf8(tmpbuf, c);
-    return _is_utf8_FOO(_CC_WORDCHAR, tmpbuf);
-}
+/* Internal function so we can deprecate the external one, and call
+   this one from other deprecated functions in this file */

 
 bool
 
 bool

-Perl_is_uni_alnumc(pTHX_ UV c)
-{
-    U8 tmpbuf[UTF8_MAXBYTES+1];
-    uvchr_to_utf8(tmpbuf, c);
-    return _is_utf8_FOO(_CC_ALPHANUMERIC, tmpbuf);
-}
-
-bool    /* Internal function so we can deprecate the external one, and call
-           this one from other deprecated functions in this file */
-S_is_utf8_idfirst(pTHX_ const U8 *p)
+Perl__is_utf8_idstart(pTHX_ const U8 *p)

 {
 {

-    dVAR;
+    PERL_ARGS_ASSERT__IS_UTF8_IDSTART;

 
     if (*p == '_')
        return TRUE;
 
     if (*p == '_')
        return TRUE;

-    /* is_utf8_idstart would be more logical. */
-    return is_utf8_common(p, &PL_utf8_idstart, "IdStart");
-}
-
-bool
-Perl_is_uni_idfirst(pTHX_ UV c)
-{
-    U8 tmpbuf[UTF8_MAXBYTES+1];
-    uvchr_to_utf8(tmpbuf, c);
-    return S_is_utf8_idfirst(aTHX_ tmpbuf);
+    return is_utf8_common(p, &PL_utf8_idstart, "IdStart", NULL);

 }
 
 bool
 }
 
 bool


@@ -1548,97 +1495,11 @@ Perl__is_uni_perl_idstart(pTHX_ UV c)
     return _is_utf8_perl_idstart(tmpbuf);
 }
 
     return _is_utf8_perl_idstart(tmpbuf);
 }
 

-bool
-Perl_is_uni_alpha(pTHX_ UV c)
-{
-    U8 tmpbuf[UTF8_MAXBYTES+1];
-    uvchr_to_utf8(tmpbuf, c);
-    return _is_utf8_FOO(_CC_ALPHA, tmpbuf);
-}
-
-bool
-Perl_is_uni_ascii(pTHX_ UV c)
-{
-    return isASCII(c);
-}
-
-bool
-Perl_is_uni_blank(pTHX_ UV c)
-{
-    return isBLANK_uni(c);
-}
-
-bool
-Perl_is_uni_space(pTHX_ UV c)
-{
-    return isSPACE_uni(c);
-}
-
-bool
-Perl_is_uni_digit(pTHX_ UV c)
-{
-    U8 tmpbuf[UTF8_MAXBYTES+1];
-    uvchr_to_utf8(tmpbuf, c);
-    return _is_utf8_FOO(_CC_DIGIT, tmpbuf);
-}
-
-bool
-Perl_is_uni_upper(pTHX_ UV c)
-{
-    U8 tmpbuf[UTF8_MAXBYTES+1];
-    uvchr_to_utf8(tmpbuf, c);
-    return _is_utf8_FOO(_CC_UPPER, tmpbuf);
-}
-
-bool
-Perl_is_uni_lower(pTHX_ UV c)
-{
-    U8 tmpbuf[UTF8_MAXBYTES+1];
-    uvchr_to_utf8(tmpbuf, c);
-    return _is_utf8_FOO(_CC_LOWER, tmpbuf);
-}
-
-bool
-Perl_is_uni_cntrl(pTHX_ UV c)
-{
-    return isCNTRL_L1(c);
-}
-
-bool
-Perl_is_uni_graph(pTHX_ UV c)
-{
-    U8 tmpbuf[UTF8_MAXBYTES+1];
-    uvchr_to_utf8(tmpbuf, c);
-    return _is_utf8_FOO(_CC_GRAPH, tmpbuf);
-}
-
-bool
-Perl_is_uni_print(pTHX_ UV c)
-{
-    U8 tmpbuf[UTF8_MAXBYTES+1];
-    uvchr_to_utf8(tmpbuf, c);
-    return _is_utf8_FOO(_CC_PRINT, tmpbuf);
-}
-
-bool
-Perl_is_uni_punct(pTHX_ UV c)
-{
-    U8 tmpbuf[UTF8_MAXBYTES+1];
-    uvchr_to_utf8(tmpbuf, c);
-    return _is_utf8_FOO(_CC_PUNCT, tmpbuf);
-}
-
-bool
-Perl_is_uni_xdigit(pTHX_ UV c)
-{
-    return isXDIGIT_uni(c);
-}
-

 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
 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

-     * 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 */


@@ -1649,8 +1510,8 @@ Perl__to_upper_title_latin1(pTHX_ const U8 c, U8* p, STRLEN *lenp, const char S_
 
     assert(S_or_s == 'S' || S_or_s == 's');
 
 
     assert(S_or_s == 'S' || S_or_s == 's');
 

-    if (UNI_IS_INVARIANT(converted)) { /* No difference between the two for
-                                         characters in this range */
+    if (UVCHR_IS_INVARIANT(converted)) { /* No difference between the two for
+                                            characters in this range */

        *p = (U8) converted;
        *lenp = 1;
        return converted;
        *p = (U8) converted;
        *lenp = 1;
        return converted;


@@ -1667,14 +1528,18 @@ 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);
            default:
                Perl_croak(aTHX_ "panic: to_upper_title_latin1 did not expect '%c' to map to '%c'", c, LATIN_SMALL_LETTER_Y_WITH_DIAERESIS);

-               assert(0); /* NOTREACHED */
+               NOT_REACHED; /* NOTREACHED */

        }
     }
 
        }
     }
 


@@ -1693,20 +1558,18 @@ 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", "utf8::ToSpecUc")
-#define CALL_TITLE_CASE(INP, OUTP, LENP) Perl_to_utf8_case(aTHX_ INP, OUTP, LENP, &PL_utf8_totitle, "ToTc", "utf8::ToSpecTc")
-#define CALL_LOWER_CASE(INP, OUTP, LENP) Perl_to_utf8_case(aTHX_ INP, OUTP, LENP, &PL_utf8_tolower, "ToLc", "utf8::ToSpecLc")
+#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) ? "utf8::ToSpecCf" : 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)
 {

-    dVAR;
-

     /* Convert the Unicode character whose ordinal is <c> to its uppercase
      * version and store that in UTF-8 in <p> and its length in bytes in <lenp>.
      * Note that the <p> needs to be at least UTF8_MAXBYTES_CASE+1 bytes since
     /* Convert the Unicode character whose ordinal is <c> to its uppercase
      * version and store that in UTF-8 in <p> and its length in bytes in <lenp>.
      * Note that the <p> needs to be at least UTF8_MAXBYTES_CASE+1 bytes since


@@ -1722,14 +1585,12 @@ 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
 Perl_to_uni_title(pTHX_ UV c, U8* p, STRLEN *lenp)
 {
 }
 
 UV
 Perl_to_uni_title(pTHX_ UV c, U8* p, STRLEN *lenp)
 {

-    dVAR;
-

     PERL_ARGS_ASSERT_TO_UNI_TITLE;
 
     if (c < 256) {
     PERL_ARGS_ASSERT_TO_UNI_TITLE;
 
     if (c < 256) {


@@ -1737,26 +1598,28 @@ 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
 }
 
 STATIC U8

-S_to_lower_latin1(pTHX_ const U8 c, U8* p, STRLEN *lenp)
+S_to_lower_latin1(const U8 c, U8* p, STRLEN *lenp)

 {
     /* We have the latin1-range values compiled into the core, so just use
 {
     /* 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);
 
     if (p != NULL) {
      * one character, we allow <p> to be NULL */
 
     U8 converted = toLOWER_LATIN1(c);
 
     if (p != NULL) {

-       if (UNI_IS_INVARIANT(converted)) {
+       if (NATIVE_BYTE_IS_INVARIANT(converted)) {

            *p = converted;
            *lenp = 1;
        }
        else {
            *p = converted;
            *lenp = 1;
        }
        else {

-           *p = UTF8_TWO_BYTE_HI(converted);
-           *(p+1) = UTF8_TWO_BYTE_LO(converted);
+            /* Result is known to always be < 256, so can use the EIGHT_BIT
+             * macros */
+           *p = UTF8_EIGHT_BIT_HI(converted);
+           *(p+1) = UTF8_EIGHT_BIT_LO(converted);

            *lenp = 2;
        }
     }
            *lenp = 2;
        }
     }


@@ -1766,8 +1629,6 @@ S_to_lower_latin1(pTHX_ const U8 c, U8* p, STRLEN *lenp)
 UV
 Perl_to_uni_lower(pTHX_ UV c, U8* p, STRLEN *lenp)
 {
 UV
 Perl_to_uni_lower(pTHX_ UV c, U8* p, STRLEN *lenp)
 {

-    dVAR;
-

     PERL_ARGS_ASSERT_TO_UNI_LOWER;
 
     if (c < 256) {
     PERL_ARGS_ASSERT_TO_UNI_LOWER;
 
     if (c < 256) {


@@ -1775,34 +1636,58 @@ 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

-Perl__to_fold_latin1(pTHX_ const U8 c, U8* p, STRLEN *lenp, const bool flags)
+Perl__to_fold_latin1(pTHX_ const U8 c, U8* p, STRLEN *lenp, const unsigned int flags)

 {
 {

-    /* Corresponds to to_lower_latin1(), <flags> is TRUE if to use full case
-     * folding */
+    /* Corresponds to to_lower_latin1(); <flags> bits meanings:
+     *     FOLD_FLAGS_NOMIX_ASCII iff non-ASCII to ASCII folds are prohibited
+     *     FOLD_FLAGS_FULL  iff full folding is to be used;
+     *
+     * Not to be used for locale folds
+     */

 
     UV converted;
 
     PERL_ARGS_ASSERT__TO_FOLD_LATIN1;
 
     UV converted;
 
     PERL_ARGS_ASSERT__TO_FOLD_LATIN1;

+    PERL_UNUSED_CONTEXT;
+
+    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 && c == LATIN_SMALL_LETTER_SHARP_S) {
-       *(p)++ = 's';
-       *p = 's';
-       *lenp = 2;
-       return '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 (flags & FOLD_FLAGS_NOMIX_ASCII) {
+            *lenp = 2 * sizeof(LATIN_SMALL_LETTER_LONG_S_UTF8) - 2;
+            Copy(LATIN_SMALL_LETTER_LONG_S_UTF8 LATIN_SMALL_LETTER_LONG_S_UTF8,
+                 p, *lenp, U8);
+            return LATIN_SMALL_LETTER_LONG_S;
+        }
+        else {
+            *(p)++ = 's';
+            *p = 's';
+            *lenp = 2;
+            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);
     }
 

-    if (UNI_IS_INVARIANT(converted)) {
+    if (UVCHR_IS_INVARIANT(converted)) {

        *p = (U8) converted;
        *lenp = 1;
     }
        *p = (U8) converted;
        *lenp = 1;
     }


@@ -1816,228 +1701,67 @@ Perl__to_fold_latin1(pTHX_ const U8 c, U8* p, STRLEN *lenp, const bool flags)
 }
 
 UV
 }
 
 UV

-Perl__to_uni_fold_flags(pTHX_ UV c, U8* p, STRLEN *lenp, const U8 flags)
+Perl__to_uni_fold_flags(pTHX_ UV c, U8* p, STRLEN *lenp, U8 flags)

 {
 
     /* Not currently externally documented, and subject to change
      *  <flags> bits meanings:
      *     FOLD_FLAGS_FULL  iff full folding is to be used;
 {
 
     /* Not currently externally documented, and subject to change
      *  <flags> bits meanings:
      *     FOLD_FLAGS_FULL  iff full folding is to be used;

-     *     FOLD_FLAGS_LOCALE iff in locale
+     *     FOLD_FLAGS_LOCALE is set iff the rules from the current underlying
+     *                       locale are to be used.

      *     FOLD_FLAGS_NOMIX_ASCII iff non-ASCII to ASCII folds are prohibited
      */
 
     PERL_ARGS_ASSERT__TO_UNI_FOLD_FLAGS;
 
      *     FOLD_FLAGS_NOMIX_ASCII iff non-ASCII to ASCII folds are prohibited
      */
 
     PERL_ARGS_ASSERT__TO_UNI_FOLD_FLAGS;
 

+    if (flags & FOLD_FLAGS_LOCALE) {
+        /* Treat a UTF-8 locale as not being in locale at all */
+        if (IN_UTF8_CTYPE_LOCALE) {
+            flags &= ~FOLD_FLAGS_LOCALE;
+        }
+        else {
+            _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
+            goto needs_full_generality;
+        }
+    }
+

     if (c < 256) {
     if (c < 256) {

-       UV result = _to_fold_latin1((U8) c, p, lenp,
-                              cBOOL(((flags & FOLD_FLAGS_FULL)
-                                  /* If ASCII-safe, don't allow full folding,
-                                   * as that could include SHARP S => ss;
-                                   * otherwise there is no crossing of
-                                   * ascii/non-ascii in the latin1 range */
-                                  && ! (flags & FOLD_FLAGS_NOMIX_ASCII))));
-       /* It is illegal for the fold to cross the 255/256 boundary under
-        * locale; in this case return the original */
-       return (result > 256 && flags & FOLD_FLAGS_LOCALE)
-              ? c
-              : result;
-    }
-
-    /* If no special needs, just use the macro */
+        return _to_fold_latin1((U8) c, p, lenp,
+                           flags & (FOLD_FLAGS_FULL | FOLD_FLAGS_NOMIX_ASCII));
+    }
+
+    /* 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);
     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. */
        U8 utf8_c[UTF8_MAXBYTES + 1];
     }
     else {  /* Otherwise, _to_utf8_fold_flags has the intelligence to deal with
               the special flags. */
        U8 utf8_c[UTF8_MAXBYTES + 1];

-       uvchr_to_utf8(utf8_c, c);
-       return _to_utf8_fold_flags(utf8_c, p, lenp, flags, NULL);
-    }
-}
-
-bool
-Perl_is_uni_alnum_lc(pTHX_ UV c)
-{
-    if (c < 256) {
-        return isALNUM_LC(UNI_TO_NATIVE(c));
-    }
-    return _is_uni_FOO(_CC_WORDCHAR, c);
-}
-
-bool
-Perl_is_uni_alnumc_lc(pTHX_ UV c)
-{
-    if (c < 256) {
-        return isALPHANUMERIC_LC(UNI_TO_NATIVE(c));
-    }
-    return _is_uni_FOO(_CC_ALPHANUMERIC, c);
-}
-
-bool
-Perl_is_uni_idfirst_lc(pTHX_ UV c)
-{
-    if (c < 256) {
-        return isIDFIRST_LC(UNI_TO_NATIVE(c));
-    }
-    return _is_uni_perl_idstart(c);
-}
-
-bool
-Perl_is_uni_alpha_lc(pTHX_ UV c)
-{
-    if (c < 256) {
-        return isALPHA_LC(UNI_TO_NATIVE(c));
-    }
-    return _is_uni_FOO(_CC_ALPHA, c);
-}
-
-bool
-Perl_is_uni_ascii_lc(pTHX_ UV c)
-{
-    if (c < 256) {
-        return isASCII_LC(UNI_TO_NATIVE(c));
-    }
-    return 0;
-}
-
-bool
-Perl_is_uni_blank_lc(pTHX_ UV c)
-{
-    if (c < 256) {
-        return isBLANK_LC(UNI_TO_NATIVE(c));
-    }
-    return isBLANK_uni(c);
-}
-
-bool
-Perl_is_uni_space_lc(pTHX_ UV c)
-{
-    if (c < 256) {
-        return isSPACE_LC(UNI_TO_NATIVE(c));
-    }
-    return isSPACE_uni(c);
-}
-
-bool
-Perl_is_uni_digit_lc(pTHX_ UV c)
-{
-    if (c < 256) {
-        return isDIGIT_LC(UNI_TO_NATIVE(c));
-    }
-    return _is_uni_FOO(_CC_DIGIT, c);
-}
-
-bool
-Perl_is_uni_upper_lc(pTHX_ UV c)
-{
-    if (c < 256) {
-        return isUPPER_LC(UNI_TO_NATIVE(c));
-    }
-    return _is_uni_FOO(_CC_UPPER, c);
-}
-
-bool
-Perl_is_uni_lower_lc(pTHX_ UV c)
-{
-    if (c < 256) {
-        return isLOWER_LC(UNI_TO_NATIVE(c));
-    }
-    return _is_uni_FOO(_CC_LOWER, c);
-}
-
-bool
-Perl_is_uni_cntrl_lc(pTHX_ UV c)
-{
-    if (c < 256) {
-        return isCNTRL_LC(UNI_TO_NATIVE(c));
-    }
-    return 0;
-}
-
-bool
-Perl_is_uni_graph_lc(pTHX_ UV c)
-{
-    if (c < 256) {
-        return isGRAPH_LC(UNI_TO_NATIVE(c));
-    }
-    return _is_uni_FOO(_CC_GRAPH, c);
-}
-
-bool
-Perl_is_uni_print_lc(pTHX_ UV c)
-{
-    if (c < 256) {
-        return isPRINT_LC(UNI_TO_NATIVE(c));
-    }
-    return _is_uni_FOO(_CC_PRINT, c);
-}
-
-bool
-Perl_is_uni_punct_lc(pTHX_ UV c)
-{
-    if (c < 256) {
-        return isPUNCT_LC(UNI_TO_NATIVE(c));
-    }
-    return _is_uni_FOO(_CC_PUNCT, c);
-}

 
 

-bool
-Perl_is_uni_xdigit_lc(pTHX_ UV c)
-{
-    if (c < 256) {
-       return isXDIGIT_LC(UNI_TO_NATIVE(c));
+      needs_full_generality:
+       uvchr_to_utf8(utf8_c, c);
+       return _to_utf8_fold_flags(utf8_c, p, lenp, flags);

     }
     }

-    return isXDIGIT_uni(c);
-}
-
-U32
-Perl_to_uni_upper_lc(pTHX_ U32 c)
-{
-    /* XXX returns only the first character -- do not use XXX */
-    /* XXX no locale support yet */
-    STRLEN len;
-    U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
-    return (U32)to_uni_upper(c, tmpbuf, &len);
-}
-
-U32
-Perl_to_uni_title_lc(pTHX_ U32 c)
-{
-    /* XXX returns only the first character XXX -- do not use XXX */
-    /* XXX no locale support yet */
-    STRLEN len;
-    U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
-    return (U32)to_uni_title(c, tmpbuf, &len);
-}
-
-U32
-Perl_to_uni_lower_lc(pTHX_ U32 c)
-{
-    /* XXX returns only the first character -- do not use XXX */
-    /* XXX no locale support yet */
-    STRLEN len;
-    U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
-    return (U32)to_uni_lower(c, tmpbuf, &len);

 }
 
 PERL_STATIC_INLINE bool
 S_is_utf8_common(pTHX_ const U8 *const p, SV **swash,
 }
 
 PERL_STATIC_INLINE bool
 S_is_utf8_common(pTHX_ const U8 *const p, SV **swash,

-                const char *const swashname)
+                const char *const swashname, SV* const invlist)

 {
     /* returns a boolean giving whether or not the UTF8-encoded character that
      * starts at <p> is in the swash indicated by <swashname>.  <swash>
      * contains a pointer to where the swash indicated by <swashname>
      * is to be stored; which this routine will do, so that future calls will
 {
     /* returns a boolean giving whether or not the UTF8-encoded character that
      * starts at <p> is in the swash indicated by <swashname>.  <swash>
      * contains a pointer to where the swash indicated by <swashname>
      * is to be stored; which this routine will do, so that future calls will

-     * look at <*swash> and only generate a swash if it is not null
+     * look at <*swash> and only generate a swash if it is not null.  <invlist>
+     * is NULL or an inversion list that defines the swash.  If not null, it
+     * saves time during initialization of the swash.

      *
      * Note that it is assumed that the buffer length of <p> is enough to
      * contain all the bytes that comprise the character.  Thus, <*p> should
      * have been checked before this call for mal-formedness enough to assure
      * that. */
 
      *
      * Note that it is assumed that the buffer length of <p> is enough to
      * contain all the bytes that comprise the character.  Thus, <*p> should
      * have been checked before this call for mal-formedness enough to assure
      * that. */
 

-    dVAR;
-

     PERL_ARGS_ASSERT_IS_UTF8_COMMON;
 
     /* The API should have included a length for the UTF-8 character in <p>,
     PERL_ARGS_ASSERT_IS_UTF8_COMMON;
 
     /* The API should have included a length for the UTF-8 character in <p>,


@@ -2045,7 +1769,7 @@ S_is_utf8_common(pTHX_ const U8 *const p, SV **swash,
      * as far as there being enough bytes available in it to accommodate the
      * character without reading beyond the end, and pass that number on to the
      * validating routine */
      * as far as there being enough bytes available in it to accommodate the
      * character without reading beyond the end, and pass that number on to the
      * validating routine */

-    if (! is_utf8_char_buf(p, p + UTF8SKIP(p))) {
+    if (! isUTF8_CHAR(p, p + UTF8SKIP(p))) {

         if (ckWARN_d(WARN_UTF8)) {
             Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED,WARN_UTF8),
                    "Passing malformed UTF-8 to \"%s\" is deprecated", swashname);
         if (ckWARN_d(WARN_UTF8)) {
             Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED,WARN_UTF8),
                    "Passing malformed UTF-8 to \"%s\" is deprecated", swashname);


@@ -2058,7 +1782,13 @@ S_is_utf8_common(pTHX_ const U8 *const p, SV **swash,
     }
     if (!*swash) {
         U8 flags = _CORE_SWASH_INIT_ACCEPT_INVLIST;
     }
     if (!*swash) {
         U8 flags = _CORE_SWASH_INIT_ACCEPT_INVLIST;

-        *swash = _core_swash_init("utf8", swashname, &PL_sv_undef, 1, 0, NULL, &flags);
+        *swash = _core_swash_init("utf8",
+
+                                  /* Only use the name if there is no inversion
+                                   * list; otherwise will go out to disk */
+                                  (invlist) ? "" : swashname,
+
+                                  &PL_sv_undef, 1, 0, invlist, &flags);

     }
 
     return swash_fetch(*swash, p, TRUE) != 0;
     }
 
     return swash_fetch(*swash, p, TRUE) != 0;


@@ -2067,304 +1797,108 @@ S_is_utf8_common(pTHX_ const U8 *const p, SV **swash,
 bool
 Perl__is_utf8_FOO(pTHX_ const U8 classnum, const U8 *p)
 {
 bool
 Perl__is_utf8_FOO(pTHX_ const U8 classnum, const U8 *p)
 {

-    dVAR;
-

     PERL_ARGS_ASSERT__IS_UTF8_FOO;
 
     assert(classnum < _FIRST_NON_SWASH_CC);
 
     PERL_ARGS_ASSERT__IS_UTF8_FOO;
 
     assert(classnum < _FIRST_NON_SWASH_CC);
 

-    return is_utf8_common(p, &PL_utf8_swash_ptrs[classnum], swash_property_names[classnum]);
+    return is_utf8_common(p,
+                          &PL_utf8_swash_ptrs[classnum],
+                          swash_property_names[classnum],
+                          PL_XPosix_ptrs[classnum]);

 }
 
 bool
 }
 
 bool

-Perl_is_utf8_alnum(pTHX_ const U8 *p)
-{
-    dVAR;
-
-    PERL_ARGS_ASSERT_IS_UTF8_ALNUM;
-
-    /* NOTE: "IsWord", not "IsAlnum", since Alnum is a true
-     * descendant of isalnum(3), in other words, it doesn't
-     * contain the '_'. --jhi */
-    return is_utf8_common(p, &PL_utf8_swash_ptrs[_CC_WORDCHAR], "IsWord");
-}
-
-bool
-Perl_is_utf8_alnumc(pTHX_ const U8 *p)
-{
-    dVAR;
-
-    PERL_ARGS_ASSERT_IS_UTF8_ALNUMC;
-
-    return is_utf8_common(p, &PL_utf8_swash_ptrs[_CC_ALPHANUMERIC], "IsAlnum");
-}
-
-bool
-Perl_is_utf8_idfirst(pTHX_ const U8 *p) /* The naming is historical. */
+Perl__is_utf8_perl_idstart(pTHX_ const U8 *p)

 {
 {

-    dVAR;
+    SV* invlist = NULL;

 
 

-    PERL_ARGS_ASSERT_IS_UTF8_IDFIRST;
+    PERL_ARGS_ASSERT__IS_UTF8_PERL_IDSTART;

 
 

-    return S_is_utf8_idfirst(aTHX_ p);
+    if (! PL_utf8_perl_idstart) {
+        invlist = _new_invlist_C_array(_Perl_IDStart_invlist);
+    }
+    return is_utf8_common(p, &PL_utf8_perl_idstart, "_Perl_IDStart", invlist);

 }
 
 bool
 }
 
 bool

-Perl_is_utf8_xidfirst(pTHX_ const U8 *p) /* The naming is historical. */
+Perl__is_utf8_xidstart(pTHX_ const U8 *p)

 {
 {

-    dVAR;
-
-    PERL_ARGS_ASSERT_IS_UTF8_XIDFIRST;
+    PERL_ARGS_ASSERT__IS_UTF8_XIDSTART;

 
     if (*p == '_')
        return TRUE;
 
     if (*p == '_')
        return TRUE;

-    /* is_utf8_idstart would be more logical. */
-    return is_utf8_common(p, &PL_utf8_xidstart, "XIdStart");
-}
-
-bool
-Perl__is_utf8_perl_idstart(pTHX_ const U8 *p)
-{
-    dVAR;
-
-    PERL_ARGS_ASSERT__IS_UTF8_PERL_IDSTART;
-
-    return is_utf8_common(p, &PL_utf8_perl_idstart, "_Perl_IDStart");
+    return is_utf8_common(p, &PL_utf8_xidstart, "XIdStart", NULL);

 }
 
 bool
 Perl__is_utf8_perl_idcont(pTHX_ const U8 *p)
 {
 }
 
 bool
 Perl__is_utf8_perl_idcont(pTHX_ const U8 *p)
 {

-    dVAR;
+    SV* invlist = NULL;

 
     PERL_ARGS_ASSERT__IS_UTF8_PERL_IDCONT;
 
 
     PERL_ARGS_ASSERT__IS_UTF8_PERL_IDCONT;
 

-    return is_utf8_common(p, &PL_utf8_perl_idcont, "_Perl_IDCont");
-}
-
-
-bool
-Perl_is_utf8_idcont(pTHX_ const U8 *p)
-{
-    dVAR;
-
-    PERL_ARGS_ASSERT_IS_UTF8_IDCONT;
-
-    return is_utf8_common(p, &PL_utf8_idcont, "IdContinue");
-}
-
-bool
-Perl_is_utf8_xidcont(pTHX_ const U8 *p)
-{
-    dVAR;
-
-    PERL_ARGS_ASSERT_IS_UTF8_XIDCONT;
-
-    return is_utf8_common(p, &PL_utf8_idcont, "XIdContinue");
-}
-
-bool
-Perl_is_utf8_alpha(pTHX_ const U8 *p)
-{
-    dVAR;
-
-    PERL_ARGS_ASSERT_IS_UTF8_ALPHA;
-
-    return is_utf8_common(p, &PL_utf8_swash_ptrs[_CC_ALPHA], "IsAlpha");
-}
-
-bool
-Perl_is_utf8_ascii(pTHX_ const U8 *p)
-{
-    dVAR;
-
-    PERL_ARGS_ASSERT_IS_UTF8_ASCII;
-
-    /* ASCII characters are the same whether in utf8 or not.  So the macro
-     * works on both utf8 and non-utf8 representations. */
-    return isASCII(*p);
-}
-
-bool
-Perl_is_utf8_blank(pTHX_ const U8 *p)
-{
-    dVAR;
-
-    PERL_ARGS_ASSERT_IS_UTF8_BLANK;
-
-    return isBLANK_utf8(p);
-}
-
-bool
-Perl_is_utf8_space(pTHX_ const U8 *p)
-{
-    dVAR;
-
-    PERL_ARGS_ASSERT_IS_UTF8_SPACE;
-
-    return isSPACE_utf8(p);
-}
-
-bool
-Perl_is_utf8_perl_space(pTHX_ const U8 *p)
-{
-    dVAR;
-
-    PERL_ARGS_ASSERT_IS_UTF8_PERL_SPACE;
-
-    /* Only true if is an ASCII space-like character, and ASCII is invariant
-     * under utf8, so can just use the macro */
-    return isSPACE_A(*p);
-}
-
-bool
-Perl_is_utf8_perl_word(pTHX_ const U8 *p)
-{
-    dVAR;
-
-    PERL_ARGS_ASSERT_IS_UTF8_PERL_WORD;
-
-    /* Only true if is an ASCII word character, and ASCII is invariant
-     * under utf8, so can just use the macro */
-    return isWORDCHAR_A(*p);
-}
-
-bool
-Perl_is_utf8_digit(pTHX_ const U8 *p)
-{
-    dVAR;
-
-    PERL_ARGS_ASSERT_IS_UTF8_DIGIT;
-
-    return is_utf8_common(p, &PL_utf8_swash_ptrs[_CC_DIGIT], "IsDigit");
-}
-
-bool
-Perl_is_utf8_posix_digit(pTHX_ const U8 *p)
-{
-    dVAR;
-
-    PERL_ARGS_ASSERT_IS_UTF8_POSIX_DIGIT;
-
-    /* Only true if is an ASCII digit character, and ASCII is invariant
-     * under utf8, so can just use the macro */
-    return isDIGIT_A(*p);
-}
-
-bool
-Perl_is_utf8_upper(pTHX_ const U8 *p)
-{
-    dVAR;
-
-    PERL_ARGS_ASSERT_IS_UTF8_UPPER;
-
-    return is_utf8_common(p, &PL_utf8_swash_ptrs[_CC_UPPER], "IsUppercase");
-}
-
-bool
-Perl_is_utf8_lower(pTHX_ const U8 *p)
-{
-    dVAR;
-
-    PERL_ARGS_ASSERT_IS_UTF8_LOWER;
-
-    return is_utf8_common(p, &PL_utf8_swash_ptrs[_CC_LOWER], "IsLowercase");
-}
-
-bool
-Perl_is_utf8_cntrl(pTHX_ const U8 *p)
-{
-    dVAR;
-
-    PERL_ARGS_ASSERT_IS_UTF8_CNTRL;
-
-    return isCNTRL_utf8(p);
-}
-
-bool
-Perl_is_utf8_graph(pTHX_ const U8 *p)
-{
-    dVAR;
-
-    PERL_ARGS_ASSERT_IS_UTF8_GRAPH;
-
-    return is_utf8_common(p, &PL_utf8_swash_ptrs[_CC_GRAPH], "IsGraph");
-}
-
-bool
-Perl_is_utf8_print(pTHX_ const U8 *p)
-{
-    dVAR;
-
-    PERL_ARGS_ASSERT_IS_UTF8_PRINT;
-
-    return is_utf8_common(p, &PL_utf8_swash_ptrs[_CC_PRINT], "IsPrint");
+    if (! PL_utf8_perl_idcont) {
+        invlist = _new_invlist_C_array(_Perl_IDCont_invlist);
+    }
+    return is_utf8_common(p, &PL_utf8_perl_idcont, "_Perl_IDCont", invlist);

 }
 
 bool
 }
 
 bool

-Perl_is_utf8_punct(pTHX_ const U8 *p)
+Perl__is_utf8_idcont(pTHX_ const U8 *p)

 {
 {

-    dVAR;
-
-    PERL_ARGS_ASSERT_IS_UTF8_PUNCT;
+    PERL_ARGS_ASSERT__IS_UTF8_IDCONT;

 
 

-    return is_utf8_common(p, &PL_utf8_swash_ptrs[_CC_PUNCT], "IsPunct");
+    return is_utf8_common(p, &PL_utf8_idcont, "IdContinue", NULL);

 }
 
 bool
 }
 
 bool

-Perl_is_utf8_xdigit(pTHX_ const U8 *p)
+Perl__is_utf8_xidcont(pTHX_ const U8 *p)

 {
 {

-    dVAR;
-
-    PERL_ARGS_ASSERT_IS_UTF8_XDIGIT;
+    PERL_ARGS_ASSERT__IS_UTF8_XIDCONT;

 
 

-    return is_XDIGIT_utf8(p);
+    return is_utf8_common(p, &PL_utf8_idcont, "XIdContinue", NULL);

 }
 
 bool
 Perl__is_utf8_mark(pTHX_ const U8 *p)
 {
 }
 
 bool
 Perl__is_utf8_mark(pTHX_ const U8 *p)
 {

-    dVAR;
-

     PERL_ARGS_ASSERT__IS_UTF8_MARK;
 
     PERL_ARGS_ASSERT__IS_UTF8_MARK;
 

-    return is_utf8_common(p, &PL_utf8_mark, "IsM");
-}
-
-
-bool
-Perl_is_utf8_mark(pTHX_ const U8 *p)
-{
-    dVAR;
-
-    PERL_ARGS_ASSERT_IS_UTF8_MARK;
-
-    return _is_utf8_mark(p);
+    return is_utf8_common(p, &PL_utf8_mark, "IsM", NULL);

 }
 
 /*
 =for apidoc to_utf8_case
 
 }
 
 /*
 =for apidoc to_utf8_case
 

-The C<p> contains the pointer to the UTF-8 string encoding
+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.
 
 the character that is being converted.  This routine assumes that the character
 at C<p> is well-formed.
 

-The C<ustrp> is a pointer to the character buffer to put the
-conversion result to.  The C<lenp> is a pointer to the length
+C<ustrp> is a pointer to the character buffer to put the
+conversion result to.  C<lenp> is a pointer to the length

 of the result.
 
 of the result.
 

-The C<swashp> is a pointer to the swash to use.
+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>,
 
 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>.  The 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.
 
 but not always, a multicharacter mapping), is tried first.
 

-The C<special> is a string like "utf8::ToSpecLower", which means the
-hash %utf8::ToSpecLower.  The access to the hash is through
-Perl_to_utf8_case().
+C<special> is a string, normally C<NULL> or C<"">.  C<NULL> means to not use
+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">.

 
 

-The 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 */
 


@@ -2372,101 +1906,159 @@ 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)
 {

-    dVAR;
-    U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
+    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 uv0 = valid_utf8_to_uvchr(p, NULL);
-    /* The NATIVE_TO_UNI() and UNI_TO_NATIVE() mappings
-     * are necessary in EBCDIC, they are redundant no-ops
-     * in ASCII-ish platforms, and hopefully optimized away. */
-    const UV uv1 = NATIVE_TO_UNI(uv0);

 
 

-    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 */

     }
 
     }
 

-    uvuni_to_utf8(tmpbuf, uv1);
-

     if (!*swashp) /* load on-demand */
          *swashp = _core_swash_init("utf8", normal, &PL_sv_undef, 4, 0, NULL, NULL);
 
     if (special) {
          /* It might be "special" (sometimes, but not always,
          * a multicharacter mapping) */
     if (!*swashp) /* load on-demand */
          *swashp = _core_swash_init("utf8", normal, &PL_sv_undef, 4, 0, NULL, NULL);
 
     if (special) {
          /* It might be "special" (sometimes, but not always,
          * a multicharacter mapping) */

-        HV * const hv = get_hv(special, 0);
+         HV *hv = NULL;

         SV **svp;
 
         SV **svp;
 

-        if (hv &&
-            (svp = hv_fetch(hv, (const char*)tmpbuf, UNISKIP(uv1), FALSE)) &&
-            (*svp)) {
+        /* If passed in the specials name, use that; otherwise use any
+         * given in the swash */
+         if (*special != '\0') {
+            hv = get_hv(special, 0);
+        }
+        else {
+            svp = hv_fetchs(MUTABLE_HV(SvRV(*swashp)), "SPECIALS", 0);
+            if (svp) {
+                hv = MUTABLE_HV(SvRV(*svp));
+            }
+        }
+
+        if (hv
+             && (svp = hv_fetch(hv, (const char*)p, UVCHR_SKIP(uv1), FALSE))
+             && (*svp))
+         {

             const char *s;
 
              s = SvPV_const(*svp, len);
              if (len == 1)
             const char *s;
 
              s = SvPV_const(*svp, len);
              if (len == 1)

-                  len = uvuni_to_utf8(ustrp, NATIVE_TO_UNI(*(U8*)s)) - ustrp;
+                  /* EIGHTBIT */
+                  len = uvchr_to_utf8(ustrp, *(U8*)s) - ustrp;

              else {
              else {

-#ifdef EBCDIC
-                  /* If we have EBCDIC we need to remap the characters
-                   * since any characters in the low 256 are Unicode
-                   * code points, not EBCDIC. */
-                  U8 *t = (U8*)s, *tend = t + len, *d;
-               
-                  d = tmpbuf;
-                  if (SvUTF8(*svp)) {
-                       STRLEN tlen = 0;
-                       
-                       while (t < tend) {
-                            const UV c = utf8_to_uvchr_buf(t, tend, &tlen);
-                            if (tlen > 0) {
-                                 d = uvchr_to_utf8(d, UNI_TO_NATIVE(c));
-                                 t += tlen;
-                            }
-                            else
-                                 break;
-                       }
-                  }
-                  else {
-                       while (t < tend) {
-                            d = uvchr_to_utf8(d, UNI_TO_NATIVE(*t));
-                            t++;
-                       }
-                  }
-                  len = d - tmpbuf;
-                  Copy(tmpbuf, ustrp, len, U8);
-#else

                   Copy(s, ustrp, len, U8);
                   Copy(s, ustrp, len, U8);

-#endif

              }
         }
     }
 
     if (!len && *swashp) {
              }
         }
     }
 
     if (!len && *swashp) {

-       const UV uv2 = swash_fetch(*swashp, tmpbuf, 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). */

-             const UV uv3 = UNI_TO_NATIVE(uv2);
-             len = uvchr_to_utf8(ustrp, uv3) - ustrp;
+             len = uvchr_to_utf8(ustrp, uv2) - ustrp;

         }
     }
 
         }
     }
 


@@ -2479,6 +2071,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);


@@ -2487,17 +2080,18 @@ Perl_to_utf8_case(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp,
     if (lenp)
         *lenp = len;
 
     if (lenp)
         *lenp = len;
 

-    return uv0;
+    return uv1;

 
 }
 
 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
-     * the Latin1 range, and the operation is in 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 why;
+    /* 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
+     * why;

      *
      * p       points to the original string whose case was changed; assumed
      *          by this routine to be well-formed
      *
      * p       points to the original string whose case was changed; assumed
      *          by this routine to be well-formed


@@ -2509,7 +2103,7 @@ S_check_locale_boundary_crossing(pTHX_ const U8* const p, const UV result, U8* c
 
     PERL_ARGS_ASSERT_CHECK_LOCALE_BOUNDARY_CROSSING;
 
 
     PERL_ARGS_ASSERT_CHECK_LOCALE_BOUNDARY_CROSSING;
 

-    assert(! UTF8_IS_INVARIANT(*p) && ! UTF8_IS_DOWNGRADEABLE_START(*p));
+    assert(UTF8_IS_ABOVE_LATIN1(*p));

 
     /* We know immediately if the first character in the string crosses the
      * boundary, so can skip */
 
     /* We know immediately if the first character in the string crosses the
      * boundary, so can skip */


@@ -2520,21 +2114,29 @@ S_check_locale_boundary_crossing(pTHX_ const U8* const p, const UV result, U8* c
        U8* s = ustrp + UTF8SKIP(ustrp);
        U8* e = ustrp + *lenp;
        while (s < e) {
        U8* s = ustrp + UTF8SKIP(ustrp);
        U8* e = ustrp + *lenp;
        while (s < e) {

-           if (UTF8_IS_INVARIANT(*s) || UTF8_IS_DOWNGRADEABLE_START(*s))
-           {
+           if (! UTF8_IS_ABOVE_LATIN1(*s)) {

                goto bad_crossing;
            }
            s += UTF8SKIP(s);
        }
 
                goto bad_crossing;
            }
            s += UTF8SKIP(s);
        }
 

-       /* Here, no characters crossed, result is ok as-is */
+        /* Here, no characters crossed, result is ok as-is, but we warn. */
+        _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(p, p + UTF8SKIP(p));

        return result;
     }
 
        return result;
     }
 

-bad_crossing:
+  bad_crossing:

 
     /* Failed, have to return the original */
     original = valid_utf8_to_uvchr(p, lenp);
 
     /* Failed, have to return the original */
     original = valid_utf8_to_uvchr(p, lenp);

+
+    /* 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 %s(\"\\x{%"UVXf"}\") on non-UTF-8 locale; "
+                           "resolved to \"\\x{%"UVXf"}\".",
+                           OP_DESC(PL_op),
+                           original,
+                           original);

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


@@ -2542,32 +2144,31 @@ bad_crossing:
 /*
 =for apidoc to_utf8_upper
 
 /*
 =for apidoc to_utf8_upper
 

-Convert the UTF-8 encoded character at C<p> to its uppercase version and
-store that in UTF-8 in C<ustrp> and its length in bytes in C<lenp>.  Note
-that the ustrp needs to be at least UTF8_MAXBYTES_CASE+1 bytes since
-the uppercase version may be longer than the original character.
-
-The first character of the uppercased version is returned
-(but note, as explained above, that there may be more.)
-
-The character at C<p> is assumed by this routine to be well-formed.
+Instead use L</toUPPER_utf8>.

 
 =cut */
 
 /* Not currently externally documented, and subject to change:
 
 =cut */
 
 /* Not currently externally documented, and subject to change:

- * <flags> is set iff locale semantics are to be used for code points < 256
- * <tainted_ptr> if non-null, *tainted_ptr will be set TRUE iff locale rules
- *              were used in the calculation; otherwise unchanged. */
+ * <flags> is set iff iff the rules from the current underlying locale are to
+ *         be used. */

 
 UV
 
 UV

-Perl__to_utf8_upper_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, const bool flags, bool* tainted_ptr)
+Perl__to_utf8_upper_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, bool flags)

 {
 {

-    dVAR;
-

     UV result;
 
     PERL_ARGS_ASSERT__TO_UTF8_UPPER_FLAGS;
 
     UV result;
 
     PERL_ARGS_ASSERT__TO_UTF8_UPPER_FLAGS;
 

+    if (flags) {
+        /* Treat a UTF-8 locale as not being in locale at all */
+        if (IN_UTF8_CTYPE_LOCALE) {
+            flags = FALSE;
+        }
+        else {
+            _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
+        }
+    }
+

     if (UTF8_IS_INVARIANT(*p)) {
        if (flags) {
            result = toUPPER_LC(*p);
     if (UTF8_IS_INVARIANT(*p)) {
        if (flags) {
            result = toUPPER_LC(*p);


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

-           result = toUPPER_LC(TWO_BYTE_UTF8_TO_UNI(*p, *(p+1)));
+            U8 c = EIGHT_BIT_UTF8_TO_NATIVE(*p, *(p+1));
+           result = toUPPER_LC(c);

        }
        else {
        }
        else {

-           return _to_upper_title_latin1(TWO_BYTE_UTF8_TO_UNI(*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);


@@ -2594,54 +2196,50 @@ Perl__to_utf8_upper_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, const bool
        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;
     }
     else {
     if (UTF8_IS_INVARIANT(result)) {
        *ustrp = (U8) result;
        *lenp = 1;
     }
     else {

-       *ustrp = UTF8_EIGHT_BIT_HI(result);
-       *(ustrp + 1) = UTF8_EIGHT_BIT_LO(result);
+       *ustrp = UTF8_EIGHT_BIT_HI((U8) result);
+       *(ustrp + 1) = UTF8_EIGHT_BIT_LO((U8) result);

        *lenp = 2;
     }
 
        *lenp = 2;
     }
 

-    if (tainted_ptr) {
-       *tainted_ptr = TRUE;
-    }

     return result;
 }
 
 /*
 =for apidoc to_utf8_title
 
     return result;
 }
 
 /*
 =for apidoc to_utf8_title
 

-Convert the UTF-8 encoded character at C<p> to its titlecase version and
-store that in UTF-8 in C<ustrp> and its length in bytes in C<lenp>.  Note
-that the C<ustrp> needs to be at least UTF8_MAXBYTES_CASE+1 bytes since the
-titlecase version may be longer than the original character.
-
-The first character of the titlecased version is returned
-(but note, as explained above, that there may be more.)
-
-The character at C<p> is assumed by this routine to be well-formed.
+Instead use L</toTITLE_utf8>.

 
 =cut */
 
 /* Not currently externally documented, and subject to change:
 
 =cut */
 
 /* Not currently externally documented, and subject to change:

- * <flags> is set iff locale semantics are to be used for code points < 256
- *        Since titlecase is not defined in POSIX, uppercase is used instead
- *        for these/
- * <tainted_ptr> if non-null, *tainted_ptr will be set TRUE iff locale rules
- *              were used in the calculation; otherwise unchanged. */
+ * <flags> is set iff the rules from the current underlying locale are to be
+ *         used.  Since titlecase is not defined in POSIX, for other than a
+ *         UTF-8 locale, uppercase is used instead for code points < 256.
+ */

 
 UV
 
 UV

-Perl__to_utf8_title_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, const bool flags, bool* tainted_ptr)
+Perl__to_utf8_title_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, bool flags)

 {
 {

-    dVAR;
-

     UV result;
 
     PERL_ARGS_ASSERT__TO_UTF8_TITLE_FLAGS;
 
     UV result;
 
     PERL_ARGS_ASSERT__TO_UTF8_TITLE_FLAGS;
 

+    if (flags) {
+        /* Treat a UTF-8 locale as not being in locale at all */
+        if (IN_UTF8_CTYPE_LOCALE) {
+            flags = FALSE;
+        }
+        else {
+            _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
+        }
+    }
+

     if (UTF8_IS_INVARIANT(*p)) {
        if (flags) {
            result = toUPPER_LC(*p);
     if (UTF8_IS_INVARIANT(*p)) {
        if (flags) {
            result = toUPPER_LC(*p);


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

-           result = toUPPER_LC(TWO_BYTE_UTF8_TO_UNI(*p, *(p+1)));
+            U8 c = EIGHT_BIT_UTF8_TO_NATIVE(*p, *(p+1));
+           result = toUPPER_LC(c);

        }
        else {
        }
        else {

-           return _to_upper_title_latin1(TWO_BYTE_UTF8_TO_UNI(*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);


@@ -2668,52 +2267,49 @@ Perl__to_utf8_title_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, const bool
        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;
     }
     else {
     if (UTF8_IS_INVARIANT(result)) {
        *ustrp = (U8) result;
        *lenp = 1;
     }
     else {

-       *ustrp = UTF8_EIGHT_BIT_HI(result);
-       *(ustrp + 1) = UTF8_EIGHT_BIT_LO(result);
+       *ustrp = UTF8_EIGHT_BIT_HI((U8) result);
+       *(ustrp + 1) = UTF8_EIGHT_BIT_LO((U8) result);

        *lenp = 2;
     }
 
        *lenp = 2;
     }
 

-    if (tainted_ptr) {
-       *tainted_ptr = TRUE;
-    }

     return result;
 }
 
 /*
 =for apidoc to_utf8_lower
 
     return result;
 }
 
 /*
 =for apidoc to_utf8_lower
 

-Convert the UTF-8 encoded character at C<p> to its lowercase version and
-store that in UTF-8 in ustrp and its length in bytes in C<lenp>.  Note
-that the C<ustrp> needs to be at least UTF8_MAXBYTES_CASE+1 bytes since the
-lowercase version may be longer than the original character.
-
-The first character of the lowercased version is returned
-(but note, as explained above, that there may be more.)
-
-The character at C<p> is assumed by this routine to be well-formed.
+Instead use L</toLOWER_utf8>.

 
 =cut */
 
 /* Not currently externally documented, and subject to change:
 
 =cut */
 
 /* Not currently externally documented, and subject to change:

- * <flags> is set iff locale semantics are to be used for code points < 256
- * <tainted_ptr> if non-null, *tainted_ptr will be set TRUE iff locale rules
- *              were used in the calculation; otherwise unchanged. */
+ * <flags> is set iff iff the rules from the current underlying locale are to
+ *         be used.
+ */

 
 UV
 
 UV

-Perl__to_utf8_lower_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, const bool flags, bool* tainted_ptr)
+Perl__to_utf8_lower_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, bool flags)

 {
     UV result;
 
 {
     UV result;
 

-    dVAR;
-

     PERL_ARGS_ASSERT__TO_UTF8_LOWER_FLAGS;
 
     PERL_ARGS_ASSERT__TO_UTF8_LOWER_FLAGS;
 

+    if (flags) {
+        /* Treat a UTF-8 locale as not being in locale at all */
+        if (IN_UTF8_CTYPE_LOCALE) {
+            flags = FALSE;
+        }
+        else {
+            _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
+        }
+    }
+

     if (UTF8_IS_INVARIANT(*p)) {
        if (flags) {
            result = toLOWER_LC(*p);
     if (UTF8_IS_INVARIANT(*p)) {
        if (flags) {
            result = toLOWER_LC(*p);


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

-           result = toLOWER_LC(TWO_BYTE_UTF8_TO_UNI(*p, *(p+1)));
+            U8 c = EIGHT_BIT_UTF8_TO_NATIVE(*p, *(p+1));
+           result = toLOWER_LC(c);

        }
        else {
        }
        else {

-           return to_lower_latin1(TWO_BYTE_UTF8_TO_UNI(*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);


@@ -2741,56 +2338,40 @@ Perl__to_utf8_lower_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, const bool
        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;
     }
     else {
     if (UTF8_IS_INVARIANT(result)) {
        *ustrp = (U8) result;
        *lenp = 1;
     }
     else {

-       *ustrp = UTF8_EIGHT_BIT_HI(result);
-       *(ustrp + 1) = UTF8_EIGHT_BIT_LO(result);
+       *ustrp = UTF8_EIGHT_BIT_HI((U8) result);
+       *(ustrp + 1) = UTF8_EIGHT_BIT_LO((U8) result);

        *lenp = 2;
     }
 
        *lenp = 2;
     }
 

-    if (tainted_ptr) {
-       *tainted_ptr = TRUE;
-    }

     return result;
 }
 
 /*
 =for apidoc to_utf8_fold
 
     return result;
 }
 
 /*
 =for apidoc to_utf8_fold
 

-Convert the UTF-8 encoded character at C<p> to its foldcase version and
-store that in UTF-8 in C<ustrp> and its length in bytes in C<lenp>.  Note
-that the C<ustrp> needs to be at least UTF8_MAXBYTES_CASE+1 bytes since the
-foldcase version may be longer than the original character (up to
-three characters).
-
-The first character of the foldcased version is returned
-(but note, as explained above, that there may be more.)
-
-The character at C<p> is assumed by this routine to be well-formed.
+Instead use L</toFOLD_utf8>.

 
 =cut */
 
 /* Not currently externally documented, and subject to change,
  * in <flags>
 
 =cut */
 
 /* Not currently externally documented, and subject to change,
  * in <flags>

- *     bit FOLD_FLAGS_LOCALE is set iff locale semantics are to be used for code
- *                           points < 256.  Since foldcase is not defined in
- *                           POSIX, lowercase is used instead
+ *     bit FOLD_FLAGS_LOCALE is set iff the rules from the current underlying
+ *                           locale are to be used.

  *      bit FOLD_FLAGS_FULL   is set iff full case folds are to be used;
  *                           otherwise simple folds
  *      bit FOLD_FLAGS_NOMIX_ASCII is set iff folds of non-ASCII to ASCII are
  *                           prohibited
  *      bit FOLD_FLAGS_FULL   is set iff full case folds are to be used;
  *                           otherwise simple folds
  *      bit FOLD_FLAGS_NOMIX_ASCII is set iff folds of non-ASCII to ASCII are
  *                           prohibited

- * <tainted_ptr> if non-null, *tainted_ptr will be set TRUE iff locale rules
- *              were used in the calculation; otherwise unchanged. */
+ */

 
 UV
 
 UV

-Perl__to_utf8_fold_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, U8 flags, bool* tainted_ptr)
+Perl__to_utf8_fold_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, U8 flags)

 {
 {

-    dVAR;
-

     UV result;
 
     PERL_ARGS_ASSERT__TO_UTF8_FOLD_FLAGS;
     UV result;
 
     PERL_ARGS_ASSERT__TO_UTF8_FOLD_FLAGS;


@@ -2800,44 +2381,102 @@ Perl__to_utf8_fold_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, U8 flags, b
 
     assert(p != ustrp); /* Otherwise overwrites */
 
 
     assert(p != ustrp); /* Otherwise overwrites */
 

+    if (flags & FOLD_FLAGS_LOCALE) {
+        /* Treat a UTF-8 locale as not being in locale at all */
+        if (IN_UTF8_CTYPE_LOCALE) {
+            flags &= ~FOLD_FLAGS_LOCALE;
+        }
+        else {
+            _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
+        }
+    }
+

     if (UTF8_IS_INVARIANT(*p)) {
        if (flags & FOLD_FLAGS_LOCALE) {
     if (UTF8_IS_INVARIANT(*p)) {
        if (flags & FOLD_FLAGS_LOCALE) {

-           result = toLOWER_LC(*p);
+           result = toFOLD_LC(*p);

        }
        else {
            return _to_fold_latin1(*p, ustrp, lenp,
        }
        else {
            return _to_fold_latin1(*p, ustrp, lenp,

-                                  cBOOL(flags & FOLD_FLAGS_FULL));
+                            flags & (FOLD_FLAGS_FULL | FOLD_FLAGS_NOMIX_ASCII));

        }
     }
     else if UTF8_IS_DOWNGRADEABLE_START(*p) {
        if (flags & FOLD_FLAGS_LOCALE) {
        }
     }
     else if UTF8_IS_DOWNGRADEABLE_START(*p) {
        if (flags & FOLD_FLAGS_LOCALE) {

-           result = toLOWER_LC(TWO_BYTE_UTF8_TO_UNI(*p, *(p+1)));
+            U8 c = EIGHT_BIT_UTF8_TO_NATIVE(*p, *(p+1));
+           result = toFOLD_LC(c);

        }
        else {
        }
        else {

-           return _to_fold_latin1(TWO_BYTE_UTF8_TO_UNI(*p, *(p+1)),
-                                  ustrp, lenp,
-                                  cBOOL((flags & FOLD_FLAGS_FULL
-                                      /* If ASCII safe, don't allow full
-                                       * folding, as that could include SHARP
-                                       * S => ss; otherwise there is no
-                                       * crossing of ascii/non-ascii in the
-                                       * latin1 range */
-                                      && ! (flags & FOLD_FLAGS_NOMIX_ASCII))));
+           return _to_fold_latin1(EIGHT_BIT_UTF8_TO_NATIVE(*p, *(p+1)),
+                            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) {
+
+#           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;
+
+            /* Special case these two characters, as what normally gets
+             * returned under locale doesn't work */
+            if (UTF8SKIP(p) == cap_sharp_s_len
+                && memEQ((char *) p, CAP_SHARP_S, cap_sharp_s_len))
+            {
+                /* 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{1E9E}\") on non-UTF-8 locale; "
+                              "resolved to \"\\x{17F}\\x{17F}\".");
+                goto return_long_s;
+            }
+            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". */
+                Perl_ck_warner(aTHX_ packWARN(WARN_LOCALE),
+                              "Can't do fc(\"\\x{FB05}\") on non-UTF-8 locale; "
+                              "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

 
 

-       if ((flags & FOLD_FLAGS_LOCALE)) {

            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
-            * character above the Latin1 range, and the result should not
-            * contain an ASCII character. */
+           /* 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. */

 
            UV original;    /* To store the first code point of <p> */
 
 
            UV original;    /* To store the first code point of <p> */
 


@@ -2849,6 +2488,27 @@ Perl__to_utf8_fold_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, U8 flags, b
                if (isASCII(*s)) {
                    /* Crossed, have to return the original */
                    original = valid_utf8_to_uvchr(p, lenp);
                if (isASCII(*s)) {
                    /* Crossed, have to return the original */
                    original = valid_utf8_to_uvchr(p, lenp);

+
+                    /* But in these instances, there is an alternative we can
+                     * return that is valid */
+                    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;
+                    }
+#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;
                }


@@ -2860,21 +2520,50 @@ Perl__to_utf8_fold_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, U8 flags, b
        }
     }
 
        }
     }
 

-    /* 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;
     }
     else {
     if (UTF8_IS_INVARIANT(result)) {
        *ustrp = (U8) result;
        *lenp = 1;
     }
     else {

-       *ustrp = UTF8_EIGHT_BIT_HI(result);
-       *(ustrp + 1) = UTF8_EIGHT_BIT_LO(result);
+       *ustrp = UTF8_EIGHT_BIT_HI((U8) result);
+       *(ustrp + 1) = UTF8_EIGHT_BIT_LO((U8) result);

        *lenp = 2;
     }
 
        *lenp = 2;
     }
 

-    if (tainted_ptr) {
-       *tainted_ptr = TRUE;
-    }

     return result;
     return result;

+
+  return_long_s:
+    /* Certain folds to 'ss' are prohibited by the options, but they do allow
+     * folds to a string of two of these characters.  By returning this
+     * instead, then, e.g.,
+     *      fc("\x{1E9E}") eq fc("\x{17F}\x{17F}")
+     * works. */
+
+    *lenp = 2 * sizeof(LATIN_SMALL_LETTER_LONG_S_UTF8) - 2;
+    Copy(LATIN_SMALL_LETTER_LONG_S_UTF8 LATIN_SMALL_LETTER_LONG_S_UTF8,
+        ustrp, *lenp, U8);
+    return LATIN_SMALL_LETTER_LONG_S;
+
+  return_ligature_st:
+    /* Two folds to 'st' are prohibited by the options; instead we pick one and
+     * have the other one fold to it */
+
+    *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:


@@ -2898,6 +2587,14 @@ Perl_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 minbits
 SV*
 Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 minbits, I32 none, SV* invlist, U8* const flags_p)
 {
 SV*
 Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 minbits, I32 none, SV* invlist, U8* const flags_p)
 {

+
+    /*NOTE NOTE NOTE - If you want to use "return" in this routine you MUST
+     * use the following define */
+
+#define CORE_SWASH_INIT_RETURN(x)   \
+    PL_curpm= old_PL_curpm;         \
+    return x
+

     /* Initialize and return a swash, creating it if necessary.  It does this
      * by calling utf8_heavy.pl in the general case.  The returned value may be
      * the swash's inversion list instead if the input parameters allow it.
     /* Initialize and return a swash, creating it if necessary.  It does this
      * by calling utf8_heavy.pl in the general case.  The returned value may be
      * the swash's inversion list instead if the input parameters allow it.


@@ -2936,11 +2633,14 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m
      * Thus there are three possible inputs to find the swash: <name>,
      * <listsv>, and <invlist>.  At least one must be specified.  The result
      * will be the union of the specified ones, although <listsv>'s various
      * Thus there are three possible inputs to find the swash: <name>,
      * <listsv>, and <invlist>.  At least one must be specified.  The result
      * will be the union of the specified ones, although <listsv>'s various

-     * actions can intersect, etc. what <name> gives.
+     * actions can intersect, etc. what <name> gives.  To avoid going out to
+     * disk at all, <invlist> should specify completely what the swash should
+     * have, and <listsv> should be &PL_sv_undef and <name> should be "".

      *
      * <invlist> is only valid for binary properties */
 
      *
      * <invlist> is only valid for binary properties */
 

-    dVAR;
+    PMOP *old_PL_curpm= PL_curpm; /* save away the old PL_curpm */
+

     SV* retval = &PL_sv_undef;
     HV* swash_hv = NULL;
     const int invlist_swash_boundary =
     SV* retval = &PL_sv_undef;
     HV* swash_hv = NULL;
     const int invlist_swash_boundary =


@@ -2952,6 +2652,10 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m
     assert(listsv != &PL_sv_undef || strNE(name, "") || invlist);
     assert(! invlist || minbits == 1);
 
     assert(listsv != &PL_sv_undef || strNE(name, "") || invlist);
     assert(! invlist || minbits == 1);
 

+    PL_curpm= NULL; /* reset PL_curpm so that we dont get confused between the regex
+                       that triggered the swash init and the swash init perl logic itself.
+                       See perl #122747 */
+

     /* If data was passed in to go out to utf8_heavy to find the swash of, do
      * so */
     if (listsv != &PL_sv_undef || strNE(name, "")) {
     /* If data was passed in to go out to utf8_heavy to find the swash of, do
      * so */
     if (listsv != &PL_sv_undef || strNE(name, "")) {


@@ -2975,17 +2679,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;
            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.  */
            /* 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.  */

-#ifndef NO_TAINT_SUPPORT

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


@@ -3040,12 +2744,12 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m
 
                /* 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) {

-                   return NULL;
+                    CORE_SWASH_INIT_RETURN(NULL);

                }
                Perl_croak(aTHX_
                           "Can't find Unicode property definition \"%"SVf"\"",
                           SVfARG(retval));
                }
                Perl_croak(aTHX_
                           "Can't find Unicode property definition \"%"SVf"\"",
                           SVfARG(retval));

-           Perl_croak(aTHX_ "SWASHNEW didn't return an HV ref");
+                NOT_REACHED; /* NOTREACHED */

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


@@ -3118,7 +2822,7 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m
 
         /* Here, we have computed the union of all the passed-in data.  It may
          * be that there was an inversion list in the swash which didn't get
 
         /* Here, we have computed the union of all the passed-in data.  It may
          * be that there was an inversion list in the swash which didn't get

-         * touched; otherwise save the one computed one */
+         * touched; otherwise save the computed one */

        if (! invlist_in_swash_is_valid
             && (int) _invlist_len(swash_invlist) > invlist_swash_boundary)
         {
        if (! invlist_in_swash_is_valid
             && (int) _invlist_len(swash_invlist) > invlist_swash_boundary)
         {


@@ -3131,6 +2835,8 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m
            else SvREFCNT_inc_simple_void_NN(swash_invlist);
        }
 
            else SvREFCNT_inc_simple_void_NN(swash_invlist);
        }
 

+        SvREADONLY_on(swash_invlist);
+

         /* Use the inversion list stand-alone if small enough */
         if ((int) _invlist_len(swash_invlist) <= invlist_swash_boundary) {
            SvREFCNT_dec(retval);
         /* Use the inversion list stand-alone if small enough */
         if ((int) _invlist_len(swash_invlist) <= invlist_swash_boundary) {
            SvREFCNT_dec(retval);


@@ -3140,7 +2846,8 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m
         }
     }
 
         }
     }
 

-    return retval;
+    CORE_SWASH_INIT_RETURN(retval);
+#undef CORE_SWASH_INIT_RETURN

 }
 
 
 }
 
 


@@ -3149,14 +2856,14 @@ 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 utf8. 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>.
+ * 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
  * SWASHNEW.  The purpose is to be able to completely represent a Unicode
  *
  * A "swash" is a hash which contains initially the keys/values set up by
  * SWASHNEW.  The purpose is to be able to completely represent a Unicode


@@ -3189,17 +2896,14 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m
 UV
 Perl_swash_fetch(pTHX_ SV *swash, const U8 *ptr, bool do_utf8)
 {
 UV
 Perl_swash_fetch(pTHX_ SV *swash, const U8 *ptr, bool do_utf8)
 {

-    dVAR;

     HV *const hv = MUTABLE_HV(SvRV(swash));
     U32 klen;
     U32 off;
     HV *const hv = MUTABLE_HV(SvRV(swash));
     U32 klen;
     U32 off;

-    STRLEN slen;
+    STRLEN slen = 0;

     STRLEN needents;
     const U8 *tmps = NULL;
     STRLEN needents;
     const U8 *tmps = NULL;

-    U32 bit;

     SV *swatch;
     SV *swatch;

-    U8 tmputf8[2];
-    const UV c = NATIVE_TO_ASCII(*ptr);
+    const U8 c = *ptr;

 
     PERL_ARGS_ASSERT_SWASH_FETCH;
 
 
     PERL_ARGS_ASSERT_SWASH_FETCH;
 


@@ -3212,35 +2916,64 @@ Perl_swash_fetch(pTHX_ SV *swash, const U8 *ptr, bool do_utf8)
                                      : c);
     }
 
                                      : c);
     }
 

-    /* Convert to utf8 if not already */
-    if (!do_utf8 && !UNI_IS_INVARIANT(c)) {
-       tmputf8[0] = (U8)UTF8_EIGHT_BIT_HI(c);
-       tmputf8[1] = (U8)UTF8_EIGHT_BIT_LO(c);
-       ptr = tmputf8;
+    /* We store the values in a "swatch" which is a vec() value in a swash
+     * hash.  Code points 0-255 are a single vec() stored with key length
+     * (klen) 0.  All other code points have a UTF-8 representation
+     * 0xAA..0xYY,0xZZ.  A vec() is constructed containing all of them which
+     * share 0xAA..0xYY, which is the key in the hash to that vec.  So the key
+     * length for them is the length of the encoded char - 1.  ptr[klen] is the
+     * final byte in the sequence representing the character */
+    if (!do_utf8 || UTF8_IS_INVARIANT(c)) {
+        klen = 0;
+       needents = 256;
+        off = c;

     }
     }

-    /* Given a UTF-X encoded char 0xAA..0xYY,0xZZ
-     * then the "swatch" is a vec() for all the chars which start
-     * with 0xAA..0xYY
-     * So the key in the hash (klen) is length of encoded char -1
-     */
-    klen = UTF8SKIP(ptr) - 1;
-    off  = ptr[klen];
-
-    if (klen == 0) {
-      /* If char is invariant then swatch is for all the invariant chars
-       * In both UTF-8 and UTF-8-MOD that happens to be UTF_CONTINUATION_MARK
-       */
-       needents = UTF_CONTINUATION_MARK;
-       off      = NATIVE_TO_UTF(ptr[klen]);
+    else if (UTF8_IS_DOWNGRADEABLE_START(c)) {
+        klen = 0;
+       needents = 256;
+        off = EIGHT_BIT_UTF8_TO_NATIVE(c, *(ptr + 1));

     }
     else {
     }
     else {

-      /* If char is encoded then swatch is for the prefix */
+        klen = UTF8SKIP(ptr) - 1;
+
+        /* Each vec() stores 2**UTF_ACCUMULATION_SHIFT values.  The offset into
+         * the vec is the final byte in the sequence.  (In EBCDIC this is
+         * converted to I8 to get consecutive values.)  To help you visualize
+         * all this:
+         *                       Straight 1047   After final byte
+         *             UTF-8      UTF-EBCDIC     I8 transform
+         *  U+0400:  \xD0\x80    \xB8\x41\x41    \xB8\x41\xA0
+         *  U+0401:  \xD0\x81    \xB8\x41\x42    \xB8\x41\xA1
+         *    ...
+         *  U+0409:  \xD0\x89    \xB8\x41\x4A    \xB8\x41\xA9
+         *  U+040A:  \xD0\x8A    \xB8\x41\x51    \xB8\x41\xAA
+         *    ...
+         *  U+0412:  \xD0\x92    \xB8\x41\x59    \xB8\x41\xB2
+         *  U+0413:  \xD0\x93    \xB8\x41\x62    \xB8\x41\xB3
+         *    ...
+         *  U+041B:  \xD0\x9B    \xB8\x41\x6A    \xB8\x41\xBB
+         *  U+041C:  \xD0\x9C    \xB8\x41\x70    \xB8\x41\xBC
+         *    ...
+         *  U+041F:  \xD0\x9F    \xB8\x41\x73    \xB8\x41\xBF
+         *  U+0420:  \xD0\xA0    \xB8\x42\x41    \xB8\x42\x41
+         *
+         * (There are no discontinuities in the elided (...) entries.)
+         * The UTF-8 key for these 33 code points is '\xD0' (which also is the
+         * key for the next 31, up through U+043F, whose UTF-8 final byte is
+         * \xBF).  Thus in UTF-8, each key is for a vec() for 64 code points.
+         * The final UTF-8 byte, which ranges between \x80 and \xBF, is an
+         * index into the vec() swatch (after subtracting 0x80, which we
+         * actually do with an '&').
+         * In UTF-EBCDIC, each key is for a 32 code point vec().  The first 32
+         * code points above have key '\xB8\x41'. The final UTF-EBCDIC byte has
+         * dicontinuities which go away by transforming it into I8, and we
+         * effectively subtract 0xA0 to get the index. */

        needents = (1 << UTF_ACCUMULATION_SHIFT);
        needents = (1 << UTF_ACCUMULATION_SHIFT);

-       off      = NATIVE_TO_UTF(ptr[klen]) & UTF_CONTINUATION_MASK;
+       off      = NATIVE_UTF8_TO_I8(ptr[klen]) & UTF_CONTINUATION_MASK;

     }
 
     /*
     }
 
     /*

-     * 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...


@@ -3261,17 +2994,18 @@ Perl_swash_fetch(pTHX_ SV *swash, const U8 *ptr, bool do_utf8)
 
        /* If not cached, generate it via swatch_get */
        if (!svp || !SvPOK(*svp)
 
        /* If not cached, generate it via swatch_get */
        if (!svp || !SvPOK(*svp)

-                || !(tmps = (const U8*)SvPV_const(*svp, slen))) {
-           /* We use utf8n_to_uvuni() as we want an index into
-              Unicode tables, not a native character number.
-            */
-           const UV code_point = utf8n_to_uvuni(ptr, UTF8_MAXBYTES, 0,
-                                          ckWARN(WARN_UTF8) ?
-                                          0 : UTF8_ALLOW_ANY);
-           swatch = swatch_get(swash,
-                   /* On EBCDIC & ~(0xA0-1) isn't a useful thing to do */
-                               (klen) ? (code_point & ~((UV)needents - 1)) : 0,
-                               needents);
+                || !(tmps = (const U8*)SvPV_const(*svp, slen)))
+        {
+            if (klen) {
+                const UV code_point = valid_utf8_to_uvchr(ptr, NULL);
+                swatch = swatch_get(swash,
+                                    code_point & ~((UV)needents - 1),
+                                   needents);
+            }
+            else {  /* For the first 256 code points, the swatch has a key of
+                       length 0 */
+                swatch = swatch_get(swash, 0, needents);
+            }

 
            if (IN_PERL_COMPILETIME)
                CopHINTS_set(PL_curcop, PL_hints);
 
            if (IN_PERL_COMPILETIME)
                CopHINTS_set(PL_curcop, PL_hints);


@@ -3297,17 +3031,21 @@ Perl_swash_fetch(pTHX_ SV *swash, const U8 *ptr, bool do_utf8)
 
     switch ((int)((slen << 3) / needents)) {
     case 1:
 
     switch ((int)((slen << 3) / needents)) {
     case 1:

-       bit = 1 << (off & 7);
-       off >>= 3;
-       return (tmps[off] & bit) != 0;
+       return ((UV) tmps[off >> 3] & (1 << (off & 7))) != 0;

     case 8:
     case 8:

-       return tmps[off];
+       return ((UV) tmps[off]);

     case 16:
        off <<= 1;
     case 16:
        off <<= 1;

-       return (tmps[off] << 8) + tmps[off + 1] ;
+       return
+            ((UV) tmps[off    ] << 8) +
+            ((UV) tmps[off + 1]);

     case 32:
        off <<= 2;
     case 32:
        off <<= 2;

-       return (tmps[off] << 24) + (tmps[off+1] << 16) + (tmps[off+2] << 8) + tmps[off + 3] ;
+       return
+            ((UV) tmps[off    ] << 24) +
+            ((UV) tmps[off + 1] << 16) +
+            ((UV) tmps[off + 2] <<  8) +
+            ((UV) tmps[off + 3]);

     }
     Perl_croak(aTHX_ "panic: swash_fetch got swatch of unexpected bit width, "
               "slen=%"UVuf", needents=%"UVuf, (UV)slen, (UV)needents);
     }
     Perl_croak(aTHX_ "panic: swash_fetch got swatch of unexpected bit width, "
               "slen=%"UVuf", needents=%"UVuf, (UV)slen, (UV)needents);


@@ -3345,9 +3083,12 @@ S_swash_scan_list_line(pTHX_ U8* l, U8* const lend, UV* min, UV* max, UV* val,
     /* nl points to the next \n in the scan */
     U8* const nl = (U8*)memchr(l, '\n', lend - l);
 
     /* nl points to the next \n in the scan */
     U8* const nl = (U8*)memchr(l, '\n', lend - l);
 

+    PERL_ARGS_ASSERT_SWASH_SCAN_LIST_LINE;
+

     /* Get the first number on the line: the range minimum */
     numlen = lend - l;
     *min = grok_hex((char *)l, &numlen, &flags, NULL);
     /* Get the first number on the line: the range minimum */
     numlen = lend - l;
     *min = grok_hex((char *)l, &numlen, &flags, NULL);

+    *max = *min;    /* So can never return without setting max */

     if (numlen)            /* If found a hex number, position past it */
        l += numlen;
     else if (nl) {         /* Else, go handle next line, if any */
     if (numlen)            /* If found a hex number, position past it */
        l += numlen;
     else if (nl) {         /* Else, go handle next line, if any */


@@ -3371,30 +3112,19 @@ S_swash_scan_list_line(pTHX_ U8* l, U8* const lend, UV* min, UV* max, UV* val,
            *max = *min;
 
        /* Non-binary tables have a third entry: what the first element of the
            *max = *min;
 
        /* Non-binary tables have a third entry: what the first element of the

-        * range maps to */
+        * range maps to.  The map for those currently read here is in hex */

        if (wants_value) {
            if (isBLANK(*l)) {
                ++l;
        if (wants_value) {
            if (isBLANK(*l)) {
                ++l;

-
-               /* The ToLc, etc table mappings are not in hex, and must be
-                * corrected by adding the code point to them */
-               if (typeto) {
-                   char *after_strtol = (char *) lend;
-                   *val = Strtol((char *)l, &after_strtol, 10);
-                   l = (U8 *) after_strtol;
-               }
-               else { /* Other tables are in hex, and are the correct result
-                         without tweaking */
-                   flags = PERL_SCAN_SILENT_ILLDIGIT
-                       | PERL_SCAN_DISALLOW_PREFIX
-                       | PERL_SCAN_SILENT_NON_PORTABLE;
-                   numlen = lend - l;
-                   *val = grok_hex((char *)l, &numlen, &flags, NULL);
-                   if (numlen)
-                       l += numlen;
-                   else
-                       *val = 0;
-               }
+                flags = PERL_SCAN_SILENT_ILLDIGIT
+                    | PERL_SCAN_DISALLOW_PREFIX
+                    | PERL_SCAN_SILENT_NON_PORTABLE;
+                numlen = lend - l;
+                *val = grok_hex((char *)l, &numlen, &flags, NULL);
+                if (numlen)
+                    l += numlen;
+                else
+                    *val = 0;

            }
            else {
                *val = 0;
            }
            else {
                *val = 0;


@@ -3410,7 +3140,6 @@ S_swash_scan_list_line(pTHX_ U8* l, U8* const lend, UV* min, UV* max, UV* val,
     }
     else { /* Nothing following range min, should be single element with no
              mapping expected */
     }
     else { /* Nothing following range min, should be single element with no
              mapping expected */

-       *max = *min;

        if (wants_value) {
            *val = 0;
            if (typeto) {
        if (wants_value) {
            *val = 0;
            if (typeto) {


@@ -3525,8 +3254,8 @@ S_swatch_get(pTHX_ SV* swash, UV start, UV span)
     lend = l + lcur;
     while (l < lend) {
        UV min, max, val, upper;
     lend = l + lcur;
     while (l < lend) {
        UV min, max, val, upper;

-       l = S_swash_scan_list_line(aTHX_ l, lend, &min, &max, &val,
-                                        cBOOL(octets), typestr);
+       l = swash_scan_list_line(l, lend, &min, &max, &val,
+                                                        cBOOL(octets), typestr);

        if (l > lend) {
            break;
        }
        if (l > lend) {
            break;
        }


@@ -3761,10 +3490,13 @@ 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 a 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.

     *
     * Essentially, for any code point, it gives all the code points that map to
     * it, or the list of 'froms' for that point.
     *
     * Essentially, for any code point, it gives all the code points that map to
     * it, or the list of 'froms' for that point.


@@ -3775,7 +3507,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


@@ -3784,7 +3516,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;


@@ -3829,8 +3578,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;


@@ -3842,7 +3591,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),


@@ -3885,13 +3634,13 @@ 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_len(from_list) > 0) {
-               int i;
+           if (av_tindex(from_list) > 0) {
+               SSize_t i;

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

-               for (i = 0; i <= av_len(from_list); i++) {
-                   int j;
+               for (i = 0; i <= av_tindex(from_list); i++) {
+                   SSize_t j;

                    AV* i_list = newAV();
                    SV** entryp = av_fetch(from_list, i, FALSE);
                    if (entryp == NULL) {
                    AV* i_list = newAV();
                    SV** entryp = av_fetch(from_list, i, FALSE);
                    if (entryp == NULL) {


@@ -3906,8 +3655,8 @@ Perl__swash_inversion_hash(pTHX_ SV* const swash)
                        Perl_croak(aTHX_ "panic: hv_store() unexpectedly failed");
                    }
 
                        Perl_croak(aTHX_ "panic: hv_store() unexpectedly failed");
                    }
 

-                   /* For debugging: UV u = valid_utf8_to_uvchr((U8*) SvPVX(*entryp), 0);*/
-                   for (j = 0; j <= av_len(from_list); j++) {
+                   /* For DEBUG_U: UV u = valid_utf8_to_uvchr((U8*) SvPVX(*entryp), 0);*/
+                   for (j = 0; j <= av_tindex(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");


@@ -3927,15 +3676,32 @@ 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 */
     while (l < lend) {
        UV min, max, val;
        UV inverse;
     lend = l + lcur;
 
     /* Go through each input line */
     while (l < lend) {
        UV min, max, val;
        UV inverse;

-       l = S_swash_scan_list_line(aTHX_ l, lend, &min, &max, &val,
-                                        cBOOL(octets), typestr);
+       l = swash_scan_list_line(l, lend, &min, &max, &val,
+                                                     cBOOL(octets), typestr);

        if (l > lend) {
            break;
        }
        if (l > lend) {
            break;
        }


@@ -3950,7 +3716,7 @@ Perl__swash_inversion_hash(pTHX_ SV* const swash)
 
            /* The key is the inverse mapping */
            char key[UTF8_MAXBYTES+1];
 
            /* The key is the inverse mapping */
            char key[UTF8_MAXBYTES+1];

-           char* key_end = (char *) uvuni_to_utf8((U8*) key, val);
+           char* key_end = (char *) uvchr_to_utf8((U8*) key, val);

            STRLEN key_len = key_end - key;
 
            /* Get the list for the map */
            STRLEN key_len = key_end - key;
 
            /* Get the list for the map */


@@ -3966,18 +3732,20 @@ 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_len(list); i++) {
+           for (i = 0; i <= av_tindex(list); i++) {

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

+               UV uv;

                if (entryp == NULL) {
                    Perl_croak(aTHX_ "panic: av_fetch() unexpectedly failed");
                }
                entry = *entryp;
                if (entryp == NULL) {
                    Perl_croak(aTHX_ "panic: av_fetch() unexpectedly failed");
                }
                entry = *entryp;

-               /*DEBUG_U(PerlIO_printf(Perl_debug_log, "list for %"UVXf" contains %"UVXf"\n", val, SvUV(entry)));*/
-               if (SvUV(entry) == val) {
+               uv = SvUV(entry);
+               /*DEBUG_U(PerlIO_printf(Perl_debug_log, "list for %"UVXf" contains %"UVXf"\n", val, uv));*/
+               if (uv == val) {

                    found_key = TRUE;
                }
                    found_key = TRUE;
                }

-               if (SvUV(entry) == inverse) {
+               if (uv == inverse) {

                    found_inverse = TRUE;
                }
 
                    found_inverse = TRUE;
                }
 


@@ -4077,43 +3845,85 @@ Perl__swash_to_invlist(pTHX_ SV* const swash)
     loc = (char *) l;
     lend = l + lcur;
 
     loc = (char *) l;
     lend = l + lcur;
 

-    /* Scan the input to count the number of lines to preallocate array size
-     * based on worst possible case, which is each line in the input creates 2
-     * elements in the inversion list: 1) the beginning of a range in the list;
-     * 2) the beginning of a range not in the list.  */
-    while ((loc = (strchr(loc, '\n'))) != NULL) {
-       elements += 2;
-       loc++;
-    }
+    if (*l == 'V') {    /*  Inversion list format */
+        const char *after_atou = (char *) lend;
+        UV element0;
+        UV* other_elements_ptr;

 
 

-    /* If the ending is somehow corrupt and isn't a new line, add another
-     * element for the final range that isn't in the inversion list */
-    if (! (*lend == '\n'
-       || (*lend == '\0' && (lcur == 0 || *(lend - 1) == '\n'))))
-    {
-       elements++;
+        /* The first number is a count of the rest */
+        l++;
+        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);
+        }
+        else {
+            while (isSPACE(*l)) l++;
+            l = (U8 *) after_atou;
+
+            /* Get the 0th element, which is needed to setup the inversion list */
+            while (isSPACE(*l)) l++;
+            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--;
+
+            /* Then just populate the rest of the input */
+            while (elements-- > 0) {
+                if (l > lend) {
+                    Perl_croak(aTHX_ "panic: Expecting %"UVuf" more elements than available", elements);
+                }
+                while (isSPACE(*l)) l++;
+                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;
+            }
+        }

     }
     }

+    else {
+
+        /* Scan the input to count the number of lines to preallocate array
+         * size based on worst possible case, which is each line in the input
+         * creates 2 elements in the inversion list: 1) the beginning of a
+         * range in the list; 2) the beginning of a range not in the list.  */
+        while ((loc = (strchr(loc, '\n'))) != NULL) {
+            elements += 2;
+            loc++;
+        }

 
 

-    invlist = _new_invlist(elements);
+        /* If the ending is somehow corrupt and isn't a new line, add another
+         * element for the final range that isn't in the inversion list */
+        if (! (*lend == '\n'
+            || (*lend == '\0' && (lcur == 0 || *(lend - 1) == '\n'))))
+        {
+            elements++;
+        }

 
 

-    /* Now go through the input again, adding each range to the list */
-    while (l < lend) {
-       UV start, end;
-       UV val;         /* Not used by this function */
+        invlist = _new_invlist(elements);

 
 

-       l = S_swash_scan_list_line(aTHX_ l, lend, &start, &end, &val,
-                                        cBOOL(octets), typestr);
+        /* Now go through the input again, adding each range to the list */
+        while (l < lend) {
+            UV start, end;
+            UV val;            /* Not used by this function */

 
 

-       if (l > lend) {
-           break;
-       }
+            l = swash_scan_list_line(l, lend, &start, &end, &val,
+                                                        cBOOL(octets), typestr);
+
+            if (l > lend) {
+                break;
+            }

 
 

-       invlist = _add_range_to_invlist(invlist, start, end);
+            invlist = _add_range_to_invlist(invlist, start, end);
+        }

     }
 
     /* Invert if the data says it should be */
     if (invert_it_svp && SvUV(*invert_it_svp)) {
     }
 
     /* Invert if the data says it should be */
     if (invert_it_svp && SvUV(*invert_it_svp)) {

-       _invlist_invert_prop(invlist);
+       _invlist_invert(invlist);

     }
 
     /* This code is copied from swatch_get()
     }
 
     /* This code is copied from swatch_get()


@@ -4190,6 +4000,7 @@ Perl__swash_to_invlist(pTHX_ SV* const swash)
        sv_free(other); /* through with it! */
     }
 
        sv_free(other); /* through with it! */
     }
 

+    SvREADONLY_on(invlist);

     return invlist;
 }
 
     return invlist;
 }
 


@@ -4218,75 +4029,16 @@ Perl__get_swash_invlist(pTHX_ SV* const swash)
     return *ptr;
 }
 
     return *ptr;
 }
 

-/*
-=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<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,
-
-    d = uvchr_to_utf8(d, uv);
-
-is the recommended wide native character-aware way of saying
-
-    *(d++) = uv;
-
-=cut
-*/
-
-/* On ASCII machines this is normally a macro but we want a
-   real function in case XS code wants it
-*/
-U8 *
-Perl_uvchr_to_utf8(pTHX_ U8 *d, UV uv)
-{
-    PERL_ARGS_ASSERT_UVCHR_TO_UTF8;
-
-    return Perl_uvuni_to_utf8_flags(aTHX_ d, NATIVE_TO_UNI(uv), 0);
-}
-
-U8 *
-Perl_uvchr_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags)
-{
-    PERL_ARGS_ASSERT_UVCHR_TO_UTF8_FLAGS;
-
-    return Perl_uvuni_to_utf8_flags(aTHX_ d, NATIVE_TO_UNI(uv), flags);
-}
-
-/*
-=for apidoc utf8n_to_uvchr
-
-Returns the native character value of the first character in the string
-C<s>
-which is assumed to be in UTF-8 encoding; C<retlen> will be set to the
-length, in bytes, of that character.
-
-C<length> and C<flags> are the same as L</utf8n_to_uvuni>().
-
-=cut
-*/
-/* On ASCII machines this is normally a macro but we want
-   a real function in case XS code wants it
-*/
-UV
-Perl_utf8n_to_uvchr(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen,
-U32 flags)
-{
-    const UV uv = Perl_utf8n_to_uvuni(aTHX_ s, curlen, retlen, flags);
-
-    PERL_ARGS_ASSERT_UTF8N_TO_UVCHR;
-
-    return UNI_TO_NATIVE(uv);
-}
-

 bool
 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
 bool
 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

-     * 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;


@@ -4299,31 +4051,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;
            }
        }


@@ -4338,17 +4110,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)


@@ -4428,9 +4202,12 @@ The pointer to the PV of the C<dsv> is returned.
 char *
 Perl_sv_uni_display(pTHX_ SV *dsv, SV *ssv, STRLEN pvlim, UV flags)
 {
 char *
 Perl_sv_uni_display(pTHX_ SV *dsv, SV *ssv, STRLEN pvlim, UV flags)
 {

+    const char * const ptr =
+        isREGEXP(ssv) ? RX_WRAPPED((REGEXP*)ssv) : SvPVX_const(ssv);
+

     PERL_ARGS_ASSERT_SV_UNI_DISPLAY;
 
     PERL_ARGS_ASSERT_SV_UNI_DISPLAY;
 

-     return Perl_pv_uni_display(aTHX_ dsv, (const U8*)SvPVX_const(ssv),
+    return Perl_pv_uni_display(aTHX_ dsv, (const U8*)ptr,

                                SvCUR(ssv), pvlim, flags);
 }
 
                                SvCUR(ssv), pvlim, flags);
 }
 


@@ -4451,7 +4228,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;


@@ -4468,7 +4245,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>.
 


@@ -4483,18 +4260,25 @@ L<http://www.unicode.org/unicode/reports/tr21/> (Case Mappings).
  *  0 for as-documented above
  *  FOLDEQ_UTF8_NOMIX_ASCII meaning that if a non-ASCII character folds to an
                            ASCII one, to not match
  *  0 for as-documented above
  *  FOLDEQ_UTF8_NOMIX_ASCII meaning that if a non-ASCII character folds to an
                            ASCII one, to not match

- *  FOLDEQ_UTF8_LOCALE     meaning that locale rules are to be used for code
- *                         points below 256; unicode rules for above 255; and
- *                         folds that cross those boundaries are disallowed,
- *                         like the NOMIX_ASCII option
- *  FOLDEQ_S1_ALREADY_FOLDED s1 has already been folded before calling this
- *                           routine.  This allows that step to be skipped.
- *  FOLDEQ_S2_ALREADY_FOLDED   Similarly.
+ *  FOLDEQ_LOCALE          is set iff the rules from the current underlying
+ *                         locale are to be used.
+ *  FOLDEQ_S1_ALREADY_FOLDED  s1 has already been folded before calling this
+ *                          routine.  This allows that step to be skipped.
+ *                          Currently, this requires s1 to be encoded as UTF-8
+ *                          (u1 must be true), which is asserted for.
+ *  FOLDEQ_S1_FOLDS_SANE    With either NOMIX_ASCII or LOCALE, no folds may
+ *                          cross certain boundaries.  Hence, the caller should
+ *                          let this function do the folding instead of
+ *                          pre-folding.  This code contains an assertion to
+ *                          that effect.  However, if the caller knows what
+ *                          it's doing, it can pass this flag to indicate that,
+ *                          and the assertion is skipped.
+ *  FOLDEQ_S2_ALREADY_FOLDED  Similarly.
+ *  FOLDEQ_S2_FOLDS_SANE

  */
 I32
 Perl_foldEQ_utf8_flags(pTHX_ const char *s1, char **pe1, UV l1, bool u1, const char *s2, char **pe2, UV l2, bool u2, U32 flags)
 {
  */
 I32
 Perl_foldEQ_utf8_flags(pTHX_ const char *s1, char **pe1, UV l1, bool u1, const char *s2, char **pe2, UV l2, bool u2, U32 flags)
 {

-    dVAR;

     const U8 *p1  = (const U8*)s1; /* Point to current char */
     const U8 *p2  = (const U8*)s2;
     const U8 *g1 = NULL;       /* goal for s1 */
     const U8 *p1  = (const U8*)s1; /* Point to current char */
     const U8 *p2  = (const U8*)s2;
     const U8 *g1 = NULL;       /* goal for s1 */


@@ -4506,13 +4290,34 @@ Perl_foldEQ_utf8_flags(pTHX_ const char *s1, char **pe1, UV l1, bool u1, const c
     STRLEN n1 = 0, n2 = 0;              /* Number of bytes in current char */
     U8 foldbuf1[UTF8_MAXBYTES_CASE+1];
     U8 foldbuf2[UTF8_MAXBYTES_CASE+1];
     STRLEN n1 = 0, n2 = 0;              /* Number of bytes in current char */
     U8 foldbuf1[UTF8_MAXBYTES_CASE+1];
     U8 foldbuf2[UTF8_MAXBYTES_CASE+1];

+    U8 flags_for_folder = FOLD_FLAGS_FULL;

 
     PERL_ARGS_ASSERT_FOLDEQ_UTF8_FLAGS;
 
 
     PERL_ARGS_ASSERT_FOLDEQ_UTF8_FLAGS;
 

-    /* The algorithm requires that input with the flags on the first line of
-     * the assert not be pre-folded. */
-    assert( ! ((flags & (FOLDEQ_UTF8_NOMIX_ASCII | FOLDEQ_UTF8_LOCALE))
-       && (flags & (FOLDEQ_S1_ALREADY_FOLDED | FOLDEQ_S2_ALREADY_FOLDED))));
+    assert( ! ((flags & (FOLDEQ_UTF8_NOMIX_ASCII | FOLDEQ_LOCALE))
+               && (((flags & FOLDEQ_S1_ALREADY_FOLDED)
+                     && !(flags & FOLDEQ_S1_FOLDS_SANE))
+                   || ((flags & FOLDEQ_S2_ALREADY_FOLDED)
+                       && !(flags & FOLDEQ_S2_FOLDS_SANE)))));
+    /* The algorithm is to trial the folds without regard to the flags on
+     * the first line of the above assert(), and then see if the result
+     * violates them.  This means that the inputs can't be pre-folded to a
+     * violating result, hence the assert.  This could be changed, with the
+     * addition of extra tests here for the already-folded case, which would
+     * slow it down.  That cost is more than any possible gain for when these
+     * flags are specified, as the flags indicate /il or /iaa matching which
+     * is less common than /iu, and I (khw) also believe that real-world /il
+     * and /iaa matches are most likely to involve code points 0-255, and this
+     * function only under rare conditions gets called for 0-255. */
+
+    if (flags & FOLDEQ_LOCALE) {
+        if (IN_UTF8_CTYPE_LOCALE) {
+            flags &= ~FOLDEQ_LOCALE;
+        }
+        else {
+            flags_for_folder |= FOLD_FLAGS_LOCALE;
+        }
+    }

 
     if (pe1) {
         e1 = *(U8**)pe1;
 
     if (pe1) {
         e1 = *(U8**)pe1;


@@ -4563,110 +4368,65 @@ Perl_foldEQ_utf8_flags(pTHX_ const char *s1, char **pe1, UV l1, bool u1, const c
     while (p1 < e1 && p2 < e2) {
 
         /* If at the beginning of a new character in s1, get its fold to use
     while (p1 < e1 && p2 < e2) {
 
         /* If at the beginning of a new character in s1, get its fold to use

-        * and the length of the fold.  (exception: locale rules just get the
-        * character to a single byte) */
+        * and the length of the fold. */

         if (n1 == 0) {
            if (flags & FOLDEQ_S1_ALREADY_FOLDED) {
                f1 = (U8 *) p1;
         if (n1 == 0) {
            if (flags & FOLDEQ_S1_ALREADY_FOLDED) {
                f1 = (U8 *) p1;

+                assert(u1);

                n1 = UTF8SKIP(f1);
            }
            else {
                n1 = UTF8SKIP(f1);
            }
            else {

-               /* If in locale matching, we use two sets of rules, depending
-                * on if the code point is above or below 255.  Here, we test
-                * for and handle locale rules */
-               if ((flags & FOLDEQ_UTF8_LOCALE)
-                   && (! u1 || UTF8_IS_INVARIANT(*p1)
-                       || UTF8_IS_DOWNGRADEABLE_START(*p1)))
-               {
-                   /* There is no mixing of code points above and below 255. */
-                   if (u2 && (! UTF8_IS_INVARIANT(*p2)
-                       && ! UTF8_IS_DOWNGRADEABLE_START(*p2)))
-                   {
-                       return 0;
-                   }
-
-                   /* We handle locale rules by converting, if necessary, the
-                    * code point to a single byte. */
-                   if (! u1 || UTF8_IS_INVARIANT(*p1)) {
-                       *foldbuf1 = *p1;
-                   }
-                   else {
-                       *foldbuf1 = TWO_BYTE_UTF8_TO_UNI(*p1, *(p1 + 1));
-                   }
-                   n1 = 1;
-               }
-               else if (isASCII(*p1)) {    /* Note, that here won't be both
-                                              ASCII and using locale rules */
-
-                   /* If trying to mix non- with ASCII, and not supposed to,
-                    * fail */
-                   if ((flags & FOLDEQ_UTF8_NOMIX_ASCII) && ! isASCII(*p2)) {
-                       return 0;
-                   }
-                   n1 = 1;
-                   *foldbuf1 = toLOWER(*p1);   /* Folds in the ASCII range are
-                                                  just lowercased */
-               }
-               else if (u1) {
-                   to_utf8_fold(p1, foldbuf1, &n1);
-               }
-               else {  /* Not utf8, get utf8 fold */
-                   to_uni_fold(NATIVE_TO_UNI(*p1), foldbuf1, &n1);
-               }
-               f1 = foldbuf1;
-           }
+                if (isASCII(*p1) && ! (flags & FOLDEQ_LOCALE)) {
+
+                    /* We have to forbid mixing ASCII with non-ASCII if the
+                     * flags so indicate.  And, we can short circuit having to
+                     * call the general functions for this common ASCII case,
+                     * all of whose non-locale folds are also ASCII, and hence
+                     * UTF-8 invariants, so the UTF8ness of the strings is not
+                     * relevant. */
+                    if ((flags & FOLDEQ_UTF8_NOMIX_ASCII) && ! isASCII(*p2)) {
+                        return 0;
+                    }
+                    n1 = 1;
+                    *foldbuf1 = toFOLD(*p1);
+                }
+                else if (u1) {
+                    _to_utf8_fold_flags(p1, foldbuf1, &n1, flags_for_folder);
+                }
+                else {  /* Not UTF-8, get UTF-8 fold */
+                    _to_uni_fold_flags(*p1, foldbuf1, &n1, flags_for_folder);
+                }
+                f1 = foldbuf1;
+            }

         }
 
         if (n2 == 0) {    /* Same for s2 */
            if (flags & FOLDEQ_S2_ALREADY_FOLDED) {
                f2 = (U8 *) p2;
         }
 
         if (n2 == 0) {    /* Same for s2 */
            if (flags & FOLDEQ_S2_ALREADY_FOLDED) {
                f2 = (U8 *) p2;

+                assert(u2);

                n2 = UTF8SKIP(f2);
            }
            else {
                n2 = UTF8SKIP(f2);
            }
            else {

-               if ((flags & FOLDEQ_UTF8_LOCALE)
-                   && (! u2 || UTF8_IS_INVARIANT(*p2) || UTF8_IS_DOWNGRADEABLE_START(*p2)))
-               {
-                   /* Here, the next char in s2 is < 256.  We've already
-                    * worked on s1, and if it isn't also < 256, can't match */
-                   if (u1 && (! UTF8_IS_INVARIANT(*p1)
-                       && ! UTF8_IS_DOWNGRADEABLE_START(*p1)))
-                   {
-                       return 0;
-                   }
-                   if (! u2 || UTF8_IS_INVARIANT(*p2)) {
-                       *foldbuf2 = *p2;
-                   }
-                   else {
-                       *foldbuf2 = TWO_BYTE_UTF8_TO_UNI(*p2, *(p2 + 1));
-                   }
-
-                   /* Use another function to handle locale rules.  We've made
-                    * sure that both characters to compare are single bytes */
-                   if (! foldEQ_locale((char *) f1, (char *) foldbuf2, 1)) {
-                       return 0;
-                   }
-                   n1 = n2 = 0;
-               }
-               else if (isASCII(*p2)) {
-                   if ((flags & FOLDEQ_UTF8_NOMIX_ASCII) && ! isASCII(*p1)) {
-                       return 0;
-                   }
-                   n2 = 1;
-                   *foldbuf2 = toLOWER(*p2);
-               }
-               else if (u2) {
-                   to_utf8_fold(p2, foldbuf2, &n2);
-               }
-               else {
-                   to_uni_fold(NATIVE_TO_UNI(*p2), foldbuf2, &n2);
-               }
-               f2 = foldbuf2;
+                if (isASCII(*p2) && ! (flags & FOLDEQ_LOCALE)) {
+                    if ((flags & FOLDEQ_UTF8_NOMIX_ASCII) && ! isASCII(*p1)) {
+                        return 0;
+                    }
+                    n2 = 1;
+                    *foldbuf2 = toFOLD(*p2);
+                }
+                else if (u2) {
+                    _to_utf8_fold_flags(p2, foldbuf2, &n2, flags_for_folder);
+                }
+                else {
+                    _to_uni_fold_flags(*p2, foldbuf2, &n2, flags_for_folder);
+                }
+                f2 = foldbuf2;

            }
         }
 
        /* 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 */


@@ -4715,12 +4475,66 @@ Perl_foldEQ_utf8_flags(pTHX_ const char *s1, char **pe1, UV l1, bool u1, const c
     return 1;
 }
 
     return 1;
 }
 

+/* XXX The next two functions should likely be moved to mathoms.c once all
+ * occurrences of them are removed from the core; some cpan-upstream modules
+ * still use them */
+
+U8 *
+Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv)
+{
+    PERL_ARGS_ASSERT_UVUNI_TO_UTF8;
+
+    return Perl_uvoffuni_to_utf8_flags(aTHX_ d, uv, 0);
+}
+
+/*
+=for apidoc utf8n_to_uvuni
+
+Instead use L</utf8_to_uvchr_buf>, or rarely, L</utf8n_to_uvchr>.
+
+This function was useful for code that wanted to handle both EBCDIC and
+ASCII platforms with Unicode properties, but starting in Perl v5.20, the
+distinctions between the platforms have mostly been made invisible to most
+code, so this function is quite unlikely to be what you want.  If you do need
+this precise functionality, use instead
+C<L<NATIVE_TO_UNI(utf8_to_uvchr_buf(...))|/utf8_to_uvchr_buf>>
+or C<L<NATIVE_TO_UNI(utf8n_to_uvchr(...))|/utf8n_to_uvchr>>.
+
+=cut
+*/
+
+UV
+Perl_utf8n_to_uvuni(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
+{
+    PERL_ARGS_ASSERT_UTF8N_TO_UVUNI;
+
+    return NATIVE_TO_UNI(utf8n_to_uvchr(s, curlen, retlen, flags));
+}
+
+/*
+=for apidoc uvuni_to_utf8_flags
+
+Instead you almost certainly want to use L</uvchr_to_utf8> or
+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
+circumstances.  These functions were useful for code that wanted to handle
+both EBCDIC and ASCII platforms with Unicode properties, but starting in Perl
+v5.20, the distinctions between the platforms have mostly been made invisible
+to most code, so this function is quite unlikely to be what you want.
+
+=cut
+*/
+
+U8 *
+Perl_uvuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags)
+{
+    PERL_ARGS_ASSERT_UVUNI_TO_UTF8_FLAGS;
+
+    return uvoffuni_to_utf8_flags(d, 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:
  */