Extract common code to an inline function

[perl5.git] / utf8.c

diff --git a/utf8.c b/utf8.c
index 88ca041..b445a2e 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -90,7 +90,7 @@ Perl_is_ascii_string(const U8 *s, STRLEN len)
 /*
 =for apidoc uvuni_to_utf8_flags
 
 /*
 =for apidoc uvuni_to_utf8_flags
 

-Adds the UTF-8 representation of the code point C<uv> to the end
+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,
 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,


@@ -109,6 +109,10 @@ This is the recommended Unicode-aware way of saying
 
     *(d++) = uv;
 
 
     *(d++) = uv;
 

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

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


@@ -119,8 +123,9 @@ UNICODE_DISALLOW_SURROGATE is set, the function will fail and return NULL.
 If both flags are set, the function will both warn and return NULL.
 
 The UNICODE_WARN_NONCHAR and UNICODE_DISALLOW_NONCHAR flags correspondingly
 If both flags are set, the function will both warn and return NULL.
 
 The UNICODE_WARN_NONCHAR and UNICODE_DISALLOW_NONCHAR flags correspondingly

-affect how the function handles a Unicode non-character.  And, likewise for the
-UNICODE_WARN_SUPER and UNICODE_DISALLOW_SUPER flags, and code points that are
+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
 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


@@ -177,7 +182,7 @@ Perl_uvuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags)
        }
     }
     if (UNI_IS_INVARIANT(uv)) {
        }
     }
     if (UNI_IS_INVARIANT(uv)) {

-       *d++ = (U8)UTF_TO_NATIVE(uv);
+       *d++ = (U8) I8_TO_NATIVE_UTF8(uv);

        return d;
     }
 #if defined(EBCDIC)
        return d;
     }
 #if defined(EBCDIC)


@@ -185,10 +190,10 @@ Perl_uvuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags)
        STRLEN len  = UNISKIP(uv);
        U8 *p = d+len-1;
        while (p > d) {
        STRLEN len  = UNISKIP(uv);
        U8 *p = d+len-1;
        while (p > d) {

-           *p-- = (U8)UTF_TO_NATIVE((uv & UTF_CONTINUATION_MASK) | UTF_CONTINUATION_MARK);
+           *p-- = (U8) 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 = (U8) I8_TO_NATIVE_UTF8((uv & UTF_START_MASK(len)) | UTF_START_MARK(len));

        return d+len;
     }
 #else /* Non loop style */
        return d+len;
     }
 #else /* Non loop style */


@@ -258,7 +263,7 @@ Perl_uvuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags)
        return d;
     }
 #endif
        return d;
     }
 #endif

-#endif /* Loop style */
+#endif /* Non loop style */

 }
 
 /*
 }
 
 /*


@@ -275,11 +280,11 @@ 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
 you should use the _slow().  In practice this means that the _slow()
 will be used very rarely, since the maximum Unicode code point (as of
 Unicode 4.1) is U+10FFFF, which encodes in UTF-8 to four bytes.  Only

-the "Perl extended UTF-8" (the infamous 'v-strings') will encode into
+the "Perl extended UTF-8" (e.g, the infamous 'v-strings') will encode into

 five bytes or more.
 
 =cut */
 five bytes or more.
 
 =cut */

-STATIC STRLEN
+PERL_STATIC_INLINE STRLEN

 S_is_utf8_char_slow(const U8 *s, const STRLEN len)
 {
     dTHX;   /* The function called below requires thread context */
 S_is_utf8_char_slow(const U8 *s, const STRLEN len)
 {
     dTHX;   /* The function called below requires thread context */


@@ -288,7 +293,7 @@ S_is_utf8_char_slow(const U8 *s, const STRLEN len)
 
     PERL_ARGS_ASSERT_IS_UTF8_CHAR_SLOW;
 
 
     PERL_ARGS_ASSERT_IS_UTF8_CHAR_SLOW;
 

-    utf8n_to_uvuni(s, len, &actual_len, UTF8_CHECK_ONLY);
+    utf8n_to_uvchr(s, len, &actual_len, UTF8_CHECK_ONLY);

 
     return (actual_len == (STRLEN) -1) ? 0 : actual_len;
 }
 
     return (actual_len == (STRLEN) -1) ? 0 : actual_len;
 }


