This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Deprecate isFOO_utf8() macros
[perl5.git] / sv.c
diff --git a/sv.c b/sv.c
index d3cb3c2..0382e96 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -245,7 +245,7 @@ Public API:
        if ((sv)->sv_debug_file) PerlMemShared_free((sv)->sv_debug_file); \
     } STMT_END
 #  define DEBUG_SV_SERIAL(sv)                                              \
-    DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) del_SV\n",    \
+    DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%" UVxf ": (%05ld) del_SV\n",    \
            PTR2UV(sv), (long)(sv)->sv_debug_serial))
 #else
 #  define FREE_SV_DEBUG_FILE(sv)
@@ -340,7 +340,7 @@ S_new_SV(pTHX_ const char *file, int line, const char *func)
     sv->sv_debug_serial = PL_sv_serial++;
 
     MEM_LOG_NEW_SV(sv, file, line, func);
-    DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) new_SV (from %s:%d [%s])\n",
+    DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%" UVxf ": (%05ld) new_SV (from %s:%d [%s])\n",
            PTR2UV(sv), (long)sv->sv_debug_serial, file, line, func));
 
     return sv;
@@ -392,7 +392,7 @@ S_del_sv(pTHX_ SV *p)
        }
        if (!ok) {
            Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
-                            "Attempt to free non-arena SV: 0x%"UVxf
+                            "Attempt to free non-arena SV: 0x%" UVxf
                             pTHX__FORMAT, PTR2UV(p) pTHX__VALUE);
            return;
        }
@@ -654,7 +654,7 @@ do_clean_all(pTHX_ SV *const sv)
        /* don't clean pid table and strtab */
        return;
     }
-    DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops: SV at 0x%"UVxf"\n", PTR2UV(sv)) ));
+    DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops: SV at 0x%" UVxf "\n", PTR2UV(sv)) ));
     SvFLAGS(sv) |= SVf_BREAK;
     SvREFCNT_dec_NN(sv);
 }
