Document packWARN.?

[perl5.git] / sv.c

diff --git a/sv.c b/sv.c
index 2475d46..a268002 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -130,7 +130,7 @@ static const char S_destroy[] = "DESTROY";
 
 /* ============================================================================
 
 
 /* ============================================================================
 

-=head1 Allocation and deallocation of SVs.
+=for apidoc_section SV Handling

 An SV (or AV, HV, etc.) is allocated in two parts: the head (struct
 sv, av, hv...) contains type and reference count information, and for
 many types, a pointer to the body (struct xrv, xpv, xpviv...), which
 An SV (or AV, HV, etc.) is allocated in two parts: the head (struct
 sv, av, hv...) contains type and reference count information, and for
 many types, a pointer to the body (struct xrv, xpv, xpviv...), which


@@ -408,7 +408,7 @@ S_del_sv(pTHX_ SV *p)
 
 
 /*
 
 
 /*

-=head1 SV Manipulation Functions
+=for apidoc_section SV Handling

 
 =for apidoc sv_add_arena
 
 
 =for apidoc sv_add_arena
 


@@ -769,7 +769,7 @@ Perl_sv_free_arenas(pTHX)
 
 /*
   Here are mid-level routines that manage the allocation of bodies out
 
 /*
   Here are mid-level routines that manage the allocation of bodies out

-  of the various arenas.  There are 5 kinds of arenas:
+  of the various arenas.  There are 4 kinds of arenas:

 
   1. SV-head arenas, which are discussed and handled above
   2. regular body arenas
 
   1. SV-head arenas, which are discussed and handled above
   2. regular body arenas


@@ -782,7 +782,7 @@ Perl_sv_free_arenas(pTHX)
   unused block of them is wasteful.  Also, several svtypes dont have
   bodies; the data fits into the sv-head itself.  The arena-root
   pointer thus has a few unused root-pointers (which may be hijacked
   unused block of them is wasteful.  Also, several svtypes dont have
   bodies; the data fits into the sv-head itself.  The arena-root
   pointer thus has a few unused root-pointers (which may be hijacked

-  later for arena types 4,5)
+  later for arena type 4)

 
   3 differs from 2 as an optimization; some body types have several
   unused fields in the front of the structure (which are kept in-place
 
   3 differs from 2 as an optimization; some body types have several
   unused fields in the front of the structure (which are kept in-place


@@ -791,11 +791,6 @@ Perl_sv_free_arenas(pTHX)
   are decremented to point at the unused 'ghost' memory, knowing that
   the pointers are used with offsets to the real memory.
 
   are decremented to point at the unused 'ghost' memory, knowing that
   the pointers are used with offsets to the real memory.
 

-
-=head1 SV-Body Allocation
-
-=cut
-

 Allocation of SV-bodies is similar to SV-heads, differing as follows;
 the allocation mechanism is used for many body types, so is somewhat
 more complicated, it uses arena-sets, and has no need for still-live
 Allocation of SV-bodies is similar to SV-heads, differing as follows;
 the allocation mechanism is used for many body types, so is somewhat
 more complicated, it uses arena-sets, and has no need for still-live


@@ -887,6 +882,23 @@ struct body_details {
     U32 arena_size;                 /* Size of arena to allocate */
 };
 
     U32 arena_size;                 /* Size of arena to allocate */
 };
 

+#define ALIGNED_TYPE_NAME(name) name##_aligned
+#define ALIGNED_TYPE(name)             \
+    typedef union {    \
+        name align_me;                         \
+        NV nv;                         \
+        IV iv;                         \
+    } ALIGNED_TYPE_NAME(name);
+
+ALIGNED_TYPE(regexp);
+ALIGNED_TYPE(XPVGV);
+ALIGNED_TYPE(XPVLV);
+ALIGNED_TYPE(XPVAV);
+ALIGNED_TYPE(XPVHV);
+ALIGNED_TYPE(XPVCV);
+ALIGNED_TYPE(XPVFM);
+ALIGNED_TYPE(XPVIO);
+

 #define HADNV FALSE
 #define NONV TRUE
 
 #define HADNV FALSE
 #define NONV TRUE
 


@@ -975,48 +987,48 @@ static const struct body_details bodies_by_type[] = {
     { sizeof(XPVMG), copy_length(XPVMG, xnv_u), 0, SVt_PVMG, FALSE, HADNV,
       HASARENA, FIT_ARENA(0, sizeof(XPVMG)) },
 
     { sizeof(XPVMG), copy_length(XPVMG, xnv_u), 0, SVt_PVMG, FALSE, HADNV,
       HASARENA, FIT_ARENA(0, sizeof(XPVMG)) },
 

-    { sizeof(regexp),
+    { sizeof(ALIGNED_TYPE_NAME(regexp)),

       sizeof(regexp),
       0,
       SVt_REGEXP, TRUE, NONV, HASARENA,
       sizeof(regexp),
       0,
       SVt_REGEXP, TRUE, NONV, HASARENA,

-      FIT_ARENA(0, sizeof(regexp))
+      FIT_ARENA(0, sizeof(ALIGNED_TYPE_NAME(regexp)))

     },
 
     },
 

-    { sizeof(XPVGV), sizeof(XPVGV), 0, SVt_PVGV, TRUE, HADNV,
-      HASARENA, FIT_ARENA(0, sizeof(XPVGV)) },
+    { sizeof(ALIGNED_TYPE_NAME(XPVGV)), sizeof(XPVGV), 0, SVt_PVGV, TRUE, HADNV,
+      HASARENA, FIT_ARENA(0, sizeof(ALIGNED_TYPE_NAME(XPVGV))) },

     
     

-    { sizeof(XPVLV), sizeof(XPVLV), 0, SVt_PVLV, TRUE, HADNV,
-      HASARENA, FIT_ARENA(0, sizeof(XPVLV)) },
+    { sizeof(ALIGNED_TYPE_NAME(XPVLV)), sizeof(XPVLV), 0, SVt_PVLV, TRUE, HADNV,
+      HASARENA, FIT_ARENA(0, sizeof(ALIGNED_TYPE_NAME(XPVLV))) },

 
 

-    { sizeof(XPVAV),
+    { sizeof(ALIGNED_TYPE_NAME(XPVAV)),

       copy_length(XPVAV, xav_alloc),
       0,
       SVt_PVAV, TRUE, NONV, HASARENA,
       copy_length(XPVAV, xav_alloc),
       0,
       SVt_PVAV, TRUE, NONV, HASARENA,

-      FIT_ARENA(0, sizeof(XPVAV)) },
+      FIT_ARENA(0, sizeof(ALIGNED_TYPE_NAME(XPVAV))) },

 
 

-    { sizeof(XPVHV),
+    { sizeof(ALIGNED_TYPE_NAME(XPVHV)),

       copy_length(XPVHV, xhv_max),
       0,
       SVt_PVHV, TRUE, NONV, HASARENA,
       copy_length(XPVHV, xhv_max),
       0,
       SVt_PVHV, TRUE, NONV, HASARENA,

-      FIT_ARENA(0, sizeof(XPVHV)) },
+      FIT_ARENA(0, sizeof(ALIGNED_TYPE_NAME(XPVHV))) },

 
 

-    { sizeof(XPVCV),
+    { sizeof(ALIGNED_TYPE_NAME(XPVCV)),

       sizeof(XPVCV),
       0,
       SVt_PVCV, TRUE, NONV, HASARENA,
       sizeof(XPVCV),
       0,
       SVt_PVCV, TRUE, NONV, HASARENA,

-      FIT_ARENA(0, sizeof(XPVCV)) },
+      FIT_ARENA(0, sizeof(ALIGNED_TYPE_NAME(XPVCV))) },

 
 

-    { sizeof(XPVFM),
+    { sizeof(ALIGNED_TYPE_NAME(XPVFM)),

       sizeof(XPVFM),
       0,
       SVt_PVFM, TRUE, NONV, NOARENA,
       sizeof(XPVFM),
       0,
       SVt_PVFM, TRUE, NONV, NOARENA,

-      FIT_ARENA(20, sizeof(XPVFM)) },
+      FIT_ARENA(20, sizeof(ALIGNED_TYPE_NAME(XPVFM))) },

 
 

-    { sizeof(XPVIO),
+    { sizeof(ALIGNED_TYPE_NAME(XPVIO)),

       sizeof(XPVIO),
       0,
       SVt_PVIO, TRUE, NONV, HASARENA,
       sizeof(XPVIO),
       0,
       SVt_PVIO, TRUE, NONV, HASARENA,

-      FIT_ARENA(24, sizeof(XPVIO)) },
+      FIT_ARENA(24, sizeof(ALIGNED_TYPE_NAME(XPVIO))) },

 };
 
 #define new_body_allocated(sv_type)            \
 };
 
 #define new_body_allocated(sv_type)            \


@@ -1072,14 +1084,9 @@ Perl_more_bodies (pTHX_ const svtype sv_type, const size_t body_size,
     char *start;
     const char *end;
     const size_t good_arena_size = Perl_malloc_good_size(arena_size);
     char *start;
     const char *end;
     const size_t good_arena_size = Perl_malloc_good_size(arena_size);

-#if defined(DEBUGGING) && defined(PERL_GLOBAL_STRUCT)
-    dVAR;
-#endif
-#if defined(DEBUGGING) && !defined(PERL_GLOBAL_STRUCT_PRIVATE)
+#if defined(DEBUGGING)

     static bool done_sanity_check;
 
     static bool done_sanity_check;
 

-    /* PERL_GLOBAL_STRUCT_PRIVATE cannot coexist with global
-     * variables like done_sanity_check. */

     if (!done_sanity_check) {
        unsigned int i = SVt_LAST;
 
     if (!done_sanity_check) {
        unsigned int i = SVt_LAST;
 


@@ -2090,10 +2097,6 @@ S_sv_2iuv_non_preserve(pTHX_ SV *const sv
 
 /* If numtype is infnan, set the NV of the sv accordingly.
  * If numtype is anything else, try setting the NV using Atof(PV). */
 
 /* If numtype is infnan, set the NV of the sv accordingly.
  * If numtype is anything else, try setting the NV using Atof(PV). */

-#ifdef USING_MSVC6
-#  pragma warning(push)
-#  pragma warning(disable:4756;disable:4056)
-#endif

 static void
 S_sv_setnv(pTHX_ SV* sv, int numtype)
 {
 static void
 S_sv_setnv(pTHX_ SV* sv, int numtype)
 {


@@ -2122,9 +2125,6 @@ S_sv_setnv(pTHX_ SV* sv, int numtype)
             SvPOK_on(sv); /* PV is okay, though. */
     }
 }
             SvPOK_on(sv); /* PV is okay, though. */
     }
 }

-#ifdef USING_MSVC6
-#  pragma warning(pop)
-#endif

 
 STATIC bool
 S_sv_2iuv_common(pTHX_ SV *const sv)
 
 STATIC bool
 S_sv_2iuv_common(pTHX_ SV *const sv)


@@ -2405,7 +2405,7 @@ S_sv_2iuv_common(pTHX_ SV *const sv)
            SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK);
        }
     }
            SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK);
        }
     }

-    else  {
+    else {

        if (isGV_with_GP(sv))
            return glob_2number(MUTABLE_GV(sv));
 
        if (isGV_with_GP(sv))
            return glob_2number(MUTABLE_GV(sv));
 


@@ -2523,6 +2523,8 @@ Return the unsigned integer value of an SV, doing any necessary string
 conversion.  If C<flags> has the C<SV_GMAGIC> bit set, does an C<mg_get()> first.
 Normally used via the C<SvUV(sv)> and C<SvUVx(sv)> macros.
 
 conversion.  If C<flags> has the C<SV_GMAGIC> bit set, does an C<mg_get()> first.
 Normally used via the C<SvUV(sv)> and C<SvUVx(sv)> macros.
 

+=for apidoc Amnh||SV_GMAGIC
+

 =cut
 */
 
 =cut
 */
 


@@ -2667,6 +2669,7 @@ Perl_sv_2nv_flags(pTHX_ SV *const sv, const I32 flags)
     if (SvTYPE(sv) < SVt_NV) {
        /* The logic to use SVt_PVNV if necessary is in sv_upgrade.  */
        sv_upgrade(sv, SVt_NV);
     if (SvTYPE(sv) < SVt_NV) {
        /* The logic to use SVt_PVNV if necessary is in sv_upgrade.  */
        sv_upgrade(sv, SVt_NV);

+        CLANG_DIAG_IGNORE_STMT(-Wthread-safety);

        DEBUG_c({
             DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
             STORE_LC_NUMERIC_SET_STANDARD();
        DEBUG_c({
             DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
             STORE_LC_NUMERIC_SET_STANDARD();


@@ -2675,6 +2678,8 @@ Perl_sv_2nv_flags(pTHX_ SV *const sv, const I32 flags)
                          PTR2UV(sv), SvNVX(sv));
             RESTORE_LC_NUMERIC();
        });
                          PTR2UV(sv), SvNVX(sv));
             RESTORE_LC_NUMERIC();
        });

+        CLANG_DIAG_RESTORE_STMT;
+

     }
     else if (SvTYPE(sv) < SVt_PVNV)
        sv_upgrade(sv, SVt_PVNV);
     }
     else if (SvTYPE(sv) < SVt_PVNV)
        sv_upgrade(sv, SVt_PVNV);