@@ -333,8 +338,6 @@ Perl_is_utf8_char_buf(const U8 *buf, const U8* buf_end)
 /*
 =for apidoc is_utf8_char
 
 /*
 =for apidoc is_utf8_char
 

-DEPRECATED!
-

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


@@ -383,8 +386,6 @@ Perl_is_utf8_string(const U8 *s, STRLEN len)
         if (UTF8_IS_INVARIANT(*x)) {
            x++;
         }
         if (UTF8_IS_INVARIANT(*x)) {
            x++;
         }

-        else if (!UTF8_IS_START(*x))
-            return FALSE;

         else {
              /* ... and call is_utf8_char() only if really needed. */
             const STRLEN c = UTF8SKIP(x);
         else {
              /* ... and call is_utf8_char() only if really needed. */
             const STRLEN c = UTF8SKIP(x);


@@ -447,8 +448,6 @@ Perl_is_utf8_string_loclen(const U8 *s, STRLEN len, const U8 **ep, STRLEN *el)
         /* Inline the easy bits of is_utf8_char() here for speed... */
         if (UTF8_IS_INVARIANT(*x))
             next_char_ptr = x + 1;
         /* Inline the easy bits of is_utf8_char() here for speed... */
         if (UTF8_IS_INVARIANT(*x))
             next_char_ptr = x + 1;

-        else if (!UTF8_IS_START(*x))
-            goto out;

         else {
             /* ... and call is_utf8_char() only if really needed. */
             c = UTF8SKIP(x);
         else {
             /* ... and call is_utf8_char() only if really needed. */
             c = UTF8SKIP(x);


@@ -507,7 +506,13 @@ determinable reasonable value.
 The 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
 The 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> and return zero.
+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
+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.

 
 Certain code points are considered problematic.  These are Unicode surrogates,
 Unicode non-characters, and code points above the Unicode maximum of 0x10FFFF.
 
 Certain code points are considered problematic.  These are Unicode surrogates,
 Unicode non-characters, and code points above the Unicode maximum of 0x10FFFF.


@@ -618,7 +623,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) (NATIVE_UTF8_TO_I8(*s));

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


@@ -638,7 +643,7 @@ Perl_utf8n_to_uvuni(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
     }
 
 #ifdef EBCDIC
     }
 
 #ifdef EBCDIC

-    uv = NATIVE_TO_UTF(uv);
+    uv = NATIVE_UTF8_TO_I8(uv);

 #endif
 
     /* Here is not a continuation byte, nor an invariant.  The only thing left
 #endif
 
     /* Here is not a continuation byte, nor an invariant.  The only thing left


@@ -899,11 +904,12 @@ 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 (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.
+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
 */
 
 =cut
 */


@@ -938,8 +944,6 @@ Perl_valid_utf8_to_uvchr(pTHX_ const U8 *s, STRLEN *retlen)
 /*
 =for apidoc utf8_to_uvchr
 
 /*
 =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.
 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.


@@ -1009,7 +1013,7 @@ 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 = NATIVE_UTF8_TO_I8(*s);

 
     PERL_ARGS_ASSERT_VALID_UTF8_TO_UVUNI;
 
 
     PERL_ARGS_ASSERT_VALID_UTF8_TO_UVUNI;
 


@@ -1039,8 +1043,6 @@ Perl_valid_utf8_to_uvuni(pTHX_ const U8 *s, STRLEN *retlen)
 /*
 =for apidoc utf8_to_uvuni
 
 /*
 =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.
 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.


@@ -1096,10 +1098,7 @@ Perl_utf8_length(pTHX_ const U8 *s, const U8 *e)
     if (e < s)
        goto warn_and_return;
     while (s < e) {
     if (e < s)
        goto warn_and_return;
     while (s < e) {

-       if (!UTF8_IS_INVARIANT(*s))
-           s += UTF8SKIP(s);
-       else
-           s++;
+        s += UTF8SKIP(s);

        len++;
     }
 
        len++;
     }
 


@@ -1377,13 +1376,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;


@@ -1414,7 +1408,7 @@ Perl_utf16_to_utf8(pTHX_ U8* p, U8* d, I32 bytelen, I32 *newlen)
        p += 2;
        if (uv < 0x80) {
 #ifdef EBCDIC
        p += 2;
        if (uv < 0x80) {
 #ifdef EBCDIC

-           *d++ = UNI_TO_NATIVE(uv);
+           *d++ = LATIN1_TO_NATIVE(uv);

 #else
            *d++ = (U8)uv;
 #endif
 #else
            *d++ = (U8)uv;
 #endif


@@ -1425,17 +1419,22 @@ 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;
        }

-       if (uv >= 0xd800 && uv <= 0xdbff) {     /* surrogates */
+#define FIRST_HIGH_SURROGATE UNICODE_SURROGATE_FIRST
+#define LAST_HIGH_SURROGATE  0xDBFF
+#define FIRST_LOW_SURROGATE  0xDC00
+#define LAST_LOW_SURROGATE   UNICODE_SURROGATE_LAST
+       if (uv >= FIRST_HIGH_SURROGATE && uv <= LAST_HIGH_SURROGATE) {

            if (p >= pend) {
                Perl_croak(aTHX_ "Malformed UTF-16 surrogate");
            } else {
                UV low = (p[0] << 8) + p[1];
                p += 2;
            if (p >= pend) {
                Perl_croak(aTHX_ "Malformed UTF-16 surrogate");
            } else {
                UV low = (p[0] << 8) + p[1];
                p += 2;

-               if (low < 0xdc00 || low > 0xdfff)
+               if (low < FIRST_LOW_SURROGATE || 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;
+               uv = ((uv - FIRST_HIGH_SURROGATE) << 10)
+                                       + (low - FIRST_LOW_SURROGATE) + 0x10000;

            }
            }

-       } else if (uv >= 0xdc00 && uv <= 0xdfff) {
+       } else if (uv >= FIRST_LOW_SURROGATE && uv <= LAST_LOW_SURROGATE) {

            Perl_croak(aTHX_ "Malformed UTF-16 surrogate");
        }
        if (uv < 0x10000) {
            Perl_croak(aTHX_ "Malformed UTF-16 surrogate");
        }
        if (uv < 0x10000) {


@@ -1479,6 +1478,14 @@ Perl_utf16_to_utf8_reversed(pTHX_ U8* p, U8* d, I32 bytelen, I32 *newlen)
     return utf16_to_utf8(p, d, bytelen, newlen);
 }
 
     return utf16_to_utf8(p, d, bytelen, newlen);
 }
 

+bool
+Perl__is_uni_FOO(pTHX_ const U8 classnum, const UV c)
+{
+    U8 tmpbuf[UTF8_MAXBYTES+1];
+    uvchr_to_utf8(tmpbuf, c);
+    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 */
 /* 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 */


@@ -1488,7 +1495,29 @@ Perl_is_uni_alnum(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXBYTES+1];
     uvchr_to_utf8(tmpbuf, c);
 {
     U8 tmpbuf[UTF8_MAXBYTES+1];
     uvchr_to_utf8(tmpbuf, c);

-    return is_utf8_alnum(tmpbuf);
+    return _is_utf8_FOO(_CC_WORDCHAR, tmpbuf);
+}
+
+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);
+}
+
+/* Internal function so we can deprecate the external one, and call
+   this one from other deprecated functions in this file */
+
+PERL_STATIC_INLINE bool
+S_is_utf8_idfirst(pTHX_ const U8 *p)
+{
+    dVAR;
+
+    if (*p == '_')
+       return TRUE;
+    /* is_utf8_idstart would be more logical. */
+    return is_utf8_common(p, &PL_utf8_idstart, "IdStart");

 }
 
 bool
 }
 
 bool


@@ -1496,7 +1525,23 @@ Perl_is_uni_idfirst(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXBYTES+1];
     uvchr_to_utf8(tmpbuf, c);
 {
     U8 tmpbuf[UTF8_MAXBYTES+1];
     uvchr_to_utf8(tmpbuf, c);

-    return is_utf8_idfirst(tmpbuf);
+    return S_is_utf8_idfirst(aTHX_ tmpbuf);
+}
+
+bool
+Perl__is_uni_perl_idcont(pTHX_ UV c)
+{
+    U8 tmpbuf[UTF8_MAXBYTES+1];
+    uvchr_to_utf8(tmpbuf, c);
+    return _is_utf8_perl_idcont(tmpbuf);
+}
+
+bool
+Perl__is_uni_perl_idstart(pTHX_ UV c)
+{
+    U8 tmpbuf[UTF8_MAXBYTES+1];
+    uvchr_to_utf8(tmpbuf, c);
+    return _is_utf8_perl_idstart(tmpbuf);

 }
 
 bool
 }
 
 bool


@@ -1504,7 +1549,7 @@ Perl_is_uni_alpha(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXBYTES+1];
     uvchr_to_utf8(tmpbuf, c);
 {
     U8 tmpbuf[UTF8_MAXBYTES+1];
     uvchr_to_utf8(tmpbuf, c);

-    return is_utf8_alpha(tmpbuf);
+    return _is_utf8_FOO(_CC_ALPHA, tmpbuf);

 }
 
 bool
 }
 
 bool


@@ -1516,17 +1561,13 @@ Perl_is_uni_ascii(pTHX_ UV c)
 bool
 Perl_is_uni_blank(pTHX_ UV c)
 {
 bool
 Perl_is_uni_blank(pTHX_ UV c)
 {

-    U8 tmpbuf[UTF8_MAXBYTES+1];
-    uvchr_to_utf8(tmpbuf, c);
-    return is_utf8_blank(tmpbuf);
+    return isBLANK_uni(c);

 }
 
 bool
 Perl_is_uni_space(pTHX_ UV c)
 {
 }
 
 bool
 Perl_is_uni_space(pTHX_ UV c)
 {

-    U8 tmpbuf[UTF8_MAXBYTES+1];
-    uvchr_to_utf8(tmpbuf, c);
-    return is_utf8_space(tmpbuf);
+    return isSPACE_uni(c);

 }
 
 bool
 }
 
 bool


@@ -1534,7 +1575,7 @@ Perl_is_uni_digit(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXBYTES+1];
     uvchr_to_utf8(tmpbuf, c);
 {
     U8 tmpbuf[UTF8_MAXBYTES+1];
     uvchr_to_utf8(tmpbuf, c);

-    return is_utf8_digit(tmpbuf);
+    return _is_utf8_FOO(_CC_DIGIT, tmpbuf);

 }
 
 bool
 }
 
 bool