@@ -1111,7 +1111,7 @@ Perl_more_bodies (pTHX_ const svtype sv_type, const size_t body_size,
     Newx(adesc->arena, good_arena_size, char);
     adesc->size = good_arena_size;
     adesc->utype = sv_type;
-    DEBUG_m(PerlIO_printf(Perl_debug_log, "arena %d added: %p size %"UVuf"\n", 
+    DEBUG_m(PerlIO_printf(Perl_debug_log, "arena %d added: %p size %" UVuf "\n",
                          curr, (void*)adesc->arena, (UV)good_arena_size));
 
     start = (char *) adesc->arena;
@@ -2038,7 +2038,7 @@ S_sv_2iuv_non_preserve(pTHX_ SV *const sv
     PERL_ARGS_ASSERT_SV_2IUV_NON_PRESERVE;
     PERL_UNUSED_CONTEXT;
 
-    DEBUG_c(PerlIO_printf(Perl_debug_log,"sv_2iuv_non '%s', IV=0x%"UVxf" NV=%"NVgf" inttype=%"UVXf"\n", SvPVX_const(sv), SvIVX(sv), SvNVX(sv), (UV)numtype));
+    DEBUG_c(PerlIO_printf(Perl_debug_log,"sv_2iuv_non '%s', IV=0x%" UVxf " NV=%" NVgf " inttype=%" UVXf "\n", SvPVX_const(sv), SvIVX(sv), SvNVX(sv), (UV)numtype));
     if (SvNVX(sv) < (NV)IV_MIN) {
        (void)SvIOKp_on(sv);
        (void)SvNOK_on(sv);
@@ -2165,7 +2165,7 @@ S_sv_2iuv_common(pTHX_ SV *const sv)
                    /* scalar has trailing garbage, eg "42a" */
                }
                DEBUG_c(PerlIO_printf(Perl_debug_log,
-                                     "0x%"UVxf" iv(%"NVgf" => %"IVdf") (precise)\n",
+                                     "0x%" UVxf " iv(%" NVgf " => %" IVdf ") (precise)\n",
                                      PTR2UV(sv),
                                      SvNVX(sv),
                                      SvIVX(sv)));
@@ -2176,7 +2176,7 @@ S_sv_2iuv_common(pTHX_ SV *const sv)
                   that PV->IV would be better than PV->NV->IV
                   flags already correct - don't set public IOK.  */
                DEBUG_c(PerlIO_printf(Perl_debug_log,
-                                     "0x%"UVxf" iv(%"NVgf" => %"IVdf") (imprecise)\n",
+                                     "0x%" UVxf " iv(%" NVgf " => %" IVdf ") (imprecise)\n",
                                      PTR2UV(sv),
                                      SvNVX(sv),
                                      SvIVX(sv)));
@@ -2207,7 +2207,7 @@ S_sv_2iuv_common(pTHX_ SV *const sv)
                SvIOK_on(sv);
            SvIsUV_on(sv);
            DEBUG_c(PerlIO_printf(Perl_debug_log,
-                                 "0x%"UVxf" 2iv(%"UVuf" => %"IVdf") (as unsigned)\n",
+                                 "0x%" UVxf " 2iv(%" UVuf " => %" IVdf ") (as unsigned)\n",
                                  PTR2UV(sv),
                                  SvUVX(sv),
                                  SvUVX(sv)));
@@ -2313,7 +2313,7 @@ S_sv_2iuv_common(pTHX_ SV *const sv)
            if (! numtype && ckWARN(WARN_NUMERIC))
                not_a_number(sv);
 
-           DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2iv(%" NVgf ")\n",
+           DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%" UVxf " 2iv(%" NVgf ")\n",
                                  PTR2UV(sv), SvNVX(sv)));
 
 #ifdef NV_PRESERVES_UV
@@ -2372,7 +2372,7 @@ S_sv_2iuv_common(pTHX_ SV *const sv)
                        this NV is in the preserved range, therefore: */
                     if (!(U_V(SvNVX(sv) > 0 ? SvNVX(sv) : -SvNVX(sv))
                           < (UV)IV_MAX)) {
-                        Perl_croak(aTHX_ "sv_2iv assumed (U_V(fabs((double)SvNVX(sv))) < (UV)IV_MAX) but SvNVX(sv)=%"NVgf" U_V is 0x%"UVxf", IV_MAX is 0x%"UVxf"\n", SvNVX(sv), U_V(SvNVX(sv)), (UV)IV_MAX);
+                        Perl_croak(aTHX_ "sv_2iv assumed (U_V(fabs((double)SvNVX(sv))) < (UV)IV_MAX) but SvNVX(sv)=%" NVgf " U_V is 0x%" UVxf ", IV_MAX is 0x%" UVxf "\n", SvNVX(sv), U_V(SvNVX(sv)), (UV)IV_MAX);
                     }
                 } else {
                     /* IN_UV NOT_INT
@@ -2449,8 +2449,8 @@ Perl_sv_2iv_flags(pTHX_ SV *const sv, const I32 flags)
     }
 
     if (SvVALID(sv) || isREGEXP(sv)) {
-       /* FBMs use the space for SvIVX and SvNVX for other purposes, and use
-          the same flag bit as SVf_IVisUV, so must not let them cache IVs.
+        /* FBMs use the space for SvIVX and SvNVX for other purposes, so
+           must not let them cache IVs.
           In practice they are extremely unlikely to actually get anywhere
           accessible by user Perl code - the only way that I'm aware of is when
           a constant subroutine which is used as the second argument to index.
@@ -2505,7 +2505,7 @@ Perl_sv_2iv_flags(pTHX_ SV *const sv, const I32 flags)
            return 0;
     }
 
-    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2iv(%"IVdf")\n",
+    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%" UVxf " 2iv(%" IVdf ")\n",
        PTR2UV(sv),SvIVX(sv)));
     return SvIsUV(sv) ? (IV)SvUVX(sv) : SvIVX(sv);
 }
@@ -2588,7 +2588,7 @@ Perl_sv_2uv_flags(pTHX_ SV *const sv, const I32 flags)
            return 0;
     }
 
-    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2uv(%"UVuf")\n",
+    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%" UVxf " 2uv(%" UVuf ")\n",
                          PTR2UV(sv),SvUVX(sv)));
     return SvIsUV(sv) ? SvUVX(sv) : (UV)SvIVX(sv);
 }
@@ -2669,7 +2669,7 @@ Perl_sv_2nv_flags(pTHX_ SV *const sv, const I32 flags)
        DEBUG_c({
            STORE_NUMERIC_LOCAL_SET_STANDARD();
            PerlIO_printf(Perl_debug_log,
-                         "0x%"UVxf" num(%" NVgf ")\n",
+                         "0x%" UVxf " num(%" NVgf ")\n",
                          PTR2UV(sv), SvNVX(sv));
            RESTORE_NUMERIC_LOCAL();
        });
@@ -2809,7 +2809,7 @@ Perl_sv_2nv_flags(pTHX_ SV *const sv, const I32 flags)
     }
     DEBUG_c({
        STORE_NUMERIC_LOCAL_SET_STANDARD();
-       PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2nv(%" NVgf ")\n",
+       PerlIO_printf(Perl_debug_log, "0x%" UVxf " 2nv(%" NVgf ")\n",
                      PTR2UV(sv), SvNVX(sv));
        RESTORE_NUMERIC_LOCAL();
     });
@@ -3206,7 +3206,7 @@ Perl_sv_2pv_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags)
            *lp = len;
        SvCUR_set(sv, len);
     }
-    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2pv(%s)\n",
+    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%" UVxf " 2pv(%s)\n",
                          PTR2UV(sv),SvPVX_const(sv)));
     if (flags & SV_CONST_RETURN)
        return (char *)SvPVX_const(sv);
@@ -4080,11 +4080,11 @@ Perl_gv_setref(pTHX_ SV *const dstr, SV *const sstr)
                           sv_2mortal(
                              stash
                                ? Perl_newSVpvf(aTHX_
-                                   "%"HEKf"::%"HEKf,
+                                   "%" HEKf "::%" HEKf,
                                    HEKfARG(HvNAME_HEK(stash)),
                                    HEKfARG(GvENAME_HEK(MUTABLE_GV(dstr))))
                                : Perl_newSVpvf(aTHX_
-                                   "%"HEKf,
+                                   "%" HEKf,
                                    HEKfARG(GvENAME_HEK(MUTABLE_GV(dstr))))
                           ),
                           cv,
@@ -4280,12 +4280,17 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, SV* sstr, const I32 flags)
          * special-casing */
         U32 sflags;
         U32 new_dflags;
+        SV *old_rv = NULL;
 
         /* minimal subset of SV_CHECK_THINKFIRST_COW_DROP(dstr) */
         if (SvREADONLY(dstr))
             Perl_croak_no_modify();
-        if (SvROK(dstr))
-            sv_unref_flags(dstr, 0);
+        if (SvROK(dstr)) {
+            if (SvWEAKREF(dstr))
+                sv_unref_flags(dstr, 0);
+            else
+                old_rv = SvRV(dstr);
+        }
 
         assert(!SvGMAGICAL(sstr));
         assert(!SvGMAGICAL(dstr));
@@ -4315,6 +4320,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, SV* sstr, const I32 flags)
             new_dflags = dtype; /* turn off everything except the type */
         }
         SvFLAGS(dstr) = new_dflags;
