This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Chart the self-tying minefield.
[perl5.git] / sv.c
diff --git a/sv.c b/sv.c
index 0e0c5fc..18fdfc1 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1,6 +1,6 @@
 /*    sv.c
  *
 /*    sv.c
  *
- *    Copyright (c) 1991-2001, Larry Wall
+ *    Copyright (c) 1991-2002, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -199,7 +199,7 @@ S_del_sv(pTHX_ SV *p)
        }
        if (!ok) {
            if (ckWARN_d(WARN_INTERNAL))        
        }
        if (!ok) {
            if (ckWARN_d(WARN_INTERNAL))        
-               Perl_warner(aTHX_ WARN_INTERNAL,
+               Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
                            "Attempt to free non-arena SV: 0x%"UVxf,
                            PTR2UV(p));
            return;
                            "Attempt to free non-arena SV: 0x%"UVxf,
                            PTR2UV(p));
            return;
@@ -546,10 +546,10 @@ void
 Perl_report_uninit(pTHX)
 {
     if (PL_op)
 Perl_report_uninit(pTHX)
 {
     if (PL_op)
-       Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit,
+       Perl_warner(aTHX_ packWARN(WARN_UNINITIALIZED), PL_warn_uninit,
                    " in ", OP_DESC(PL_op));
     else
                    " in ", OP_DESC(PL_op));
     else
-       Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit, "", "");
+       Perl_warner(aTHX_ packWARN(WARN_UNINITIALIZED), PL_warn_uninit, "", "");
 }
 
 /* grab a new IV body from the free list, allocating more if necessary */
 }
 
 /* grab a new IV body from the free list, allocating more if necessary */
@@ -1226,13 +1226,13 @@ You generally want to use the C<SvUPGRADE> macro wrapper. See also C<svtype>.
 bool
 Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
 {
 bool
 Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
 {
-    char*      pv;
-    U32                cur;
-    U32                len;
-    IV         iv;
-    NV         nv;
-    MAGIC*     magic;
-    HV*                stash;
+    char*      pv = NULL;
+    U32                cur = 0;
+    U32                len = 0;
+    IV         iv = 0;
+    NV         nv = 0.0;
+    MAGIC*     magic = NULL;
+    HV*                stash = Nullhv;
 
     if (mt != SVt_PV && SvREADONLY(sv) && SvFAKE(sv)) {
        sv_force_normal(sv);
 
     if (mt != SVt_PV && SvREADONLY(sv) && SvFAKE(sv)) {
        sv_force_normal(sv);
@@ -1540,6 +1540,8 @@ Perl_sv_grow(pTHX_ register SV *sv, register STRLEN newlen)
 {
     register char *s;
 
 {
     register char *s;
 
+
+
 #ifdef HAS_64K_LIMIT
     if (newlen >= 0x10000) {
        PerlIO_printf(Perl_debug_log,
 #ifdef HAS_64K_LIMIT
     if (newlen >= 0x10000) {
        PerlIO_printf(Perl_debug_log,
@@ -1565,6 +1567,7 @@ Perl_sv_grow(pTHX_ register SV *sv, register STRLEN newlen)
     }
     else
        s = SvPVX(sv);
     }
     else
        s = SvPVX(sv);
+
     if (newlen > SvLEN(sv)) {          /* need more room? */
        if (SvLEN(sv) && s) {
 #if defined(MYMALLOC) && !defined(LEAKTEST)
     if (newlen > SvLEN(sv)) {          /* need more room? */
        if (SvLEN(sv) && s) {
 #if defined(MYMALLOC) && !defined(LEAKTEST)
@@ -1584,6 +1587,9 @@ Perl_sv_grow(pTHX_ register SV *sv, register STRLEN newlen)
                SvREADONLY_off(sv);
            }
            New(703, s, newlen, char);
                SvREADONLY_off(sv);
            }
            New(703, s, newlen, char);
+           if (SvPVX(sv) && SvCUR(sv)) {
+               Move(SvPVX(sv), s, (newlen < SvCUR(sv)) ? newlen : SvCUR(sv), char);
+           }
        }
        SvPV_set(sv, s);
         SvLEN_set(sv, newlen);
        }
        SvPV_set(sv, s);
         SvLEN_set(sv, newlen);
@@ -1821,11 +1827,11 @@ S_not_a_number(pTHX_ SV *sv)
     }
 
     if (PL_op)
     }
 
     if (PL_op)
-       Perl_warner(aTHX_ WARN_NUMERIC,
+       Perl_warner(aTHX_ packWARN(WARN_NUMERIC),
                    "Argument \"%s\" isn't numeric in %s", pv,
                    OP_DESC(PL_op));
     else
                    "Argument \"%s\" isn't numeric in %s", pv,
                    OP_DESC(PL_op));
     else
-       Perl_warner(aTHX_ WARN_NUMERIC,
+       Perl_warner(aTHX_ packWARN(WARN_NUMERIC),
                    "Argument \"%s\" isn't numeric", pv);
 }
 
                    "Argument \"%s\" isn't numeric", pv);
 }
 
@@ -2861,7 +2867,7 @@ uiv_2buf(char *buf, IV iv, UV uv, int is_uv, char **peob)
        sign = 1;
     }
     do {
        sign = 1;
     }
     do {
-       *--ptr = '0' + (uv % 10);
+       *--ptr = '0' + (char)(uv % 10);
     } while (uv /= 10);
     if (sign)
        *--ptr = '-';
     } while (uv /= 10);
     if (sign)
        *--ptr = '-';
@@ -2869,16 +2875,6 @@ uiv_2buf(char *buf, IV iv, UV uv, int is_uv, char **peob)
     return ptr;
 }
 
     return ptr;
 }
 
-/* For backwards-compatibility only. sv_2pv() is normally #def'ed to
- * C<sv_2pv_macro()>. See also C<sv_2pv_flags()>.
- */
-
-char *
-Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
-{
-    return sv_2pv_flags(sv, lp, SV_GMAGIC);
-}
-
 /*
 =for apidoc sv_2pv_flags
 
 /*
 =for apidoc sv_2pv_flags
 
@@ -2960,7 +2956,8 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
                            char ch;
                            int left = 0;
                            int right = 4;
                            char ch;
                            int left = 0;
                            int right = 4;
-                           U16 reganch = (re->reganch & PMf_COMPILETIME) >> 12;
+                            char need_newline = 0;
+                           U16 reganch = (U16)((re->reganch & PMf_COMPILETIME) >> 12);
 
                            while((ch = *fptr++)) {
                                if(reganch & 1) {
 
                            while((ch = *fptr++)) {
                                if(reganch & 1) {
@@ -2977,11 +2974,45 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
                            }
 
                            mg->mg_len = re->prelen + 4 + left;
                            }
 
                            mg->mg_len = re->prelen + 4 + left;
+                            /*
+                             * If /x was used, we have to worry about a regex
+                             * ending with a comment later being embedded
+                             * within another regex. If so, we don't want this
+                             * regex's "commentization" to leak out to the
+                             * right part of the enclosing regex, we must cap
+                             * it with a newline.
+                             *
+                             * So, if /x was used, we scan backwards from the
+                             * end of the regex. If we find a '#' before we
+                             * find a newline, we need to add a newline
+                             * ourself. If we find a '\n' first (or if we
+                             * don't find '#' or '\n'), we don't need to add
+                             * anything.  -jfriedl
+                             */
+                            if (PMf_EXTENDED & re->reganch)
+                            {
+                                char *endptr = re->precomp + re->prelen;
+                                while (endptr >= re->precomp)
+                                {
+                                    char c = *(endptr--);
+                                    if (c == '\n')
+                                        break; /* don't need another */
+                                    if (c == '#') {
+                                        /* we end while in a comment, so we
+                                           need a newline */
+                                        mg->mg_len++; /* save space for it */
+                                        need_newline = 1; /* note to add it */
+                                    }
+                                }
+                            }
+
                            New(616, mg->mg_ptr, mg->mg_len + 1 + left, char);
                            Copy("(?", mg->mg_ptr, 2, char);
                            Copy(reflags, mg->mg_ptr+2, left, char);
                            Copy(":", mg->mg_ptr+left+2, 1, char);
                            Copy(re->precomp, mg->mg_ptr+3+left, re->prelen, char);
                            New(616, mg->mg_ptr, mg->mg_len + 1 + left, char);
                            Copy("(?", mg->mg_ptr, 2, char);
                            Copy(reflags, mg->mg_ptr+2, left, char);
                            Copy(":", mg->mg_ptr+left+2, 1, char);
                            Copy(re->precomp, mg->mg_ptr+3+left, re->prelen, char);
+                            if (need_newline)
+                                mg->mg_ptr[mg->mg_len - 2] = '\n';
                            mg->mg_ptr[mg->mg_len - 1] = ')';
                            mg->mg_ptr[mg->mg_len] = 0;
                        }
                            mg->mg_ptr[mg->mg_len - 1] = ')';
                            mg->mg_ptr[mg->mg_len] = 0;
                        }
@@ -3049,7 +3080,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
            ptr = uiv_2buf(buf, 0, SvUVX(sv), 1, &ebuf);
        else
            ptr = uiv_2buf(buf, SvIVX(sv), 0, 0, &ebuf);
            ptr = uiv_2buf(buf, 0, SvUVX(sv), 1, &ebuf);
        else
            ptr = uiv_2buf(buf, SvIVX(sv), 0, 0, &ebuf);
-       SvGROW(sv, ebuf - ptr + 1);     /* inlined from sv_setpvn */
+       SvGROW(sv, (STRLEN)(ebuf - ptr + 1));   /* inlined from sv_setpvn */
        Move(ptr,SvPVX(sv),ebuf - ptr,char);
        SvCUR_set(sv, ebuf - ptr);
        s = SvEND(sv);
        Move(ptr,SvPVX(sv),ebuf - ptr,char);
        SvCUR_set(sv, ebuf - ptr);
        s = SvEND(sv);