@@ -1542,7 +1583,7 @@ Perl_is_uni_upper(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXBYTES+1];
     uvchr_to_utf8(tmpbuf, c);
 {
     U8 tmpbuf[UTF8_MAXBYTES+1];
     uvchr_to_utf8(tmpbuf, c);

-    return is_utf8_upper(tmpbuf);
+    return _is_utf8_FOO(_CC_UPPER, tmpbuf);

 }
 
 bool
 }
 
 bool


@@ -1550,7 +1591,7 @@ Perl_is_uni_lower(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXBYTES+1];
     uvchr_to_utf8(tmpbuf, c);
 {
     U8 tmpbuf[UTF8_MAXBYTES+1];
     uvchr_to_utf8(tmpbuf, c);

-    return is_utf8_lower(tmpbuf);
+    return _is_utf8_FOO(_CC_LOWER, tmpbuf);

 }
 
 bool
 }
 
 bool


@@ -1564,7 +1605,7 @@ Perl_is_uni_graph(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXBYTES+1];
     uvchr_to_utf8(tmpbuf, c);
 {
     U8 tmpbuf[UTF8_MAXBYTES+1];
     uvchr_to_utf8(tmpbuf, c);

-    return is_utf8_graph(tmpbuf);
+    return _is_utf8_FOO(_CC_GRAPH, tmpbuf);

 }
 
 bool
 }
 
 bool


@@ -1572,7 +1613,7 @@ Perl_is_uni_print(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXBYTES+1];
     uvchr_to_utf8(tmpbuf, c);
 {
     U8 tmpbuf[UTF8_MAXBYTES+1];
     uvchr_to_utf8(tmpbuf, c);

-    return is_utf8_print(tmpbuf);
+    return _is_utf8_FOO(_CC_PRINT, tmpbuf);

 }
 
 bool
 }
 
 bool


@@ -1580,15 +1621,13 @@ Perl_is_uni_punct(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXBYTES+1];
     uvchr_to_utf8(tmpbuf, c);
 {
     U8 tmpbuf[UTF8_MAXBYTES+1];
     uvchr_to_utf8(tmpbuf, c);

-    return is_utf8_punct(tmpbuf);
+    return _is_utf8_FOO(_CC_PUNCT, tmpbuf);

 }
 
 bool
 Perl_is_uni_xdigit(pTHX_ UV c)
 {
 }
 
 bool
 Perl_is_uni_xdigit(pTHX_ UV c)
 {

-    U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
-    uvchr_to_utf8(tmpbuf, c);
-    return is_utf8_xdigit(tmpbuf);
+    return isXDIGIT_uni(c);

 }
 
 UV
 }
 
 UV


@@ -1736,23 +1775,41 @@ Perl_to_uni_lower(pTHX_ UV c, U8* p, STRLEN *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;
 

+    assert (! (flags & FOLD_FLAGS_LOCALE));
+

     if (c == MICRO_SIGN) {
        converted = GREEK_SMALL_LETTER_MU;
     }
     if (c == MICRO_SIGN) {
        converted = GREEK_SMALL_LETTER_MU;
     }

-    else if (flags && c == LATIN_SMALL_LETTER_SHARP_S) {
-       *(p)++ = 's';
-       *p = 's';
-       *lenp = 2;
-       return 's';
+    else if ((flags & FOLD_FLAGS_FULL) && 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';
+        }

     }
     else { /* In this range the fold of all other characters is their lower
               case */
     }
     else { /* In this range the fold of all other characters is their lower
               case */


@@ -1787,12 +1844,7 @@ Perl__to_uni_fold_flags(pTHX_ UV c, U8* p, STRLEN *lenp, const U8 flags)
 
     if (c < 256) {
        UV result = _to_fold_latin1((U8) c, p, lenp,
 
     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))));
+                             flags & (FOLD_FLAGS_FULL | 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)
        /* 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)


@@ -1813,92 +1865,139 @@ Perl__to_uni_fold_flags(pTHX_ UV c, U8* p, STRLEN *lenp, const U8 flags)
     }
 }
 
     }
 }
 

-/* for now these all assume no locale info available for Unicode > 255; and
- * the corresponding macros in handy.h (like isALNUM_LC_uvchr) should have been
- * called instead, so that these don't get called for < 255 */
-

 bool
 Perl_is_uni_alnum_lc(pTHX_ UV c)
 {
 bool
 Perl_is_uni_alnum_lc(pTHX_ UV c)
 {

-    return is_uni_alnum(c);    /* XXX no locale support yet */
+    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)
 {
 }
 
 bool
 Perl_is_uni_idfirst_lc(pTHX_ UV c)
 {

-    return is_uni_idfirst(c);  /* XXX no locale support yet */
+    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)
 {
 }
 
 bool
 Perl_is_uni_alpha_lc(pTHX_ UV c)
 {

-    return is_uni_alpha(c);    /* XXX no locale support yet */
+    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)
 {
 }
 
 bool
 Perl_is_uni_ascii_lc(pTHX_ UV c)
 {

-    return is_uni_ascii(c);    /* XXX no locale support yet */
+    if (c < 256) {
+        return isASCII_LC(UNI_TO_NATIVE(c));
+    }
+    return 0;

 }
 
 bool
 Perl_is_uni_blank_lc(pTHX_ UV c)
 {
 }
 
 bool
 Perl_is_uni_blank_lc(pTHX_ UV c)
 {

-    return is_uni_blank(c);    /* XXX no locale support yet */
+    if (c < 256) {
+        return isBLANK_LC(UNI_TO_NATIVE(c));
+    }
+    return isBLANK_uni(c);

 }
 
 bool
 Perl_is_uni_space_lc(pTHX_ UV c)
 {
 }
 
 bool
 Perl_is_uni_space_lc(pTHX_ UV c)
 {

-    return is_uni_space(c);    /* XXX no locale support yet */
+    if (c < 256) {
+        return isSPACE_LC(UNI_TO_NATIVE(c));
+    }
+    return isSPACE_uni(c);

 }
 
 bool
 Perl_is_uni_digit_lc(pTHX_ UV c)
 {
 }
 
 bool
 Perl_is_uni_digit_lc(pTHX_ UV c)
 {

-    return is_uni_digit(c);    /* XXX no locale support yet */
+    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)
 {
 }
 
 bool
 Perl_is_uni_upper_lc(pTHX_ UV c)
 {

-    return is_uni_upper(c);    /* XXX no locale support yet */
+    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)
 {
 }
 
 bool
 Perl_is_uni_lower_lc(pTHX_ UV c)
 {

-    return is_uni_lower(c);    /* XXX no locale support yet */
+    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)
 {
 }
 
 bool
 Perl_is_uni_cntrl_lc(pTHX_ UV c)
 {

-    return is_uni_cntrl(c);    /* XXX no locale support yet */
+    if (c < 256) {
+        return isCNTRL_LC(UNI_TO_NATIVE(c));
+    }
+    return 0;

 }
 
 bool
 Perl_is_uni_graph_lc(pTHX_ UV c)
 {
 }
 
 bool
 Perl_is_uni_graph_lc(pTHX_ UV c)
 {

-    return is_uni_graph(c);    /* XXX no locale support yet */
+    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)
 {
 }
 
 bool
 Perl_is_uni_print_lc(pTHX_ UV c)
 {

-    return is_uni_print(c);    /* XXX no locale support yet */
+    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)
 {
 }
 
 bool
 Perl_is_uni_punct_lc(pTHX_ UV c)
 {

-    return is_uni_punct(c);    /* XXX no locale support yet */
+    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)
 {
 }
 
 bool
 Perl_is_uni_xdigit_lc(pTHX_ UV c)
 {

-    return is_uni_xdigit(c);   /* XXX no locale support yet */
+    if (c < 256) {
+       return isXDIGIT_LC(UNI_TO_NATIVE(c));
+    }
+    return isXDIGIT_uni(c);

 }
 
 U32
 }
 
 U32