@@ -2795,7 +2800,7 @@ Perl_sv_2nv_flags(pTHX_ SV *const sv, const I32 flags)
            SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK);
 #endif /* NV_PRESERVES_UV */
     }
            SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK);
 #endif /* NV_PRESERVES_UV */
     }

-    else  {
+    else {

        if (isGV_with_GP(sv)) {
            glob_2number(MUTABLE_GV(sv));
            return 0.0;
        if (isGV_with_GP(sv)) {
            glob_2number(MUTABLE_GV(sv));
            return 0.0;


@@ -2809,6 +2814,7 @@ Perl_sv_2nv_flags(pTHX_ SV *const sv, const I32 flags)
           and ideally should be fixed.  */
        return 0.0;
     }
           and ideally should be fixed.  */
        return 0.0;
     }

+    CLANG_DIAG_IGNORE_STMT(-Wthread-safety);

     DEBUG_c({
         DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
         STORE_LC_NUMERIC_SET_STANDARD();
     DEBUG_c({
         DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
         STORE_LC_NUMERIC_SET_STANDARD();


@@ -2816,6 +2822,7 @@ Perl_sv_2nv_flags(pTHX_ SV *const sv, const I32 flags)
                      PTR2UV(sv), SvNVX(sv));
         RESTORE_LC_NUMERIC();
     });
                      PTR2UV(sv), SvNVX(sv));
         RESTORE_LC_NUMERIC();
     });

+    CLANG_DIAG_RESTORE_STMT;

     return SvNVX(sv);
 }
 
     return SvNVX(sv);
 }
 


@@ -2845,6 +2852,34 @@ Perl_sv_2num(pTHX_ SV *const sv)
     return sv_2mortal(newSVuv(PTR2UV(SvRV(sv))));
 }
 
     return sv_2mortal(newSVuv(PTR2UV(SvRV(sv))));
 }
 

+/* int2str_table: lookup table containing string representations of all
+ * two digit numbers. For example, int2str_table.arr[0] is "00" and
+ * int2str_table.arr[12*2] is "12".
+ *
+ * We are going to read two bytes at a time, so we have to ensure that
+ * the array is aligned to a 2 byte boundary. That's why it was made a
+ * union with a dummy U16 member. */
+static const union {
+    char arr[200];
+    U16 dummy;
+} int2str_table = {{
+    '0', '0', '0', '1', '0', '2', '0', '3', '0', '4', '0', '5', '0', '6',
+    '0', '7', '0', '8', '0', '9', '1', '0', '1', '1', '1', '2', '1', '3',
+    '1', '4', '1', '5', '1', '6', '1', '7', '1', '8', '1', '9', '2', '0',
+    '2', '1', '2', '2', '2', '3', '2', '4', '2', '5', '2', '6', '2', '7',
+    '2', '8', '2', '9', '3', '0', '3', '1', '3', '2', '3', '3', '3', '4',
+    '3', '5', '3', '6', '3', '7', '3', '8', '3', '9', '4', '0', '4', '1',
+    '4', '2', '4', '3', '4', '4', '4', '5', '4', '6', '4', '7', '4', '8',
+    '4', '9', '5', '0', '5', '1', '5', '2', '5', '3', '5', '4', '5', '5',
+    '5', '6', '5', '7', '5', '8', '5', '9', '6', '0', '6', '1', '6', '2',
+    '6', '3', '6', '4', '6', '5', '6', '6', '6', '7', '6', '8', '6', '9',
+    '7', '0', '7', '1', '7', '2', '7', '3', '7', '4', '7', '5', '7', '6',
+    '7', '7', '7', '8', '7', '9', '8', '0', '8', '1', '8', '2', '8', '3',
+    '8', '4', '8', '5', '8', '6', '8', '7', '8', '8', '8', '9', '9', '0',
+    '9', '1', '9', '2', '9', '3', '9', '4', '9', '5', '9', '6', '9', '7',
+    '9', '8', '9', '9'
+}};
+

 /* uiv_2buf(): private routine for use by sv_2pv_flags(): print an IV or
  * UV as a string towards the end of buf, and return pointers to start and
  * end of it.
 /* uiv_2buf(): private routine for use by sv_2pv_flags(): print an IV or
  * UV as a string towards the end of buf, and return pointers to start and
  * end of it.


@@ -2852,29 +2887,49 @@ Perl_sv_2num(pTHX_ SV *const sv)
  * We assume that buf is at least TYPE_CHARS(UV) long.
  */
 
  * We assume that buf is at least TYPE_CHARS(UV) long.
  */
 

-static char *
+PERL_STATIC_INLINE char *

 S_uiv_2buf(char *const buf, const IV iv, UV uv, const int is_uv, char **const peob)
 {
     char *ptr = buf + TYPE_CHARS(UV);
     char * const ebuf = ptr;
     int sign;
 S_uiv_2buf(char *const buf, const IV iv, UV uv, const int is_uv, char **const peob)
 {
     char *ptr = buf + TYPE_CHARS(UV);
     char * const ebuf = ptr;
     int sign;

+    U16 *word_ptr, *word_table;

 
     PERL_ARGS_ASSERT_UIV_2BUF;
 
 
     PERL_ARGS_ASSERT_UIV_2BUF;
 

-    if (is_uv)
+    /* ptr has to be properly aligned, because we will cast it to U16* */
+    assert(PTR2nat(ptr) % 2 == 0);
+    /* we are going to read/write two bytes at a time */
+    word_ptr = (U16*)ptr;
+    word_table = (U16*)int2str_table.arr;
+
+    if (UNLIKELY(is_uv))

        sign = 0;
     else if (iv >= 0) {
        uv = iv;
        sign = 0;
     } else {
        sign = 0;
     else if (iv >= 0) {
        uv = iv;
        sign = 0;
     } else {

-        uv = (iv == IV_MIN) ? (UV)iv : (UV)(-iv);
+        /* Using 0- here to silence bogus warning from MS VC */
+        uv = (UV) (0 - (UV) iv);

        sign = 1;
     }
        sign = 1;
     }

-    do {
-       *--ptr = '0' + (char)(uv % 10);
-    } while (uv /= 10);
+
+    while (uv > 99) {
+        *--word_ptr = word_table[uv % 100];
+        uv /= 100;
+    }
+    ptr = (char*)word_ptr;
+
+    if (uv < 10)
+        *--ptr = (char)uv + '0';
+    else {
+        *--word_ptr = word_table[uv];
+        ptr = (char*)word_ptr;
+    }
+

     if (sign)
     if (sign)

-       *--ptr = '-';
+        *--ptr = '-';
+

     *peob = ebuf;
     return ptr;
 }
     *peob = ebuf;
     return ptr;
 }


@@ -3004,8 +3059,8 @@ Perl_sv_2pv_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags)
  
                return RX_WRAPPED(re);
            } else {
  
                return RX_WRAPPED(re);
            } else {

-               const char *const typestr = sv_reftype(referent, 0);
-               const STRLEN typelen = strlen(typestr);
+               const char *const typestring = sv_reftype(referent, 0);
+               const STRLEN typelen = strlen(typestring);

                UV addr = PTR2UV(referent);
                const char *stashname = NULL;
                STRLEN stashnamelen = 0; /* hush, gcc */
                UV addr = PTR2UV(referent);
                const char *stashname = NULL;
                STRLEN stashnamelen = 0; /* hush, gcc */


@@ -3048,7 +3103,7 @@ Perl_sv_2pv_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags)
                *--retval = '(';
 
                retval -= typelen;
                *--retval = '(';
 
                retval -= typelen;