@@ -3145,6 +3176,47 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
 }
 
 /*
 }
 
 /*
+=for apidoc sv_copypv
+
+Copies a stringified representation of the source SV into the
+destination SV.  Automatically performs any necessary mg_get and
+coercion of numeric values into strings.  Guaranteed to preserve
+UTF-8 flag even from overloaded objects.  Similar in nature to
+sv_2pv[_flags] but operates directly on an SV instead of just the
+string.  Mostly uses sv_2pv_flags to do its work, except when that
+would lose the UTF-8'ness of the PV.
+
+=cut
+*/
+
+void
+Perl_sv_copypv(pTHX_ SV *dsv, register SV *ssv)
+{
+    SV *tmpsv;
+
+    if ( SvTHINKFIRST(ssv) && SvROK(ssv) && SvAMAGIC(ssv) && 
+        (tmpsv = AMG_CALLun(ssv,string))) {
+       if (SvTYPE(tmpsv) != SVt_RV || (SvRV(tmpsv) != SvRV(ssv))) {
+           SvSetSV(dsv,tmpsv);
+           return;
+       }
+    } else {
+        tmpsv = sv_newmortal();
+    }
+    {
+       STRLEN len;
+       char *s;
+       s = SvPV(ssv,len);
+       sv_setpvn(tmpsv,s,len);
+       if (SvUTF8(ssv))
+           SvUTF8_on(tmpsv);
+       else
+           SvUTF8_off(tmpsv);
+       SvSetSV(dsv,tmpsv);
+    }
+}
+
+/*
 =for apidoc sv_2pvbyte_nolen
 
 Return a pointer to the byte-encoded representation of the SV.
 =for apidoc sv_2pvbyte_nolen
 
 Return a pointer to the byte-encoded representation of the SV.
@@ -3238,7 +3310,7 @@ Perl_sv_2bool(pTHX_ register SV *sv)
        SV* tmpsv;
         if (SvAMAGIC(sv) && (tmpsv=AMG_CALLun(sv,bool_)) &&
                 (!SvROK(tmpsv) || (SvRV(tmpsv) != SvRV(sv))))
        SV* tmpsv;
         if (SvAMAGIC(sv) && (tmpsv=AMG_CALLun(sv,bool_)) &&
                 (!SvROK(tmpsv) || (SvRV(tmpsv) != SvRV(sv))))
-           return SvTRUE(tmpsv);
+           return (bool)SvTRUE(tmpsv);
       return SvRV(sv) != 0;
     }
     if (SvPOKp(sv)) {
       return SvRV(sv) != 0;
     }
     if (SvPOKp(sv)) {
@@ -3271,16 +3343,9 @@ Forces the SV to string form if it is not already.
 Always sets the SvUTF8 flag to avoid future validity checks even
 if all the bytes have hibit clear.
 
 Always sets the SvUTF8 flag to avoid future validity checks even
 if all the bytes have hibit clear.
 
-=cut
-*/
+This is not as a general purpose byte encoding to Unicode interface:
+use the Encode extension for that.
 
 
-STRLEN
-Perl_sv_utf8_upgrade(pTHX_ register SV *sv)
-{
-    return sv_utf8_upgrade_flags(sv, SV_GMAGIC);
-}
-
-/*
 =for apidoc sv_utf8_upgrade_flags
 
 Convert the PV of an SV to its UTF8-encoded form.
 =for apidoc sv_utf8_upgrade_flags
 
 Convert the PV of an SV to its UTF8-encoded form.
@@ -3290,6 +3355,9 @@ if all the bytes have hibit clear. If C<flags> has C<SV_GMAGIC> bit set,
 will C<mg_get> on C<sv> if appropriate, else not. C<sv_utf8_upgrade> and
 C<sv_utf8_upgrade_nomg> are implemented in terms of this function.
 
 will C<mg_get> on C<sv> if appropriate, else not. C<sv_utf8_upgrade> and
 C<sv_utf8_upgrade_nomg> are implemented in terms of this function.
 
+This is not as a general purpose byte encoding to Unicode interface:
+use the Encode extension for that.
+
 =cut
 */
 
 =cut
 */
 
@@ -3317,7 +3385,7 @@ Perl_sv_utf8_upgrade_flags(pTHX_ register SV *sv, I32 flags)
     }
 
     if (PL_encoding)
     }
 
     if (PL_encoding)
-        Perl_sv_recode_to_utf8(aTHX_ sv, PL_encoding);
+        sv_recode_to_utf8(sv, PL_encoding);
     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 hibit
     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 hibit
@@ -3355,6 +3423,9 @@ This may not be possible if the PV contains non-byte encoding characters;
 if this is the case, either returns false or, if C<fail_ok> is not
 true, croaks.
 
 if this is the case, either returns false or, if C<fail_ok> is not
 true, croaks.
 
+This is not as a general purpose Unicode to byte encoding interface:
+use the Encode extension for that.
+
 =cut
 */
 
 =cut
 */
 