@@ -1931,7 +2030,7 @@ Perl_to_uni_lower_lc(pTHX_ U32 c)
     return (U32)to_uni_lower(c, tmpbuf, &len);
 }
 
     return (U32)to_uni_lower(c, tmpbuf, &len);
 }
 

-static bool
+PERL_STATIC_INLINE bool

 S_is_utf8_common(pTHX_ const U8 *const p, SV **swash,
                 const char *const swashname)
 {
 S_is_utf8_common(pTHX_ const U8 *const p, SV **swash,
                 const char *const swashname)
 {


@@ -1951,20 +2050,42 @@ S_is_utf8_common(pTHX_ const U8 *const p, SV **swash,
     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>,

-     * but it doesn't.  We therefor assume that p has been validated at least
+     * but it doesn't.  We therefore assume that p has been validated at least

      * 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)))
-       return FALSE;
+    if (! is_utf8_char_buf(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(WARN_UTF8)) {    /* This will output details as to the
+                                           what the malformation is */
+                utf8_to_uvchr_buf(p, p + UTF8SKIP(p), NULL);
+            }
+        }
+        return FALSE;
+    }

     if (!*swash) {
         U8 flags = _CORE_SWASH_INIT_ACCEPT_INVLIST;
         *swash = _core_swash_init("utf8", swashname, &PL_sv_undef, 1, 0, NULL, &flags);
     }
     if (!*swash) {
         U8 flags = _CORE_SWASH_INIT_ACCEPT_INVLIST;
         *swash = _core_swash_init("utf8", swashname, &PL_sv_undef, 1, 0, NULL, &flags);
     }

+

     return swash_fetch(*swash, p, TRUE) != 0;
 }
 
 bool
     return swash_fetch(*swash, p, TRUE) != 0;
 }
 
 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);
+
+    return is_utf8_common(p, &PL_utf8_swash_ptrs[classnum], swash_property_names[classnum]);
+}
+
+bool

 Perl_is_utf8_alnum(pTHX_ const U8 *p)
 {
     dVAR;
 Perl_is_utf8_alnum(pTHX_ const U8 *p)
 {
     dVAR;


@@ -1974,7 +2095,17 @@ Perl_is_utf8_alnum(pTHX_ const U8 *p)
     /* NOTE: "IsWord", not "IsAlnum", since Alnum is a true
      * descendant of isalnum(3), in other words, it doesn't
      * contain the '_'. --jhi */
     /* 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_alnum, "IsWord");
+    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
 }
 
 bool


@@ -1984,10 +2115,7 @@ Perl_is_utf8_idfirst(pTHX_ const U8 *p) /* The naming is historical. */
 
     PERL_ARGS_ASSERT_IS_UTF8_IDFIRST;
 
 
     PERL_ARGS_ASSERT_IS_UTF8_IDFIRST;
 

-    if (*p == '_')
-       return TRUE;
-    /* is_utf8_idstart would be more logical. */
-    return is_utf8_common(p, &PL_utf8_idstart, "IdStart");
+    return S_is_utf8_idfirst(aTHX_ p);

 }
 
 bool
 }
 
 bool


@@ -2004,16 +2132,27 @@ Perl_is_utf8_xidfirst(pTHX_ const U8 *p) /* The naming is historical. */
 }
 
 bool
 }
 
 bool

-Perl__is_utf8__perl_idstart(pTHX_ const U8 *p)
+Perl__is_utf8_perl_idstart(pTHX_ const U8 *p)

 {
     dVAR;
 
 {
     dVAR;
 

-    PERL_ARGS_ASSERT__IS_UTF8__PERL_IDSTART;
+    PERL_ARGS_ASSERT__IS_UTF8_PERL_IDSTART;

 
     return is_utf8_common(p, &PL_utf8_perl_idstart, "_Perl_IDStart");
 }
 
 bool
 
     return is_utf8_common(p, &PL_utf8_perl_idstart, "_Perl_IDStart");
 }
 
 bool

+Perl__is_utf8_perl_idcont(pTHX_ const U8 *p)
+{
+    dVAR;
+
+    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_is_utf8_idcont(pTHX_ const U8 *p)
 {
     dVAR;


@@ -2040,7 +2179,7 @@ Perl_is_utf8_alpha(pTHX_ const U8 *p)
 
     PERL_ARGS_ASSERT_IS_UTF8_ALPHA;
 
 
     PERL_ARGS_ASSERT_IS_UTF8_ALPHA;
 

-    return is_utf8_common(p, &PL_utf8_alpha, "IsAlpha");
+    return is_utf8_common(p, &PL_utf8_swash_ptrs[_CC_ALPHA], "IsAlpha");

 }
 
 bool
 }
 
 bool


@@ -2062,7 +2201,7 @@ Perl_is_utf8_blank(pTHX_ const U8 *p)
 
     PERL_ARGS_ASSERT_IS_UTF8_BLANK;
 
 
     PERL_ARGS_ASSERT_IS_UTF8_BLANK;
 

-    return is_utf8_common(p, &PL_utf8_blank, "XPosixBlank");
+    return isBLANK_utf8(p);

 }
 
 bool
 }
 
 bool


@@ -2072,7 +2211,7 @@ Perl_is_utf8_space(pTHX_ const U8 *p)
 
     PERL_ARGS_ASSERT_IS_UTF8_SPACE;
 
 
     PERL_ARGS_ASSERT_IS_UTF8_SPACE;
 

-    return is_utf8_common(p, &PL_utf8_space, "IsXPerlSpace");
+    return isSPACE_utf8(p);

 }
 
 bool
 }
 
 bool


@@ -2106,7 +2245,7 @@ Perl_is_utf8_digit(pTHX_ const U8 *p)
 
     PERL_ARGS_ASSERT_IS_UTF8_DIGIT;
 
 
     PERL_ARGS_ASSERT_IS_UTF8_DIGIT;
 

-    return is_utf8_common(p, &PL_utf8_digit, "IsDigit");
+    return is_utf8_common(p, &PL_utf8_swash_ptrs[_CC_DIGIT], "IsDigit");

 }
 
 bool
 }
 
 bool


@@ -2128,7 +2267,7 @@ Perl_is_utf8_upper(pTHX_ const U8 *p)
 
     PERL_ARGS_ASSERT_IS_UTF8_UPPER;
 
 
     PERL_ARGS_ASSERT_IS_UTF8_UPPER;
 

-    return is_utf8_common(p, &PL_utf8_upper, "IsUppercase");
+    return is_utf8_common(p, &PL_utf8_swash_ptrs[_CC_UPPER], "IsUppercase");

 }
 
 bool
 }
 
 bool


@@ -2138,7 +2277,7 @@ Perl_is_utf8_lower(pTHX_ const U8 *p)
 
     PERL_ARGS_ASSERT_IS_UTF8_LOWER;
 
 
     PERL_ARGS_ASSERT_IS_UTF8_LOWER;
 

-    return is_utf8_common(p, &PL_utf8_lower, "IsLowercase");
+    return is_utf8_common(p, &PL_utf8_swash_ptrs[_CC_LOWER], "IsLowercase");

 }
 
 bool
 }
 
 bool