+        SvREFCNT_dec(old_rv);
 
         return;
     }
@@ -4741,8 +4747,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, SV* sstr, const I32 flags)
        }
        if (sflags & SVp_IOK) {
            SvIV_set(dstr, SvIVX(sstr));
-           /* Must do this otherwise some other overloaded use of 0x80000000
-              gets confused. I guess SVpbm_VALID */
            if (sflags & SVf_IVisUV)
                SvIsUV_on(dstr);
        }
@@ -4778,6 +4782,64 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, SV* sstr, const I32 flags)
        SvTAINT(dstr);
 }
 
+
+/*
+=for apidoc sv_set_undef
+
+Equivalent to C<sv_setsv(sv, &PL_sv_undef)>, but more efficient.
+Doesn't handle set magic.
+
+The perl equivalent is C<$sv = undef;>. Note that it doesn't free any string
+buffer, unlike C<undef $sv>.
+
+Introduced in perl 5.26.0.
+
+=cut
+*/
+
+void
+Perl_sv_set_undef(pTHX_ SV *sv)
+{
+    U32 type = SvTYPE(sv);
+
+    PERL_ARGS_ASSERT_SV_SET_UNDEF;
+
+    /* shortcut, NULL, IV, RV */
+
+    if (type <= SVt_IV) {
+        assert(!SvGMAGICAL(sv));
+        if (SvREADONLY(sv))
+            Perl_croak_no_modify();
+
+        if (SvROK(sv)) {
+            if (SvWEAKREF(sv))
+                sv_unref_flags(sv, 0);
+            else {
+                SV *rv = SvRV(sv);
+                SvFLAGS(sv) = type; /* quickly turn off all flags */
+                SvREFCNT_dec_NN(rv);
+                return;
+            }
+        }
+        SvFLAGS(sv) = type; /* quickly turn off all flags */
+        return;
+    }
+
+    if (SvIS_FREED(sv))
+        Perl_croak(aTHX_ "panic: attempt to undefine a freed scalar %p",
+            (void *)sv);
+
+    SV_CHECK_THINKFIRST_COW_DROP(sv);
+
+    if (isGV_with_GP(sv))
+        Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
+                       "Undefined value assigned to typeglob");
+
+    SvOK_off(sv);
+}
+
+
+
 /*
 =for apidoc sv_setsv_mg
 
@@ -5657,7 +5719,9 @@ Perl_sv_magicext(pTHX_ SV *const sv, SV *const obj, const int how,
     */
     if (!obj || obj == sv ||
        how == PERL_MAGIC_arylen ||
-       how == PERL_MAGIC_symtab ||
+        how == PERL_MAGIC_regdata ||
+        how == PERL_MAGIC_regdatum ||
+        how == PERL_MAGIC_symtab ||
        (SvTYPE(obj) == SVt_PVGV &&
            (GvSV(obj) == sv || GvHV(obj) == (const HV *)sv
             || GvAV(obj) == (const AV *)sv || GvCV(obj) == (const CV *)sv
@@ -6225,7 +6289,7 @@ Perl_sv_kill_backrefs(pTHX_ SV *const sv, AV *const av)
 
                } else {
                    Perl_croak(aTHX_
-                              "panic: magic_killbackrefs (flags=%"UVxf")",
+                              "panic: magic_killbackrefs (flags=%" UVxf ")",
                               (UV)SvFLAGS(referrer));
                }
 
@@ -6559,7 +6623,7 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
                {
                    if (PL_stashcache) {
                        DEBUG_o(Perl_deb(aTHX_
-                           "sv_clear clearing PL_stashcache for '%"HEKf
+                           "sv_clear clearing PL_stashcache for '%" HEKf
                            "'\n",
                             HEKfARG(hek)));
                        (void)hv_deletehek(PL_stashcache,
@@ -6626,7 +6690,7 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
                /* If we're in a stash, we don't own a reference to it.
                 * However it does have a back reference to us, which
                 * needs to be cleared.  */
-               if (!SvVALID(sv) && (stash = GvSTASH(sv)))
+               if ((stash = GvSTASH(sv)))
                        sv_del_backref(MUTABLE_SV(stash), sv);
            }
            /* FIXME. There are probably more unreferenced pointers to SVs
@@ -6783,7 +6847,7 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
 #ifdef DEBUGGING
            if (SvTEMP(sv)) {
                Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING),
-                        "Attempt to free temp prematurely: SV 0x%"UVxf
+                        "Attempt to free temp prematurely: SV 0x%" UVxf
                         pTHX__FORMAT, PTR2UV(sv) pTHX__VALUE);
                continue;
            }
@@ -6908,7 +6972,7 @@ S_curse(pTHX_ SV * const sv, const bool check_refcnt) {
        if (check_refcnt && SvREFCNT(sv)) {
            if (PL_in_clean_objs)
                Perl_croak(aTHX_
-                 "DESTROY created new reference to dead object '%"HEKf"'",
+                 "DESTROY created new reference to dead object '%" HEKf "'",
                   HEKfARG(HvNAME_HEK(stash)));
            /* DESTROY gave object new lease on life */
            return FALSE;
@@ -6979,7 +7043,7 @@ Perl_sv_free2(pTHX_ SV *const sv, const U32 rc)
 #ifdef DEBUGGING
         if (SvTEMP(sv)) {
             Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING),
-                             "Attempt to free temp prematurely: SV 0x%"UVxf
+                             "Attempt to free temp prematurely: SV 0x%" UVxf
                              pTHX__FORMAT, PTR2UV(sv) pTHX__VALUE);
             return;
         }
@@ -7026,7 +7090,7 @@ Perl_sv_free2(pTHX_ SV *const sv, const U32 rc)
 #endif
         /* This may not return:  */
         Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
-                    "Attempt to free unreferenced scalar: SV 0x%"UVxf
+                    "Attempt to free unreferenced scalar: SV 0x%" UVxf
                     pTHX__FORMAT, PTR2UV(sv) pTHX__VALUE);
 #endif
     }