@@ -3372,28 +3443,6 @@ Perl_sv_utf8_downgrade(pTHX_ register SV* sv, bool fail_ok)
            if (!utf8_to_bytes(s, &len)) {
                if (fail_ok)
                    return FALSE;
            if (!utf8_to_bytes(s, &len)) {
                if (fail_ok)
                    return FALSE;
-#ifdef USE_BYTES_DOWNGRADES
-               else if (IN_BYTES) {
-                   U8 *d = s;
-                   U8 *e = (U8 *) SvEND(sv);
-                   int first = 1;
-                   while (s < e) {
-                       UV ch = utf8n_to_uvchr(s,(e-s),&len,0);
-                       if (first && ch > 255) {
-                           if (PL_op)
-                               Perl_warner(aTHX_ WARN_UTF8, "Wide character in byte %s",
-                                          OP_DESC(PL_op);
-                           else
-                               Perl_warner(aTHX_ WARN_UTF8, "Wide character in byte");
-                           first = 0;
-                       }
-                       *d++ = ch;
-                       s += len;
-                   }
-                   *d = '\0';
-                   len = (d - (U8 *) SvPVX(sv));
-               }
-#endif
                else {
                    if (PL_op)
                        Perl_croak(aTHX_ "Wide character in %s",
                else {
                    if (PL_op)
                        Perl_croak(aTHX_ "Wide character in %s",
@@ -3480,20 +3529,6 @@ You probably want to use one of the assortment of wrappers, such as
 C<SvSetSV>, C<SvSetSV_nosteal>, C<SvSetMagicSV> and
 C<SvSetMagicSV_nosteal>.
 
 C<SvSetSV>, C<SvSetSV_nosteal>, C<SvSetMagicSV> and
 C<SvSetMagicSV_nosteal>.
 
-
-=cut
-*/
-
-/* sv_setsv() is aliased to Perl_sv_setsv_macro; this function provided
-   for binary compatibility only
-*/
-void
-Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
-{
-    sv_setsv_flags(dstr, sstr, SV_GMAGIC);
-}
-
-/*
 =for apidoc sv_setsv_flags
 
 Copies the contents of the source SV C<ssv> into the destination SV
 =for apidoc sv_setsv_flags
 
 Copies the contents of the source SV C<ssv> into the destination SV
@@ -3673,7 +3708,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
     default:
        if (SvGMAGICAL(sstr) && (flags & SV_GMAGIC)) {
            mg_get(sstr);
     default:
        if (SvGMAGICAL(sstr) && (flags & SV_GMAGIC)) {
            mg_get(sstr);
-           if (SvTYPE(sstr) != stype) {
+           if ((int)SvTYPE(sstr) != stype) {
                stype = SvTYPE(sstr);
                if (stype == SVt_PVGV && dtype <= SVt_PVGV)
                    goto glob_assign;
                stype = SvTYPE(sstr);
                if (stype == SVt_PVGV && dtype <= SVt_PVGV)
                    goto glob_assign;
@@ -3682,7 +3717,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
        if (stype == SVt_PVLV)
            (void)SvUPGRADE(dstr, SVt_PVNV);
        else
        if (stype == SVt_PVLV)
            (void)SvUPGRADE(dstr, SVt_PVNV);
        else
-           (void)SvUPGRADE(dstr, stype);
+           (void)SvUPGRADE(dstr, (U32)stype);
     }
 
     sflags = SvFLAGS(sstr);
     }
 
     sflags = SvFLAGS(sstr);
@@ -3764,15 +3799,17 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
                                            || sv_cmp(cv_const_sv(cv),
                                                      cv_const_sv((CV*)sref)))))
                                {
                                            || sv_cmp(cv_const_sv(cv),
                                                      cv_const_sv((CV*)sref)))))
                                {
-                                   Perl_warner(aTHX_ WARN_REDEFINE,
+                                   Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
                                        CvCONST(cv)
                                        CvCONST(cv)
-                                       ? "Constant subroutine %s redefined"
-                                       : "Subroutine %s redefined",
+                                       ? "Constant subroutine %s::%s redefined"
+                                       : "Subroutine %s::%s redefined",
+                                       HvNAME(GvSTASH((GV*)dstr)),
                                        GvENAME((GV*)dstr));
                                }
                            }
                                        GvENAME((GV*)dstr));
                                }
                            }
-                           cv_ckproto(cv, (GV*)dstr,
-                                      SvPOK(sref) ? SvPVX(sref) : Nullch);
+                           if (!intro)
+                               cv_ckproto(cv, (GV*)dstr,
+                                       SvPOK(sref) ? SvPVX(sref) : Nullch);
                        }
                        GvCV(dstr) = (CV*)sref;
                        GvCVGEN(dstr) = 0; /* Switch off cacheness. */
                        }
                        GvCV(dstr) = (CV*)sref;
                        GvCVGEN(dstr) = 0; /* Switch off cacheness. */
@@ -3887,7 +3924,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
        }
        else {                          /* have to copy actual string */
            STRLEN len = SvCUR(sstr);
        }
        else {                          /* have to copy actual string */
            STRLEN len = SvCUR(sstr);
-
            SvGROW(dstr, len + 1);      /* inlined from sv_setpvn */
            Move(SvPVX(sstr),SvPVX(dstr),len,char);
            SvCUR_set(dstr, len);
            SvGROW(dstr, len + 1);      /* inlined from sv_setpvn */
            Move(SvPVX(sstr),SvPVX(dstr),len,char);
            SvCUR_set(dstr, len);
@@ -3943,7 +3979,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
     else {
        if (dtype == SVt_PVGV) {
            if (ckWARN(WARN_MISC))
     else {
        if (dtype == SVt_PVGV) {
            if (ckWARN(WARN_MISC))
-               Perl_warner(aTHX_ WARN_MISC, "Undefined value assigned to typeglob");
+               Perl_warner(aTHX_ packWARN(WARN_MISC), "Undefined value assigned to typeglob");
        }
        else
            (void)SvOK_off(dstr);
        }
        else
            (void)SvOK_off(dstr);
@@ -4212,19 +4248,6 @@ C<len> indicates number of bytes to copy.  If the SV has the UTF8
 status set, then the bytes appended should be valid UTF8.
 Handles 'get' magic, but not 'set' magic.  See C<sv_catpvn_mg>.
 
 status set, then the bytes appended should be valid UTF8.
 Handles 'get' magic, but not 'set' magic.  See C<sv_catpvn_mg>.
 
-=cut
-*/
-
-/* sv_catpvn() is aliased to Perl_sv_catpvn_macro; this function provided
-   for binary compatibility only
-*/
-void
-Perl_sv_catpvn(pTHX_ SV *dsv, const char* sstr, STRLEN slen)
-{
-    sv_catpvn_flags(dsv, sstr, slen, SV_GMAGIC);
-}
-
-/*
 =for apidoc sv_catpvn_flags
 
 Concatenates the string onto the end of the string which is in the SV.  The
 =for apidoc sv_catpvn_flags
 
 Concatenates the string onto the end of the string which is in the SV.  The
@@ -4276,18 +4299,6 @@ Concatenates the string from SV C<ssv> onto the end of the string in
 SV C<dsv>.  Modifies C<dsv> but not C<ssv>.  Handles 'get' magic, but
 not 'set' magic.  See C<sv_catsv_mg>.
 
 SV C<dsv>.  Modifies C<dsv> but not C<ssv>.  Handles 'get' magic, but
 not 'set' magic.  See C<sv_catsv_mg>.
 
-=cut */
-
-/* sv_catsv() is aliased to Perl_sv_catsv_macro; this function provided
-   for binary compatibility only
-*/
-void
-Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr)
-{
-    sv_catsv_flags(dstr, sstr, SV_GMAGIC);
-}
-
-/*
 =for apidoc sv_catsv_flags
 
 Concatenates the string from SV C<ssv> onto the end of the string in
 =for apidoc sv_catsv_flags
 
 Concatenates the string from SV C<ssv> onto the end of the string in
@@ -4415,43 +4426,33 @@ Perl_newSV(pTHX_ STRLEN len)
     }
     return sv;
 }
     }
     return sv;
 }
-
 /*
 /*
-=for apidoc sv_magic
+=for apidoc sv_magicext
 
 
-Adds magic to an SV. First upgrades C<sv> to type C<SVt_PVMG> if necessary,
-then adds a new magic item of type C<how> to the head of the magic list.
+Adds magic to an SV, upgrading it if necessary. Applies the
+supplied vtable and returns pointer to the magic added.
 
 
-C<name> is assumed to contain an C<SV*> if C<(name && namelen == HEf_SVKEY)>
+Note that sv_magicext will allow things that sv_magic will not.
+In particular you can add magic to SvREADONLY SVs and and more than
+one instance of the same 'how'
+
+I C<namelen> is greater then zero then a savepvn() I<copy> of C<name> is stored,
+if C<namelen> is zero then C<name> is stored as-is and - as another special
+case - if C<(name && namelen == HEf_SVKEY)> then C<name> is assumed to contain
+an C<SV*> and has its REFCNT incremented
+
+(This is now used as a subroutine by sv_magic.)
 
 =cut
 */
 
 =cut
 */
-
-void
-Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 namlen)
+MAGIC *        
+Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, MGVTBL *vtable,
+                const char* name, I32 namlen)
 {
     MAGIC* mg;
 
 {
     MAGIC* mg;
 
-    if (SvREADONLY(sv)) {
-       if (PL_curcop != &PL_compiling
-           && how != PERL_MAGIC_regex_global
-           && how != PERL_MAGIC_bm
-           && how != PERL_MAGIC_fm
-           && how != PERL_MAGIC_sv
-          )
-       {
-           Perl_croak(aTHX_ PL_no_modify);
-       }
-    }
-    if (SvMAGICAL(sv) || (how == PERL_MAGIC_taint && SvTYPE(sv) >= SVt_PVMG)) {
-       if (SvMAGIC(sv) && (mg = mg_find(sv, how))) {
-           if (how == PERL_MAGIC_taint)
-               mg->mg_len |= 1;
-           return;
-       }
-    }
-    else {
-        (void)SvUPGRADE(sv, SVt_PVMG);
+    if (SvTYPE(sv) < SVt_PVMG) {
+       (void)SvUPGRADE(sv, SVt_PVMG);
     }
     Newz(702,mg, 1, MAGIC);
     mg->mg_moremagic = SvMAGIC(sv);
     }
     Newz(702,mg, 1, MAGIC);
     mg->mg_moremagic = SvMAGIC(sv);
@@ -4460,7 +4461,13 @@ Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 nam
     /* Some magic sontains a reference loop, where the sv and object refer to
        each other.  To prevent a reference loop that would prevent such
        objects being freed, we look for such loops and if we find one we
     /* Some magic sontains a reference loop, where the sv and object refer to
        each other.  To prevent a reference loop that would prevent such
        objects being freed, we look for such loops and if we find one we
-       avoid incrementing the object refcount. */
+       avoid incrementing the object refcount.
+
+       Note we cannot do this to avoid self-tie loops as intervening RV must
+       have its REFCNT incremented to keep it in existence - instead we could
+       special case them in sv_free() -- NI-S
+
+    */
     if (!obj || obj == sv ||
        how == PERL_MAGIC_arylen ||
        how == PERL_MAGIC_qr ||
     if (!obj || obj == sv ||
        how == PERL_MAGIC_arylen ||
        how == PERL_MAGIC_qr ||
@@ -4478,129 +4485,182 @@ Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 nam
     mg->mg_type = how;
     mg->mg_len = namlen;
     if (name) {
     mg->mg_type = how;
     mg->mg_len = namlen;
     if (name) {
-       if (namlen >= 0)
+       if (namlen > 0)
            mg->mg_ptr = savepvn(name, namlen);
        else if (namlen == HEf_SVKEY)
            mg->mg_ptr = (char*)SvREFCNT_inc((SV*)name);
            mg->mg_ptr = savepvn(name, namlen);
        else if (namlen == HEf_SVKEY)
            mg->mg_ptr = (char*)SvREFCNT_inc((SV*)name);
+       else
+           mg->mg_ptr = (char *) name;
+    }
+    mg->mg_virtual = vtable;
+
+    mg_magical(sv);
+    if (SvGMAGICAL(sv))
+       SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
+    return mg;
+}
+
+/*
+=for apidoc sv_magic
+
+Adds magic to an SV. First upgrades C<sv> to type C<SVt_PVMG> if necessary,
+then adds a new magic item of type C<how> to the head of the magic list.
+
+=cut
+*/
+
+void
+Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 namlen)
+{
+    MAGIC* mg;
+    MGVTBL *vtable = 0;
+
+    if (SvREADONLY(sv)) {
+       if (PL_curcop != &PL_compiling
+           && how != PERL_MAGIC_regex_global
+           && how != PERL_MAGIC_bm
+           && how != PERL_MAGIC_fm
+           && how != PERL_MAGIC_sv
+          )
+       {
+           Perl_croak(aTHX_ PL_no_modify);
+       }
+    }
+    if (SvMAGICAL(sv) || (how == PERL_MAGIC_taint && SvTYPE(sv) >= SVt_PVMG)) {
+       if (SvMAGIC(sv) && (mg = mg_find(sv, how))) {
+           /* sv_magic() refuses to add a magic of the same 'how' as an
+              existing one
+            */
+           if (how == PERL_MAGIC_taint)
+               mg->mg_len |= 1;
+           return;
+       }
     }
 
     switch (how) {
     case PERL_MAGIC_sv:
     }
 
     switch (how) {
     case PERL_MAGIC_sv:
-       mg->mg_virtual = &PL_vtbl_sv;
+       vtable = &PL_vtbl_sv;
        break;
     case PERL_MAGIC_overload:
        break;
     case PERL_MAGIC_overload:
-        mg->mg_virtual = &PL_vtbl_amagic;
+        vtable = &PL_vtbl_amagic;
         break;
     case PERL_MAGIC_overload_elem:
         break;
     case PERL_MAGIC_overload_elem:
-        mg->mg_virtual = &PL_vtbl_amagicelem;
+        vtable = &PL_vtbl_amagicelem;
         break;
     case PERL_MAGIC_overload_table:
         break;
     case PERL_MAGIC_overload_table:
-        mg->mg_virtual = &PL_vtbl_ovrld;
+        vtable = &PL_vtbl_ovrld;
         break;
     case PERL_MAGIC_bm:
         break;
     case PERL_MAGIC_bm:
-       mg->mg_virtual = &PL_vtbl_bm;
+       vtable = &PL_vtbl_bm;
        break;
     case PERL_MAGIC_regdata:
        break;
     case PERL_MAGIC_regdata:
-       mg->mg_virtual = &PL_vtbl_regdata;
+       vtable = &PL_vtbl_regdata;
        break;
     case PERL_MAGIC_regdatum:
        break;
     case PERL_MAGIC_regdatum:
-       mg->mg_virtual = &PL_vtbl_regdatum;
+       vtable = &PL_vtbl_regdatum;
        break;
     case PERL_MAGIC_env:
        break;
     case PERL_MAGIC_env:
-       mg->mg_virtual = &PL_vtbl_env;
+       vtable = &PL_vtbl_env;
        break;
     case PERL_MAGIC_fm:
        break;
     case PERL_MAGIC_fm:
-       mg->mg_virtual = &PL_vtbl_fm;
+       vtable = &PL_vtbl_fm;
        break;
     case PERL_MAGIC_envelem:
        break;
     case PERL_MAGIC_envelem:
-       mg->mg_virtual = &PL_vtbl_envelem;
+       vtable = &PL_vtbl_envelem;
        break;
     case PERL_MAGIC_regex_global:
        break;
     case PERL_MAGIC_regex_global:
-       mg->mg_virtual = &PL_vtbl_mglob;
+       vtable = &PL_vtbl_mglob;
        break;
     case PERL_MAGIC_isa:
        break;
     case PERL_MAGIC_isa:
-       mg->mg_virtual = &PL_vtbl_isa;
+       vtable = &PL_vtbl_isa;
        break;
     case PERL_MAGIC_isaelem:
        break;
     case PERL_MAGIC_isaelem:
-       mg->mg_virtual = &PL_vtbl_isaelem;
+       vtable = &PL_vtbl_isaelem;
        break;
     case PERL_MAGIC_nkeys:
        break;
     case PERL_MAGIC_nkeys:
-       mg->mg_virtual = &PL_vtbl_nkeys;
+       vtable = &PL_vtbl_nkeys;
        break;
     case PERL_MAGIC_dbfile:
        break;
     case PERL_MAGIC_dbfile:
-       SvRMAGICAL_on(sv);
-       mg->mg_virtual = 0;
+       vtable = 0;
        break;
     case PERL_MAGIC_dbline:
        break;
     case PERL_MAGIC_dbline:
-       mg->mg_virtual = &PL_vtbl_dbline;
+       vtable = &PL_vtbl_dbline;
        break;
 #ifdef USE_5005THREADS
     case PERL_MAGIC_mutex:
        break;
 #ifdef USE_5005THREADS
     case PERL_MAGIC_mutex:
-       mg->mg_virtual = &PL_vtbl_mutex;
+       vtable = &PL_vtbl_mutex;
        break;
 #endif /* USE_5005THREADS */
 #ifdef USE_LOCALE_COLLATE
     case PERL_MAGIC_collxfrm:
        break;
 #endif /* USE_5005THREADS */
 #ifdef USE_LOCALE_COLLATE
     case PERL_MAGIC_collxfrm:
-        mg->mg_virtual = &PL_vtbl_collxfrm;
+        vtable = &PL_vtbl_collxfrm;
         break;
 #endif /* USE_LOCALE_COLLATE */
     case PERL_MAGIC_tied:
         break;
 #endif /* USE_LOCALE_COLLATE */
     case PERL_MAGIC_tied:
-       mg->mg_virtual = &PL_vtbl_pack;
+       vtable = &PL_vtbl_pack;
        break;
     case PERL_MAGIC_tiedelem:
     case PERL_MAGIC_tiedscalar:
        break;
     case PERL_MAGIC_tiedelem:
     case PERL_MAGIC_tiedscalar:
-       mg->mg_virtual = &PL_vtbl_packelem;
+       vtable = &PL_vtbl_packelem;
        break;
     case PERL_MAGIC_qr:
        break;
     case PERL_MAGIC_qr:
-       mg->mg_virtual = &PL_vtbl_regexp;
+       vtable = &PL_vtbl_regexp;
        break;
     case PERL_MAGIC_sig:
        break;
     case PERL_MAGIC_sig:
-       mg->mg_virtual = &PL_vtbl_sig;
+       vtable = &PL_vtbl_sig;
        break;
     case PERL_MAGIC_sigelem:
        break;
     case PERL_MAGIC_sigelem:
-       mg->mg_virtual = &PL_vtbl_sigelem;
+       vtable = &PL_vtbl_sigelem;
        break;
     case PERL_MAGIC_taint:
        break;
     case PERL_MAGIC_taint:
-       mg->mg_virtual = &PL_vtbl_taint;
-       mg->mg_len = 1;
+       vtable = &PL_vtbl_taint;
        break;
     case PERL_MAGIC_uvar:
        break;
     case PERL_MAGIC_uvar:
-       mg->mg_virtual = &PL_vtbl_uvar;
+       vtable = &PL_vtbl_uvar;
        break;
     case PERL_MAGIC_vec:
        break;
     case PERL_MAGIC_vec:
-       mg->mg_virtual = &PL_vtbl_vec;
+       vtable = &PL_vtbl_vec;
        break;
     case PERL_MAGIC_substr:
        break;
     case PERL_MAGIC_substr:
-       mg->mg_virtual = &PL_vtbl_substr;
+       vtable = &PL_vtbl_substr;
        break;
     case PERL_MAGIC_defelem:
        break;
     case PERL_MAGIC_defelem:
-       mg->mg_virtual = &PL_vtbl_defelem;
+       vtable = &PL_vtbl_defelem;
        break;
     case PERL_MAGIC_glob:
        break;
     case PERL_MAGIC_glob:
-       mg->mg_virtual = &PL_vtbl_glob;
+       vtable = &PL_vtbl_glob;
        break;
     case PERL_MAGIC_arylen:
        break;
     case PERL_MAGIC_arylen:
-       mg->mg_virtual = &PL_vtbl_arylen;
+       vtable = &PL_vtbl_arylen;
        break;
     case PERL_MAGIC_pos:
        break;
     case PERL_MAGIC_pos:
-       mg->mg_virtual = &PL_vtbl_pos;
+       vtable = &PL_vtbl_pos;
        break;
     case PERL_MAGIC_backref:
        break;
     case PERL_MAGIC_backref:
-       mg->mg_virtual = &PL_vtbl_backref;
+       vtable = &PL_vtbl_backref;
        break;
     case PERL_MAGIC_ext:
        /* Reserved for use by extensions not perl internals.           */
        /* Useful for attaching extension internal data to perl vars.   */
        /* Note that multiple extensions may clash if magical scalars   */
        /* etc holding private data from one are passed to another.     */
        break;
     case PERL_MAGIC_ext:
        /* Reserved for use by extensions not perl internals.           */
        /* Useful for attaching extension internal data to perl vars.   */
        /* Note that multiple extensions may clash if magical scalars   */
        /* etc holding private data from one are passed to another.     */
-       SvRMAGICAL_on(sv);
        break;
     default:
        Perl_croak(aTHX_ "Don't know how to handle magic of type \\%o", how);
     }
        break;
     default:
        Perl_croak(aTHX_ "Don't know how to handle magic of type \\%o", how);
     }
-    mg_magical(sv);
-    if (SvGMAGICAL(sv))
-       SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
+
+    /* Rest of work is done else where */
+    mg = sv_magicext(sv,obj,how,vtable,name,namlen);
+
+    switch (how) {
+    case PERL_MAGIC_taint:
+       mg->mg_len = 1;
+       break;
+    case PERL_MAGIC_ext:
+    case PERL_MAGIC_dbfile:
+       SvRMAGICAL_on(sv);
+       break;
+    }
 }
 
 /*
 }
 
 /*
@@ -4626,7 +4686,7 @@ Perl_sv_unmagic(pTHX_ SV *sv, int type)
            if (vtbl && vtbl->svt_free)
                CALL_FPTR(vtbl->svt_free)(aTHX_ sv, mg);
            if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) {
            if (vtbl && vtbl->svt_free)
                CALL_FPTR(vtbl->svt_free)(aTHX_ sv, mg);
            if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) {
-               if (mg->mg_len >= 0)
+               if (mg->mg_len > 0)
                    Safefree(mg->mg_ptr);
                else if (mg->mg_len == HEf_SVKEY)
                    SvREFCNT_dec((SV*)mg->mg_ptr);
                    Safefree(mg->mg_ptr);
                else if (mg->mg_len == HEf_SVKEY)
                    SvREFCNT_dec((SV*)mg->mg_ptr);
@@ -4667,7 +4727,7 @@ Perl_sv_rvweaken(pTHX_ SV *sv)
        Perl_croak(aTHX_ "Can't weaken a nonreference");
     else if (SvWEAKREF(sv)) {
        if (ckWARN(WARN_MISC))
        Perl_croak(aTHX_ "Can't weaken a nonreference");
     else if (SvWEAKREF(sv)) {
        if (ckWARN(WARN_MISC))
-           Perl_warner(aTHX_ WARN_MISC, "Reference is already weak");
+           Perl_warner(aTHX_ packWARN(WARN_MISC), "Reference is already weak");
        return sv;
     }
     tsv = SvRV(sv);
        return sv;
     }
     tsv = SvRV(sv);
@@ -4707,7 +4767,7 @@ S_sv_del_backref(pTHX_ SV *sv)
     SV **svp;
     I32 i;
     SV *tsv = SvRV(sv);
     SV **svp;
     I32 i;
     SV *tsv = SvRV(sv);
-    MAGIC *mg;
+    MAGIC *mg = NULL;
     if (!SvMAGICAL(tsv) || !(mg = mg_find(tsv, PERL_MAGIC_backref)))
        Perl_croak(aTHX_ "panic: del_backref");
     av = (AV *)mg->mg_obj;
     if (!SvMAGICAL(tsv) || !(mg = mg_find(tsv, PERL_MAGIC_backref)))
        Perl_croak(aTHX_ "panic: del_backref");
     av = (AV *)mg->mg_obj;
@@ -4834,7 +4894,7 @@ Perl_sv_replace(pTHX_ register SV *sv, register SV *nsv)
     U32 refcnt = SvREFCNT(sv);
     SV_CHECK_THINKFIRST(sv);
     if (SvREFCNT(nsv) != 1 && ckWARN_d(WARN_INTERNAL))
     U32 refcnt = SvREFCNT(sv);
     SV_CHECK_THINKFIRST(sv);
     if (SvREFCNT(nsv) != 1 && ckWARN_d(WARN_INTERNAL))
-       Perl_warner(aTHX_ WARN_INTERNAL, "Reference miscount in sv_replace()");
+       Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "Reference miscount in sv_replace()");
     if (SvMAGICAL(sv)) {
        if (SvMAGICAL(nsv))
            mg_free(nsv);
     if (SvMAGICAL(sv)) {
        if (SvMAGICAL(nsv))
            mg_free(nsv);
@@ -5109,7 +5169,7 @@ Perl_sv_free(pTHX_ SV *sv)
            return;
        }
        if (ckWARN_d(WARN_INTERNAL))
            return;
        }
        if (ckWARN_d(WARN_INTERNAL))
-           Perl_warner(aTHX_ WARN_INTERNAL, "Attempt to free unreferenced scalar");
+           Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "Attempt to free unreferenced scalar");
        return;
     }
     ATOMIC_DEC_AND_TEST(refcount_is_zero, SvREFCNT(sv));
        return;
     }
     ATOMIC_DEC_AND_TEST(refcount_is_zero, SvREFCNT(sv));
@@ -5118,7 +5178,7 @@ Perl_sv_free(pTHX_ SV *sv)
 #ifdef DEBUGGING
     if (SvTEMP(sv)) {
        if (ckWARN_d(WARN_DEBUGGING))
 #ifdef DEBUGGING
     if (SvTEMP(sv)) {
        if (ckWARN_d(WARN_DEBUGGING))
-           Perl_warner(aTHX_ WARN_DEBUGGING,
+           Perl_warner(aTHX_ packWARN(WARN_DEBUGGING),
                        "Attempt to free temp prematurely: SV 0x%"UVxf,
                        PTR2UV(sv));
        return;
                        "Attempt to free temp prematurely: SV 0x%"UVxf,
                        PTR2UV(sv));
        return;
@@ -5248,7 +5308,7 @@ Perl_sv_pos_b2u(pTHX_ register SV *sv, I32* offsetp)
        return;
 
     s = (U8*)SvPV(sv, len);
        return;
 
     s = (U8*)SvPV(sv, len);
-    if (len < *offsetp)
+    if ((I32)len < *offsetp)
        Perl_croak(aTHX_ "panic: sv_pos_b2u: bad byte offset");
     send = s + *offsetp;
     len = 0;
        Perl_croak(aTHX_ "panic: sv_pos_b2u: bad byte offset");
     send = s + *offsetp;
     len = 0;
@@ -5286,6 +5346,7 @@ Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2)
     STRLEN cur2;
     I32  eq     = 0;
     char *tpv   = Nullch;
     STRLEN cur2;
     I32  eq     = 0;
     char *tpv   = Nullch;
+    SV* svrecode = Nullsv;
 
     if (!sv1) {
        pv1 = "";
 
     if (!sv1) {
        pv1 = "";
@@ -5301,33 +5362,57 @@ Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2)
     else
        pv2 = SvPV(sv2, cur2);
 
     else
        pv2 = SvPV(sv2, cur2);
 
-    /* do not utf8ize the comparands as a side-effect */
     if (cur1 && cur2 && SvUTF8(sv1) != SvUTF8(sv2) && !IN_BYTES) {
     if (cur1 && cur2 && SvUTF8(sv1) != SvUTF8(sv2) && !IN_BYTES) {
-       bool is_utf8 = TRUE;
-        /* UTF-8ness differs */
-
-       if (SvUTF8(sv1)) {
-           /* sv1 is the UTF-8 one , If is equal it must be downgrade-able */
-           char *pv = (char*)bytes_from_utf8((U8*)pv1, &cur1, &is_utf8);
-           if (pv != pv1)
-               pv1 = tpv = pv;
-       }
-       else {
-           /* sv2 is the UTF-8 one , If is equal it must be downgrade-able */
-           char *pv = (char *)bytes_from_utf8((U8*)pv2, &cur2, &is_utf8);
-           if (pv != pv2)
-               pv2 = tpv = pv;
-       }
-       if (is_utf8) {
-           /* Downgrade not possible - cannot be eq */
-           return FALSE;
-       }
+        /* Differing utf8ness.
+        * Do not UTF8size the comparands as a side-effect. */
+        if (PL_encoding) {
+             if (SvUTF8(sv1)) {
+                  svrecode = newSVpvn(pv2, cur2);
+                  sv_recode_to_utf8(svrecode, PL_encoding);
+                  pv2 = SvPV(svrecode, cur2);
+             }
+             else {
+                  svrecode = newSVpvn(pv1, cur1);
+                  sv_recode_to_utf8(svrecode, PL_encoding);
+                  pv1 = SvPV(svrecode, cur1);
+             }
+             /* Now both are in UTF-8. */
+             if (cur1 != cur2)
+                  return FALSE;
+        }
+        else {
+             bool is_utf8 = TRUE;
+
+             if (SvUTF8(sv1)) {
+                  /* sv1 is the UTF-8 one,
+                   * if is equal it must be downgrade-able */
+                  char *pv = (char*)bytes_from_utf8((U8*)pv1,
+                                                    &cur1, &is_utf8);
+                  if (pv != pv1)
+                       pv1 = tpv = pv;
+             }
+             else {
+                  /* sv2 is the UTF-8 one,
+                   * if is equal it must be downgrade-able */
+                  char *pv = (char *)bytes_from_utf8((U8*)pv2,
+                                                     &cur2, &is_utf8);
+                  if (pv != pv2)
+                       pv2 = tpv = pv;
+             }
+             if (is_utf8) {
+                  /* Downgrade not possible - cannot be eq */
+                  return FALSE;
+             }
+        }
     }
 
     if (cur1 == cur2)
        eq = memEQ(pv1, pv2, cur1);
        
     }
 
     if (cur1 == cur2)
        eq = memEQ(pv1, pv2, cur1);
        
-    if (tpv != Nullch)
+    if (svrecode)
+        SvREFCNT_dec(svrecode);
+
+    if (tpv)
        Safefree(tpv);
 
     return eq;
        Safefree(tpv);
 
     return eq;
@@ -5348,10 +5433,9 @@ I32
 Perl_sv_cmp(pTHX_ register SV *sv1, register SV *sv2)
 {
     STRLEN cur1, cur2;
 Perl_sv_cmp(pTHX_ register SV *sv1, register SV *sv2)
 {
     STRLEN cur1, cur2;
-    char *pv1, *pv2;
+    char *pv1, *pv2, *tpv = Nullch;
     I32  cmp;
     I32  cmp;
-    bool pv1tmp = FALSE;
-    bool pv2tmp = FALSE;
+    SV *svrecode = Nullsv;
 
     if (!sv1) {
        pv1 = "";
 
     if (!sv1) {
        pv1 = "";
@@ -5360,22 +5444,35 @@ Perl_sv_cmp(pTHX_ register SV *sv1, register SV *sv2)
     else
        pv1 = SvPV(sv1, cur1);
 
     else
        pv1 = SvPV(sv1, cur1);
 
-    if (!sv2){
+    if (!sv2) {
        pv2 = "";
        cur2 = 0;
     }
     else
        pv2 = SvPV(sv2, cur2);
 
        pv2 = "";
        cur2 = 0;
     }
     else
        pv2 = SvPV(sv2, cur2);
 
-    /* do not utf8ize the comparands as a side-effect */
     if (cur1 && cur2 && SvUTF8(sv1) != SvUTF8(sv2) && !IN_BYTES) {
     if (cur1 && cur2 && SvUTF8(sv1) != SvUTF8(sv2) && !IN_BYTES) {
+        /* Differing utf8ness.
+        * Do not UTF8size the comparands as a side-effect. */
        if (SvUTF8(sv1)) {
        if (SvUTF8(sv1)) {
-           pv2 = (char*)bytes_to_utf8((U8*)pv2, &cur2);
-           pv2tmp = TRUE;
+           if (PL_encoding) {
+                svrecode = newSVpvn(pv2, cur2);
+                sv_recode_to_utf8(svrecode, PL_encoding);
+                pv2 = SvPV(svrecode, cur2);
+           }
+           else {
+                pv2 = tpv = (char*)bytes_to_utf8((U8*)pv2, &cur2);
+           }
        }
        else {
        }
        else {
-           pv1 = (char*)bytes_to_utf8((U8*)pv1, &cur1);
-           pv1tmp = TRUE;
+           if (PL_encoding) {
+                svrecode = newSVpvn(pv1, cur1);
+                sv_recode_to_utf8(svrecode, PL_encoding);
+                pv1 = SvPV(svrecode, cur1);
+           }
+           else {
+                pv1 = tpv = (char*)bytes_to_utf8((U8*)pv1, &cur1);
+           }
        }
     }
 
        }
     }
 
@@ -5395,10 +5492,11 @@ Perl_sv_cmp(pTHX_ register SV *sv1, register SV *sv2)
        }
     }
 
        }
     }
 
-    if (pv1tmp)
-       Safefree(pv1);
-    if (pv2tmp)
-       Safefree(pv2);
+    if (svrecode)
+        SvREFCNT_dec(svrecode);
+
+    if (tpv)
+       Safefree(tpv);
 
     return cmp;
 }
 
     return cmp;
 }
@@ -5564,7 +5662,7 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
       /* Grab the size of the record we're getting */
       recsize = SvIV(SvRV(PL_rs));
       (void)SvPOK_only(sv);    /* Validate pointer */
       /* Grab the size of the record we're getting */
       recsize = SvIV(SvRV(PL_rs));
       (void)SvPOK_only(sv);    /* Validate pointer */
-      buffer = SvGROW(sv, recsize + 1);
+      buffer = SvGROW(sv, (STRLEN)(recsize + 1));
       /* Go yank in */
 #ifdef VMS
       /* VMS wants read instead of fread, because fread doesn't respect */
       /* Go yank in */
 #ifdef VMS
       /* VMS wants read instead of fread, because fread doesn't respect */
@@ -5650,15 +5748,15 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
 
     cnt = PerlIO_get_cnt(fp);                  /* get count into register */
     (void)SvPOK_only(sv);              /* validate pointer */
 
     cnt = PerlIO_get_cnt(fp);                  /* get count into register */
     (void)SvPOK_only(sv);              /* validate pointer */
-    if (SvLEN(sv) - append <= cnt + 1) { /* make sure we have the room */
-       if (cnt > 80 && SvLEN(sv) > append) {
+    if ((I32)(SvLEN(sv) - append) <= cnt + 1) { /* make sure we have the room */
+       if (cnt > 80 && (I32)SvLEN(sv) > append) {
            shortbuffered = cnt - SvLEN(sv) + append + 1;
            cnt -= shortbuffered;
        }
        else {
            shortbuffered = 0;
            /* remember that cnt can be negative */
            shortbuffered = cnt - SvLEN(sv) + append + 1;
            cnt -= shortbuffered;
        }
        else {
            shortbuffered = 0;
            /* remember that cnt can be negative */
-           SvGROW(sv, append + (cnt <= 0 ? 2 : (cnt + 1)));
+           SvGROW(sv, (STRLEN)(append + (cnt <= 0 ? 2 : (cnt + 1))));
        }
     }
     else
        }
     }
     else
@@ -5732,14 +5830,14 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
        SvGROW(sv, bpx + cnt + 2);
        bp = (STDCHAR*)SvPVX(sv) + bpx; /* unbox after relocation */
 
        SvGROW(sv, bpx + cnt + 2);
        bp = (STDCHAR*)SvPVX(sv) + bpx; /* unbox after relocation */
 
-       *bp++ = i;                      /* store character from PerlIO_getc */
+       *bp++ = (STDCHAR)i;             /* store character from PerlIO_getc */
 
        if (rslen && (STDCHAR)i == rslast)  /* all done for now? */
            goto thats_all_folks;
     }
 
 thats_all_folks:
 
        if (rslen && (STDCHAR)i == rslast)  /* all done for now? */
            goto thats_all_folks;
     }
 
 thats_all_folks:
-    if ((rslen > 1 && (bp - (STDCHAR*)SvPVX(sv) < rslen)) ||
+    if ((rslen > 1 && (STRLEN)(bp - (STDCHAR*)SvPVX(sv)) < rslen) ||
          memNE((char*)bp - rslen, rsptr, rslen))
        goto screamer;                          /* go back to the fray */
 thats_really_all_folks:
          memNE((char*)bp - rslen, rsptr, rslen))
        goto screamer;                          /* go back to the fray */
 thats_really_all_folks:
@@ -5775,7 +5873,7 @@ screamer2:
        if (rslen) {
            register STDCHAR *bpe = buf + sizeof(buf);
            bp = buf;
        if (rslen) {
            register STDCHAR *bpe = buf + sizeof(buf);
            bp = buf;
-           while ((i = PerlIO_getc(fp)) != EOF && (*bp++ = i) != rslast && bp < bpe)
+           while ((i = PerlIO_getc(fp)) != EOF && (*bp++ = (STDCHAR)i) != rslast && bp < bpe)
                ; /* keep reading */
            cnt = bp - buf;
        }
                ; /* keep reading */
            cnt = bp - buf;
        }
@@ -6418,7 +6516,7 @@ Perl_newSVsv(pTHX_ register SV *old)
        return Nullsv;
     if (SvTYPE(old) == SVTYPEMASK) {
         if (ckWARN_d(WARN_INTERNAL))
        return Nullsv;
     if (SvTYPE(old) == SVTYPEMASK) {
         if (ckWARN_d(WARN_INTERNAL))
-           Perl_warner(aTHX_ WARN_INTERNAL, "semi-panic: attempt to dup freed string");
+           Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "semi-panic: attempt to dup freed string");
        return Nullsv;
     }
     new_SV(sv);
        return Nullsv;
     }
     new_SV(sv);
@@ -6504,8 +6602,14 @@ Perl_sv_reset(pTHX_ register char *s, HV *stash)
                if (GvHV(gv) && !HvNAME(GvHV(gv))) {
                    hv_clear(GvHV(gv));
 #ifdef USE_ENVIRON_ARRAY
                if (GvHV(gv) && !HvNAME(GvHV(gv))) {
                    hv_clear(GvHV(gv));
 #ifdef USE_ENVIRON_ARRAY
-                   if (gv == PL_envgv)
+                   if (gv == PL_envgv
+#  ifdef USE_ITHREADS
+                       && PL_curinterp == aTHX
+#  endif
+                   )
+                   {
                        environ[0] = Nullch;
                        environ[0] = Nullch;
+                   }
 #endif
                }
            }
 #endif
                }
            }