@@ -2148,15 +2287,7 @@ Perl_is_utf8_cntrl(pTHX_ const U8 *p)
 
     PERL_ARGS_ASSERT_IS_UTF8_CNTRL;
 
 
     PERL_ARGS_ASSERT_IS_UTF8_CNTRL;
 

-    if (isASCII(*p)) {
-       return isCNTRL_A(*p);
-    }
-
-    /* All controls are in Latin1 */
-    if (! UTF8_IS_DOWNGRADEABLE_START(*p)) {
-       return 0;
-    }
-    return isCNTRL_L1(TWO_BYTE_UTF8_TO_UNI(*p, *(p+1)));
+    return isCNTRL_utf8(p);

 }
 
 bool
 }
 
 bool


@@ -2166,7 +2297,7 @@ Perl_is_utf8_graph(pTHX_ const U8 *p)
 
     PERL_ARGS_ASSERT_IS_UTF8_GRAPH;
 
 
     PERL_ARGS_ASSERT_IS_UTF8_GRAPH;
 

-    return is_utf8_common(p, &PL_utf8_graph, "IsGraph");
+    return is_utf8_common(p, &PL_utf8_swash_ptrs[_CC_GRAPH], "IsGraph");

 }
 
 bool
 }
 
 bool


@@ -2176,7 +2307,7 @@ Perl_is_utf8_print(pTHX_ const U8 *p)
 
     PERL_ARGS_ASSERT_IS_UTF8_PRINT;
 
 
     PERL_ARGS_ASSERT_IS_UTF8_PRINT;
 

-    return is_utf8_common(p, &PL_utf8_print, "IsPrint");
+    return is_utf8_common(p, &PL_utf8_swash_ptrs[_CC_PRINT], "IsPrint");

 }
 
 bool
 }
 
 bool


@@ -2186,7 +2317,7 @@ Perl_is_utf8_punct(pTHX_ const U8 *p)
 
     PERL_ARGS_ASSERT_IS_UTF8_PUNCT;
 
 
     PERL_ARGS_ASSERT_IS_UTF8_PUNCT;
 

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

 }
 
 bool
 }
 
 bool


@@ -2196,119 +2327,30 @@ Perl_is_utf8_xdigit(pTHX_ const U8 *p)
 
     PERL_ARGS_ASSERT_IS_UTF8_XDIGIT;
 
 
     PERL_ARGS_ASSERT_IS_UTF8_XDIGIT;
 

-    return is_utf8_common(p, &PL_utf8_xdigit, "IsXDigit");
+    return is_XDIGIT_utf8(p);

 }
 
 bool
 }
 
 bool

-Perl_is_utf8_mark(pTHX_ const U8 *p)
+Perl__is_utf8_mark(pTHX_ const U8 *p)

 {
     dVAR;
 
 {
     dVAR;
 

-    PERL_ARGS_ASSERT_IS_UTF8_MARK;
+    PERL_ARGS_ASSERT__IS_UTF8_MARK;

 
     return is_utf8_common(p, &PL_utf8_mark, "IsM");
 }
 
 
     return is_utf8_common(p, &PL_utf8_mark, "IsM");
 }
 

-bool
-Perl_is_utf8_X_regular_begin(pTHX_ const U8 *p)
-{
-    dVAR;
-
-    PERL_ARGS_ASSERT_IS_UTF8_X_REGULAR_BEGIN;
-
-    return is_utf8_common(p, &PL_utf8_X_regular_begin, "_X_Regular_Begin");
-}

 
 bool
 
 bool

-Perl_is_utf8_X_extend(pTHX_ const U8 *p)
-{
-    dVAR;
-
-    PERL_ARGS_ASSERT_IS_UTF8_X_EXTEND;
-
-    return is_utf8_common(p, &PL_utf8_X_extend, "_X_Extend");
-}
-
-/* These constants are for finding GCB=LV and GCB=LVT.  These are for the
- * pre-composed Hangul syllables, which are all in a contiguous block and
- * arranged there in such a way so as to facilitate alorithmic determination of
- * their characteristics.  As such, they don't need a swash, but can be
- * determined by simple arithmetic.  Almost all are GCB=LVT, but every 28th one
- * is a GCB=LV */
-#define SBASE 0xAC00    /* Start of block */
-#define SCount 11172    /* Length of block */
-#define TCount 28
-
-#if 0   /* This routine is not currently used */
-bool
-Perl_is_utf8_X_LV(pTHX_ const U8 *p)
-{
-    /* Unlike most other similarly named routines here, this does not create a
-     * swash, so swash_fetch() cannot be used on PL_utf8_X_LV. */
-
-    dVAR;
-
-    UV cp = valid_utf8_to_uvchr(p, NULL);
-
-    PERL_ARGS_ASSERT_IS_UTF8_X_LV;
-
-    /* The earliest Unicode releases did not have these precomposed Hangul
-     * syllables.  Set to point to undef in that case, so will return false on
-     * every call */
-    if (! PL_utf8_X_LV) {   /* Set up if this is the first time called */
-        PL_utf8_X_LV = swash_init("utf8", "_X_GCB_LV", &PL_sv_undef, 1, 0);
-        if (_invlist_len(_get_swash_invlist(PL_utf8_X_LV)) == 0) {
-            SvREFCNT_dec(PL_utf8_X_LV);
-            PL_utf8_X_LV = &PL_sv_undef;
-        }
-    }
-
-    return (PL_utf8_X_LV != &PL_sv_undef
-            && cp >= SBASE && cp < SBASE + SCount
-            && (cp - SBASE) % TCount == 0); /* Only every TCount one is LV */
-}
-#endif
-
-bool
-Perl_is_utf8_X_LVT(pTHX_ const U8 *p)
+Perl_is_utf8_mark(pTHX_ const U8 *p)

 {
 {

-    /* Unlike most other similarly named routines here, this does not create a
-     * swash, so swash_fetch() cannot be used on PL_utf8_X_LVT. */
-

     dVAR;
 
     dVAR;
 

-    UV cp = valid_utf8_to_uvchr(p, NULL);
-
-    PERL_ARGS_ASSERT_IS_UTF8_X_LVT;
-
-    /* The earliest Unicode releases did not have these precomposed Hangul
-     * syllables.  Set to point to undef in that case, so will return false on
-     * every call */
-    if (! PL_utf8_X_LVT) {   /* Set up if this is the first time called */
-        PL_utf8_X_LVT = swash_init("utf8", "_X_GCB_LVT", &PL_sv_undef, 1, 0);
-        if (_invlist_len(_get_swash_invlist(PL_utf8_X_LVT)) == 0) {
-            SvREFCNT_dec(PL_utf8_X_LVT);
-            PL_utf8_X_LVT = &PL_sv_undef;
-        }
-    }
+    PERL_ARGS_ASSERT_IS_UTF8_MARK;

 
 

-    return (PL_utf8_X_LVT != &PL_sv_undef
-            && cp >= SBASE && cp < SBASE + SCount
-            && (cp - SBASE) % TCount != 0); /* All but every TCount one is LV */
+    return _is_utf8_mark(p);

 }
 
 }
 

-
-bool
-Perl__is_utf8_quotemeta(pTHX_ const U8 *p)
-{
-    /* For exclusive use of pp_quotemeta() */
-
-    dVAR;
-
-    PERL_ARGS_ASSERT__IS_UTF8_QUOTEMETA;
-
-    return is_utf8_common(p, &PL_utf8_quotemeta, "_Perl_Quotemeta");
-}

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


