perlre: Italicize a bunch of stuff

[perl5.git] / sv.c

diff --git a/sv.c b/sv.c
index fa5295d..2123cf4 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -131,6 +131,7 @@ static const char S_destroy[] = "DESTROY";
 /* ============================================================================
 
 =head1 Allocation and deallocation of SVs.
 /* ============================================================================
 
 =head1 Allocation and deallocation of SVs.

+

 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


@@ -769,7 +770,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 +783,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 +792,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


@@ -1075,10 +1071,10 @@ Perl_more_bodies (pTHX_ const svtype sv_type, const size_t body_size,
 #if defined(DEBUGGING) && defined(PERL_GLOBAL_STRUCT)
     dVAR;
 #endif
 #if defined(DEBUGGING) && defined(PERL_GLOBAL_STRUCT)
     dVAR;
 #endif

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

     static bool done_sanity_check;
 
     static bool done_sanity_check;
 

-    /* PERL_GLOBAL_STRUCT_PRIVATE cannot coexist with global
+    /* PERL_GLOBAL_STRUCT cannot coexist with global

      * variables like done_sanity_check. */
     if (!done_sanity_check) {
        unsigned int i = SVt_LAST;
      * variables like done_sanity_check. */
     if (!done_sanity_check) {
        unsigned int i = SVt_LAST;


@@ -2667,6 +2663,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 +2672,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);


@@ -2809,6 +2808,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 +2816,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 +2846,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 +2881,48 @@ 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);
+        uv = -(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;
 }


@@ -3082,13 +3130,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);


@@ -3465,7 +3518,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


@@ -4330,6 +4384,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 +4405,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:


@@ -5160,9 +5217,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)


@@ -6267,8 +6323,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
 


@@ -7802,8 +7860,6 @@ Perl_sv_eq_flags(pTHX_ SV *sv1, SV *sv2, const U32 flags)
     STRLEN cur1;
     const char *pv2;
     STRLEN cur2;
     STRLEN cur1;
     const char *pv2;
     STRLEN cur2;

-    I32  eq     = 0;
-    SV* svrecode = NULL;

 
     if (!sv1) {
        pv1 = "";
 
     if (!sv1) {
        pv1 = "";


@@ -7843,11 +7899,9 @@ Perl_sv_eq_flags(pTHX_ SV *sv1, SV *sv2, const U32 flags)
     }
 
     if (cur1 == cur2)
     }
 
     if (cur1 == cur2)

-       eq = (pv1 == pv2) || memEQ(pv1, pv2, cur1);
-       
-    SvREFCNT_dec(svrecode);
-
-    return eq;
+       return (pv1 == pv2) || memEQ(pv1, pv2, cur1);
+    else
+       return 0;

 }
 
 /*
 }
 
 /*


@@ -8482,18 +8536,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 ! */


@@ -9325,7 +9380,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


@@ -9695,11 +9750,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;
 


@@ -9710,11 +9769,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;
 }
 


@@ -10620,9 +10678,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;
 


@@ -12594,7 +12657,7 @@ 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);
+                        uv = -(UV)iv;

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


@@ -13329,10 +13392,15 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
 
     SvTAINT(sv);
 
 
     SvTAINT(sv);
 

+#ifdef USE_LOCALE_NUMERIC
+

     if (lc_numeric_set) {
         RESTORE_LC_NUMERIC();   /* Done outside loop, so don't have to
                                    save/restore each iteration. */
     }
     if (lc_numeric_set) {
         RESTORE_LC_NUMERIC();   /* Done outside loop, so don't have to
                                    save/restore each iteration. */
     }

+
+#endif
+

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


@@ -15235,6 +15303,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;
+#endif

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


@@ -15507,16 +15578,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);


@@ -15548,6 +15612,13 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     PL_subname         = sv_dup_inc(proto_perl->Isubname, param);
 
 
     PL_subname         = sv_dup_inc(proto_perl->Isubname, param);
 

+#if   defined(USE_POSIX_2008_LOCALE)      \
+ &&   defined(USE_THREAD_SAFE_LOCALE)     \
+ && ! defined(HAS_QUERYLOCALE)
+    for (i = 0; i < (int) C_ARRAY_LENGTH(PL_curlocales); i++) {
+        PL_curlocales[i] = savepv("."); /* An illegal value */
+    }
+#endif

 #ifdef USE_LOCALE_CTYPE
     /* Should we warn if uses locale? */
     PL_warn_locale      = sv_dup_inc(proto_perl->Iwarn_locale, param);
 #ifdef USE_LOCALE_CTYPE
     /* Should we warn if uses locale? */
     PL_warn_locale      = sv_dup_inc(proto_perl->Iwarn_locale, param);


@@ -15561,7 +15632,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_numeric_name    = SAVEPV(proto_perl->Inumeric_name);
     PL_numeric_radix_sv        = sv_dup_inc(proto_perl->Inumeric_radix_sv, param);
 
     PL_numeric_name    = SAVEPV(proto_perl->Inumeric_name);
     PL_numeric_radix_sv        = sv_dup_inc(proto_perl->Inumeric_radix_sv, param);
 

-#  if defined(HAS_NEWLOCALE) && ! defined(NO_POSIX_2008_LOCALE)
+#  if defined(HAS_POSIX_2008_LOCALE)

     PL_underlying_numeric_obj = NULL;
 #  endif
 #endif /* !USE_LOCALE_NUMERIC */
     PL_underlying_numeric_obj = NULL;
 #  endif
 #endif /* !USE_LOCALE_NUMERIC */


@@ -15569,41 +15640,11 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_langinfo_buf = NULL;
     PL_langinfo_bufsize = 0;
 
     PL_langinfo_buf = NULL;
     PL_langinfo_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);
+    PL_setlocale_buf = NULL;
+    PL_setlocale_bufsize = 0;

 
     /* utf8 character class swashes */
 
     /* 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);
-    }
-    for (i = 0; i < POSIX_CC_COUNT; i++) {
-        PL_XPosix_ptrs[i] = sv_dup_inc(proto_perl->IXPosix_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_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_utf8_charname_continue = sv_dup_inc(proto_perl->Iutf8_charname_continue, param);

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


@@ -15703,7 +15744,6 @@ 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.


@@ -15852,6 +15892,8 @@ Perl_clone_params_new(PerlInterpreter *const from, PerlInterpreter *const to)
 void
 Perl_init_constants(pTHX)
 {
 void
 Perl_init_constants(pTHX)
 {

+    dVAR;
+

     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;