@@ -6569,8 +6673,8 @@ possible to set C<*st> and C<*gvp> to the stash and GV associated with it.
 CV *
 Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref)
 {
 CV *
 Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref)
 {
-    GV *gv;
-    CV *cv;
+    GV *gv = Nullgv;
+    CV *cv = Nullcv;
     STRLEN n_a;
 
     if (!sv)
     STRLEN n_a;
 
     if (!sv)
@@ -6734,24 +6838,8 @@ Perl_sv_nv(pTHX_ register SV *sv)
 /*
 =for apidoc sv_pv
 
 /*
 =for apidoc sv_pv
 
-A private implementation of the C<SvPV_nolen> macro for compilers which can't
-cope with complex macro expressions. Always use the macro instead.
-
-=cut
-*/
-
-char *
-Perl_sv_pv(pTHX_ SV *sv)
-{
-    STRLEN n_a;
+Use the C<SvPV_nolen> macro instead
 
 
-    if (SvPOK(sv))
-       return SvPVX(sv);
-
-    return sv_2pv(sv, &n_a);
-}
-
-/*
 =for apidoc sv_pvn
 
 A private implementation of the C<SvPV> macro for compilers which can't
 =for apidoc sv_pvn
 
 A private implementation of the C<SvPV> macro for compilers which can't
@@ -6770,8 +6858,6 @@ Perl_sv_pvn(pTHX_ SV *sv, STRLEN *lp)
     return sv_2pv(sv, lp);
 }
 
     return sv_2pv(sv, lp);
 }
 
-/* For -DCRIPPLED_CC only. See also C<sv_2pv_flags()>.
- */
 
 char *
 Perl_sv_pvn_nomg(pTHX_ register SV *sv, STRLEN *lp)
 
 char *
 Perl_sv_pvn_nomg(pTHX_ register SV *sv, STRLEN *lp)
@@ -6790,16 +6876,6 @@ Get a sensible string out of the SV somehow.
 A private implementation of the C<SvPV_force> macro for compilers which
 can't cope with complex macro expressions. Always use the macro instead.
 
 A private implementation of the C<SvPV_force> macro for compilers which
 can't cope with complex macro expressions. Always use the macro instead.
 
-=cut
-*/
-
-char *
-Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp)
-{
-    return sv_pvn_force_flags(sv, lp, SV_GMAGIC);
-}
-
-/*
 =for apidoc sv_pvn_force_flags
 
 Get a sensible string out of the SV somehow.
 =for apidoc sv_pvn_force_flags
 
 Get a sensible string out of the SV somehow.
@@ -6815,7 +6891,7 @@ C<SvPV_force> and C<SvPV_force_nomg>
 char *
 Perl_sv_pvn_force_flags(pTHX_ SV *sv, STRLEN *lp, I32 flags)
 {
 char *
 Perl_sv_pvn_force_flags(pTHX_ SV *sv, STRLEN *lp, I32 flags)
 {
-    char *s;
+    char *s = NULL;
 
     if (SvTHINKFIRST(sv) && !SvROK(sv))
        sv_force_normal(sv);
 
     if (SvTHINKFIRST(sv) && !SvROK(sv))
        sv_force_normal(sv);
@@ -6854,21 +6930,8 @@ Perl_sv_pvn_force_flags(pTHX_ SV *sv, STRLEN *lp, I32 flags)
 /*
 =for apidoc sv_pvbyte
 
 /*
 =for apidoc sv_pvbyte
 
-A private implementation of the C<SvPVbyte_nolen> macro for compilers
-which can't cope with complex macro expressions. Always use the macro
-instead.
-
-=cut
-*/
-
-char *
-Perl_sv_pvbyte(pTHX_ SV *sv)
-{
-    sv_utf8_downgrade(sv,0);
-    return sv_pv(sv);
-}
+Use C<SvPVbyte_nolen> instead.
 
 
-/*
 =for apidoc sv_pvbyten
 
 A private implementation of the C<SvPVbyte> macro for compilers
 =for apidoc sv_pvbyten
 
 A private implementation of the C<SvPVbyte> macro for compilers
@@ -6905,21 +6968,8 @@ Perl_sv_pvbyten_force(pTHX_ SV *sv, STRLEN *lp)
 /*
 =for apidoc sv_pvutf8
 
 /*
 =for apidoc sv_pvutf8
 
-A private implementation of the C<SvPVutf8_nolen> macro for compilers
-which can't cope with complex macro expressions. Always use the macro
-instead.
-
-=cut
-*/
-
-char *
-Perl_sv_pvutf8(pTHX_ SV *sv)
-{
-    sv_utf8_upgrade(sv);
-    return sv_pv(sv);
-}
+Use the C<SvPVutf8_nolen> macro instead
 
 
-/*
 =for apidoc sv_pvutf8n
 
 A private implementation of the C<SvPVutf8> macro for compilers
 =for apidoc sv_pvutf8n
 
 A private implementation of the C<SvPVutf8> macro for compilers
@@ -7254,9 +7304,6 @@ Perl_sv_bless(pTHX_ SV *sv, HV *stash)
 }
 
 /* Downgrades a PVGV to a PVMG.
 }
 
 /* Downgrades a PVGV to a PVMG.
- *
- * XXX This function doesn't actually appear to be used anywhere
- * DAPM 15-Jun-01
  */
 
 STATIC void
  */
 
 STATIC void