@@ -2447,7 +2489,9 @@ 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 */
     len = UTF8SKIP(p);
     /* Here, there was no mapping defined, which means that the code point maps
      * to itself.  Return the inputs */
     len = UTF8SKIP(p);

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

 
     if (lenp)
         *lenp = len;
 
     if (lenp)
         *lenp = len;


@@ -2474,7 +2518,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 */


@@ -2485,8 +2529,7 @@ 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);


@@ -2507,15 +2550,7 @@ 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 */
 
 
 =cut */
 


@@ -2579,15 +2614,7 @@ Perl__to_utf8_upper_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, const bool
 /*
 =for apidoc to_utf8_title
 
 /*
 =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 */
 
 
 =cut */
 


@@ -2653,15 +2680,7 @@ Perl__to_utf8_title_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, const bool
 /*
 =for apidoc to_utf8_lower
 
 /*
 =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 */
 
 
 =cut */
 


@@ -2726,16 +2745,7 @@ Perl__to_utf8_lower_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, const bool
 /*
 =for apidoc to_utf8_fold
 
 /*
 =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 */
 
 
 =cut */
 


@@ -2767,33 +2777,36 @@ Perl__to_utf8_fold_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, U8 flags, b
 
     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)));
+           result = toFOLD_LC(TWO_BYTE_UTF8_TO_UNI(*p, *(p+1)));

        }
        else {
            return _to_fold_latin1(TWO_BYTE_UTF8_TO_UNI(*p, *(p+1)),
        }
        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))));
+                            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 {  /* utf8, ord above 255 */
        result = CALL_FOLD_CASE(p, ustrp, lenp, flags & FOLD_FLAGS_FULL);
 

-       if ((flags & FOLD_FLAGS_LOCALE)) {
+       if (flags & FOLD_FLAGS_LOCALE) {
+
+            /* Special case this character, as what normally gets returned
+             * under locale doesn't work */
+            if (UTF8SKIP(p) == sizeof(LATIN_CAPITAL_LETTER_SHARP_S_UTF8) - 1
+                && memEQ((char *) p, LATIN_CAPITAL_LETTER_SHARP_S_UTF8,
+                          sizeof(LATIN_CAPITAL_LETTER_SHARP_S_UTF8) - 1))
+            {
+                goto return_long_s;
+            }

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


@@ -2814,6 +2827,12 @@ 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 this one instance, there is an alternative we can
+                     * return that is valid */
+                    if (original == LATIN_CAPITAL_LETTER_SHARP_S) {
+                        goto return_long_s;
+                    }

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


@@ -2840,6 +2859,18 @@ Perl__to_utf8_fold_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, U8 flags, b
        *tainted_ptr = TRUE;
     }
     return result;
        *tainted_ptr = TRUE;
     }
     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;

 }
 
 /* Note:
 }
 
 /* Note:


@@ -2867,8 +2898,8 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m
      * 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.
      * Which is returned should be immaterial to callers, as the only
      * 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.
      * Which is returned should be immaterial to callers, as the only

-     * operations permitted on a swash, swash_fetch() and
-     * _get_swash_invlist(), handle both these transparently.
+     * operations permitted on a swash, swash_fetch(), _get_swash_invlist(),
+     * and swash_to_invlist() handle both these transparently.

      *
      * This interface should only be used by functions that won't destroy or
      * adversely change the swash, as doing so affects all other uses of the
      *
      * This interface should only be used by functions that won't destroy or
      * adversely change the swash, as doing so affects all other uses of the


@@ -2942,20 +2973,29 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m
        method = gv_fetchmeth(stash, "SWASHNEW", 8, -1);
        if (!method) {  /* demand load utf8 */
            ENTER;
        method = gv_fetchmeth(stash, "SWASHNEW", 8, -1);
        if (!method) {  /* demand load utf8 */
            ENTER;

-           errsv_save = newSVsv(ERRSV);
+           if ((errsv_save = GvSV(PL_errgv))) SAVEFREESV(errsv_save);
+           GvSV(PL_errgv) = NULL;

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

-           SAVEBOOL(PL_tainted);
-           PL_tainted = 0;
+#ifndef NO_TAINT_SUPPORT
+           SAVEBOOL(TAINT_get);
+           TAINT_NOT;
+#endif

            Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, newSVpvn(pkg,pkg_len),
                             NULL);
            Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, newSVpvn(pkg,pkg_len),
                             NULL);

-           if (!SvTRUE(ERRSV))
-               sv_setsv(ERRSV, errsv_save);
-           SvREFCNT_dec(errsv_save);
+           {
+               /* Not ERRSV, as there is no need to vivify a scalar we are
+                  about to discard. */
+               SV * const errsv = GvSV(PL_errgv);
+               if (!SvTRUE(errsv)) {
+                   GvSV(PL_errgv) = SvREFCNT_inc_simple(errsv_save);
+                   SvREFCNT_dec(errsv);
+               }
+           }

            LEAVE;
        }
        SPAGAIN;
            LEAVE;
        }
        SPAGAIN;


@@ -2967,18 +3007,25 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m
        mPUSHi(minbits);
        mPUSHi(none);
        PUTBACK;
        mPUSHi(minbits);
        mPUSHi(none);
        PUTBACK;

-       errsv_save = newSVsv(ERRSV);
+       if ((errsv_save = GvSV(PL_errgv))) SAVEFREESV(errsv_save);
+       GvSV(PL_errgv) = NULL;

        /* If we already have a pointer to the method, no need to use
         * call_method() to repeat the lookup.  */
        /* If we already have a pointer to the method, no need to use
         * call_method() to repeat the lookup.  */

-       if (method ? call_sv(MUTABLE_SV(method), G_SCALAR)
+       if (method
+            ? call_sv(MUTABLE_SV(method), G_SCALAR)

            : call_sv(newSVpvs_flags("SWASHNEW", SVs_TEMP), G_SCALAR | G_METHOD))
        {
            retval = *PL_stack_sp--;
            SvREFCNT_inc(retval);
        }
            : call_sv(newSVpvs_flags("SWASHNEW", SVs_TEMP), G_SCALAR | G_METHOD))
        {
            retval = *PL_stack_sp--;
            SvREFCNT_inc(retval);
        }

-       if (!SvTRUE(ERRSV))
-           sv_setsv(ERRSV, errsv_save);
-       SvREFCNT_dec(errsv_save);
+       {
+           /* Not ERRSV.  See above. */
+           SV * const errsv = GvSV(PL_errgv);
+           if (!SvTRUE(errsv)) {
+               GvSV(PL_errgv) = SvREFCNT_inc_simple(errsv_save);
+               SvREFCNT_dec(errsv);
+           }
+       }

        LEAVE;
        POPSTACK;
        if (IN_PERL_COMPILETIME) {
        LEAVE;
        POPSTACK;
        if (IN_PERL_COMPILETIME) {


@@ -3022,6 +3069,8 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m
        SV** swash_invlistsvp = NULL;
        SV* swash_invlist = NULL;
        bool invlist_in_swash_is_valid = FALSE;
        SV** swash_invlistsvp = NULL;
        SV* swash_invlist = NULL;
        bool invlist_in_swash_is_valid = FALSE;

+       bool swash_invlist_unclaimed = FALSE; /* whether swash_invlist has
+                                           an unclaimed reference count */

 
         /* If this operation fetched a swash, get its already existing
          * inversion list, or create one for it */
 
         /* If this operation fetched a swash, get its already existing
          * inversion list, or create one for it */


@@ -3034,6 +3083,7 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m
            }
            else {
                swash_invlist = _swash_to_invlist(retval);
            }
            else {
                swash_invlist = _swash_to_invlist(retval);

+               swash_invlist_unclaimed = TRUE;

            }
        }
 
            }
        }
 