@@ -7615,8 +7679,8 @@ Perl_sv_pos_b2u_flags(pTHX_ SV *const sv, STRLEN const offset, U32 flags)
     s = (const U8*)SvPV_flags(sv, blen, flags);
 
     if (blen < offset)
-       Perl_croak(aTHX_ "panic: sv_pos_b2u: bad byte offset, blen=%"UVuf
-                  ", byte=%"UVuf, (UV)blen, (UV)offset);
+       Perl_croak(aTHX_ "panic: sv_pos_b2u: bad byte offset, blen=%" UVuf
+                  ", byte=%" UVuf, (UV)blen, (UV)offset);
 
     send = s + offset;
 
@@ -7733,7 +7797,7 @@ S_assert_uft8_cache_coherent(pTHX_ const char *const func, STRLEN from_cache,
        while printing error messages.  */
     SAVEI8(PL_utf8cache);
     PL_utf8cache = 0;
-    Perl_croak(aTHX_ "panic: %s cache %"UVuf" real %"UVuf" for %"SVf,
+    Perl_croak(aTHX_ "panic: %s cache %" UVuf " real %" UVuf " for %" SVf,
               func, (UV) from_cache, (UV) real, SVfARG(sv));
 }
 
@@ -8576,10 +8640,10 @@ Perl_sv_gets(pTHX_ SV *const sv, PerlIO *const fp, I32 append)
 
     /* some trace debug output */
     DEBUG_P(PerlIO_printf(Perl_debug_log,
-       "Screamer: entering, ptr=%"UVuf", cnt=%ld\n",PTR2UV(ptr),(long)cnt));
+       "Screamer: entering, ptr=%" UVuf ", cnt=%ld\n",PTR2UV(ptr),(long)cnt));
     DEBUG_P(PerlIO_printf(Perl_debug_log,
-       "Screamer: entering: PerlIO * thinks ptr=%"UVuf", cnt=%"IVdf", base=%"
-        UVuf"\n",
+       "Screamer: entering: PerlIO * thinks ptr=%" UVuf ", cnt=%" IVdf ", base=%"
+        UVuf "\n",
               PTR2UV(PerlIO_get_ptr(fp)), (IV)PerlIO_get_cnt(fp),
               PTR2UV(PerlIO_has_base(fp) ? PerlIO_get_base(fp) : 0)));
 