@@ -7384,44 +7431,6 @@ Perl_sv_tainted(pTHX_ SV *sv)
     return FALSE;
 }
 
     return FALSE;
 }
 
-/*
-=for apidoc sv_setpviv
-
-Copies an integer into the given SV, also updating its string value.
-Does not handle 'set' magic.  See C<sv_setpviv_mg>.
-
-=cut
-*/
-
-void
-Perl_sv_setpviv(pTHX_ SV *sv, IV iv)
-{
-    char buf[TYPE_CHARS(UV)];
-    char *ebuf;
-    char *ptr = uiv_2buf(buf, iv, 0, 0, &ebuf);
-
-    sv_setpvn(sv, ptr, ebuf - ptr);
-}
-
-/*
-=for apidoc sv_setpviv_mg
-
-Like C<sv_setpviv>, but also handles 'set' magic.
-
-=cut
-*/
-
-void
-Perl_sv_setpviv_mg(pTHX_ SV *sv, IV iv)
-{
-    char buf[TYPE_CHARS(UV)];
-    char *ebuf;
-    char *ptr = uiv_2buf(buf, iv, 0, 0, &ebuf);
-
-    sv_setpvn(sv, ptr, ebuf - ptr);
-    SvSETMAGIC(sv);
-}
-
 #if defined(PERL_IMPLICIT_CONTEXT)
 
 /* pTHX_ magic can't cope with varargs, so this is a no-context
 #if defined(PERL_IMPLICIT_CONTEXT)
 
 /* pTHX_ magic can't cope with varargs, so this is a no-context
@@ -7724,7 +7733,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
        SV *vecsv;
        U8 *vecstr = Null(U8*);
        STRLEN veclen = 0;
        SV *vecsv;
        U8 *vecstr = Null(U8*);
        STRLEN veclen = 0;
-       char c;
+       char c = 0;
        int i;
        unsigned base = 0;
        IV iv = 0;
        int i;
        unsigned base = 0;
        IV iv = 0;
@@ -7886,6 +7895,25 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
        /* SIZE */
 
        switch (*q) {
        /* SIZE */
 
        switch (*q) {
+#ifdef WIN32
+       case 'I':                       /* Ix, I32x, and I64x */
+#  ifdef WIN64
+           if (q[1] == '6' && q[2] == '4') {
+               q += 3;
+               intsize = 'q';
+               break;
+           }
+#  endif
+           if (q[1] == '3' && q[2] == '2') {
+               q += 3;
+               break;
+           }
+#  ifdef WIN64
+           intsize = 'q';
+#  endif
+           q++;
+           break;
+#endif
 #if defined(HAS_QUAD) || (defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE))
        case 'L':                       /* Ld */
            /* FALL THROUGH */
 #if defined(HAS_QUAD) || (defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE))
        case 'L':                       /* Ld */
            /* FALL THROUGH */
@@ -8181,7 +8209,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                    if (n >= 2 && s[n-2] == '1' && s[n-1] == '9'
                        && (n == 2 || !isDIGIT(s[n-3])))
                    {
                    if (n >= 2 && s[n-2] == '1' && s[n-1] == '9'
                        && (n == 2 || !isDIGIT(s[n-3])))
                    {
-                       Perl_warner(aTHX_ WARN_Y2K,
+                       Perl_warner(aTHX_ packWARN(WARN_Y2K),
                                    "Possible Y2K bug: %%%c %s",
                                    c, "format string following '19'");
                    }
                                    "Possible Y2K bug: %%%c %s",
                                    c, "format string following '19'");
                    }
@@ -8318,7 +8346,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                                       (UV)c & 0xFF);
                } else
                    sv_catpv(msg, "end of string");
                                       (UV)c & 0xFF);
                } else
                    sv_catpv(msg, "end of string");