-               memcpy(retval, typestr, typelen);
+               memcpy(retval, typestring, typelen);

 
                if (stashname) {
                    *--retval = '=';
 
                if (stashname) {
                    *--retval = '=';


@@ -3082,13 +3137,18 @@ Perl_sv_2pv_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags)
        /* I'm assuming that if both IV and NV are equally valid then
           converting the IV is going to be more efficient */
        const U32 isUIOK = SvIsUV(sv);
        /* I'm assuming that if both IV and NV are equally valid then
           converting the IV is going to be more efficient */
        const U32 isUIOK = SvIsUV(sv);

-       char buf[TYPE_CHARS(UV)];
+        /* The purpose of this union is to ensure that arr is aligned on
+           a 2 byte boundary, because that is what uiv_2buf() requires */
+        union {
+            char arr[TYPE_CHARS(UV)];
+            U16 dummy;
+        } buf;

        char *ebuf, *ptr;
        STRLEN len;
 
        if (SvTYPE(sv) < SVt_PVIV)
            sv_upgrade(sv, SVt_PVIV);
        char *ebuf, *ptr;
        STRLEN len;
 
        if (SvTYPE(sv) < SVt_PVIV)
            sv_upgrade(sv, SVt_PVIV);

-       ptr = uiv_2buf(buf, SvIVX(sv), SvUVX(sv), isUIOK, &ebuf);
+        ptr = uiv_2buf(buf.arr, SvIVX(sv), SvUVX(sv), isUIOK, &ebuf);

        len = ebuf - ptr;
        /* inlined from sv_setpvn */
        s = SvGROW_mutable(sv, len + 1);
        len = ebuf - ptr;
        /* inlined from sv_setpvn */
        s = SvGROW_mutable(sv, len + 1);


@@ -3259,8 +3319,9 @@ Perl_sv_copypv_flags(pTHX_ SV *const dsv, SV *const ssv, const I32 flags)
 =for apidoc sv_2pvbyte
 
 Return a pointer to the byte-encoded representation of the SV, and set C<*lp>
 =for apidoc sv_2pvbyte
 
 Return a pointer to the byte-encoded representation of the SV, and set C<*lp>

-to its length.  May cause the SV to be downgraded from UTF-8 as a
-side-effect.
+to its length.  If the SV is marked as being encoded as UTF-8, it will
+downgrade it to a byte string as a side-effect, if possible.  If the SV cannot
+be downgraded, this croaks.

 
 Usually accessed via the C<SvPVbyte> macro.
 
 
 Usually accessed via the C<SvPVbyte> macro.
 


@@ -3268,18 +3329,19 @@ Usually accessed via the C<SvPVbyte> macro.
 */
 
 char *
 */
 
 char *

-Perl_sv_2pvbyte(pTHX_ SV *sv, STRLEN *const lp)
+Perl_sv_2pvbyte_flags(pTHX_ SV *sv, STRLEN *const lp, const U32 flags)

 {
 {

-    PERL_ARGS_ASSERT_SV_2PVBYTE;
+    PERL_ARGS_ASSERT_SV_2PVBYTE_FLAGS;

 
 

-    SvGETMAGIC(sv);
+    if (SvGMAGICAL(sv) && (flags & SV_GMAGIC))
+        mg_get(sv);

     if (((SvREADONLY(sv) || SvFAKE(sv)) && !SvIsCOW(sv))
      || isGV_with_GP(sv) || SvROK(sv)) {
        SV *sv2 = sv_newmortal();
        sv_copypv_nomg(sv2,sv);
        sv = sv2;
     }
     if (((SvREADONLY(sv) || SvFAKE(sv)) && !SvIsCOW(sv))
      || isGV_with_GP(sv) || SvROK(sv)) {
        SV *sv2 = sv_newmortal();
        sv_copypv_nomg(sv2,sv);
        sv = sv2;
     }

-    sv_utf8_downgrade(sv,0);
+    sv_utf8_downgrade_nomg(sv,0);

     return lp ? SvPV_nomg(sv,*lp) : SvPV_nomg_nolen(sv);
 }
 
     return lp ? SvPV_nomg(sv,*lp) : SvPV_nomg_nolen(sv);
 }
 


@@ -3295,15 +3357,18 @@ Usually accessed via the C<SvPVutf8> macro.
 */
 
 char *
 */
 
 char *

-Perl_sv_2pvutf8(pTHX_ SV *sv, STRLEN *const lp)
+Perl_sv_2pvutf8_flags(pTHX_ SV *sv, STRLEN *const lp, const U32 flags)

 {
 {

-    PERL_ARGS_ASSERT_SV_2PVUTF8;
+    PERL_ARGS_ASSERT_SV_2PVUTF8_FLAGS;

 
 

+    if (SvGMAGICAL(sv) && (flags & SV_GMAGIC))
+        mg_get(sv);

     if (((SvREADONLY(sv) || SvFAKE(sv)) && !SvIsCOW(sv))
     if (((SvREADONLY(sv) || SvFAKE(sv)) && !SvIsCOW(sv))

-     || isGV_with_GP(sv) || SvROK(sv))
-       sv = sv_mortalcopy(sv);
-    else
-        SvGETMAGIC(sv);
+     || isGV_with_GP(sv) || SvROK(sv)) {
+        SV *sv2 = sv_newmortal();
+        sv_copypv_nomg(sv2,sv);
+        sv = sv2;
+    }

     sv_utf8_upgrade_nomg(sv);
     return lp ? SvPV_nomg(sv,*lp) : SvPV_nomg_nolen(sv);
 }
     sv_utf8_upgrade_nomg(sv);
     return lp ? SvPV_nomg(sv,*lp) : SvPV_nomg_nolen(sv);
 }


@@ -3465,7 +3530,8 @@ Perl_sv_utf8_upgrade_flags_grow(pTHX_ SV *const sv, const I32 flags, STRLEN extr
     }
 
     if (SvCUR(sv) == 0) {
     }
 
     if (SvCUR(sv) == 0) {

-       if (extra) SvGROW(sv, extra);
+        if (extra) SvGROW(sv, extra + 1); /* Make sure is room for a trailing
+                                             byte */

     } else { /* Assume Latin-1/EBCDIC */
        /* This function could be much more efficient if we
         * had a FLAG in SVs to signal if there are any variant
     } else { /* Assume Latin-1/EBCDIC */
        /* This function could be much more efficient if we
         * had a FLAG in SVs to signal if there are any variant


@@ -3594,19 +3660,30 @@ true, croaks.
 This is not a general purpose Unicode to byte encoding interface:
 use the C<Encode> extension for that.
 
 This is not a general purpose Unicode to byte encoding interface:
 use the C<Encode> extension for that.
 

+This function process get magic on C<sv>.
+
+=for apidoc sv_utf8_downgrade_nomg
+
+Like C<sv_utf8_downgrade>, but does not process get magic on C<sv>.
+
+=for apidoc sv_utf8_downgrade_flags
+
+Like C<sv_utf8_downgrade>, but with additional C<flags>.
+If C<flags> has C<SV_GMAGIC> bit set, processes get magic on C<sv>.
+

 =cut
 */
 
 bool
 =cut
 */
 
 bool

-Perl_sv_utf8_downgrade(pTHX_ SV *const sv, const bool fail_ok)
+Perl_sv_utf8_downgrade_flags(pTHX_ SV *const sv, const bool fail_ok, const U32 flags)

 {
 {

-    PERL_ARGS_ASSERT_SV_UTF8_DOWNGRADE;
+    PERL_ARGS_ASSERT_SV_UTF8_DOWNGRADE_FLAGS;

 
     if (SvPOKp(sv) && SvUTF8(sv)) {
         if (SvCUR(sv)) {
            U8 *s;
            STRLEN len;
 
     if (SvPOKp(sv) && SvUTF8(sv)) {
         if (SvCUR(sv)) {
            U8 *s;
            STRLEN len;

-           int mg_flags = SV_GMAGIC;
+            U32 mg_flags = flags & SV_GMAGIC;

 
             if (SvIsCOW(sv)) {
                 S_sv_uncow(aTHX_ sv, 0);
 
             if (SvIsCOW(sv)) {
                 S_sv_uncow(aTHX_ sv, 0);


@@ -3616,7 +3693,7 @@ Perl_sv_utf8_downgrade(pTHX_ SV *const sv, const bool fail_ok)
                MAGIC * mg = mg_find(sv, PERL_MAGIC_regex_global);
                if (mg && mg->mg_len > 0 && mg->mg_flags & MGf_BYTES) {
                        mg->mg_len = sv_pos_b2u_flags(sv, mg->mg_len,
                MAGIC * mg = mg_find(sv, PERL_MAGIC_regex_global);
                if (mg && mg->mg_len > 0 && mg->mg_flags & MGf_BYTES) {
                        mg->mg_len = sv_pos_b2u_flags(sv, mg->mg_len,

-                                               SV_GMAGIC|SV_CONST_RETURN);
+                                               mg_flags|SV_CONST_RETURN);

                        mg_flags = 0; /* sv_pos_b2u does get magic */
                }
                if ((mg = mg_find(sv, PERL_MAGIC_utf8)))
                        mg_flags = 0; /* sv_pos_b2u does get magic */
                }
                if ((mg = mg_find(sv, PERL_MAGIC_utf8)))


@@ -3756,6 +3833,8 @@ C<SvSetMagicSV_nosteal>.
 This is the primary function for copying scalars, and most other
 copy-ish functions and macros use this underneath.
 
 This is the primary function for copying scalars, and most other
 copy-ish functions and macros use this underneath.
 

+=for apidoc Amnh||SV_NOSTEAL
+

 =cut
 */
 
 =cut
 */
 


@@ -4330,6 +4409,10 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, SV* sstr, const I32 flags)
        if (dtype < SVt_PVNV)
            sv_upgrade(dstr, SVt_PVNV);
        break;
        if (dtype < SVt_PVNV)
            sv_upgrade(dstr, SVt_PVNV);
        break;

+
+    case SVt_INVLIST:
+        invlist_clone(sstr, dstr);
+        break;

     default:
        {
        const char * const type = sv_reftype(sstr,0);
     default:
        {
        const char * const type = sv_reftype(sstr,0);


@@ -4347,7 +4430,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, SV* sstr, const I32 flags)
            sv_upgrade(dstr, SVt_REGEXP);
        break;
 
            sv_upgrade(dstr, SVt_REGEXP);
        break;
 

-       case SVt_INVLIST:

     case SVt_PVLV:
     case SVt_PVGV:
     case SVt_PVMG:
     case SVt_PVLV:
     case SVt_PVGV:
     case SVt_PVMG:


@@ -4873,6 +4955,9 @@ The C<len> parameter indicates the number of
 bytes to be copied.  If the C<ptr> argument is NULL the SV will become
 undefined.  Does not handle 'set' magic.  See C<L</sv_setpvn_mg>>.
 
 bytes to be copied.  If the C<ptr> argument is NULL the SV will become
 undefined.  Does not handle 'set' magic.  See C<L</sv_setpvn_mg>>.
 

+The UTF-8 flag is not changed by this function.  A terminating NUL byte is
+guaranteed.
+

 =cut
 */
 
 =cut
 */
 


@@ -5042,6 +5127,9 @@ and the realloc
 will be skipped (i.e. the buffer is actually at least 1 byte longer than
 C<len>, and already meets the requirements for storing in C<SvPVX>).
 
 will be skipped (i.e. the buffer is actually at least 1 byte longer than
 C<len>, and already meets the requirements for storing in C<SvPVX>).
 

+=for apidoc Amnh||SV_SMAGIC
+=for apidoc Amnh||SV_HAS_TRAILING_NUL
+

 =cut
 */
 
 =cut
 */
 


@@ -5160,9 +5248,8 @@ S_sv_uncow(pTHX_ SV * const sv, const U32 flags)
                 SvCUR_set(sv, cur);
                 *SvEND(sv) = '\0';
             }
                 SvCUR_set(sv, cur);
                 *SvEND(sv) = '\0';
             }

-           if (len) {
-           } else {
-               unshare_hek(SvSHARED_HEK_FROM_PV(pvx));
+           if (! len) {
+                       unshare_hek(SvSHARED_HEK_FROM_PV(pvx));

            }
 #ifdef DEBUGGING
             if (DEBUG_C_TEST)
            }
 #ifdef DEBUGGING
             if (DEBUG_C_TEST)


@@ -5209,6 +5296,8 @@ This function is expected to be used to signal to perl that this SV is
 about to be written to, and any extra book-keeping needs to be taken care
 of.  Hence, it croaks on read-only values.
 
 about to be written to, and any extra book-keeping needs to be taken care
 of.  Hence, it croaks on read-only values.
 

+=for apidoc Amnh||SV_COW_DROP_PV
+

 =cut
 */
 
 =cut
 */
 


@@ -5415,6 +5504,9 @@ C<mg_set> on C<dsv> afterwards if appropriate.
 C<sv_catpvn> and C<sv_catpvn_nomg> are implemented
 in terms of this function.
 
 C<sv_catpvn> and C<sv_catpvn_nomg> are implemented
 in terms of this function.
 

+=for apidoc Amnh||SV_CATUTF8
+=for apidoc Amnh||SV_CATBYTES
+

 =cut
 */
 
 =cut
 */
 


@@ -6267,8 +6359,10 @@ Perl_sv_kill_backrefs(pTHX_ SV *const sv, AV *const av)
 /*
 =for apidoc sv_insert
 
 /*
 =for apidoc sv_insert
 

-Inserts a string at the specified offset/length within the SV.  Similar to
-the Perl C<substr()> function.  Handles get magic.
+Inserts and/or replaces a string at the specified offset/length within the SV.
+Similar to the Perl C<substr()> function, with C<littlelen> bytes starting at
+C<little> replacing C<len> bytes of the string in C<bigstr> starting at
+C<offset>.  Handles get magic.

 
 =for apidoc sv_insert_flags
 
 
 =for apidoc sv_insert_flags
 


@@ -6484,7 +6578,6 @@ instead.
 void
 Perl_sv_clear(pTHX_ SV *const orig_sv)
 {
 void
 Perl_sv_clear(pTHX_ SV *const orig_sv)
 {

-    dVAR;

     HV *stash;
     U32 type;
     const struct body_details *sv_type_details;
     HV *stash;
     U32 type;
     const struct body_details *sv_type_details;


@@ -6578,9 +6671,6 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
                sv_del_backref(MUTABLE_SV(stash), sv);
            goto freescalar;
        case SVt_PVHV:
                sv_del_backref(MUTABLE_SV(stash), sv);
            goto freescalar;
        case SVt_PVHV:

-           if (PL_last_swash_hv == (const HV *)sv) {
-               PL_last_swash_hv = NULL;
-           }

            if (HvTOTALKEYS((HV*)sv) > 0) {
                const HEK *hek;
                /* this statement should match the one at the beginning of
            if (HvTOTALKEYS((HV*)sv) > 0) {
                const HEK *hek;
                /* this statement should match the one at the beginning of


@@ -7010,7 +7100,6 @@ Perl_sv_free(pTHX_ SV *const sv)
 void
 Perl_sv_free2(pTHX_ SV *const sv, const U32 rc)
 {
 void
 Perl_sv_free2(pTHX_ SV *const sv, const U32 rc)
 {

-    dVAR;

 
     PERL_ARGS_ASSERT_SV_FREE2;
 
 
     PERL_ARGS_ASSERT_SV_FREE2;
 


@@ -8478,18 +8567,19 @@ Perl_sv_gets(pTHX_ SV *const sv, PerlIO *const fp, I32 append)
      * null assign is a placeholder. */
     rslast = rslen ? rsptr[rslen - 1] : '\0';
 
      * null assign is a placeholder. */
     rslast = rslen ? rsptr[rslen - 1] : '\0';
 

-    if (rspara) {              /* have to do this both before and after */
-       do {                    /* to make sure file boundaries work right */
-           if (PerlIO_eof(fp))
-               return 0;
-           i = PerlIO_getc(fp);
-           if (i != '\n') {
-               if (i == -1)
-                   return 0;
-               PerlIO_ungetc(fp,i);
-               break;
-           }
-       } while (i != EOF);
+    if (rspara) {        /* have to do this both before and after */
+                         /* to make sure file boundaries work right */
+        while (1) {
+            if (PerlIO_eof(fp))
+                return 0;
+            i = PerlIO_getc(fp);
+            if (i != '\n') {
+                if (i == -1)
+                    return 0;
+                PerlIO_ungetc(fp,i);
+                break;
+            }
+        }

     }
 
     /* See if we know enough about I/O mechanism to cheat it ! */
     }
 
     /* See if we know enough about I/O mechanism to cheat it ! */


@@ -8695,7 +8785,10 @@ Perl_sv_gets(pTHX_ SV *const sv, PerlIO *const fp, I32 append)
 
             Note we have to deal with the char in 'i' if we are not at EOF
         */
 
             Note we have to deal with the char in 'i' if we are not at EOF
         */

+        bpx = bp - (STDCHAR*)SvPVX_const(sv);
+        /* signals might be called here, possibly modifying sv */

        i   = PerlIO_getc(fp);          /* get more characters */
        i   = PerlIO_getc(fp);          /* get more characters */

+        bp = (STDCHAR*)SvPVX_const(sv) + bpx;

 
        DEBUG_Pv(PerlIO_printf(Perl_debug_log,
           "Screamer: post: FILE * thinks ptr=%" UVuf ", cnt=%" IVdf ", base=%" UVuf "\n",
 
        DEBUG_Pv(PerlIO_printf(Perl_debug_log,
           "Screamer: post: FILE * thinks ptr=%" UVuf ", cnt=%" IVdf ", base=%" UVuf "\n",


@@ -8752,13 +8845,7 @@ Perl_sv_gets(pTHX_ SV *const sv, PerlIO *const fp, I32 append)
    else
     {
        /*The big, slow, and stupid way. */
    else
     {
        /*The big, slow, and stupid way. */

-#ifdef USE_HEAP_INSTEAD_OF_STACK       /* Even slower way. */
-       STDCHAR *buf = NULL;
-       Newx(buf, 8192, STDCHAR);
-       assert(buf);
-#else

        STDCHAR buf[8192];
        STDCHAR buf[8192];

-#endif

 
       screamer2:
        if (rslen) {
 
       screamer2:
        if (rslen) {


@@ -8807,9 +8894,6 @@ Perl_sv_gets(pTHX_ SV *const sv, PerlIO *const fp, I32 append)
                goto screamer2;
        }
 
                goto screamer2;
        }
 

-#ifdef USE_HEAP_INSTEAD_OF_STACK
-       Safefree(buf);
-#endif

     }
 
     if (rspara) {              /* have to do this both before and after */
     }
 
     if (rspara) {              /* have to do this both before and after */


@@ -9164,6 +9248,11 @@ The new SV is marked as mortal.  It will be destroyed "soon", either by an
 explicit call to C<FREETMPS>, or by an implicit call at places such as
 statement boundaries.  See also C<L</sv_newmortal>> and C<L</sv_2mortal>>.
 
 explicit call to C<FREETMPS>, or by an implicit call at places such as
 statement boundaries.  See also C<L</sv_newmortal>> and C<L</sv_2mortal>>.
 

+=for apidoc sv_mortalcopy_flags
+
+Like C<sv_mortalcopy>, but the extra C<flags> are passed to the
+C<sv_setsv_flags>.
+

 =cut
 */
 
 =cut
 */
 


@@ -9227,6 +9316,8 @@ C<newSVpvn_utf8()> is a convenience wrapper for this function, defined as
     #define newSVpvn_utf8(s, len, u)                   \
        newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
 
     #define newSVpvn_utf8(s, len, u)                   \
        newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
 

+=for apidoc Amnh||SVs_TEMP
+

 =cut
 */
 
 =cut
 */
 


@@ -9273,7 +9364,6 @@ C<L</sv_newmortal>> and C<L</sv_mortalcopy>>.
 SV *
 Perl_sv_2mortal(pTHX_ SV *const sv)
 {
 SV *
 Perl_sv_2mortal(pTHX_ SV *const sv)
 {

-    dVAR;

     if (!sv)
        return sv;
     if (SvIMMORTAL(sv))
     if (!sv)
        return sv;
     if (SvIMMORTAL(sv))


@@ -9321,7 +9411,7 @@ Creates a new SV and copies a string into it, which may contain C<NUL> character
 (C<\0>) and other binary data.  The reference count for the SV is set to 1.
 Note that if C<len> is zero, Perl will create a zero length (Perl) string.  You
 are responsible for ensuring that the source buffer is at least
 (C<\0>) and other binary data.  The reference count for the SV is set to 1.
 Note that if C<len> is zero, Perl will create a zero length (Perl) string.  You
 are responsible for ensuring that the source buffer is at least

-C<len> bytes long.  If the C<s> argument is NULL the new SV will be
+C<len> bytes long.  If the C<buffer> argument is NULL the new SV will be

 undefined.
 
 =cut
 undefined.
 
 =cut


@@ -9420,7 +9510,6 @@ C<SvPVX_const == HeKEY> and hash lookup will avoid string compare.
 SV *
 Perl_newSVpvn_share(pTHX_ const char *src, I32 len, U32 hash)
 {
 SV *
 Perl_newSVpvn_share(pTHX_ const char *src, I32 len, U32 hash)
 {

-    dVAR;

     SV *sv;
     bool is_utf8 = FALSE;
     const char *const orig_src = src;
     SV *sv;
     bool is_utf8 = FALSE;
     const char *const orig_src = src;


@@ -9494,6 +9583,14 @@ Perl_newSVpvf_nocontext(const char *const pat, ...)
 Creates a new SV and initializes it with the string formatted like
 C<sv_catpvf>.
 
 Creates a new SV and initializes it with the string formatted like
 C<sv_catpvf>.
 

+=for apidoc newSVpvf_nocontext
+Like C<L</newSVpvf>> but does not take a thread context (C<aTHX>) parameter,
+so is used in situations where the caller doesn't already have the thread
+context.
+
+=for apidoc vnewSVpvf
+Like C<L</newSVpvf>> but but the arguments are an encapsulated argument list.
+

 =cut
 */
 
 =cut
 */
 


@@ -9691,11 +9788,15 @@ Perl_newRV(pTHX_ SV *const sv)
 Creates a new SV which is an exact duplicate of the original SV.
 (Uses C<sv_setsv>.)
 
 Creates a new SV which is an exact duplicate of the original SV.
 (Uses C<sv_setsv>.)
 

+=for apidoc newSVsv_nomg
+
+Like C<newSVsv> but does not process get magic.
+

 =cut
 */
 
 SV *
 =cut
 */
 
 SV *

-Perl_newSVsv(pTHX_ SV *const old)
+Perl_newSVsv_flags(pTHX_ SV *const old, I32 flags)

 {
     SV *sv;
 
 {
     SV *sv;
 


@@ -9706,11 +9807,10 @@ Perl_newSVsv(pTHX_ SV *const old)
        return NULL;
     }
     /* Do this here, otherwise we leak the new SV if this croaks. */
        return NULL;
     }
     /* Do this here, otherwise we leak the new SV if this croaks. */

-    SvGETMAGIC(old);
+    if (flags & SV_GMAGIC)
+        SvGETMAGIC(old);

     new_SV(sv);
     new_SV(sv);

-    /* SV_NOSTEAL prevents TEMP buffers being, well, stolen, and saves games
-       with SvTEMP_off and SvTEMP_on round a call to sv_setsv.  */
-    sv_setsv_flags(sv, old, SV_NOSTEAL);
+    sv_setsv_flags(sv, old, flags & ~SV_GMAGIC);

     return sv;
 }
 
     return sv;
 }
 


@@ -10054,7 +10154,7 @@ Perl_sv_pvn_force_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags)
 =for apidoc sv_pvbyten_force
 
 The backend for the C<SvPVbytex_force> macro.  Always use the macro
 =for apidoc sv_pvbyten_force
 
 The backend for the C<SvPVbytex_force> macro.  Always use the macro

-instead.
+instead.  If the SV cannot be downgraded from UTF-8, this croaks.

 
 =cut
 */
 
 =cut
 */


@@ -10213,8 +10313,12 @@ Perl_sv_isobject(pTHX_ SV *sv)
 =for apidoc sv_isa
 
 Returns a boolean indicating whether the SV is blessed into the specified
 =for apidoc sv_isa
 
 Returns a boolean indicating whether the SV is blessed into the specified

-class.  This does not check for subtypes; use C<sv_derived_from> to verify
-an inheritance relationship.
+class.
+
+This does not check for subtypes or method overloading. Use C<sv_isa_sv> to
+verify an inheritance relationship in the same way as the C<isa> operator by
+respecting any C<isa()> method overloading; or C<sv_derived_from_sv> to test
+directly on the actual object type.

 
 =cut
 */
 
 =cut
 */


@@ -10247,7 +10351,8 @@ Perl_sv_isa(pTHX_ SV *sv, const char *const name)
 Creates a new SV for the existing RV, C<rv>, to point to.  If C<rv> is not an
 RV then it will be upgraded to one.  If C<classname> is non-null then the new
 SV will be blessed in the specified package.  The new SV is returned and its
 Creates a new SV for the existing RV, C<rv>, to point to.  If C<rv> is not an
 RV then it will be upgraded to one.  If C<classname> is non-null then the new
 SV will be blessed in the specified package.  The new SV is returned and its

-reference count is 1.  The reference count 1 is owned by C<rv>.
+reference count is 1.  The reference count 1 is owned by C<rv>. See also
+newRV_inc() and newRV_noinc() for creating a new RV properly.

 
 =cut
 */
 
 =cut
 */


@@ -10532,6 +10637,8 @@ C<SV_IMMEDIATE_UNREF> to force the reference count to be decremented
 different from one or the reference being a readonly SV).
 See C<L</SvROK_off>>.
 
 different from one or the reference being a readonly SV).
 See C<L</SvROK_off>>.
 

+=for apidoc Amnh||SV_IMMEDIATE_UNREF
+

 =cut
 */
 
 =cut
 */
 


@@ -10616,9 +10723,14 @@ Does not handle 'set' magic.  See C<L</sv_setpviv_mg>>.
 void
 Perl_sv_setpviv(pTHX_ SV *const sv, const IV iv)
 {
 void
 Perl_sv_setpviv(pTHX_ SV *const sv, const IV iv)
 {

-    char buf[TYPE_CHARS(UV)];
+    /* The purpose of this union is to ensure that arr is aligned on
+       a 2 byte boundary, because that is what uiv_2buf() requires */
+    union {
+        char arr[TYPE_CHARS(UV)];
+        U16 dummy;
+    } buf;

     char *ebuf;
     char *ebuf;

-    char * const ptr = uiv_2buf(buf, iv, 0, 0, &ebuf);
+    char * const ptr = uiv_2buf(buf.arr, iv, 0, 0, &ebuf);

 
     PERL_ARGS_ASSERT_SV_SETPVIV;
 
 
     PERL_ARGS_ASSERT_SV_SETPVIV;
 


@@ -10638,7 +10750,12 @@ Perl_sv_setpviv_mg(pTHX_ SV *const sv, const IV iv)
 {
     PERL_ARGS_ASSERT_SV_SETPVIV_MG;
 
 {
     PERL_ARGS_ASSERT_SV_SETPVIV_MG;
 

+    GCC_DIAG_IGNORE_STMT(-Wdeprecated-declarations);
+

     sv_setpviv(sv, iv);
     sv_setpviv(sv, iv);

+
+    GCC_DIAG_RESTORE_STMT;
+

     SvSETMAGIC(sv);
 }
 
     SvSETMAGIC(sv);
 }
 


@@ -10689,6 +10806,11 @@ Perl_sv_setpvf_mg_nocontext(SV *const sv, const char *const pat, ...)
 Works like C<sv_catpvf> but copies the text into the SV instead of
 appending it.  Does not handle 'set' magic.  See C<L</sv_setpvf_mg>>.
 
 Works like C<sv_catpvf> but copies the text into the SV instead of
 appending it.  Does not handle 'set' magic.  See C<L</sv_setpvf_mg>>.
 

+=for apidoc sv_setpvf_nocontext
+Like C<L</sv_setpvf>> but does not take a thread context (C<aTHX>) parameter,
+so is used in situations where the caller doesn't already have the thread
+context.
+

 =cut
 */
 
 =cut
 */
 


@@ -10728,6 +10850,11 @@ Perl_sv_vsetpvf(pTHX_ SV *const sv, const char *const pat, va_list *const args)
 
 Like C<sv_setpvf>, but also handles 'set' magic.
 
 
 Like C<sv_setpvf>, but also handles 'set' magic.
 

+=for apidoc sv_setpvf_mg_nocontext
+Like C<L</sv_setpvf_mg>>, but does not take a thread context (C<aTHX>)
+parameter, so is used in situations where the caller doesn't already have the
+thread context.
+

 =cut
 */
 
 =cut
 */
 


@@ -10805,8 +10932,8 @@ Perl_sv_catpvf_mg_nocontext(SV *const sv, const char *const pat, ...)
 /*
 =for apidoc sv_catpvf
 
 /*
 =for apidoc sv_catpvf
 

-Processes its arguments like C<sv_catpvfn>, and appends the formatted
-output to an SV.  As with C<sv_catpvfn> called with a non-null C-style
+Processes its arguments like C<sprintf>, and appends the formatted
+output to an SV.  As with C<sv_vcatpvfn> called with a non-null C-style

 variable argument list, argument reordering is not supported.
 If the appended data contains "wide" characters
 (including, but not limited to, SVs with a UTF-8 PV formatted with C<%s>,
 variable argument list, argument reordering is not supported.
 If the appended data contains "wide" characters
 (including, but not limited to, SVs with a UTF-8 PV formatted with C<%s>,


@@ -10815,6 +10942,11 @@ upgraded to UTF-8.  Handles 'get' magic, but not 'set' magic.  See
 C<L</sv_catpvf_mg>>.  If the original SV was UTF-8, the pattern should be
 valid UTF-8; if the original SV was bytes, the pattern should be too.
 
 C<L</sv_catpvf_mg>>.  If the original SV was UTF-8, the pattern should be
 valid UTF-8; if the original SV was bytes, the pattern should be too.
 

+=for apidoc sv_catpvf_nocontext
+Like C<L</sv_catpvf>> but does not take a thread context (C<aTHX>) parameter,
+so is used in situations where the caller doesn't already have the thread
+context.
+

 =cut */
 
 void
 =cut */
 
 void


@@ -10832,7 +10964,7 @@ Perl_sv_catpvf(pTHX_ SV *const sv, const char *const pat, ...)
 /*
 =for apidoc sv_vcatpvf
 
 /*
 =for apidoc sv_vcatpvf
 

-Processes its arguments like C<sv_catpvfn> called with a non-null C-style
+Processes its arguments like C<sv_vcatpvfn> called with a non-null C-style

 variable argument list, and appends the formatted output
 to an SV.  Does not handle 'set' magic.  See C<L</sv_vcatpvf_mg>>.
 
 variable argument list, and appends the formatted output
 to an SV.  Does not handle 'set' magic.  See C<L</sv_vcatpvf_mg>>.
 


@@ -10854,6 +10986,11 @@ Perl_sv_vcatpvf(pTHX_ SV *const sv, const char *const pat, va_list *const args)
 
 Like C<sv_catpvf>, but also handles 'set' magic.
 
 
 Like C<sv_catpvf>, but also handles 'set' magic.
 

+=for apidoc sv_catpvf_mg_nocontext
+Like C<L</sv_catpvf_mg>> but does not take a thread context (C<aTHX>) parameter,
+so is used in situations where the caller doesn't already have the thread
+context.
+

 =cut
 */
 
 =cut
 */
 


@@ -11004,12 +11141,6 @@ S_sprintf_arg_num_val(pTHX_ va_list *const args, int i, SV *sv, bool *neg)
     return (STRLEN)iv;
 }
 
     return (STRLEN)iv;
 }
 

-
-/* Returns true if c is in the range '1'..'9'
- * Written with the cast so it only needs one conditional test
- */
-#define IS_1_TO_9(c) ((U8)(c - '1') <= 8)
-

 /* Read in and return a number. Updates *pattern to point to the char
  * following the number. Expects the first char to 1..9.
  * Croaks if the number exceeds 1/4 of the maximum value of STRLEN.
 /* Read in and return a number. Updates *pattern to point to the char
  * following the number. Expects the first char to 1..9.
  * Croaks if the number exceeds 1/4 of the maximum value of STRLEN.


@@ -11026,7 +11157,7 @@ S_expect_number(pTHX_ const char **const pattern)
 
     PERL_ARGS_ASSERT_EXPECT_NUMBER;
 
 
     PERL_ARGS_ASSERT_EXPECT_NUMBER;
 

-    assert(IS_1_TO_9(**pattern));
+    assert(inRANGE(**pattern, '1', '9'));

 
     var = *(*pattern)++ - '0';
     while (isDIGIT(**pattern)) {
 
     var = *(*pattern)++ - '0';
     while (isDIGIT(**pattern)) {


@@ -11491,7 +11622,9 @@ S_hextract(pTHX_ const NV nv, int* exponent, bool *subnormal,
  * The rest of the args have the same meaning as the local vars of the
  * same name within Perl_sv_vcatpvfn_flags().
  *
  * The rest of the args have the same meaning as the local vars of the
  * same name within Perl_sv_vcatpvfn_flags().
  *

- * It assumes the caller has already done STORE_LC_NUMERIC_SET_TO_NEEDED();
+ * The caller's determination of IN_LC(LC_NUMERIC), passed as in_lc_numeric,
+ * is used to ensure we do the right thing when we need to access the locale's
+ * numeric radix.

  *
  * It requires the caller to make buf large enough.
  */
  *
  * It requires the caller to make buf large enough.
  */


@@ -11500,7 +11633,7 @@ static STRLEN
 S_format_hexfp(pTHX_ char * const buf, const STRLEN bufsize, const char c,
                     const NV nv, const vcatpvfn_long_double_t fv,
                     bool has_precis, STRLEN precis, STRLEN width,
 S_format_hexfp(pTHX_ char * const buf, const STRLEN bufsize, const char c,
                     const NV nv, const vcatpvfn_long_double_t fv,
                     bool has_precis, STRLEN precis, STRLEN width,

-                    bool alt, char plus, bool left, bool fill)
+                    bool alt, char plus, bool left, bool fill, bool in_lc_numeric)

 {
     /* Hexadecimal floating point. */
     char* p = buf;
 {
     /* Hexadecimal floating point. */
     char* p = buf;


@@ -11697,27 +11830,29 @@ S_format_hexfp(pTHX_ char * const buf, const STRLEN bufsize, const char c,
     else {
         *p++ = '0';
         exponent = 0;
     else {
         *p++ = '0';
         exponent = 0;

-        zerotail = precis;
+        zerotail = has_precis ? precis : 0;

     }
 
     /* The radix is always output if precis, or if alt. */
     }
 
     /* The radix is always output if precis, or if alt. */

-    if (precis > 0 || alt) {
+    if ((has_precis && precis > 0) || alt) {

       hexradix = TRUE;
     }
 
     if (hexradix) {
 #ifndef USE_LOCALE_NUMERIC
       hexradix = TRUE;
     }
 
     if (hexradix) {
 #ifndef USE_LOCALE_NUMERIC

-            *p++ = '.';
+        *p++ = '.';

 #else
 #else

-            if (IN_LC(LC_NUMERIC)) {
-                STRLEN n;
+        if (in_lc_numeric) {
+            STRLEN n;
+            WITH_LC_NUMERIC_SET_TO_NEEDED_IN(TRUE, {

                 const char* r = SvPV(PL_numeric_radix_sv, n);
                 Copy(r, p, n, char);
                 const char* r = SvPV(PL_numeric_radix_sv, n);
                 Copy(r, p, n, char);

-                p += n;
-            }
-            else {
-                *p++ = '.';
-            }
+            });
+            p += n;
+        }
+        else {
+            *p++ = '.';
+        }

 #endif
     }
 
 #endif
     }
 


@@ -11823,9 +11958,10 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
     char ebuf[IV_DIG * 4 + NV_DIG + 32];
     bool no_redundant_warning = FALSE; /* did we use any explicit format parameter index? */
 #ifdef USE_LOCALE_NUMERIC
     char ebuf[IV_DIG * 4 + NV_DIG + 32];
     bool no_redundant_warning = FALSE; /* did we use any explicit format parameter index? */
 #ifdef USE_LOCALE_NUMERIC

-    DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
-    bool lc_numeric_set = FALSE; /* called STORE_LC_NUMERIC_SET_TO_NEEDED? */
+    bool have_in_lc_numeric = FALSE;

 #endif
 #endif

+    /* we never change this unless USE_LOCALE_NUMERIC */
+    bool in_lc_numeric = FALSE;

 
     PERL_ARGS_ASSERT_SV_VCATPVFN_FLAGS;
     PERL_UNUSED_ARG(maybe_tainted);
 
     PERL_ARGS_ASSERT_SV_VCATPVFN_FLAGS;
     PERL_UNUSED_ARG(maybe_tainted);


@@ -11975,12 +12111,12 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
     [%bcdefginopsuxDFOUX] format (mandatory)
 */
 
     [%bcdefginopsuxDFOUX] format (mandatory)
 */
 

-       if (IS_1_TO_9(*q)) {
+       if (inRANGE(*q, '1', '9')) {

             width = expect_number(&q);
            if (*q == '$') {
                 if (args)
                     Perl_croak_nocontext(
             width = expect_number(&q);
            if (*q == '$') {
                 if (args)
                     Perl_croak_nocontext(

-                        "Cannot yet reorder sv_catpvfn() arguments from va_list");
+                        "Cannot yet reorder sv_vcatpvfn() arguments from va_list");

                ++q;
                efix = (Size_t)width;
                 width = 0;
                ++q;
                efix = (Size_t)width;
                 width = 0;


@@ -12043,12 +12179,12 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
        if (*q == '*') {
             STRLEN ix; /* explicit width/vector separator index */
            q++;
        if (*q == '*') {
             STRLEN ix; /* explicit width/vector separator index */
            q++;

-           if (IS_1_TO_9(*q)) {
+            if (inRANGE(*q, '1', '9')) {

                 ix = expect_number(&q);
                if (*q++ == '$') {
                     if (args)
                         Perl_croak_nocontext(
                 ix = expect_number(&q);
                if (*q++ == '$') {
                     if (args)
                         Perl_croak_nocontext(

-                            "Cannot yet reorder sv_catpvfn() arguments from va_list");
+                            "Cannot yet reorder sv_vcatpvfn() arguments from va_list");

                     no_redundant_warning = TRUE;
                 } else
                    goto unknown;
                     no_redundant_warning = TRUE;
                 } else
                    goto unknown;


@@ -12088,15 +12224,15 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
             /* the asterisk specified a width */
             {
                 int i = 0;
             /* the asterisk specified a width */
             {
                 int i = 0;

-                SV *sv = NULL;
+                SV *width_sv = NULL;

                 if (args)
                     i = va_arg(*args, int);
                 else {
                     ix = ix ? ix - 1 : svix++;
                 if (args)
                     i = va_arg(*args, int);
                 else {
                     ix = ix ? ix - 1 : svix++;

-                    sv = (ix < sv_count) ? svargs[ix]
+                    width_sv = (ix < sv_count) ? svargs[ix]

                                       : (arg_missing = TRUE, (SV*)NULL);
                 }
                                       : (arg_missing = TRUE, (SV*)NULL);
                 }

-                width = S_sprintf_arg_num_val(aTHX_ args, i, sv, &left);
+                width = S_sprintf_arg_num_val(aTHX_ args, i, width_sv, &left);

             }
         }
        else if (*q == 'v') {
             }
         }
        else if (*q == 'v') {


@@ -12115,7 +12251,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                fill = TRUE;
                 q++;
             }
                fill = TRUE;
                 q++;
             }

-            if (IS_1_TO_9(*q))
+            if (inRANGE(*q, '1', '9'))

                 width = expect_number(&q);
        }
 
                 width = expect_number(&q);
        }
 


@@ -12128,12 +12264,12 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
            if (*q == '*') {
                 STRLEN ix; /* explicit precision index */
                q++;
            if (*q == '*') {
                 STRLEN ix; /* explicit precision index */
                q++;

-                if (IS_1_TO_9(*q)) {
+                if (inRANGE(*q, '1', '9')) {

                     ix = expect_number(&q);
                     if (*q++ == '$') {
                         if (args)
                             Perl_croak_nocontext(
                     ix = expect_number(&q);
                     if (*q++ == '$') {
                         if (args)
                             Perl_croak_nocontext(

-                                "Cannot yet reorder sv_catpvfn() arguments from va_list");
+                                "Cannot yet reorder sv_vcatpvfn() arguments from va_list");

                         no_redundant_warning = TRUE;
                     } else
                         goto unknown;
                         no_redundant_warning = TRUE;
                     } else
                         goto unknown;


@@ -12143,18 +12279,21 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
 
                 {
                     int i = 0;
 
                 {
                     int i = 0;

-                    SV *sv = NULL;
+                    SV *width_sv = NULL;

                     bool neg = FALSE;
 
                     if (args)
                         i = va_arg(*args, int);
                     else {
                         ix = ix ? ix - 1 : svix++;
                     bool neg = FALSE;
 
                     if (args)
                         i = va_arg(*args, int);
                     else {
                         ix = ix ? ix - 1 : svix++;

-                        sv = (ix < sv_count) ? svargs[ix]
+                        width_sv = (ix < sv_count) ? svargs[ix]

                                           : (arg_missing = TRUE, (SV*)NULL);
                     }
                                           : (arg_missing = TRUE, (SV*)NULL);
                     }

-                    precis = S_sprintf_arg_num_val(aTHX_ args, i, sv, &neg);
+                    precis = S_sprintf_arg_num_val(aTHX_ args, i, width_sv, &neg);

                     has_precis = !neg;
                     has_precis = !neg;

+                    /* ignore negative precision */
+                    if (!has_precis)
+                        precis = 0;

                 }
            }
            else {
                 }
            }
            else {


@@ -12167,7 +12306,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                  */
                 while (*q == '0')
                     q++;
                  */
                 while (*q == '0')
                     q++;

-                precis = IS_1_TO_9(*q) ? expect_number(&q) : 0;
+                precis = inRANGE(*q, '1', '9') ? expect_number(&q) : 0;

                has_precis = TRUE;
            }
        }
                has_precis = TRUE;
            }
        }


@@ -12250,7 +12389,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
            goto string;
        }
 
            goto string;
        }
 

-       if (vectorize && !strchr("BbDdiOouUXx", c))
+       if (vectorize && !memCHRs("BbDdiOouUXx", c))

             goto unknown;
 
         /* get next arg (individual branches do their own va_arg()
             goto unknown;
 
         /* get next arg (individual branches do their own va_arg()


@@ -12392,7 +12531,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
              * being allowed for %c (ideally we should warn on e.g. '%hc').
              * Setting a default intsize, along with a positive
              * (which signals unsigned) base, causes, for C-ish use, the
              * being allowed for %c (ideally we should warn on e.g. '%hc').
              * Setting a default intsize, along with a positive
              * (which signals unsigned) base, causes, for C-ish use, the

-             * va_arg to be interpreted as as unsigned int, when it's
+             * va_arg to be interpreted as an unsigned int, when it's

              * actually signed, which will convert -ve values to high +ve
              * values. Note that unlike the libc %c, values > 255 will
              * convert to high unicode points rather than being truncated
              * actually signed, which will convert -ve values to high +ve
              * values. Note that unlike the libc %c, values > 255 will
              * convert to high unicode points rather than being truncated


@@ -12555,7 +12694,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                         case 't':  iv = va_arg(*args, ptrdiff_t);  break;
 #endif
                         default:   iv = va_arg(*args, int);        break;
                         case 't':  iv = va_arg(*args, ptrdiff_t);  break;
 #endif
                         default:   iv = va_arg(*args, int);        break;

-                        case 'j':  iv = va_arg(*args, PERL_INTMAX_T); break;
+                        case 'j':  iv = (IV) va_arg(*args, PERL_INTMAX_T); break;

                         case 'q':
 #if IVSIZE >= 8
                                    iv = va_arg(*args, Quad_t);     break;
                         case 'q':
 #if IVSIZE >= 8
                                    iv = va_arg(*args, Quad_t);     break;


@@ -12590,7 +12729,8 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                             esignbuf[esignlen++] = plus;
                     }
                     else {
                             esignbuf[esignlen++] = plus;
                     }
                     else {

-                        uv = (iv == IV_MIN) ? (UV)iv : (UV)(-iv);
+                        /* Using 0- here to silence bogus warning from MS VC */
+                        uv = (UV) (0 - (UV) iv);

                         esignbuf[esignlen++] = '-';
                     }
                 }
                         esignbuf[esignlen++] = '-';
                     }
                 }


@@ -12610,7 +12750,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                                    * uptrdiff_t, so oh well */
                         case 't': uv = va_arg(*args, ptrdiff_t);     break;
 #endif
                                    * uptrdiff_t, so oh well */
                         case 't': uv = va_arg(*args, ptrdiff_t);     break;
 #endif

-                        case 'j': uv = va_arg(*args, PERL_UINTMAX_T); break;
+                        case 'j': uv = (UV) va_arg(*args, PERL_UINTMAX_T); break;

                         default:  uv = va_arg(*args, unsigned);      break;
                         case 'q':
 #if IVSIZE >= 8
                         default:  uv = va_arg(*args, unsigned);      break;
                         case 'q':
 #if IVSIZE >= 8


@@ -12691,7 +12831,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                          (!UVCHR_IS_INVARIANT(uv) && SvUTF8(sv)))
                         && !IN_BYTES)
                     {
                          (!UVCHR_IS_INVARIANT(uv) && SvUTF8(sv)))
                         && !IN_BYTES)
                     {

-                        assert(sizeof(ebuf) >= UTF8_MAXBYTES + 1);
+                        STATIC_ASSERT_STMT(sizeof(ebuf) >= UTF8_MAXBYTES + 1);

                         eptr = ebuf;
                         elen = uvchr_to_utf8((U8*)eptr, uv) - (U8*)ebuf;
                         is_utf8 = TRUE;
                         eptr = ebuf;
                         elen = uvchr_to_utf8((U8*)eptr, uv) - (U8*)ebuf;
                         is_utf8 = TRUE;


@@ -12892,33 +13032,31 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
              * below, or implicitly, via an snprintf() variant.
              * Note also things like ps_AF.utf8 which has
              * "\N{ARABIC DECIMAL SEPARATOR} as a radix point */
              * below, or implicitly, via an snprintf() variant.
              * Note also things like ps_AF.utf8 which has
              * "\N{ARABIC DECIMAL SEPARATOR} as a radix point */

-            if (!lc_numeric_set) {
-                /* only set once and reuse in-locale value on subsequent
-                 * iterations.
-                 * XXX what happens if we die in an eval?
-                 */
-                STORE_LC_NUMERIC_SET_TO_NEEDED();
-                lc_numeric_set = TRUE;
+            if (! have_in_lc_numeric) {
+                in_lc_numeric = IN_LC(LC_NUMERIC);
+                have_in_lc_numeric = TRUE;

             }
 
             }
 

-            if (IN_LC(LC_NUMERIC)) {
-                /* this can't wrap unless PL_numeric_radix_sv is a string
-                 * consuming virtually all the 32-bit or 64-bit address
-                 * space
-                 */
-                float_need += (SvCUR(PL_numeric_radix_sv) - 1);
-
-                /* floating-point formats only get utf8 if the radix point
-                 * is utf8. All other characters in the string are < 128
-                 * and so can be safely appended to both a non-utf8 and utf8
-                 * string as-is.
-                 * Note that this will convert the output to utf8 even if
-                 * the radix point didn't get output.
-                 */
-                if (SvUTF8(PL_numeric_radix_sv) && !has_utf8) {
-                    sv_utf8_upgrade(sv);
-                    has_utf8 = TRUE;
-                }
+            if (in_lc_numeric) {
+                WITH_LC_NUMERIC_SET_TO_NEEDED_IN(TRUE, {
+                    /* this can't wrap unless PL_numeric_radix_sv is a string
+                     * consuming virtually all the 32-bit or 64-bit address
+                     * space
+                     */
+                    float_need += (SvCUR(PL_numeric_radix_sv) - 1);
+
+                    /* floating-point formats only get utf8 if the radix point
+                     * is utf8. All other characters in the string are < 128
+                     * and so can be safely appended to both a non-utf8 and utf8
+                     * string as-is.
+                     * Note that this will convert the output to utf8 even if
+                     * the radix point didn't get output.
+                     */
+                    if (SvUTF8(PL_numeric_radix_sv) && !has_utf8) {
+                        sv_utf8_upgrade(sv);
+                        has_utf8 = TRUE;
+                    }
+                });

             }
 #endif
 
             }
 #endif
 


@@ -12993,7 +13131,9 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                 && !fill
                 && intsize != 'q'
             ) {
                 && !fill
                 && intsize != 'q'
             ) {

-                SNPRINTF_G(fv, ebuf, sizeof(ebuf), precis);
+                WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric,
+                    SNPRINTF_G(fv, ebuf, sizeof(ebuf), precis)
+                );

                 elen = strlen(ebuf);
                 eptr = ebuf;
                 goto float_concat;
                 elen = strlen(ebuf);
                 eptr = ebuf;
                 goto float_concat;


@@ -13013,6 +13153,13 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
            if (float_need < width)
                float_need = width;
 
            if (float_need < width)
                float_need = width;
 

+            if (float_need > INT_MAX) {
+                /* snprintf() returns an int, and we use that return value,
+                   so die horribly if the expected size is too large for int
+                */
+                Perl_croak(aTHX_ "Numeric format result too large");
+            }
+

            if (PL_efloatsize <= float_need) {
                 /* PL_efloatbuf should be at least 1 greater than
                  * float_need to allow a trailing \0 to be returned by
            if (PL_efloatsize <= float_need) {
                 /* PL_efloatbuf should be at least 1 greater than
                  * float_need to allow a trailing \0 to be returned by


@@ -13031,7 +13178,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
             if (UNLIKELY(hexfp)) {
                 elen = S_format_hexfp(aTHX_ PL_efloatbuf, PL_efloatsize, c,
                                 nv, fv, has_precis, precis, width,
             if (UNLIKELY(hexfp)) {
                 elen = S_format_hexfp(aTHX_ PL_efloatbuf, PL_efloatsize, c,
                                 nv, fv, has_precis, precis, width,

-                                alt, plus, left, fill);
+                                alt, plus, left, fill, in_lc_numeric);

             }
             else {
                 char *ptr = ebuf + sizeof ebuf;
             }
             else {
                 char *ptr = ebuf + sizeof ebuf;


@@ -13084,25 +13231,26 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                 GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral);
 #ifdef USE_QUADMATH
                 {
                 GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral);
 #ifdef USE_QUADMATH
                 {

-                    const char* qfmt = quadmath_format_single(ptr);
-                    if (!qfmt)
+                    if (!quadmath_format_valid(ptr))

                         Perl_croak_nocontext("panic: quadmath invalid format \"%s\"", ptr);
                         Perl_croak_nocontext("panic: quadmath invalid format \"%s\"", ptr);

-                    elen = quadmath_snprintf(PL_efloatbuf, PL_efloatsize,
-                                             qfmt, nv);
+                    WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric,
+                        elen = quadmath_snprintf(PL_efloatbuf, PL_efloatsize,
+                                                 ptr, nv);
+                    );

                     if ((IV)elen == -1) {
                     if ((IV)elen == -1) {

-                        if (qfmt != ptr)
-                            SAVEFREEPV(qfmt);
-                        Perl_croak_nocontext("panic: quadmath_snprintf failed, format \"%s\"", qfmt);
+                        Perl_croak_nocontext("panic: quadmath_snprintf failed, format \"%s\"", ptr);

                     }
                     }

-                    if (qfmt != ptr)
-                        Safefree(qfmt);

                 }
 #elif defined(HAS_LONG_DOUBLE)
                 }
 #elif defined(HAS_LONG_DOUBLE)

-                elen = ((intsize == 'q')
-                        ? my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, fv)
-                        : my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, (double)fv));
+                WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric,
+                    elen = ((intsize == 'q')
+                            ? my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, fv)
+                            : my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, (double)fv))
+                );

 #else
 #else

-                elen = my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, fv);
+                WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric,
+                    elen = my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, fv)
+                );

 #endif
                 GCC_DIAG_RESTORE_STMT;
            }
 #endif
                 GCC_DIAG_RESTORE_STMT;
            }


@@ -13164,7 +13312,9 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                         Perl_croak_nocontext(
                             "Missing argument for %%n in %s",
                                 PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");
                         Perl_croak_nocontext(
                             "Missing argument for %%n in %s",
                                 PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");

-                    sv_setuv_mg(argsv, has_utf8 ? (UV)sv_len_utf8(sv) : (UV)len);
+                    sv_setuv_mg(argsv, has_utf8
+                        ? (UV)utf8_length((U8*)SvPVX(sv), (U8*)SvEND(sv))
+                        : (UV)len);

                 }
                 goto done_valid_conversion;
             }
                 }
                 goto done_valid_conversion;
             }


@@ -13323,17 +13473,19 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");
     }
 
                PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");
     }
 

-    SvTAINT(sv);
-
-    if (lc_numeric_set) {
-        RESTORE_LC_NUMERIC();   /* Done outside loop, so don't have to
-                                   save/restore each iteration. */
+    if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
+        /* while we shouldn't set the cache, it may have been previously
+           set in the caller, so clear it */
+        MAGIC *mg = mg_find(sv, PERL_MAGIC_utf8);
+        if (mg)
+            magic_setutf8(sv,mg); /* clear UTF8 cache */

     }
     }

+    SvTAINT(sv);

 }
 
 /* =========================================================================
 
 }
 
 /* =========================================================================
 

-=head1 Cloning an interpreter
+=for apidoc_section Embedding and Interpreter Cloning

 
 =cut
 
 
 =cut
 


@@ -13980,7 +14132,6 @@ S_sv_dup_inc_multiple(pTHX_ SV *const *source, SV **dest,
 static SV *
 S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
 {
 static SV *
 S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
 {

-    dVAR;

     SV *dstr;
 
     PERL_ARGS_ASSERT_SV_DUP_COMMON;
     SV *dstr;
 
     PERL_ARGS_ASSERT_SV_DUP_COMMON;


@@ -14478,7 +14629,7 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max, CLONE_PARAMS* param)
                 /* XXX should this sv_dup_inc? Or only if CxEVAL_TXT_REFCNTED ???? */
                ncx->blk_eval.cur_text  = sv_dup(ncx->blk_eval.cur_text, param);
                ncx->blk_eval.cv = cv_dup(ncx->blk_eval.cv, param);
                 /* XXX should this sv_dup_inc? Or only if CxEVAL_TXT_REFCNTED ???? */
                ncx->blk_eval.cur_text  = sv_dup(ncx->blk_eval.cur_text, param);
                ncx->blk_eval.cv = cv_dup(ncx->blk_eval.cv, param);

-                /* XXX what do do with cur_top_env ???? */
+                /* XXX what to do with cur_top_env ???? */

                break;
            case CXt_LOOP_LAZYSV:
                ncx->blk_loop.state_u.lazysv.end
                break;
            case CXt_LOOP_LAZYSV:
                ncx->blk_loop.state_u.lazysv.end


@@ -14568,6 +14719,7 @@ Perl_si_dup(pTHX_ PERL_SI *si, CLONE_PARAMS* param)
 
     nsi->si_stack      = av_dup_inc(si->si_stack, param);
     nsi->si_cxix       = si->si_cxix;
 
     nsi->si_stack      = av_dup_inc(si->si_stack, param);
     nsi->si_cxix       = si->si_cxix;

+    nsi->si_cxsubix    = si->si_cxsubix;

     nsi->si_cxmax      = si->si_cxmax;
     nsi->si_cxstack    = cx_dup(si->si_cxstack, si->si_cxix, si->si_cxmax, param);
     nsi->si_type       = si->si_type;
     nsi->si_cxmax      = si->si_cxmax;
     nsi->si_cxstack    = cx_dup(si->si_cxstack, si->si_cxix, si->si_cxmax, param);
     nsi->si_type       = si->si_type;


@@ -14637,7 +14789,6 @@ Perl_any_dup(pTHX_ void *v, const PerlInterpreter *proto_perl)
 ANY *
 Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
 {
 ANY *
 Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
 {

-    dVAR;

     ANY * const ss     = proto_perl->Isavestack;
     const I32 max      = proto_perl->Isavestack_max + SS_MAXPUSH;
     I32 ix             = proto_perl->Isavestack_ix;
     ANY * const ss     = proto_perl->Isavestack;
     const I32 max      = proto_perl->Isavestack_max + SS_MAXPUSH;
     I32 ix             = proto_perl->Isavestack_ix;


@@ -14870,16 +15021,16 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
            ptr = POPPTR(ss,ix);
            TOPPTR(nss,ix) = ptr;
            break;
            ptr = POPPTR(ss,ix);
            TOPPTR(nss,ix) = ptr;
            break;

+        case SAVEt_HINTS_HH:
+            hv = (const HV *)POPPTR(ss,ix);
+            TOPPTR(nss,ix) = hv_dup_inc(hv, param);
+            /* FALLTHROUGH */

        case SAVEt_HINTS:
            ptr = POPPTR(ss,ix);
            ptr = cophh_copy((COPHH*)ptr);
            TOPPTR(nss,ix) = ptr;
            i = POPINT(ss,ix);
            TOPINT(nss,ix) = i;
        case SAVEt_HINTS:
            ptr = POPPTR(ss,ix);
            ptr = cophh_copy((COPHH*)ptr);
            TOPPTR(nss,ix) = ptr;
            i = POPINT(ss,ix);
            TOPINT(nss,ix) = i;

-           if (i & HINT_LOCALIZE_HH) {
-               hv = (const HV *)POPPTR(ss,ix);
-               TOPPTR(nss,ix) = hv_dup_inc(hv, param);
-           }

            break;
        case SAVEt_PADSV_AND_MORTALIZE:
            longval = (long)POPLONG(ss,ix);
            break;
        case SAVEt_PADSV_AND_MORTALIZE:
            longval = (long)POPLONG(ss,ix);


@@ -14967,16 +15118,15 @@ C<CLONEf_KEEP_PTR_TABLE> -
 C<perl_clone> keeps a ptr_table with the pointer of the old
 variable as a key and the new variable as a value,
 this allows it to check if something has been cloned and not
 C<perl_clone> keeps a ptr_table with the pointer of the old
 variable as a key and the new variable as a value,
 this allows it to check if something has been cloned and not

-clone it again but rather just use the value and increase the
-refcount.  If C<KEEP_PTR_TABLE> is not set then C<perl_clone> will kill
-the ptr_table using the function
-C<ptr_table_free(PL_ptr_table); PL_ptr_table = NULL;>,
-reason to keep it around is if you want to dup some of your own
-variable who are outside the graph perl scans, an example of this
-code is in F<threads.xs> create.
+clone it again, but rather just use the value and increase the
+refcount.
+If C<KEEP_PTR_TABLE> is not set then C<perl_clone> will kill the ptr_table
+using the function S<C<ptr_table_free(PL_ptr_table); PL_ptr_table = NULL;>>.
+A reason to keep it around is if you want to dup some of your own
+variables which are outside the graph that perl scans.

 
 C<CLONEf_CLONE_HOST> -
 
 C<CLONEf_CLONE_HOST> -

-This is a win32 thing, it is ignored on unix, it tells perls
+This is a win32 thing, it is ignored on unix, it tells perl's

 win32host code (which is c++) to clone itself, this is needed on
 win32 if you want to run two threads at the same time,
 if you just want to do some stuff in a separate perl interpreter
 win32host code (which is c++) to clone itself, this is needed on
 win32 if you want to run two threads at the same time,
 if you just want to do some stuff in a separate perl interpreter


@@ -14993,7 +15143,6 @@ perl_clone_host(PerlInterpreter* proto_perl, UV flags);
 PerlInterpreter *
 perl_clone(PerlInterpreter *proto_perl, UV flags)
 {
 PerlInterpreter *
 perl_clone(PerlInterpreter *proto_perl, UV flags)
 {

-   dVAR;

 #ifdef PERL_IMPLICIT_SYS
 
     PERL_ARGS_ASSERT_PERL_CLONE;
 #ifdef PERL_IMPLICIT_SYS
 
     PERL_ARGS_ASSERT_PERL_CLONE;


@@ -15201,6 +15350,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_origalen                = proto_perl->Iorigalen;
 
     PL_sighandlerp     = proto_perl->Isighandlerp;
     PL_origalen                = proto_perl->Iorigalen;
 
     PL_sighandlerp     = proto_perl->Isighandlerp;

+    PL_sighandler1p    = proto_perl->Isighandler1p;
+    PL_sighandler3p    = proto_perl->Isighandler3p;

 
     PL_runops          = proto_perl->Irunops;
 
 
     PL_runops          = proto_perl->Irunops;
 


@@ -15208,10 +15359,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     PL_cv_has_eval     = proto_perl->Icv_has_eval;
 
 
     PL_cv_has_eval     = proto_perl->Icv_has_eval;
 

-#ifdef FCRYPT
-    PL_cryptseen       = proto_perl->Icryptseen;
-#endif
-

 #ifdef USE_LOCALE_COLLATE
     PL_collation_ix    = proto_perl->Icollation_ix;
     PL_collation_standard      = proto_perl->Icollation_standard;
 #ifdef USE_LOCALE_COLLATE
     PL_collation_ix    = proto_perl->Icollation_ix;
     PL_collation_standard      = proto_perl->Icollation_standard;


@@ -15231,7 +15378,9 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_in_utf8_CTYPE_locale = proto_perl->Iin_utf8_CTYPE_locale;
     PL_in_utf8_COLLATE_locale = proto_perl->Iin_utf8_COLLATE_locale;
     my_strlcpy(PL_locale_utf8ness, proto_perl->Ilocale_utf8ness, sizeof(PL_locale_utf8ness));
     PL_in_utf8_CTYPE_locale = proto_perl->Iin_utf8_CTYPE_locale;
     PL_in_utf8_COLLATE_locale = proto_perl->Iin_utf8_COLLATE_locale;
     my_strlcpy(PL_locale_utf8ness, proto_perl->Ilocale_utf8ness, sizeof(PL_locale_utf8ness));

+#if defined(USE_ITHREADS) && ! defined(USE_THREAD_SAFE_LOCALE)

     PL_lc_numeric_mutex_depth = 0;
     PL_lc_numeric_mutex_depth = 0;

+#endif

     /* Unicode features (see perlrun/-C) */
     PL_unicode         = proto_perl->Iunicode;
 
     /* Unicode features (see perlrun/-C) */
     PL_unicode         = proto_perl->Iunicode;
 


@@ -15244,9 +15393,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     /* Recursion stopper for PerlIO_find_layer */
     PL_in_load_module  = proto_perl->Iin_load_module;
 
     /* Recursion stopper for PerlIO_find_layer */
     PL_in_load_module  = proto_perl->Iin_load_module;
 

-    /* sort() routine */
-    PL_sort_RealCmp    = proto_perl->Isort_RealCmp;
-

     /* Not really needed/useful since the reenrant_retint is "volatile",
      * but do it for consistency's sake. */
     PL_reentrant_retint        = proto_perl->Ireentrant_retint;
     /* Not really needed/useful since the reenrant_retint is "volatile",
      * but do it for consistency's sake. */
     PL_reentrant_retint        = proto_perl->Ireentrant_retint;


@@ -15261,13 +15407,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     PL_globhook                = proto_perl->Iglobhook;
 
 
     PL_globhook                = proto_perl->Iglobhook;
 

-    /* swatch cache */
-    PL_last_swash_hv   = NULL; /* reinits on demand */
-    PL_last_swash_klen = 0;
-    PL_last_swash_key[0]= '\0';
-    PL_last_swash_tmps = (U8*)NULL;
-    PL_last_swash_slen = 0;
-

     PL_srand_called    = proto_perl->Isrand_called;
     Copy(&(proto_perl->Irandom_state), &PL_random_state, 1, PL_RANDOM_STATE_TYPE);
 
     PL_srand_called    = proto_perl->Isrand_called;
     Copy(&(proto_perl->Irandom_state), &PL_random_state, 1, PL_RANDOM_STATE_TYPE);
 


@@ -15504,16 +15643,9 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     if (PL_my_cxt_size) {
        Newx(PL_my_cxt_list, PL_my_cxt_size, void *);
        Copy(proto_perl->Imy_cxt_list, PL_my_cxt_list, PL_my_cxt_size, void *);
     if (PL_my_cxt_size) {
        Newx(PL_my_cxt_list, PL_my_cxt_size, void *);
        Copy(proto_perl->Imy_cxt_list, PL_my_cxt_list, PL_my_cxt_size, void *);

-#ifdef PERL_GLOBAL_STRUCT_PRIVATE
-       Newx(PL_my_cxt_keys, PL_my_cxt_size, const char *);
-       Copy(proto_perl->Imy_cxt_keys, PL_my_cxt_keys, PL_my_cxt_size, char *);
-#endif

     }
     else {
        PL_my_cxt_list  = (void**)NULL;
     }
     else {
        PL_my_cxt_list  = (void**)NULL;

-#ifdef PERL_GLOBAL_STRUCT_PRIVATE
-       PL_my_cxt_keys  = (const char**)NULL;
-#endif

     }
     PL_modglobal       = hv_dup_inc(proto_perl->Imodglobal, param);
     PL_custom_op_names  = hv_dup_inc(proto_perl->Icustom_op_names,param);
     }
     PL_modglobal       = hv_dup_inc(proto_perl->Imodglobal, param);
     PL_custom_op_names  = hv_dup_inc(proto_perl->Icustom_op_names,param);


@@ -15570,6 +15702,16 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 #  endif
 #endif /* !USE_LOCALE_NUMERIC */
 
 #  endif
 #endif /* !USE_LOCALE_NUMERIC */
 

+#ifdef HAS_MBRLEN
+    PL_mbrlen_ps = proto_perl->Imbrlen_ps;
+#endif
+#ifdef HAS_MBRTOWC
+    PL_mbrtowc_ps = proto_perl->Imbrtowc_ps;
+#endif
+#ifdef HAS_WCRTOMB
+    PL_wcrtomb_ps = proto_perl->Iwcrtomb_ps;
+#endif
+

     PL_langinfo_buf = NULL;
     PL_langinfo_bufsize = 0;
 
     PL_langinfo_buf = NULL;
     PL_langinfo_bufsize = 0;
 


@@ -15577,40 +15719,50 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_setlocale_bufsize = 0;
 
     /* Unicode inversion lists */
     PL_setlocale_bufsize = 0;
 
     /* Unicode inversion lists */

-    PL_Latin1          = sv_dup_inc(proto_perl->ILatin1, param);
-    PL_UpperLatin1     = sv_dup_inc(proto_perl->IUpperLatin1, param);
-    PL_AboveLatin1     = sv_dup_inc(proto_perl->IAboveLatin1, param);
-    PL_InBitmap         = sv_dup_inc(proto_perl->IInBitmap, param);

 
 

-    PL_NonL1NonFinalFold = sv_dup_inc(proto_perl->INonL1NonFinalFold, param);
-    PL_HasMultiCharFold = sv_dup_inc(proto_perl->IHasMultiCharFold, param);
-
-    /* utf8 character class swashes */
-    for (i = 0; i < POSIX_SWASH_COUNT; i++) {
-        PL_utf8_swash_ptrs[i] = sv_dup_inc(proto_perl->Iutf8_swash_ptrs[i], param);
-    }
+    PL_AboveLatin1            = sv_dup_inc(proto_perl->IAboveLatin1, param);
+    PL_Assigned_invlist       = sv_dup_inc(proto_perl->IAssigned_invlist, param);
+    PL_GCB_invlist            = sv_dup_inc(proto_perl->IGCB_invlist, param);
+    PL_HasMultiCharFold       = sv_dup_inc(proto_perl->IHasMultiCharFold, param);
+    PL_InMultiCharFold        = sv_dup_inc(proto_perl->IInMultiCharFold, param);
+    PL_Latin1                 = sv_dup_inc(proto_perl->ILatin1, param);
+    PL_LB_invlist             = sv_dup_inc(proto_perl->ILB_invlist, param);
+    PL_SB_invlist             = sv_dup_inc(proto_perl->ISB_invlist, param);
+    PL_SCX_invlist            = sv_dup_inc(proto_perl->ISCX_invlist, param);
+    PL_UpperLatin1            = sv_dup_inc(proto_perl->IUpperLatin1, param);
+    PL_in_some_fold           = sv_dup_inc(proto_perl->Iin_some_fold, param);
+    PL_utf8_foldclosures      = sv_dup_inc(proto_perl->Iutf8_foldclosures, param);
+    PL_utf8_idcont            = sv_dup_inc(proto_perl->Iutf8_idcont, param);
+    PL_utf8_idstart           = sv_dup_inc(proto_perl->Iutf8_idstart, param);
+    PL_utf8_perl_idcont       = sv_dup_inc(proto_perl->Iutf8_perl_idcont, param);
+    PL_utf8_perl_idstart      = sv_dup_inc(proto_perl->Iutf8_perl_idstart, param);
+    PL_utf8_xidcont           = sv_dup_inc(proto_perl->Iutf8_xidcont, param);
+    PL_utf8_xidstart          = sv_dup_inc(proto_perl->Iutf8_xidstart, param);
+    PL_WB_invlist             = sv_dup_inc(proto_perl->IWB_invlist, param);

     for (i = 0; i < POSIX_CC_COUNT; i++) {
     for (i = 0; i < POSIX_CC_COUNT; i++) {

-        PL_XPosix_ptrs[i] = sv_dup_inc(proto_perl->IXPosix_ptrs[i], param);
+        PL_XPosix_ptrs[i]     = sv_dup_inc(proto_perl->IXPosix_ptrs[i], param);
+        if (i != _CC_CASED && i != _CC_VERTSPACE) {
+            PL_Posix_ptrs[i]  = sv_dup_inc(proto_perl->IPosix_ptrs[i], param);
+        }

     }
     }

-    PL_GCB_invlist = sv_dup_inc(proto_perl->IGCB_invlist, param);
-    PL_SB_invlist = sv_dup_inc(proto_perl->ISB_invlist, param);
-    PL_SCX_invlist = sv_dup_inc(proto_perl->ISCX_invlist, param);
-    PL_WB_invlist = sv_dup_inc(proto_perl->IWB_invlist, param);
-    PL_seen_deprecated_macro = hv_dup_inc(proto_perl->Iseen_deprecated_macro, param);
-    PL_utf8_mark       = sv_dup_inc(proto_perl->Iutf8_mark, param);
-    PL_utf8_toupper    = sv_dup_inc(proto_perl->Iutf8_toupper, param);
-    PL_utf8_totitle    = sv_dup_inc(proto_perl->Iutf8_totitle, param);
-    PL_utf8_tolower    = sv_dup_inc(proto_perl->Iutf8_tolower, param);
-    PL_utf8_tofold     = sv_dup_inc(proto_perl->Iutf8_tofold, param);
-    PL_utf8_idstart    = sv_dup_inc(proto_perl->Iutf8_idstart, param);
-    PL_utf8_xidstart   = sv_dup_inc(proto_perl->Iutf8_xidstart, param);
-    PL_utf8_perl_idstart = sv_dup_inc(proto_perl->Iutf8_perl_idstart, param);
-    PL_utf8_perl_idcont = sv_dup_inc(proto_perl->Iutf8_perl_idcont, param);
-    PL_utf8_idcont     = sv_dup_inc(proto_perl->Iutf8_idcont, param);
-    PL_utf8_xidcont    = sv_dup_inc(proto_perl->Iutf8_xidcont, param);
-    PL_utf8_foldable   = sv_dup_inc(proto_perl->Iutf8_foldable, param);
-    PL_utf8_charname_begin = sv_dup_inc(proto_perl->Iutf8_charname_begin, param);
+    PL_Posix_ptrs[_CC_CASED]  = PL_Posix_ptrs[_CC_ALPHA];
+    PL_Posix_ptrs[_CC_VERTSPACE] = NULL;
+
+    PL_utf8_toupper           = sv_dup_inc(proto_perl->Iutf8_toupper, param);
+    PL_utf8_totitle           = sv_dup_inc(proto_perl->Iutf8_totitle, param);
+    PL_utf8_tolower           = sv_dup_inc(proto_perl->Iutf8_tolower, param);
+    PL_utf8_tofold            = sv_dup_inc(proto_perl->Iutf8_tofold, param);
+    PL_utf8_tosimplefold      = sv_dup_inc(proto_perl->Iutf8_tosimplefold, param);
+    PL_utf8_charname_begin    = sv_dup_inc(proto_perl->Iutf8_charname_begin, param);

     PL_utf8_charname_continue = sv_dup_inc(proto_perl->Iutf8_charname_continue, param);
     PL_utf8_charname_continue = sv_dup_inc(proto_perl->Iutf8_charname_continue, param);

+    PL_utf8_mark              = sv_dup_inc(proto_perl->Iutf8_mark, param);
+    PL_InBitmap               = sv_dup_inc(proto_perl->IInBitmap, param);
+    PL_CCC_non0_non230        = sv_dup_inc(proto_perl->ICCC_non0_non230, param);
+    PL_Private_Use            = sv_dup_inc(proto_perl->IPrivate_Use, param);
+
+#if 0
+    PL_seen_deprecated_macro = hv_dup_inc(proto_perl->Iseen_deprecated_macro, param);
+#endif

 
     if (proto_perl->Ipsig_pend) {
        Newxz(PL_psig_pend, SIG_SIZE, int);
 
     if (proto_perl->Ipsig_pend) {
        Newxz(PL_psig_pend, SIG_SIZE, int);


@@ -15710,12 +15862,11 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     PL_registered_mros  = hv_dup_inc(proto_perl->Iregistered_mros, param);
     PL_blockhooks      = av_dup_inc(proto_perl->Iblockhooks, param);
 
     PL_registered_mros  = hv_dup_inc(proto_perl->Iregistered_mros, param);
     PL_blockhooks      = av_dup_inc(proto_perl->Iblockhooks, param);

-    PL_utf8_foldclosures = hv_dup_inc(proto_perl->Iutf8_foldclosures, param);

 
     /* Call the ->CLONE method, if it exists, for each of the stashes
        identified by sv_dup() above.
     */
 
     /* Call the ->CLONE method, if it exists, for each of the stashes
        identified by sv_dup() above.
     */

-    while(av_tindex(param->stashes) != -1) {
+    while(av_count(param->stashes) != 0) {

        HV* const stash = MUTABLE_HV(av_shift(param->stashes));
        GV* const cloner = gv_fetchmethod_autoload(stash, "CLONE", 0);
        if (cloner && GvCV(cloner)) {
        HV* const stash = MUTABLE_HV(av_shift(param->stashes));
        GV* const cloner = gv_fetchmethod_autoload(stash, "CLONE", 0);
        if (cloner && GvCV(cloner)) {


@@ -15798,11 +15949,9 @@ S_unreferenced_to_tmp_stack(pTHX_ AV *const unreferenced)
 void
 Perl_clone_params_del(CLONE_PARAMS *param)
 {
 void
 Perl_clone_params_del(CLONE_PARAMS *param)
 {

-    /* This seemingly funky ordering keeps the build with PERL_GLOBAL_STRUCT
-       happy: */
+    PerlInterpreter *const was = PERL_GET_THX;

     PerlInterpreter *const to = param->new_perl;
     dTHXa(to);
     PerlInterpreter *const to = param->new_perl;
     dTHXa(to);

-    PerlInterpreter *const was = PERL_GET_THX;

 
     PERL_ARGS_ASSERT_CLONE_PARAMS_DEL;
 
 
     PERL_ARGS_ASSERT_CLONE_PARAMS_DEL;
 


@@ -15824,7 +15973,6 @@ Perl_clone_params_del(CLONE_PARAMS *param)
 CLONE_PARAMS *
 Perl_clone_params_new(PerlInterpreter *const from, PerlInterpreter *const to)
 {
 CLONE_PARAMS *
 Perl_clone_params_new(PerlInterpreter *const from, PerlInterpreter *const to)
 {

-    dVAR;

     /* Need to play this game, as newAV() can call safesysmalloc(), and that
        does a dTHX; to get the context from thread local storage.
        FIXME - under PERL_CORE Newx(), Safefree() and friends should expand to
     /* Need to play this game, as newAV() can call safesysmalloc(), and that
        does a dTHX; to get the context from thread local storage.
        FIXME - under PERL_CORE Newx(), Safefree() and friends should expand to


@@ -15859,6 +16007,7 @@ Perl_clone_params_new(PerlInterpreter *const from, PerlInterpreter *const to)
 void
 Perl_init_constants(pTHX)
 {
 void
 Perl_init_constants(pTHX)
 {

+

     SvREFCNT(&PL_sv_undef)     = SvREFCNT_IMMORTAL;
     SvFLAGS(&PL_sv_undef)      = SVf_READONLY|SVf_PROTECT|SVt_NULL;
     SvANY(&PL_sv_undef)                = NULL;
     SvREFCNT(&PL_sv_undef)     = SvREFCNT_IMMORTAL;
     SvFLAGS(&PL_sv_undef)      = SVf_READONLY|SVf_PROTECT|SVt_NULL;
     SvANY(&PL_sv_undef)                = NULL;


@@ -15924,7 +16073,7 @@ Perl_init_constants(pTHX)
 }
 
 /*
 }
 
 /*

-=head1 Unicode Support
+=for apidoc_section Unicode Support

 
 =for apidoc sv_recode_to_utf8
 
 
 =for apidoc sv_recode_to_utf8
 


@@ -16070,7 +16219,6 @@ Perl_sv_cat_decode(pTHX_ SV *dsv, SV *encoding,
 STATIC SV*
 S_find_hash_subscript(pTHX_ const HV *const hv, const SV *const val)
 {
 STATIC SV*
 S_find_hash_subscript(pTHX_ const HV *const hv, const SV *const val)
 {

-    dVAR;

     HE **array;
     I32 i;
 
     HE **array;
     I32 i;
 


@@ -16196,6 +16344,7 @@ Perl_varname(pTHX_ const GV *const gv, const char gvtype, PADOFFSET targ,
 
 
 /*
 
 
 /*

+=apidoc_section Warning and Dieing

 =for apidoc find_uninit_var
 
 Find the name of the undefined variable (if any) that caused the operator
 =for apidoc find_uninit_var
 
 Find the name of the undefined variable (if any) that caused the operator


@@ -16221,7 +16370,6 @@ STATIC SV *
 S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
                  bool match, const char **desc_p)
 {
 S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
                  bool match, const char **desc_p)
 {

-    dVAR;

     SV *sv;
     const GV *gv;
     const OP *o, *o2, *kid;
     SV *sv;
     const GV *gv;
     const OP *o, *o2, *kid;


@@ -16430,7 +16578,7 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
                    negate ? - SvIV(cSVOPx_sv(kid)) : SvIV(cSVOPx_sv(kid)),
                    FUV_SUBSCRIPT_ARRAY);
        }
                    negate ? - SvIV(cSVOPx_sv(kid)) : SvIV(cSVOPx_sv(kid)),
                    FUV_SUBSCRIPT_ARRAY);
        }

-       else  {
+       else {

            /* index is an expression;
             * attempt to find a match within the aggregate */
            if (obase->op_type == OP_HELEM) {
            /* index is an expression;
             * attempt to find a match within the aggregate */
            if (obase->op_type == OP_HELEM) {


@@ -16612,8 +16760,11 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
 
         if (agg_targ)
            sv = PAD_SV(agg_targ);
 
         if (agg_targ)
            sv = PAD_SV(agg_targ);

-        else if (agg_gv)
+        else if (agg_gv) {

             sv = is_hv ? MUTABLE_SV(GvHV(agg_gv)) : MUTABLE_SV(GvAV(agg_gv));
             sv = is_hv ? MUTABLE_SV(GvHV(agg_gv)) : MUTABLE_SV(GvAV(agg_gv));

+            if (!sv)
+                break;
+            }

         else
             break;
 
         else
             break;
 


@@ -16639,7 +16790,7 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
                : varname(agg_gv, '@', agg_targ,
                                 NULL, index_const_iv, FUV_SUBSCRIPT_ARRAY);
        }
                : varname(agg_gv, '@', agg_targ,
                                 NULL, index_const_iv, FUV_SUBSCRIPT_ARRAY);
        }

-       else  {
+       else {

            /* index is an var */
            if (is_hv) {
                SV * const keysv = find_hash_subscript((const HV*)sv, uninit_sv);
            /* index is an var */
            if (is_hv) {
                SV * const keysv = find_hash_subscript((const HV*)sv, uninit_sv);


@@ -16654,6 +16805,34 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
                    return varname(agg_gv, '@', agg_targ,
                                        NULL, index, FUV_SUBSCRIPT_ARRAY);
            }
                    return varname(agg_gv, '@', agg_targ,
                                        NULL, index, FUV_SUBSCRIPT_ARRAY);
            }

+            /* look for an element not found */
+            if (!SvMAGICAL(sv)) {
+                SV *index_sv = NULL;
+                if (index_targ) {
+                    index_sv = PL_curpad[index_targ];
+                }
+                else if (index_gv) {
+                    index_sv = GvSV(index_gv);
+                }
+                if (index_sv && !SvMAGICAL(index_sv) && !SvROK(index_sv)) {
+                    if (is_hv) {
+                        HE *he = hv_fetch_ent(MUTABLE_HV(sv), index_sv, 0, 0);
+                        if (!he) {
+                            return varname(agg_gv, '%', agg_targ,
+                                           index_sv, 0, FUV_SUBSCRIPT_HASH);
+                        }
+                    }
+                    else {
+                        SSize_t index = SvIV(index_sv);
+                        SV * const * const svp =
+                            av_fetch(MUTABLE_AV(sv), index, FALSE);
+                        if (!svp) {
+                            return varname(agg_gv, '@', agg_targ,
+                                           NULL, index, FUV_SUBSCRIPT_ARRAY);
+                        }
+                    }
+                }
+            }

            if (match)
                break;
            return varname(agg_gv,
            if (match)
                break;
            return varname(agg_gv,