@@ -8589,13 +8653,27 @@ Perl_sv_gets(pTHX_ SV *const sv, PerlIO *const fp, I32 append)
        if (cnt > 0) {
             /* if there is a separator */
            if (rslen) {
-                /* loop until we hit the end of the read-ahead buffer */
-               while (cnt > 0) {                    /* this     |  eat */
-                    /* scan forward copying and searching for rslast as we go */
-                   cnt--;
-                   if ((*bp++ = *ptr++) == rslast)  /* really   |  dust */
-                       goto thats_all_folks;        /* screams  |  sed :-) */
-               }
+                /* find next rslast */
+                STDCHAR *p;
+
+                /* shortcut common case of blank line */
+                cnt--;
+                if ((*bp++ = *ptr++) == rslast)
+                    goto thats_all_folks;
+
+                p = (STDCHAR *)memchr(ptr, rslast, cnt);
+                if (p) {
+                    SSize_t got = p - ptr + 1;
+                    Copy(ptr, bp, got, STDCHAR);
+                    ptr += got;
+                    bp  += got;
+                    cnt -= got;
+                    goto thats_all_folks;
+                }
+                Copy(ptr, bp, cnt, STDCHAR);
+                ptr += cnt;
+                bp  += cnt;
+                cnt = 0;
            }
            else {
                 /* no separator, slurp the full buffer */
@@ -8625,12 +8703,12 @@ Perl_sv_gets(pTHX_ SV *const sv, PerlIO *const fp, I32 append)
         /* we need to refill the read-ahead buffer if possible */
 
        DEBUG_P(PerlIO_printf(Perl_debug_log,
-                            "Screamer: going to getc, ptr=%"UVuf", cnt=%"IVdf"\n",
+                            "Screamer: going to getc, ptr=%" UVuf ", cnt=%" IVdf "\n",
                              PTR2UV(ptr),(IV)cnt));
        PerlIO_set_ptrcnt(fp, (STDCHAR*)ptr, cnt); /* deregisterize cnt and ptr */
 
        DEBUG_Pv(PerlIO_printf(Perl_debug_log,
-          "Screamer: pre: FILE * thinks ptr=%"UVuf", cnt=%"IVdf", base=%"UVuf"\n",
+          "Screamer: pre: FILE * thinks ptr=%" UVuf ", cnt=%" IVdf ", base=%" UVuf "\n",
            PTR2UV(PerlIO_get_ptr(fp)), (IV)PerlIO_get_cnt(fp),
            PTR2UV(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0)));
 
@@ -8646,7 +8724,7 @@ Perl_sv_gets(pTHX_ SV *const sv, PerlIO *const fp, I32 append)
        i   = PerlIO_getc(fp);          /* get more characters */
 
        DEBUG_Pv(PerlIO_printf(Perl_debug_log,
-          "Screamer: post: FILE * thinks ptr=%"UVuf", cnt=%"IVdf", base=%"UVuf"\n",
+          "Screamer: post: FILE * thinks ptr=%" UVuf ", cnt=%" IVdf ", base=%" UVuf "\n",
            PTR2UV(PerlIO_get_ptr(fp)), (IV)PerlIO_get_cnt(fp),
            PTR2UV(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0)));
 
@@ -8654,7 +8732,7 @@ Perl_sv_gets(pTHX_ SV *const sv, PerlIO *const fp, I32 append)
        cnt = PerlIO_get_cnt(fp);
        ptr = (STDCHAR*)PerlIO_get_ptr(fp);     /* reregisterize cnt and ptr */
        DEBUG_P(PerlIO_printf(Perl_debug_log,
-           "Screamer: after getc, ptr=%"UVuf", cnt=%"IVdf"\n",
+           "Screamer: after getc, ptr=%" UVuf ", cnt=%" IVdf "\n",
            PTR2UV(ptr),(IV)cnt));
 
        if (i == EOF)                   /* all done for ever? */
@@ -8684,10 +8762,10 @@ Perl_sv_gets(pTHX_ SV *const sv, PerlIO *const fp, I32 append)
     if (shortbuffered)
        cnt += shortbuffered;
        DEBUG_P(PerlIO_printf(Perl_debug_log,
-            "Screamer: quitting, ptr=%"UVuf", cnt=%"IVdf"\n",PTR2UV(ptr),(IV)cnt));
+            "Screamer: quitting, ptr=%" UVuf ", cnt=%" IVdf "\n",PTR2UV(ptr),(IV)cnt));
     PerlIO_set_ptrcnt(fp, (STDCHAR*)ptr, cnt); /* put these back or we're in trouble */
     DEBUG_P(PerlIO_printf(Perl_debug_log,
-       "Screamer: end: FILE * thinks ptr=%"UVuf", cnt=%"IVdf", base=%"UVuf
+       "Screamer: end: FILE * thinks ptr=%" UVuf ", cnt=%" IVdf ", base=%" UVuf
        "\n",
        PTR2UV(PerlIO_get_ptr(fp)), (IV)PerlIO_get_cnt(fp),
        PTR2UV(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0)));