-               Perl_warner(aTHX_ WARN_PRINTF, "%"SVf, msg); /* yes, this is reentrant */
+               Perl_warner(aTHX_ packWARN(WARN_PRINTF), "%"SVf, msg); /* yes, this is reentrant */
            }
 
            /* output mangled stuff ... */
            }
 
            /* output mangled stuff ... */
@@ -8337,6 +8365,22 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            continue;   /* not "break" */
        }
 
            continue;   /* not "break" */
        }
 
+       if (is_utf8 != has_utf8) {
+            if (is_utf8) {
+                 if (SvCUR(sv))
+                      sv_utf8_upgrade(sv);
+            }
+            else {
+                 SV *nsv = sv_2mortal(newSVpvn(eptr, elen));
+                 sv_utf8_upgrade(nsv);
+                 eptr = SvPVX(nsv);
+                 elen = SvCUR(nsv);
+            }
+            SvGROW(sv, SvCUR(sv) + elen + 1);
+            p = SvEND(sv);
+            *p = '\0';
+       }
+       
        have = esignlen + zeros + elen;
        need = (have > width ? have : width);
        gap = need - have;
        have = esignlen + zeros + elen;
        need = (have > width ? have : width);
        gap = need - have;
@@ -8344,7 +8388,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
        SvGROW(sv, SvCUR(sv) + need + dotstrlen + 1);
        p = SvEND(sv);
        if (esignlen && fill == '0') {
        SvGROW(sv, SvCUR(sv) + need + dotstrlen + 1);
        p = SvEND(sv);
        if (esignlen && fill == '0') {
-           for (i = 0; i < esignlen; i++)
+           for (i = 0; i < (int)esignlen; i++)
                *p++ = esignbuf[i];
        }
        if (gap && !left) {
                *p++ = esignbuf[i];
        }
        if (gap && !left) {
@@ -8352,7 +8396,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            p += gap;
        }
        if (esignlen && fill != '0') {
            p += gap;
        }
        if (esignlen && fill != '0') {
-           for (i = 0; i < esignlen; i++)
+           for (i = 0; i < (int)esignlen; i++)
                *p++ = esignbuf[i];
        }
        if (zeros) {
                *p++ = esignbuf[i];
        }
        if (zeros) {
@@ -8360,20 +8404,6 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                *p++ = '0';
        }
        if (elen) {
                *p++ = '0';
        }
        if (elen) {
-           if (is_utf8 != has_utf8) {
-               if (is_utf8) {
-                   if (SvCUR(sv))
-                       sv_utf8_upgrade(sv);
-               }
-               else {
-                   SV *nsv = sv_2mortal(newSVpvn(eptr, elen));
-                   sv_utf8_upgrade(nsv);
-                   eptr = SvPVX(nsv);
-                   elen = SvCUR(nsv);
-               }
-               SvGROW(sv, SvCUR(sv) + elen + 1);
-               p = SvEND(sv);
-           }
            Copy(eptr, p, elen, char);
            p += elen;
        }
            Copy(eptr, p, elen, char);
            p += elen;
        }
