From 68c014ce94346e94e5c79ae7c10cd6640202fa91 Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Thu, 3 Apr 2025 21:43:24 +0000 Subject: [PATCH 1/8] Extract S_SvPV_shared_hkey_or_CoWable logic from Perl_sv_setsv_flags --- sv.c | 43 ++++++++++++++++++++++++------------------- 1 file changed, 24 insertions(+), 19 deletions(-) diff --git a/sv.c b/sv.c index e8c6e65a2717..91b6eec86468 100644 --- a/sv.c +++ b/sv.c @@ -4205,6 +4205,28 @@ S_sv_buf_to_rw(pTHX_ SV *sv) && len /* and really is a string */ \ ) +/* The test in this macro was also extracted from Perl_sv_setsv_flags so + * that it could be used elsewhere. */ +#ifdef PERL_COPY_ON_WRITE +#define S_SvPV_shared_hkey_or_CoWable(ssv, dsv, sflags, cur, len) \ + (sflags & SVf_IsCOW \ + ? (!len || \ + ( (CHECK_COWBUF_THRESHOLD(cur,len) || SvLEN(dsv) < cur+1) \ + /* If this is a regular (non-hek) COW, only so */ \ + /* many COW "copies" are possible. */ \ + && CowREFCNT(ssv) != SV_COW_REFCNT_MAX )) \ + : ( (sflags & CAN_COW_MASK) == CAN_COW_FLAGS \ + && !(SvFLAGS(dsv) & SVf_BREAK) \ + && CHECK_COW_THRESHOLD(cur,len) && cur+1 < len \ + && (CHECK_COWBUF_THRESHOLD(cur,len) || SvLEN(dsv) < cur+1) \ + )) +#else +#define S_SvPV_shared_hkey_or_CoWable(ssv, dsv, sflags, cur, len) \ + ( sflags & SVf_IsCOW \ + && !(SvFLAGS(dsv) & SVf_BREAK) \ + ) +#endif + /* Perl_sv_can_swipe_pv_buf was originally created for pp_reverse. */ bool Perl_sv_can_swipe_pv_buf(pTHX_ SV *sv) @@ -4647,25 +4669,8 @@ Perl_sv_setsv_flags(pTHX_ SV *dsv, SV* ssv, const I32 flags) SvCUR_set(dsv, cur); SvFLAGS(dsv) |= (SVf_IsCOW|SVppv_STATIC); } - else if (flags & SV_COW_SHARED_HASH_KEYS - && -#ifdef PERL_COPY_ON_WRITE - (sflags & SVf_IsCOW - ? (!len || - ( (CHECK_COWBUF_THRESHOLD(cur,len) || SvLEN(dsv) < cur+1) - /* If this is a regular (non-hek) COW, only so - many COW "copies" are possible. */ - && CowREFCNT(ssv) != SV_COW_REFCNT_MAX )) - : ( (sflags & CAN_COW_MASK) == CAN_COW_FLAGS - && !(SvFLAGS(dsv) & SVf_BREAK) - && CHECK_COW_THRESHOLD(cur,len) && cur+1 < len - && (CHECK_COWBUF_THRESHOLD(cur,len) || SvLEN(dsv) < cur+1) - )) -#else - sflags & SVf_IsCOW - && !(SvFLAGS(dsv) & SVf_BREAK) -#endif - ) { + else if ((flags & SV_COW_SHARED_HASH_KEYS) && + S_SvPV_shared_hkey_or_CoWable(ssv, dsv, sflags, cur, len)){ /* Either it's a shared hash key, or it's suitable for copy-on-write. */ #ifdef DEBUGGING From 3a2cf3bd34cd4cabe0f3f86b86ffbe7ebab678a6 Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Tue, 1 Apr 2025 21:12:33 +0000 Subject: [PATCH 2/8] sv.c: Add S_sv_freshcopy_flags and S_sv_freshcopy_POK S_sv_freshcopy_flags is a drop-in replacement for `Perl_sv_setsv_flags`. It is designed for use when the destination SV is being freshly created and much of the logic in `sv_setsv_flags` is irrelevant. The intended users for this new function are: * Perl_sv_mortalcopy_flags * Perl_newSVsv_flags Those functions have been modified such that: * Bodyless destination SVs are created inline * SVt_PVs also have special casing * SVt_PVMG and below use S_sv_freshcopy_flags * Anything else drops back to using Perl_sv_setsv_flags S_sv_freshcopy_POK is a helper function that concentrates on the string assignment logic: * Swipe the buffer * CoW the buffer * Copy the buffer Using perl's test harness as a guide: * 45% of Perl_newSVsv_flags / 57% of Perl_sv_mortalcopy_flags calls use the bodyless code * 32% of Perl_newSVsv_flags / 36% of Perl_sv_mortalcopy_flags calls use the SVt_PV/SVp_POK code * The S_sv_freshcopy_flags code handles the bulk of the remainder. With these changes compared with a build of blead: * `perl -e 'for (1..100_000) { my $x = [ (1) x 1000 ]; }'` runs 30% faster * `perl -e 'for (1..100_000) { my $x = [ ("Perl") x 1000 ]; }' runs: * 15% faster if `newSV_type(SVt_PV)` is NOT inlined * 30% faster if it IS inlined The overall reduction in branches when cloning SVs, and refocusing of branch prediction within Perl_sv_setsv_flags, will hopefully give a meaningful boost to realistic Perl applications. --- sv.c | 420 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 401 insertions(+), 19 deletions(-) diff --git a/sv.c b/sv.c index 91b6eec86468..619dce898639 100644 --- a/sv.c +++ b/sv.c @@ -4776,6 +4776,272 @@ Perl_sv_setsv_flags(pTHX_ SV *dsv, SV* ssv, const I32 flags) SvTAINT(dsv); } +/* A helper for sv_mortalcopy_flags and newSVsv_flags, either directly or + * indirectly via S_sv_freshcopy_flags. It is more efficient for their use + * cases than calling Perl_sv_setsv_flags. */ +PERL_STATIC_INLINE void +S_sv_freshcopy_POK(pTHX_ SV* dsv, SV* ssv, const I32 flags) +{ + const U32 sflags = SvFLAGS(ssv); + /* This logic MUST mirror what is in Perl_sv_setsv_flags. + * Please refer to the comments there for the explanation + * of what is going on below. + * The only deviations here are for conditions we know the + * result of ahead of time, such as `if (SvPVX_const(dsv))`, + * which will never be true here. */ + assert(!SvPVX_const(dsv)); /* May as well prove it! */ + assert(!SvOK(dsv)); + assert(!(SvFLAGS(dsv) & SVf_BREAK)); + assert(!SvIsCOW_static(ssv)); + assert(!SvTEMP(dsv)); + + const STRLEN cur = SvCUR(ssv); + const STRLEN len = SvLEN(ssv); + + SvFLAGS(dsv) |= (SVf_POK|SVp_POK); + + if (!(flags & SV_NOSTEAL) && S_SvPV_can_swipe_buf(ssv, sflags, cur, len) ) { + /* Passes the swipe test. */ + SvPV_set(dsv, SvPVX_mutable(ssv)); + SvLEN_set(dsv, len); + SvCUR_set(dsv, cur); + + (void)SvOK_off(ssv); /* NOTE: nukes most SvFLAGS on ssv */ + SvPV_set(ssv, NULL); + SvLEN_set(ssv, 0); + SvCUR_set(ssv, 0); + SvTEMP_off(ssv); + } else if ((flags & SV_COW_SHARED_HASH_KEYS) && + S_SvPV_shared_hkey_or_CoWable(ssv, dsv, sflags, cur, len) + ) { + /* Either it's a shared hash key, or it's suitable for + copy-on-write. */ +#ifdef DEBUGGING + if (DEBUG_C_TEST) { + PerlIO_printf(Perl_debug_log, "Copy on write: ssv --> dsv\n"); + sv_dump(ssv); + sv_dump(dsv); + } +#endif +#ifdef PERL_ANY_COW + if (!(sflags & SVf_IsCOW)) { + SvIsCOW_on(ssv); + CowREFCNT(ssv) = 0; + } + + if (len) { + if (sflags & SVf_IsCOW) { + sv_buf_to_rw(ssv); + } + CowREFCNT(ssv)++; + SvPV_set(dsv, SvPVX_mutable(ssv)); + sv_buf_to_ro(ssv); + } else +#endif + { + /* SvIsCOW_shared_hash */ + DEBUG_C(PerlIO_printf(Perl_debug_log, + "Copy on write: Sharing hash\n")); + SvPV_set(dsv, + HEK_KEY(share_hek_hek(SvSHARED_HEK_FROM_PV(SvPVX_const(ssv))))); + } + SvLEN_set(dsv, len); + SvCUR_set(dsv, cur); + SvIsCOW_on(dsv); + } else { + /* Failed the swipe test, and we cannot do copy-on-write either. + Have to copy the string. */ + sv_grow_fresh(dsv, cur + 1); + + Move(SvPVX_const(ssv),SvPVX(dsv),cur,char); + SvCUR_set(dsv, cur); + *SvEND(dsv) = '\0'; + } + SvFLAGS(dsv) |= sflags & SVf_UTF8; +} + +/* A helper for sv_mortalcopy_flags and newSVsv_flags, more efficient + * for their use cases compared to Perl_sv_setsv_flags. */ +PERL_STATIC_INLINE SV * +S_sv_freshcopy_flags(pTHX_ SV* ssv, const I32 flags) +{ + /* Note: If a PVIV/PVNV/PVMG is only IOK, NOK, ROK, it is _mostly_ + * possible to create just a headless SV to store that value. + * Some parts of core (Perl_amagic_call in gv.c specifically) do + * assume - and possibly CPAN might - that SvTYPE(dsv) == SvTYPE(ssv) + * though, which is why the code below does not try that type + * simplification. Perhaps this might be worth revisiting in the future. + * -- April 2025. */ + assert(ssv); + svtype stype = SvTYPE(ssv); + +#if NVSIZE <= IVSIZE + ASSUME(stype > SVt_NV); +#else + ASSUME(stype > SVt_IV); +#endif + ASSUME(stype <= SVt_PVMG); + SV *dsv = newSV_type(stype); + U32 sflags = SvFLAGS(ssv); + + ASSUME(!(flags & SV_GMAGIC)); /* Caller should have sorted this. */ + /* Note: Perl_sv_setsv_flags essentially ignores magic, except for + * taint and vstring magic. */ + + /* The switch cases are in the order that gcov of make/make test suggests. */ + switch(sflags & (SVp_IOK|SVp_NOK|SVf_ROK|SVp_POK|SVf_FAKE|SVppv_STATIC)) { + case SVp_IOK: + SvIV_set(dsv, SvIVX(ssv)); + SvFLAGS(dsv) |= sflags & (SVf_IOK|SVp_IOK|SVf_IVisUV); + break; + case SVp_POK: + if (UNLIKELY(SvTYPE(ssv) == SVt_INVLIST)) { + invlist_clone(ssv, dsv); + return dsv; + } + S_sv_freshcopy_POK(aTHX_ dsv, ssv, flags); + { + const char *vstr_pv; + STRLEN vstr_len; + if ((vstr_pv = SvVSTRING(ssv, vstr_len))) { + sv_magic(dsv, NULL, PERL_MAGIC_vstring, vstr_pv, vstr_len); + SvRMAGICAL_on(dsv); + } + } + break; + case SVp_POK|SVp_IOK: + S_sv_freshcopy_POK(aTHX_ dsv, ssv, flags); + { + const char *vstr_pv; + STRLEN vstr_len; + if ((vstr_pv = SvVSTRING(ssv, vstr_len))) { + sv_magic(dsv, NULL, PERL_MAGIC_vstring, vstr_pv, vstr_len); + SvRMAGICAL_on(dsv); + } + } + SvIV_set(dsv, SvIVX(ssv)); + SvFLAGS(dsv) |= (sflags & (SVf_IOK|SVp_IOK|SVf_IVisUV)); + if ((sflags & SVf_IOK) && !(sflags & SVf_POK)) { + /* Source was SVf_IOK|SVp_IOK|SVp_POK but not SVf_POK, meaning + a value set as an integer and later stringified. So mark + destination the same: */ + SvFLAGS(dsv) &= ~SVf_POK; + } + break; + case SVp_POK|SVp_IOK|SVp_NOK|SVppv_STATIC: /* e.g. PL_sv_yes, PL_sv_no */ + assert(SvTYPE(ssv) != SVt_INVLIST); + + ASSUME(!SvPVX_const(dsv)); + ASSUME(!SvOK(dsv)); + ASSUME(!(SvFLAGS(dsv) & SVf_BREAK)); +{ + const STRLEN cur = SvCUR(ssv); + + (void)SvPOK_only(dsv); + SvPV_set(dsv, SvPVX(ssv)); + SvLEN_set(dsv, 0); + SvCUR_set(dsv, cur); +} + SvIV_set(dsv, SvIVX(ssv)); + SvNV_set(dsv, SvNVX(ssv)); + SvFLAGS(dsv) |= SVf_IsCOW|SVppv_STATIC| + (sflags & (SVf_IOK|SVp_IOK|SVf_IVisUV|SVf_NOK|SVp_NOK|SVf_POK|SVf_POK|SVf_UTF8)); + + { + const char *vstr_pv; + STRLEN vstr_len; + if ((vstr_pv = SvVSTRING(ssv, vstr_len))) { + sv_magic(dsv, NULL, PERL_MAGIC_vstring, vstr_pv, vstr_len); + SvRMAGICAL_on(dsv); + } + } + break; + case SVf_ROK: + SvRV_set(dsv, SvREFCNT_inc(SvRV(ssv))); + SvFLAGS(dsv) |= sflags & SVf_ROK; + break; + case SVp_POK|SVp_NOK: + assert(SvTYPE(ssv) != SVt_INVLIST); + S_sv_freshcopy_POK(aTHX_ dsv, ssv, flags); + { + const char *vstr_pv; + STRLEN vstr_len; + if ((vstr_pv = SvVSTRING(ssv, vstr_len))) { + sv_magic(dsv, NULL, PERL_MAGIC_vstring, vstr_pv, vstr_len); + SvRMAGICAL_on(dsv); + } + } + SvNV_set(dsv, SvNVX(ssv)); + + SvFLAGS(dsv) |= (sflags & (SVf_NOK|SVp_NOK)); + if ((sflags & SVf_NOK) && !(sflags & SVf_POK)) { + /* Source was SVf_NOK|SVp_NOK|SVp_POK but not SVf_POK, meaning + a value set as floating point and later stringified, where + the value happens to be one of the few that we know aren't + affected by the numeric locale, hence we can cache the + stringification. Currently that's +Inf, -Inf and NaN, but + conceivably we might extend this to -9 .. +9 (excluding -0). + So mark destination the same: */ + SvFLAGS(dsv) &= ~SVf_POK; + } + break; + case SVp_POK|SVp_IOK|SVp_NOK: + assert(SvTYPE(ssv) != SVt_INVLIST); + + S_sv_freshcopy_POK(aTHX_ dsv, ssv, flags); + { + const char *vstr_pv; + STRLEN vstr_len; + if ((vstr_pv = SvVSTRING(ssv, vstr_len))) { + sv_magic(dsv, NULL, PERL_MAGIC_vstring, vstr_pv, vstr_len); + SvRMAGICAL_on(dsv); + } + } + SvIV_set(dsv, SvIVX(ssv)); + SvNV_set(dsv, SvNVX(ssv)); + + SvFLAGS(dsv) |= (sflags & (SVf_IOK|SVp_IOK|SVf_IVisUV|SVf_NOK|SVp_NOK)); + if ((sflags & SVf_IOK) && !(sflags & SVf_POK)) { + /* Source was SVf_IOK|SVp_IOK|SVp_POK but not SVf_POK, meaning + a value set as an integer and later stringified. So mark + destination the same: */ + SvFLAGS(dsv) &= ~SVf_POK; + } else if ((sflags & SVf_NOK) && !(sflags & SVf_POK)) { + /* Source was SVf_NOK|SVp_NOK|SVp_POK but not SVf_POK, meaning + a value set as floating point and later stringified, where + the value happens to be one of the few that we know aren't + affected by the numeric locale, hence we can cache the + stringification. Currently that's +Inf, -Inf and NaN, but + conceivably we might extend this to -9 .. +9 (excluding -0). + So mark destination the same: */ + SvFLAGS(dsv) &= ~SVf_POK; + } + break; + default: + if(!SvOK(ssv)) + break; + /* Some cases seem so rare that we may as well let + * sv_setsv_flags deal with them. For example: + * SVp_IOK|SVp_NOK + * + * Some cases are (currently) not naturally occurring: + * SVp_POK|SVppv_STATIC + * SVp_POK|SVp_IOK|SVppv_STATIC + * SVp_POK|SVp_NOK|SVppv_STATIC + * + * Other cases are also rare but also trickier to handle, + * so keeps this function smaller to not even try. */ + sv_setsv_flags(dsv,ssv,flags); + return dsv; + case SVp_NOK: + SvNV_set(dsv, SvNVX(ssv)); + SvFLAGS(dsv) |= (sflags & (SVf_NOK|SVp_NOK)); + break; + } + if (SvTAINTED(ssv)) + SvTAINT(dsv); + return dsv; +} /* =for apidoc sv_set_undef @@ -9640,15 +9906,75 @@ C>. SV * Perl_sv_mortalcopy_flags(pTHX_ SV *const oldstr, U32 flags) { - SV *sv; + SV * old = (oldstr) ? oldstr : &PL_sv_undef; + SV *dsv; + const svtype old_type = SvTYPE(old); - if (flags & SV_GMAGIC) - SvGETMAGIC(oldstr); /* before new_SV, in case it dies */ - new_SV(sv); - sv_setsv_flags(sv,oldstr,flags & ~SV_GMAGIC); - PUSH_EXTEND_MORTAL__SV_C(sv); - SvTEMP_on(sv); - return sv; +#if NVSIZE <= IVSIZE + if (old_type <= SVt_NV) { +#else + if (old_type <= SVt_IV) { +#endif + new_SV(dsv); + U32 sflags = SvFLAGS(old); +#if NVSIZE <= IVSIZE + switch(sflags & (SVf_IOK|SVf_ROK|SVf_NOK)) { +#else + switch(sflags & (SVf_IOK|SVf_ROK)) { +#endif + case SVf_ROK: + SET_SVANY_FOR_BODYLESS_IV(dsv); + SvFLAGS(dsv) = SVt_IV|SVf_ROK; + dsv->sv_u.svu_rv = SvREFCNT_inc(SvRV(old)); + break; + case SVf_IOK: + SET_SVANY_FOR_BODYLESS_IV(dsv); + /* both src and dst are <= SVt_IV, so sv_any points to the + * head; so access the head directly + */ + assert( &(old->sv_u.svu_iv) + == &(((XPVIV*) SvANY(old))->xiv_iv)); + assert( &(dsv->sv_u.svu_iv) + == &(((XPVIV*) SvANY(dsv))->xiv_iv)); + dsv->sv_u.svu_iv = old->sv_u.svu_iv; + SvFLAGS(dsv) = SVt_IV|(sflags & (SVf_IOK|SVp_IOK|SVf_IVisUV)); + break; +#if NVSIZE <= IVSIZE + case SVf_NOK: + SET_SVANY_FOR_BODYLESS_NV(dsv); + assert( &(old->sv_u.svu_nv) + == &(((XPVNV*) SvANY(old))->xnv_u.xnv_nv)); + assert( &(dsv->sv_u.svu_nv) + == &(((XPVNV*) SvANY(dsv))->xnv_u.xnv_nv)); + dsv->sv_u.svu_nv = old->sv_u.svu_nv; + SvFLAGS(dsv) = SVt_NV|SVf_NOK|SVp_NOK; + break; +#endif + } + } else if (old_type == SVt_PV) { + dsv = newSV_type(SVt_PV); + if (SvFLAGS(old) & SVp_POK) { + assert(!SvIsCOW_static(old)); + S_sv_freshcopy_POK(aTHX_ dsv, old, flags); + } else if (SvFLAGS(old) & SVf_ROK) { + SvFLAGS(dsv) |= SVf_ROK; + SvRV_set(dsv, SvREFCNT_inc(SvRV(old))); + } + } else { + if (flags & SV_GMAGIC) { + SvGETMAGIC(oldstr); /* before new_SV, in case it dies */ + flags &= ~SV_GMAGIC; + } + if (old_type <= SVt_PVMG) { + dsv = S_sv_freshcopy_flags(aTHX_ old,flags); + } else { + new_SV(dsv); + sv_setsv_flags(dsv, old, flags); + } + } + PUSH_EXTEND_MORTAL__SV_C(dsv); + SvTEMP_on(dsv); + return dsv; } /* @@ -10183,20 +10509,76 @@ parameter. SV * Perl_newSVsv_flags(pTHX_ SV *const old, I32 flags) { - SV *sv; - if (!old) return NULL; - if (SvIS_FREED(old)) { - ck_warner_d(packWARN(WARN_INTERNAL), "semi-panic: attempt to dup freed string"); - return NULL; + + const svtype old_type = SvTYPE(old); +#if NVSIZE <= IVSIZE + if (old_type <= SVt_NV) { +#else + if (old_type <= SVt_IV) { +#endif + U32 sflags = SvFLAGS(old); + SV *dsv; + new_SV(dsv); + if (sflags & SVf_IOK) { + SET_SVANY_FOR_BODYLESS_IV(dsv); + /* both src and dst are <= SVt_IV, so sv_any points to the + * head; so access the head directly + */ + assert( &(old->sv_u.svu_iv) + == &(((XPVIV*) SvANY(old))->xiv_iv)); + assert( &(dsv->sv_u.svu_iv) + == &(((XPVIV*) SvANY(dsv))->xiv_iv)); + dsv->sv_u.svu_iv = old->sv_u.svu_iv; + SvFLAGS(dsv) = SVt_IV|(sflags & (SVf_IOK|SVp_IOK|SVf_IVisUV)); + } else if (sflags & SVf_ROK) { + SET_SVANY_FOR_BODYLESS_IV(dsv); + SvFLAGS(dsv) = SVt_IV|SVf_ROK; + dsv->sv_u.svu_rv = SvREFCNT_inc(SvRV(old)); + } +#if NVSIZE <= IVSIZE + else if (sflags & SVf_NOK) { + SET_SVANY_FOR_BODYLESS_NV(dsv); + assert( &(old->sv_u.svu_nv) + == &(((XPVNV*) SvANY(old))->xnv_u.xnv_nv)); + assert( &(dsv->sv_u.svu_nv) + == &(((XPVNV*) SvANY(dsv))->xnv_u.xnv_nv)); + dsv->sv_u.svu_nv = old->sv_u.svu_nv; + SvFLAGS(dsv) = SVt_NV|SVf_NOK|SVp_NOK; + } +#endif + return dsv; + } else if (old_type == SVt_PV) { + SV *dsv = newSV_type(SVt_PV); + if (SvFLAGS(old) & SVp_POK) { + assert(!SvIsCOW_static(old)); + S_sv_freshcopy_POK(aTHX_ dsv, old, flags); + } else if (SvFLAGS(old) & SVf_ROK) { + SvFLAGS(dsv) |= SVf_ROK; + SvRV_set(dsv, SvREFCNT_inc(SvRV(old))); + } + return dsv; + } else { + if (SvIS_FREED(old)) { + ck_warner_d(packWARN(WARN_INTERNAL), "semi-panic: attempt to dup freed string"); + return NULL; + } + /* Do this here, otherwise we leak the new SV if this croaks. */ + if (flags & SV_GMAGIC) { + SvGETMAGIC(old); + flags &= ~SV_GMAGIC; + } + + if (old_type <= SVt_PVMG) { + return S_sv_freshcopy_flags(aTHX_ old,flags); + } else { + SV *dsv; + new_SV(dsv); + sv_setsv_flags(dsv, old, flags); + return dsv; + } } - /* Do this here, otherwise we leak the new SV if this croaks. */ - if (flags & SV_GMAGIC) - SvGETMAGIC(old); - new_SV(sv); - sv_setsv_flags(sv, old, flags & ~SV_GMAGIC); - return sv; } /* From 27bfb77ea3d86928cff1023a36ca6fb9753c6037 Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Thu, 3 Apr 2025 14:43:45 +0000 Subject: [PATCH 3/8] Perl_av_make - use newSVsv_flags rather than doing own thing --- av.c | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/av.c b/av.c index 8ced00f47c63..2942516a4806 100644 --- a/av.c +++ b/av.c @@ -493,9 +493,7 @@ Perl_av_make(pTHX_ SSize_t size, SV **strp) 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); strp++; } /* disarm av's leak guard */ From dfaf1f0c6fad1801f900b329f99fce3771e519e2 Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Fri, 4 Apr 2025 01:05:10 +0000 Subject: [PATCH 4/8] Perl_sv_recode_to_utf8 - do mortalcopy directly --- sv.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/sv.c b/sv.c index 619dce898639..4dbb853faac3 100644 --- a/sv.c +++ b/sv.c @@ -17053,8 +17053,7 @@ Perl_sv_recode_to_utf8(pTHX_ SV *sv, SV *encoding) PUSHSTACK; SAVETMPS; if (SvPADTMP(nsv)) { - nsv = sv_newmortal(); - SvSetSV_nosteal(nsv, sv); + nsv = sv_mortalcopy_flags(sv, SV_GMAGIC|SV_NOSTEAL|SV_DO_COW_SVSETSV); } save_re_context(); PUSHMARK(sp); From dcab4dd95672f4fbd185c2a02118966e28437f3a Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Fri, 4 Apr 2025 01:06:46 +0000 Subject: [PATCH 5/8] pp_push - do newSVsv_flags directly --- pp.c | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/pp.c b/pp.c index 6e53f9b71129..7f60ca793702 100644 --- a/pp.c +++ b/pp.c @@ -6421,10 +6421,12 @@ 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) { + SvGETMAGIC(*MARK); + sv = newSVsv_flags(*MARK, SV_DO_COW_SVSETSV); + } else { + sv = newSV_type(SVt_NULL); + } av_store(ary, AvFILLp(ary)+1, sv); } if (PL_delaymagic & DM_ARRAY_ISA) From d7e215957b13e738762a51685af62f3257b3c832 Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Fri, 4 Apr 2025 01:09:31 +0000 Subject: [PATCH 6/8] S_doopen_pm - make mortalcopy directly --- pp_ctl.c | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/pp_ctl.c b/pp_ctl.c index c9419ae79fec..cf0980b29e16 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -4407,13 +4407,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; } From b3b192ba616006ec48b514b08b14e57d475925f5 Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Fri, 4 Apr 2025 01:10:59 +0000 Subject: [PATCH 7/8] S_require_file - make mortalcopy directly --- pp_ctl.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/pp_ctl.c b/pp_ctl.c index cf0980b29e16..123d89185c29 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -4803,8 +4803,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; From 24b40aa76c507d48b3602d830855d130cc4b69dc Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Fri, 4 Apr 2025 01:14:37 +0000 Subject: [PATCH 8/8] pp_subst - make mortalcopy directly --- pp_hot.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/pp_hot.c b/pp_hot.c index 11c43e80863f..1ddee929e39b 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -5357,8 +5357,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;