@@ -8906,7 +8984,7 @@ Perl_sv_inc_nomg(pTHX_ SV *const sv)
            /* I don't think we can get here. Maybe I should assert this
               And if we do get here I suspect that sv_setnv will croak. NWC
               Fall through. */
-           DEBUG_c(PerlIO_printf(Perl_debug_log,"sv_inc punt failed to convert '%s' to IOK or NOKp, UV=0x%"UVxf" NV=%"NVgf"\n",
+           DEBUG_c(PerlIO_printf(Perl_debug_log,"sv_inc punt failed to convert '%s' to IOK or NOKp, UV=0x%" UVxf " NV=%" NVgf "\n",
                                  SvPVX_const(sv), SvIVX(sv), SvNVX(sv)));
        }
 #endif /* PERL_PRESERVE_IVUV */
@@ -9084,7 +9162,7 @@ Perl_sv_dec_nomg(pTHX_ SV *const sv)
            /* I don't think we can get here. Maybe I should assert this
               And if we do get here I suspect that sv_setnv will croak. NWC
               Fall through. */
-           DEBUG_c(PerlIO_printf(Perl_debug_log,"sv_dec punt failed to convert '%s' to IOK or NOKp, UV=0x%"UVxf" NV=%"NVgf"\n",
+           DEBUG_c(PerlIO_printf(Perl_debug_log,"sv_dec punt failed to convert '%s' to IOK or NOKp, UV=0x%" UVxf " NV=%" NVgf "\n",
                                  SvPVX_const(sv), SvIVX(sv), SvNVX(sv)));
        }
     }
@@ -9778,7 +9856,7 @@ Perl_sv_2io(pTHX_ SV *const sv)
            gv = MUTABLE_GV(sv);
            io = GvIO(gv);
            if (!io)
-               Perl_croak(aTHX_ "Bad filehandle: %"HEKf,
+               Perl_croak(aTHX_ "Bad filehandle: %" HEKf,
                                     HEKfARG(GvNAME_HEK(gv)));
            break;
        }
@@ -9801,7 +9879,7 @@ Perl_sv_2io(pTHX_ SV *const sv)
                newsv = sv_newmortal();
                sv_setsv_nomg(newsv, sv);
            }
