Dedicated SV copying code in place of Perl_sv_setsv_flags

av.c

@@ -479,6 +479,8 @@ Perl_av_make(pTHX_ SSize_t size, SV **strp)
         AvALLOC(av) = ary;
         AvARRAY(av) = ary;
         AvMAX(av) = size - 1;
+        SSize_t *fillp = &AvFILLp(av);
+
         /* avoid av being leaked if croak when calling magic below */
         EXTEND_MORTAL(1);
         PL_tmps_stack[++PL_tmps_ix] = (SV*)av;
@@ -490,12 +492,8 @@ Perl_av_make(pTHX_ SSize_t size, SV **strp)
             /* Don't let sv_setsv swipe, since our source array might
                have multiple references to the same temp scalar (e.g.
                from a list slice) */
-
-            SvGETMAGIC(*strp); /* before newSV, in case it dies */
-            AvFILLp(av)++;
-            ary[i] = newSV_type(SVt_NULL);
-            sv_setsv_flags(ary[i], *strp,
-                           SV_DO_COW_SVSETSV|SV_NOSTEAL);
+            ary[i] = newSVsv_flags(*strp, SV_DO_COW_SVSETSV|SV_NOSTEAL|SV_GMAGIC);
+            *fillp = i;
             strp++;
         }
         /* disarm av's leak guard */

embed.fnc

@@ -2312,7 +2312,7 @@ ARdp	|OP *	|newSVREF	|NN OP *o
 Adp	|SV *	|newSVrv	|NN SV * const rv			\
 				|NULLOK const char * const classname
 AMRbdp	|SV *	|newSVsv	|NULLOK SV * const old
-ARdp	|SV *	|newSVsv_flags	|NULLOK SV * const old			\
+ARdip	|SV *	|newSVsv_flags	|NULLOK SV * const old			\
 				|I32 flags
 ARdm	|SV *	|newSVsv_nomg	|NULLOK SV * const old
 ARdp	|SV *	|newSV_true
@@ -3213,6 +3213,9 @@ Xopx	|void	|sv_free2	|NN SV * const sv			\
 				|const U32 refcnt
 : Used only in perl.c
 dp	|void	|sv_free_arenas
+ARdp	|SV *	|sv_freshcopy_flags					\
+				|NN SV * const old			\
+				|I32 flags
 ATdpx	|SV *	|sv_get_backrefs|NN SV * const sv
 Adip	|void	|SvGETMAGIC	|NN SV *sv
 Adp	|char * |sv_gets	|NN SV * const sv			\

embed.h

@@ -694,6 +694,7 @@
 # define sv_eq_flags(a,b,c)                     Perl_sv_eq_flags(aTHX_ a,b,c)
 # define sv_force_normal_flags(a,b)             Perl_sv_force_normal_flags(aTHX_ a,b)
 # define sv_free(a)                             Perl_sv_free(aTHX_ a)
+# define sv_freshcopy_flags(a,b)                Perl_sv_freshcopy_flags(aTHX_ a,b)
 # define sv_get_backrefs                        Perl_sv_get_backrefs
 # define sv_gets(a,b,c)                         Perl_sv_gets(aTHX_ a,b,c)
 # define sv_grow(a,b)                           Perl_sv_grow(aTHX_ a,b)

pp.c

@@ -6421,10 +6421,11 @@ PP(pp_push)
         PL_delaymagic = DM_DELAY;
         for (++MARK; MARK <= PL_stack_sp; MARK++) {
             SV *sv;
-            if (*MARK) SvGETMAGIC(*MARK);
-            sv = newSV_type(SVt_NULL);
-            if (*MARK)
-                sv_setsv_nomg(sv, *MARK);
+            if (*MARK) {
+                sv = newSVsv_flags(*MARK, SV_DO_COW_SVSETSV|SV_GMAGIC);
+            } else
+                sv = newSV_type(SVt_NULL);
+
             av_store(ary, AvFILLp(ary)+1, sv);
         }
         if (PL_delaymagic & DM_ARRAY_ISA)

