From 2bb1814aaf54298bd43284896b018a5c7b70818b Mon Sep 17 00:00:00 2001 From: David Mitchell Date: Sun, 5 Nov 2023 17:57:20 +0000 Subject: [PATCH] add rpp_replace_at_norc() to API It's like rpp_replace_at(), but it assumes that the SV has already had its refcount bumped. It replaces ugly code like SV *nsv = newSVsv(*svp); #ifdef PERL_RC_STACK rpp_replace(svp, nsv); SvREFCNT_dec(nsv); #else rpp_replace(svp, sv_2mortal(nsv)); #endif with a simple rpp_replace_at_norc(svp, newSvsv(*svp)); On PERL_RC_STACK builds it's more efficient than before as it's not unnecessarily bumping and then immediately unbumping nsv's refcount. --- embed.fnc | 3 +++ embed.h | 1 + inline.h | 33 +++++++++++++++++++++++++++++++++ pod/perlguts.pod | 6 ++++++ proto.h | 5 +++++ 5 files changed, 48 insertions(+) diff --git a/embed.fnc b/embed.fnc index e21628b8a0c5..0764cb213436 100644 --- a/embed.fnc +++ b/embed.fnc @@ -2774,6 +2774,9 @@ Adipx |void |rpp_replace_1_1|NN SV *sv Adipx |void |rpp_replace_2_1|NN SV *sv Adipx |void |rpp_replace_at |NN SV **sp \ |NN SV *sv +Adipx |void |rpp_replace_at_norc \ + |NN SV **sp \ + |NN SV *sv Adipx |bool |rpp_stack_is_rc Adipx |bool |rpp_try_AMAGIC_1 \ |int method \ diff --git a/embed.h b/embed.h index 8f5e05b257ef..10580d431bec 100644 --- a/embed.h +++ b/embed.h @@ -552,6 +552,7 @@ # define rpp_replace_1_1(a) Perl_rpp_replace_1_1(aTHX_ a) # define rpp_replace_2_1(a) Perl_rpp_replace_2_1(aTHX_ a) # define rpp_replace_at(a,b) Perl_rpp_replace_at(aTHX_ a,b) +# define rpp_replace_at_norc(a,b) Perl_rpp_replace_at_norc(aTHX_ a,b) # define rpp_stack_is_rc() Perl_rpp_stack_is_rc(aTHX) # define rpp_try_AMAGIC_1(a,b) Perl_rpp_try_AMAGIC_1(aTHX_ a,b) # define rpp_try_AMAGIC_2(a,b) Perl_rpp_try_AMAGIC_2(aTHX_ a,b) diff --git a/inline.h b/inline.h index 59d16645b235..c2b98b7a788e 100644 --- a/inline.h +++ b/inline.h @@ -705,6 +705,39 @@ Perl_rpp_replace_at(pTHX_ SV **sp, SV *sv) } +/* +=for apidoc rpp_replace_at_norc + +Replace the SV at address sp within the stack with C, while suitably +adjusting the reference count of the old SV. Equivalent to C<*sp = sv>, +except with proper reference count handling. + +C's reference count doesn't get incremented. On non-C +builds, it gets mortalised too. + +This is most useful where an SV has just been created and already has a +reference count of 1, but has not yet been anchored anywhere. + +=cut +*/ + +PERL_STATIC_INLINE void +Perl_rpp_replace_at_norc(pTHX_ SV **sp, SV *sv) +{ + PERL_ARGS_ASSERT_RPP_REPLACE_AT_NORC; + +#ifdef PERL_RC_STACK + assert(rpp_stack_is_rc()); + SV *oldsv = *sp; + *sp = sv; + SvREFCNT_dec(oldsv); +#else + *sp = sv; + sv_2mortal(sv); +#endif +} + + /* =for apidoc rpp_context diff --git a/pod/perlguts.pod b/pod/perlguts.pod index a68635b87b59..0d43edc7ad14 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -4760,6 +4760,7 @@ in summary: rpp_replace_1_1(sv) (void)POPs; PUSHs(sv); rpp_replace_2_1(sv) (void)POPs; (void)POPs; PUSHs(sv); rpp_replace_at(sp, sv) *sp = sv; + rpp_replace_at_norc(sp, sv) *sp = sv_2mortal(sv); rpp_context(mark, gimme, extra) SP -= extra; @@ -4809,6 +4810,11 @@ handle edge cases such as an old and new SV being the same. rpp_replace_at(sp, sv) is similar to rpp_replace_1_1(), except that it replaces an SV at an address in the stack rather than at the top. +rpp_replace_at_norc(sp, sv) is similar to rpp_replace_at(), except that +it assumes that C already has a bumped reference count. So, a bit +like rpp_push_1_norc() (see below), it doesn't bother increasing C's +reference count, or on non-RC builds it mortalises it instead. + rpp_popfree_to(svp) is designed to replace code like PL_stack_sp = PL_stack_base + cx->blk_oldsp; diff --git a/proto.h b/proto.h index 5b57034cc58b..8ec8cd05901a 100644 --- a/proto.h +++ b/proto.h @@ -9863,6 +9863,11 @@ Perl_rpp_replace_at(pTHX_ SV **sp, SV *sv); # define PERL_ARGS_ASSERT_RPP_REPLACE_AT \ assert(sp); assert(sv) +PERL_STATIC_INLINE void +Perl_rpp_replace_at_norc(pTHX_ SV **sp, SV *sv); +# define PERL_ARGS_ASSERT_RPP_REPLACE_AT_NORC \ + assert(sp); assert(sv) + PERL_STATIC_INLINE bool Perl_rpp_stack_is_rc(pTHX); # define PERL_ARGS_ASSERT_RPP_STACK_IS_RC