-           Perl_croak(aTHX_ "Bad filehandle: %"SVf, SVfARG(newsv));
+           Perl_croak(aTHX_ "Bad filehandle: %" SVf, SVfARG(newsv));
        }
        break;
     }
@@ -9983,7 +10061,7 @@ Perl_sv_pvn_force_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags)
        if (!SvPOK(sv)) {
            SvPOK_on(sv);               /* validate pointer */
            SvTAINT(sv);
-           DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2pv(%s)\n",
+           DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%" UVxf " 2pv(%s)\n",
                                  PTR2UV(sv),SvPVX_const(sv)));
        }
     }
@@ -10266,7 +10344,7 @@ Perl_sv_setref_pv(pTHX_ SV *const rv, const char *const classname, void *const p
     PERL_ARGS_ASSERT_SV_SETREF_PV;
 
     if (!pv) {
-       sv_setsv(rv, &PL_sv_undef);
+       sv_set_undef(rv);
        SvSETMAGIC(rv);
     }
     else
@@ -11914,7 +11992,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
            if (vectorize)
                goto unknown;
             if (infnan)
-                Perl_croak(aTHX_ "Cannot printf %"NVgf" with '%c'",
+                Perl_croak(aTHX_ "Cannot printf %" NVgf " with '%c'",
                            /* no va_arg() case */
                            SvNV_nomg(argsv), (int)c);
            uv = (args) ? va_arg(*args, int) : SvIV_nomg(argsv);
@@ -12302,7 +12380,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                 i = PERL_INT_MIN;
                 (void)Perl_frexp((NV)fv, &i);
                 if (i == PERL_INT_MIN)
-                    Perl_die(aTHX_ "panic: frexp: %"FV_GF, fv);
+                    Perl_die(aTHX_ "panic: frexp: %" FV_GF, fv);
                 /* Do not set hexfp earlier since we want to printf
                  * Inf/NaN for Inf/NaN, not their hexfp. */
                 hexfp = isALPHA_FOLD_EQ(c, 'a');
@@ -12872,14 +12950,14 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                            sv_catpvn_nomg(msg, f, 1);
                        } else {
                            Perl_sv_catpvf(aTHX_ msg,
-                                          "\\%03"UVof, (UV)*f & 0xFF);
+                                          "\\%03" UVof, (UV)*f & 0xFF);
                        }
                    }
                    sv_catpvs(msg, "\"");
                } else {
                    sv_catpvs(msg, "end of string");
                }