@@ -8477,6 +8507,7 @@ Perl_re_dup(pTHX_ REGEXP *r, CLONE_PARAMS *param)
        s->min_offset = r->substrs->data[i].min_offset;
        s->max_offset = r->substrs->data[i].max_offset;
        s->substr     = sv_dup_inc(r->substrs->data[i].substr, param);
        s->min_offset = r->substrs->data[i].min_offset;
        s->max_offset = r->substrs->data[i].max_offset;
        s->substr     = sv_dup_inc(r->substrs->data[i].substr, param);
+       s->utf8_substr = sv_dup_inc(r->substrs->data[i].utf8_substr, param);
     }
 
     ret->regstclass = NULL;
     }
 
     ret->regstclass = NULL;
@@ -8656,7 +8687,7 @@ Perl_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS* param)
        nmg->mg_len     = mg->mg_len;
        nmg->mg_ptr     = mg->mg_ptr;   /* XXX random ptr? */
        if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) {
        nmg->mg_len     = mg->mg_len;
        nmg->mg_ptr     = mg->mg_ptr;   /* XXX random ptr? */
        if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) {
-           if (mg->mg_len >= 0) {
+           if (mg->mg_len > 0) {
                nmg->mg_ptr     = SAVEPVN(mg->mg_ptr, mg->mg_len);
                if (mg->mg_type == PERL_MAGIC_overload_table &&
                        AMT_AMAGIC((AMT*)mg->mg_ptr))
                nmg->mg_ptr     = SAVEPVN(mg->mg_ptr, mg->mg_len);
                if (mg->mg_type == PERL_MAGIC_overload_table &&
                        AMT_AMAGIC((AMT*)mg->mg_ptr))
@@ -8672,6 +8703,9 @@ Perl_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS* param)
            else if (mg->mg_len == HEf_SVKEY)
                nmg->mg_ptr     = (char*)sv_dup_inc((SV*)mg->mg_ptr, param);
        }
            else if (mg->mg_len == HEf_SVKEY)
                nmg->mg_ptr     = (char*)sv_dup_inc((SV*)mg->mg_ptr, param);
        }
+       if ((mg->mg_flags & MGf_DUP) && mg->mg_virtual && mg->mg_virtual->svt_dup) {
+           CALL_FPTR(nmg->mg_virtual->svt_dup)(aTHX_ nmg, param);
+       }
        mgprev = nmg;
     }
     return mgret;
        mgprev = nmg;
     }
     return mgret;