@@ -3056,7 +3106,7 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m
                  * we are going to return a swash */
                 if ((int) _invlist_len(invlist) > invlist_swash_boundary) {
                     swash_hv = newHV();
                  * we are going to return a swash */
                 if ((int) _invlist_len(invlist) > invlist_swash_boundary) {
                     swash_hv = newHV();

-                    retval = newRV_inc(MUTABLE_SV(swash_hv));
+                    retval = newRV_noinc(MUTABLE_SV(swash_hv));

                 }
                swash_invlist = invlist;
            }
                 }
                swash_invlist = invlist;
            }


@@ -3072,11 +3122,17 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m
             {
                Perl_croak(aTHX_ "panic: hv_store() unexpectedly failed");
            }
             {
                Perl_croak(aTHX_ "panic: hv_store() unexpectedly failed");
            }

+           /* We just stole a reference count. */
+           if (swash_invlist_unclaimed) swash_invlist_unclaimed = FALSE;
+           else SvREFCNT_inc_simple_void_NN(swash_invlist);

        }
 
        }
 

+        /* Use the inversion list stand-alone if small enough */

         if ((int) _invlist_len(swash_invlist) <= invlist_swash_boundary) {
            SvREFCNT_dec(retval);
         if ((int) _invlist_len(swash_invlist) <= invlist_swash_boundary) {
            SvREFCNT_dec(retval);

-            retval = newRV_inc(swash_invlist);
+           if (!swash_invlist_unclaimed)
+               SvREFCNT_inc_simple_void_NN(swash_invlist);
+            retval = newRV_noinc(swash_invlist);

         }
     }
 
         }
     }
 


@@ -3164,19 +3220,18 @@ Perl_swash_fetch(pTHX_ SV *swash, const U8 *ptr, bool do_utf8)
      * So the key in the hash (klen) is length of encoded char -1
      */
     klen = UTF8SKIP(ptr) - 1;
      * 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;
 
     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]);
+       off      = NATIVE_UTF8_TO_I8(ptr[klen]);

     }
     else {
       /* If char is encoded then swatch is for the prefix */
        needents = (1 << UTF_ACCUMULATION_SHIFT);
     }
     else {
       /* If char is encoded then swatch is for the prefix */
        needents = (1 << UTF_ACCUMULATION_SHIFT);

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

     }
 
     /*
     }
 
     /*


@@ -3689,7 +3744,7 @@ HV*
 Perl__swash_inversion_hash(pTHX_ SV* const swash)
 {
 
 Perl__swash_inversion_hash(pTHX_ SV* const swash)
 {
 

-   /* Subject to change or removal.  For use only in one place in regcomp.c.
+   /* Subject to change or removal.  For use only in regcomp.c and regexec.c

     * Can't be used on a property that is subject to user override, as it
     * relies on the value of SPECIALS in the swash which would be set by
     * utf8_heavy.pl to the hash in the non-overriden file, and hence is not set
     * Can't be used on a property that is subject to user override, as it
     * relies on the value of SPECIALS in the swash which would be set by
     * utf8_heavy.pl to the hash in the non-overriden file, and hence is not set


@@ -3703,7 +3758,7 @@ Perl__swash_inversion_hash(pTHX_ SV* const swash)
     *
     * The returned hash would have two keys, the utf8 for 006B and the utf8 for
     * 006C.  The value for each key is an array.  For 006C, the array would
     *
     * The returned hash would have two keys, the utf8 for 006B and the utf8 for
     * 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
+    * have two elements, the utf8 for itself, and for 004C.  For 006B, there

     * would be three elements in its array, the utf8 for 006B, 004B and 212A.
     *
     * Essentially, for any code point, it gives all the code points that map to
     * would be three elements in its array, the utf8 for 006B, 004B and 212A.
     *
     * Essentially, for any code point, it gives all the code points that map to


@@ -3730,7 +3785,8 @@ Perl__swash_inversion_hash(pTHX_ SV* const swash)
     STRLEN lcur;
     HV *const hv = MUTABLE_HV(SvRV(swash));
 
     STRLEN lcur;
     HV *const hv = MUTABLE_HV(SvRV(swash));
 

-    /* The string containing the main body of the table */
+    /* The string containing the main body of the table.  This will have its
+     * assertion fail if the swash has been converted to its inversion list */

     SV** const listsvp = hv_fetchs(hv, "LIST", FALSE);
 
     SV** const typesvp = hv_fetchs(hv, "TYPE", FALSE);
     SV** const listsvp = hv_fetchs(hv, "LIST", FALSE);
 
     SV** const typesvp = hv_fetchs(hv, "TYPE", FALSE);