-               Perl_warner(aTHX_ packWARN(WARN_PRINTF), "%"SVf, SVfARG(msg)); /* yes, this is reentrant */
+               Perl_warner(aTHX_ packWARN(WARN_PRINTF), "%" SVf, SVfARG(msg)); /* yes, this is reentrant */
            }
 
            /* output mangled stuff ... */
@@ -13066,7 +13144,7 @@ Perl_parser_dup(pTHX_ const yy_parser *const proto, CLONE_PARAMS *const param)
     parser->old_parser = NULL;
     parser->stack = NULL;
     parser->ps = NULL;
-    parser->stack_size = 0;
+    parser->stack_max1 = 0;
     /* XXX parser->stack->state = 0; */
 
     /* XXX eventually, just Copy() most of the parser struct ? */
@@ -13372,7 +13450,10 @@ Perl_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *const param)
                                ? SvREFCNT_inc(av_dup_inc((const AV *)
                                                    nmg->mg_obj, param))
                                : sv_dup_inc(nmg->mg_obj, param)
-                         : sv_dup(nmg->mg_obj, param);
+                          : (nmg->mg_type == PERL_MAGIC_regdatum ||
+                             nmg->mg_type == PERL_MAGIC_regdata)
+                                  ? nmg->mg_obj
+                                  : sv_dup(nmg->mg_obj, param);
 
        if (nmg->mg_ptr && nmg->mg_type != PERL_MAGIC_regex_global) {
            if (nmg->mg_len > 0) {
@@ -14145,7 +14226,7 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max, CLONE_PARAMS* param)
            case CXt_EVAL:
                ncx->blk_eval.old_namesv = sv_dup_inc(ncx->blk_eval.old_namesv,
                                                      param);
-                /* XXX should this sv_dup_inc? Or only if SvSCREAM ???? */
+                /* XXX should this sv_dup_inc? Or only if CxEVAL_TXT_REFCNTED ???? */
                ncx->blk_eval.cur_text  = sv_dup(ncx->blk_eval.cur_text, param);
                ncx->blk_eval.cv = cv_dup(ncx->blk_eval.cv, param);
                 /* XXX what do do with cur_top_env ???? */
@@ -14574,7 +14655,7 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
            break;
        default:
            Perl_croak(aTHX_
-                      "panic: ss_dup inconsistency (%"IVdf")", (IV) type);
+                      "panic: ss_dup inconsistency (%" IVdf ")", (IV) type);
        }
     }
 
@@ -15244,6 +15325,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_GCB_invlist = sv_dup_inc(proto_perl->IGCB_invlist, param);
     PL_SB_invlist = sv_dup_inc(proto_perl->ISB_invlist, param);
     PL_WB_invlist = sv_dup_inc(proto_perl->IWB_invlist, param);
+    PL_seen_deprecated_macro = hv_dup_inc(proto_perl->Iseen_deprecated_macro, param);
     PL_utf8_mark       = sv_dup_inc(proto_perl->Iutf8_mark, param);
     PL_utf8_toupper    = sv_dup_inc(proto_perl->Iutf8_toupper, param);
     PL_utf8_totitle    = sv_dup_inc(proto_perl->Iutf8_totitle, param);
@@ -15350,7 +15432,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_watchok         = PL_watchaddr ? * PL_watchaddr : NULL;
     if (PL_debug && PL_watchaddr) {
        PerlIO_printf(Perl_debug_log,
-         "WATCHING: %"UVxf" cloned as %"UVxf" with value %"UVxf"\n",
+         "WATCHING: %" UVxf " cloned as %" UVxf " with value %" UVxf "\n",
          PTR2UV(proto_perl->Iwatchaddr), PTR2UV(PL_watchaddr),
          PTR2UV(PL_watchok));
     }
@@ -15798,7 +15880,7 @@ Perl_varname(pTHX_ const GV *const gv, const char gvtype, PADOFFSET targ,
     }
     else if (subscript_type == FUV_SUBSCRIPT_ARRAY) {
        *SvPVX(name) = '$';
-       Perl_sv_catpvf(aTHX_ name, "[%"IVdf"]", (IV)aindex);
+       Perl_sv_catpvf(aTHX_ name, "[%" IVdf "]", (IV)aindex);
     }
     else if (subscript_type == FUV_SUBSCRIPT_WITHIN) {
        /* We know that name has no magic, so can use 0 instead of SV_GMAGIC */