pp_ctl.c

@@ -4415,13 +4415,11 @@ S_doopen_pm(pTHX_ SV *name)
         return NULL;
 
     if (memENDPs(p, namelen, ".pm")) {
-        SV *const pmcsv = sv_newmortal();
-        PerlIO * pmcio;
+        SV *const pmcsv = sv_mortalcopy_flags(name, SV_GMAGIC|SV_NOSTEAL|SV_DO_COW_SVSETSV);
 
-        SvSetSV_nosteal(pmcsv,name);
         sv_catpvs(pmcsv, "c");
 
-        pmcio = check_type_and_open(pmcsv);
+        PerlIO * pmcio = check_type_and_open(pmcsv);
         if (pmcio)
             return pmcio;
     }
@@ -4813,8 +4811,7 @@ S_require_file(pTHX_ SV *sv)
                     }
 
                     if (SvPADTMP(nsv)) {
-                        nsv = sv_newmortal();
-                        SvSetSV_nosteal(nsv,sv);
+                        nsv = sv_mortalcopy_flags(sv, SV_GMAGIC|SV_NOSTEAL|SV_DO_COW_SVSETSV);
                     }
 
                     const char *method = NULL;

pp_hot.c

@@ -5375,8 +5375,7 @@ PP(pp_subst)
     if (dstr) {
         /* replacement needing upgrading? */
         if (DO_UTF8(TARG) && !doutf8) {
-             nsv = sv_newmortal();
-             SvSetSV(nsv, dstr);
+             nsv = sv_mortalcopy_flags(dstr, SV_GMAGIC|SV_DO_COW_SVSETSV);
              sv_utf8_upgrade(nsv);
              c = SvPV_const(nsv, clen);
              doutf8 = TRUE;

sv_inline.h

@@ -299,6 +299,8 @@ static const struct body_details bodies_by_type[] = {
 #if !(NVSIZE <= IVSIZE)
 #  define new_XNV()    safemalloc(sizeof(XPVNV))
 #endif
+#define new_XPV()    safemalloc(sizeof(XPV))
+#define new_XPVIV()    safemalloc(sizeof(XPVIV))
 #define new_XPVNV()    safemalloc(sizeof(XPVNV))
 #define new_XPVMG()    safemalloc(sizeof(XPVMG))
 
@@ -309,6 +311,8 @@ static const struct body_details bodies_by_type[] = {
 #if !(NVSIZE <= IVSIZE)
 #  define new_XNV()    new_body_allocated(SVt_NV)
 #endif
+#define new_XPV()    new_body_allocated(SVt_PV)
+#define new_XPVIV()    new_body_allocated(SVt_PVIV)
 #define new_XPVNV()    new_body_allocated(SVt_PVNV)
 #define new_XPVMG()    new_body_allocated(SVt_PVMG)
 
@@ -1003,6 +1007,30 @@ Perl_sv_setpv_freshbuf(pTHX_ SV *const sv)
     return SvPVX(sv);
 }
 
+/*
+=for apidoc newSVsv
+=for apidoc_item newSVsv_flags
+=for apidoc_item newSVsv_nomg
+
+These create a new SV which is an exact duplicate of the original SV
+(using C<sv_setsv>.)
+
+They differ only in that C<newSVsv> performs 'get' magic; C<newSVsv_nomg> skips
+any magic; and C<newSVsv_flags> allows you to explicitly set a C<flags>
+parameter.
+
+=cut
+*/
+
+PERL_STATIC_INLINE SV *
+Perl_newSVsv_flags(pTHX_ SV *const old, I32 flags)
+{
+    if (!old)
+        return NULL;
+
+    return sv_freshcopy_flags(old, flags);
+}
+
 /*
  * ex: set ts=8 sts=4 sw=4 et:
  */