@@ -8892,9 +8926,9 @@ Perl_rvpv_dup(pTHX_ SV *dstr, SV *sstr, CLONE_PARAMS* param)
     else if (SvPVX(sstr)) {
        /* Has something there */
        if (SvLEN(sstr)) {
     else if (SvPVX(sstr)) {
        /* Has something there */
        if (SvLEN(sstr)) {
-           /* Normal PV - clone whole allocated space */ 
+           /* Normal PV - clone whole allocated space */
            SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
            SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
-       }  
+       }
        else {
            /* Special case - not normally malloced for some reason */
            if (SvREADONLY(sstr) && SvFAKE(sstr)) {
        else {
            /* Special case - not normally malloced for some reason */
            if (SvREADONLY(sstr) && SvFAKE(sstr)) {
@@ -9131,10 +9165,12 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
                 PERL_HV_ARRAY_ALLOC_BYTES(dxhv->xhv_max+1), char);
            while (i <= sxhv->xhv_max) {
                ((HE**)dxhv->xhv_array)[i] = he_dup(((HE**)sxhv->xhv_array)[i],
                 PERL_HV_ARRAY_ALLOC_BYTES(dxhv->xhv_max+1), char);
            while (i <= sxhv->xhv_max) {
                ((HE**)dxhv->xhv_array)[i] = he_dup(((HE**)sxhv->xhv_array)[i],
-                                                   !!HvSHAREKEYS(sstr), param);
+                                                   (bool)!!HvSHAREKEYS(sstr),
+                                                   param);
                ++i;
            }
                ++i;
            }
-           dxhv->xhv_eiter = he_dup(sxhv->xhv_eiter, !!HvSHAREKEYS(sstr), param);
+           dxhv->xhv_eiter = he_dup(sxhv->xhv_eiter,
+                                    (bool)!!HvSHAREKEYS(sstr), param);
        }
        else {
            SvPVX(dstr)         = Nullch;
        }
        else {
            SvPVX(dstr)         = Nullch;
@@ -9194,7 +9230,7 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
        CvFILE(dstr) = CvXSUB(sstr) ? CvFILE(sstr) : SAVEPV(CvFILE(sstr));
        break;
     default:
        CvFILE(dstr) = CvXSUB(sstr) ? CvFILE(sstr) : SAVEPV(CvFILE(sstr));
        break;
     default:
-       Perl_croak(aTHX_ "Bizarre SvTYPE [%d]", SvTYPE(sstr));
+       Perl_croak(aTHX_ "Bizarre SvTYPE [%" IVdf "]", (IV)SvTYPE(sstr));
        break;
     }
 
        break;
     }
 
@@ -9361,8 +9397,9 @@ Perl_any_dup(pTHX_ void *v, PerlInterpreter *proto_perl)
     /* see if it is part of the interpreter structure */
     if (v >= (void*)proto_perl && v < (void*)(proto_perl+1))
        ret = (void*)(((char*)aTHX) + (((char*)v) - (char*)proto_perl));
     /* see if it is part of the interpreter structure */
     if (v >= (void*)proto_perl && v < (void*)(proto_perl+1))
        ret = (void*)(((char*)aTHX) + (((char*)v) - (char*)proto_perl));
-    else
+    else {
        ret = v;
        ret = v;
+    }
 
     return ret;
 }
 
     return ret;
 }
@@ -9415,6 +9452,12 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
            ptr = POPPTR(ss,ix);
            TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
            break;
            ptr = POPPTR(ss,ix);
            TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
            break;
+       case SAVEt_SHARED_PVREF:                /* char* in shared space */
+           c = (char*)POPPTR(ss,ix);
+           TOPPTR(nss,ix) = savesharedpv(c);
+           ptr = POPPTR(ss,ix);
+           TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+           break;
         case SAVEt_GENERIC_SVREF:              /* generic sv */
         case SAVEt_SVREF:                      /* scalar reference */
            sv = (SV*)POPPTR(ss,ix);
         case SAVEt_GENERIC_SVREF:              /* generic sv */
         case SAVEt_SVREF:                      /* scalar reference */
            sv = (SV*)POPPTR(ss,ix);
@@ -9672,7 +9715,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PERL_SET_THX(my_perl);
 
 #  ifdef DEBUGGING
     PERL_SET_THX(my_perl);
 
 #  ifdef DEBUGGING
-    memset(my_perl, 0xab, sizeof(PerlInterpreter));
+    Poison(my_perl, 1, PerlInterpreter);
     PL_markstack = 0;
     PL_scopestack = 0;
     PL_savestack = 0;
     PL_markstack = 0;
     PL_scopestack = 0;
     PL_savestack = 0;
@@ -9703,7 +9746,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
 
 #    ifdef DEBUGGING
 
 
 #    ifdef DEBUGGING
-    memset(my_perl, 0xab, sizeof(PerlInterpreter));
+    Poison(my_perl, 1, PerlInterpreter);
     PL_markstack = 0;
     PL_scopestack = 0;
     PL_savestack = 0;
     PL_markstack = 0;
     PL_scopestack = 0;
     PL_savestack = 0;
@@ -9753,8 +9796,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_debug           = proto_perl->Idebug;
 
 #ifdef USE_REENTRANT_API
     PL_debug           = proto_perl->Idebug;
 
 #ifdef USE_REENTRANT_API
-    New(31337, PL_reentrant_buffer,1, REBUF);
-    New(31337, PL_reentrant_buffer->tmbuff,1, struct tm);
+    Perl_reentrant_init(aTHX);
 #endif
 
     /* create SV map for pointer relocation */
 #endif
 
     /* create SV map for pointer relocation */
@@ -9784,15 +9826,21 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     SvNVX(&PL_sv_yes)          = 1;
     ptr_table_store(PL_ptr_table, &proto_perl->Isv_yes, &PL_sv_yes);
 
     SvNVX(&PL_sv_yes)          = 1;
     ptr_table_store(PL_ptr_table, &proto_perl->Isv_yes, &PL_sv_yes);
 
-    /* create shared string table */
+    /* create (a non-shared!) shared string table */
     PL_strtab          = newHV();
     HvSHAREKEYS_off(PL_strtab);
     hv_ksplit(PL_strtab, 512);
     ptr_table_store(PL_ptr_table, proto_perl->Istrtab, PL_strtab);
 
     PL_strtab          = newHV();
     HvSHAREKEYS_off(PL_strtab);
     hv_ksplit(PL_strtab, 512);
     ptr_table_store(PL_ptr_table, proto_perl->Istrtab, PL_strtab);
 
-    PL_compiling               = proto_perl->Icompiling;
-    PL_compiling.cop_stashpv   = SAVEPV(PL_compiling.cop_stashpv);
-    PL_compiling.cop_file      = SAVEPV(PL_compiling.cop_file);
+    PL_compiling = proto_perl->Icompiling;
+
+    /* These two PVs will be free'd special way so must set them same way op.c does */
+    PL_compiling.cop_stashpv = savesharedpv(PL_compiling.cop_stashpv);
+    ptr_table_store(PL_ptr_table, proto_perl->Icompiling.cop_stashpv, PL_compiling.cop_stashpv);
+
+    PL_compiling.cop_file    = savesharedpv(PL_compiling.cop_file);
+    ptr_table_store(PL_ptr_table, proto_perl->Icompiling.cop_file, PL_compiling.cop_file);
+
     ptr_table_store(PL_ptr_table, &proto_perl->Icompiling, &PL_compiling);
     if (!specialWARN(PL_compiling.cop_warnings))
        PL_compiling.cop_warnings = sv_dup_inc(PL_compiling.cop_warnings, param);
     ptr_table_store(PL_ptr_table, &proto_perl->Icompiling, &PL_compiling);
     if (!specialWARN(PL_compiling.cop_warnings))
        PL_compiling.cop_warnings = sv_dup_inc(PL_compiling.cop_warnings, param);
@@ -9858,6 +9906,10 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 #endif
     PL_encoding                = sv_dup(proto_perl->Iencoding, param);
 
 #endif
     PL_encoding                = sv_dup(proto_perl->Iencoding, param);
 
+    sv_setpvn(PERL_DEBUG_PAD(0), "", 0);       /* For regex debugging. */
+    sv_setpvn(PERL_DEBUG_PAD(1), "", 0);       /* ext/re needs these */
+    sv_setpvn(PERL_DEBUG_PAD(2), "", 0);       /* even without DEBUGGING. */
+
     /* Clone the regex array */
     PL_regex_padav = newAV();
     {
     /* Clone the regex array */
     PL_regex_padav = newAV();
     {
@@ -10122,6 +10174,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     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_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_idcont     = sv_dup_inc(proto_perl->Iutf8_idcont, param);
 
     /* swatch cache */
     PL_last_swash_hv   = Nullhv;       /* reinits on demand */
 
     /* swatch cache */
     PL_last_swash_hv   = Nullhv;       /* reinits on demand */
@@ -10199,7 +10253,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
        PL_retstack_ix          = proto_perl->Tretstack_ix;
        PL_retstack_max         = proto_perl->Tretstack_max;
        Newz(54, PL_retstack, PL_retstack_max, OP*);
        PL_retstack_ix          = proto_perl->Tretstack_ix;
        PL_retstack_max         = proto_perl->Tretstack_max;
        Newz(54, PL_retstack, PL_retstack_max, OP*);
-       Copy(proto_perl->Tretstack, PL_retstack, PL_retstack_ix, I32);
+       Copy(proto_perl->Tretstack, PL_retstack, PL_retstack_ix, OP*);
 
        /* NOTE: si_dup() looks at PL_markstack */
        PL_curstackinfo         = si_dup(proto_perl->Tcurstackinfo, param);
 
        /* NOTE: si_dup() looks at PL_markstack */
        PL_curstackinfo         = si_dup(proto_perl->Tcurstackinfo, param);
@@ -10424,9 +10478,10 @@ Perl_sv_recode_to_utf8(pTHX_ SV *sv, SV *encoding)
          PUTBACK;
          s = SvPV(uni, len);
          if (s != SvPVX(sv)) {
          PUTBACK;
          s = SvPV(uni, len);
          if (s != SvPVX(sv)) {
-              SvGROW(sv, len);
+              SvGROW(sv, len + 1);
               Move(s, SvPVX(sv), len, char);
               SvCUR_set(sv, len);
               Move(s, SvPVX(sv), len, char);
               SvCUR_set(sv, len);
+              SvPVX(sv)[len] = 0;      
          }
          FREETMPS;
          LEAVE;
          }
          FREETMPS;
          LEAVE;
@@ -10435,3 +10490,4 @@ Perl_sv_recode_to_utf8(pTHX_ SV *sv, SV *encoding)
      return SvPVX(sv);
 }
 
      return SvPVX(sv);
 }
 
+
Unnamed repository; edit this file 'description' to name the repository.