@@ -3825,12 +3881,12 @@ Perl__swash_inversion_hash(pTHX_ SV* const swash)
                                                 &char_to, &to_len)))
        {
            if (av_len(from_list) > 0) {
                                                 &char_to, &to_len)))
        {
            if (av_len(from_list) > 0) {

-               int i;
+               SSize_t i;

 
                /* 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++) {
 
                /* 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;
+                   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) {


@@ -3961,7 +4017,8 @@ SV*
 Perl__swash_to_invlist(pTHX_ SV* const swash)
 {
 
 Perl__swash_to_invlist(pTHX_ SV* const swash)
 {
 

-   /* Subject to change or removal.  For use only in one place in regcomp.c */
+   /* Subject to change or removal.  For use only in one place in regcomp.c.
+    * Ownership is given to one reference count in the returned SV* */

 
     U8 *l, *lend;
     char *loc;
 
     U8 *l, *lend;
     char *loc;


@@ -3969,17 +4026,15 @@ Perl__swash_to_invlist(pTHX_ SV* const swash)
     HV *const hv = MUTABLE_HV(SvRV(swash));
     UV elements = 0;    /* Number of elements in the inversion list */
     U8 empty[] = "";
     HV *const hv = MUTABLE_HV(SvRV(swash));
     UV elements = 0;    /* Number of elements in the inversion list */
     U8 empty[] = "";

+    SV** listsvp;
+    SV** typesvp;
+    SV** bitssvp;
+    SV** extssvp;
+    SV** invert_it_svp;

 
 

-    /* The string containing the main body of the table */
-    SV** const listsvp = hv_fetchs(hv, "LIST", FALSE);
-    SV** const typesvp = hv_fetchs(hv, "TYPE", FALSE);
-    SV** const bitssvp = hv_fetchs(hv, "BITS", FALSE);
-    SV** const extssvp = hv_fetchs(hv, "EXTRAS", FALSE);
-    SV** const invert_it_svp = hv_fetchs(hv, "INVERT_IT", FALSE);
-
-    const U8* const typestr = (U8*)SvPV_nolen(*typesvp);
-    const STRLEN bits  = SvUV(*bitssvp);
-    const STRLEN octets = bits >> 3; /* if bits == 1, then octets == 0 */
+    U8* typestr;
+    STRLEN bits;
+    STRLEN octets; /* if bits == 1, then octets == 0 */

     U8 *x, *xend;
     STRLEN xcur;
 
     U8 *x, *xend;
     STRLEN xcur;
 


@@ -3987,6 +4042,22 @@ Perl__swash_to_invlist(pTHX_ SV* const swash)
 
     PERL_ARGS_ASSERT__SWASH_TO_INVLIST;
 
 
     PERL_ARGS_ASSERT__SWASH_TO_INVLIST;
 

+    /* If not a hash, it must be the swash's inversion list instead */
+    if (SvTYPE(hv) != SVt_PVHV) {
+        return SvREFCNT_inc_simple_NN((SV*) hv);
+    }
+
+    /* The string containing the main body of the table */
+    listsvp = hv_fetchs(hv, "LIST", FALSE);
+    typesvp = hv_fetchs(hv, "TYPE", FALSE);
+    bitssvp = hv_fetchs(hv, "BITS", FALSE);
+    extssvp = hv_fetchs(hv, "EXTRAS", FALSE);
+    invert_it_svp = hv_fetchs(hv, "INVERT_IT", FALSE);
+
+    typestr = (U8*)SvPV_nolen(*typesvp);
+    bits  = SvUV(*bitssvp);
+    octets = bits >> 3; /* if bits == 1, then octets == 0 */
+

     /* read $swash->{LIST} */
     if (SvPOK(*listsvp)) {
        l = (U8*)SvPV(*listsvp, lcur);
     /* read $swash->{LIST} */
     if (SvPOK(*listsvp)) {
        l = (U8*)SvPV(*listsvp, lcur);


@@ -4100,8 +4171,7 @@ Perl__swash_to_invlist(pTHX_ SV* const swash)
            _invlist_union(invlist, other, &invlist);
            break;
        case '!':
            _invlist_union(invlist, other, &invlist);
            break;
        case '!':

-           _invlist_invert(other);
-           _invlist_union(invlist, other, &invlist);
+            _invlist_union_maybe_complement_2nd(invlist, other, TRUE, &invlist);

            break;
        case '-':
            _invlist_subtract(invlist, other, &invlist);
            break;
        case '-':
            _invlist_subtract(invlist, other, &invlist);


@@ -4206,7 +4276,7 @@ U32 flags)
 }
 
 bool
 }
 
 bool

-Perl_check_utf8_print(pTHX_ register const U8* s, const STRLEN len)
+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
 {
     /* May change: warns if surrogates, non-character code points, or
      * non-Unicode code points are in s which has length len bytes.  Returns


@@ -4353,9 +4423,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);
 }
 


@@ -4377,9 +4450,11 @@ scanning won't continue past that goal.  Correspondingly for C<l2> with respect
 C<s2>.
 
 If C<pe1> is non-NULL and the pointer it points to is not NULL, that pointer is
 C<s2>.
 
 If C<pe1> is non-NULL and the pointer it points to is not NULL, that pointer is

-considered an end pointer beyond which scanning of C<s1> will not continue under
-any circumstances.  This means that if both C<l1> and C<pe1> are specified, and
-C<pe1>
+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;
+malformed input can cause it to read past C<pe1>).
+This means that if both C<l1> and C<pe1> are specified, and C<pe1>

 is less than C<s1>+C<l1>, the match will never be successful because it can
 never
 get as far as its goal (and in fact is asserted against).  Correspondingly for
 is less than C<s1>+C<l1>, the match will never be successful because it can
 never
 get as far as its goal (and in fact is asserted against).  Correspondingly for


@@ -4415,7 +4490,7 @@ L<http://www.unicode.org/unicode/reports/tr21/> (Case Mappings).
  *  FOLDEQ_S2_ALREADY_FOLDED   Similarly.
  */
 I32
  *  FOLDEQ_S2_ALREADY_FOLDED   Similarly.
  */
 I32

-Perl_foldEQ_utf8_flags(pTHX_ const char *s1, char **pe1, register UV l1, bool u1, const char *s2, char **pe2, register UV l2, bool u2, U32 flags)
+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 */
 {
     dVAR;
     const U8 *p1  = (const U8*)s1; /* Point to current char */


@@ -4493,19 +4568,15 @@ Perl_foldEQ_utf8_flags(pTHX_ const char *s1, char **pe1, register UV l1, bool u1
                f1 = (U8 *) p1;
                n1 = UTF8SKIP(f1);
            }
                f1 = (U8 *) p1;
                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)
            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)))
+                   && (! u1 || ! UTF8_IS_ABOVE_LATIN1(*p1)))

                {
                    /* There is no mixing of code points above and below 255. */
                {
                    /* There is no mixing of code points above and below 255. */

-                   if (u2 && (! UTF8_IS_INVARIANT(*p2)
-                       && ! UTF8_IS_DOWNGRADEABLE_START(*p2)))
-                   {
+                   if (u2 && UTF8_IS_ABOVE_LATIN1(*p2)) {

                        return 0;
                    }
 
                        return 0;
                    }
 


@@ -4528,14 +4599,13 @@ Perl_foldEQ_utf8_flags(pTHX_ const char *s1, char **pe1, register UV l1, bool u1
                        return 0;
                    }
                    n1 = 1;
                        return 0;
                    }
                    n1 = 1;

-                   *foldbuf1 = toLOWER(*p1);   /* Folds in the ASCII range are
-                                                  just lowercased */
+                   *foldbuf1 = toFOLD(*p1);

                }
                else if (u1) {
                    to_utf8_fold(p1, foldbuf1, &n1);
                }
                else {  /* Not utf8, get utf8 fold */
                }
                else if (u1) {
                    to_utf8_fold(p1, foldbuf1, &n1);
                }
                else {  /* Not utf8, get utf8 fold */

-                   to_uni_fold(NATIVE_TO_UNI(*p1), foldbuf1, &n1);
+                   to_uni_fold(NATIVE_TO_LATIN1(*p1), foldbuf1, &n1);

                }
                f1 = foldbuf1;
            }
                }
                f1 = foldbuf1;
            }


@@ -4548,13 +4618,11 @@ Perl_foldEQ_utf8_flags(pTHX_ const char *s1, char **pe1, register UV l1, bool u1
            }
            else {
                if ((flags & FOLDEQ_UTF8_LOCALE)
            }
            else {
                if ((flags & FOLDEQ_UTF8_LOCALE)

-                   && (! u2 || UTF8_IS_INVARIANT(*p2) || UTF8_IS_DOWNGRADEABLE_START(*p2)))
+                   && (! u2 || ! UTF8_IS_ABOVE_LATIN1(*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 */
                {
                    /* 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)))
-                   {
+                   if (u1 && UTF8_IS_ABOVE_LATIN1(*p1)) {

                        return 0;
                    }
                    if (! u2 || UTF8_IS_INVARIANT(*p2)) {
                        return 0;
                    }
                    if (! u2 || UTF8_IS_INVARIANT(*p2)) {


@@ -4576,13 +4644,13 @@ Perl_foldEQ_utf8_flags(pTHX_ const char *s1, char **pe1, register UV l1, bool u1
                        return 0;
                    }
                    n2 = 1;
                        return 0;
                    }
                    n2 = 1;

-                   *foldbuf2 = toLOWER(*p2);
+                   *foldbuf2 = toFOLD(*p2);

                }
                else if (u2) {
                    to_utf8_fold(p2, foldbuf2, &n2);
                }
                else {
                }
                else if (u2) {
                    to_utf8_fold(p2, foldbuf2, &n2);
                }
                else {

-                   to_uni_fold(NATIVE_TO_UNI(*p2), foldbuf2, &n2);
+                   to_uni_fold(NATIVE_TO_LATIN1(*p2), foldbuf2, &n2);

                }
                f2 = foldbuf2;
            }
                }
                f2 = foldbuf2;
            }