From 75a9bf9690b77515a287eb483ea2709b73810c41 Mon Sep 17 00:00:00 2001 From: David Mitchell Date: Sun, 2 Dec 2012 12:59:37 +0000 Subject: [PATCH] make SvREFCNT_dec() more efficient Historically, SvREFCNT_dec was just #define SvREFCNT_dec(sv) sv_free((SV*)(sv)) then in 5.10.0, for GCC, the macro was partially inlined, avoiding a function call for the refcnt > 1 case. Recently, the macro was turned into an inline function, providing the function-call avoidance to other platforms too. However, the macro/inline-function is quite big, and appears over 500 times in the core source. Its action is logically equivalent to: if (sv) { if (SvREFCNT(sv) > 1) SvREFCNT(sv)--; else if (SvREFCNT == 1) { // normal case SvREFCNT(sv)--; sv_free2(sv); } else { // exceptional case sv_free(sv); } } Where sv_free2() handles the "normal" quick cases, while sv_free() handles the odd cases (e,g. a ref count already at 0 during global destruction). This means we have to plant code that potentially calls two different subs, over 500 times. This commit changes SvREFCNT_dec and sv_free2() to look like: PERL_STATIC_INLINE void S_SvREFCNT_dec(pTHX_ SV *sv) { if (sv) { U32 rc = SvREFCNT(sv); if (rc > 1) SvREFCNT(sv) = rc - 1; else Perl_sv_free2(aTHX_ sv, rc); } } Perl_sv_free2(pTHX_ SV *const sv, const U32 rc) { if (rc == 1) { SvREFCNT(sv) = 0; ... do sv_clear, del_SV etc ... return } /* handle exceptional rc == 0 */ ... } So for the normal cases (rc > 1, rc == 1) there is the same amount of testing and function calls, but the second test has been moved inside the sv_free2() function. This makes the perl executable about 10-15K smaller, and apparently a bit faster (modulo the fact that most benchmarks are just measuring noise). The refcount is passed as a second arg to sv_free2(), as on platforms that pass the first few args in registers, it saves reading sv->sv_refcnt again. --- embed.fnc | 4 +-- inline.h | 11 +++--- proto.h | 2 +- sv.c | 121 +++++++++++++++++++++++++++++++++----------------------------- 4 files changed, 72 insertions(+), 66 deletions(-) diff --git a/embed.fnc b/embed.fnc index a1e1f5e..337769f 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1294,9 +1294,7 @@ ApdR |bool |sv_does_pvn |NN SV* sv|NN const char *const name|const STRLEN len \ Amd |I32 |sv_eq |NULLOK SV* sv1|NULLOK SV* sv2 Apd |I32 |sv_eq_flags |NULLOK SV* sv1|NULLOK SV* sv2|const U32 flags Apd |void |sv_free |NULLOK SV *const sv -: FIXME Used in SvREFCNT_dec() but only -: if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) -poMX |void |sv_free2 |NN SV *const sv +poMX |void |sv_free2 |NN SV *const sv|const U32 refcnt : Used only in perl.c pd |void |sv_free_arenas Apd |char* |sv_gets |NN SV *const sv|NN PerlIO *const fp|I32 append diff --git a/inline.h b/inline.h index 0d53860..5e11b69 100644 --- a/inline.h +++ b/inline.h @@ -55,12 +55,11 @@ PERL_STATIC_INLINE void S_SvREFCNT_dec(pTHX_ SV *sv) { if (sv) { - if (SvREFCNT(sv)) { - if (--(SvREFCNT(sv)) == 0) - Perl_sv_free2(aTHX_ sv); - } else { - sv_free(sv); - } + U32 rc = SvREFCNT(sv); + if (rc > 1) + SvREFCNT(sv) = rc - 1; + else + Perl_sv_free2(aTHX_ sv, rc); } } diff --git a/proto.h b/proto.h index f9d7b9e..22210ab 100644 --- a/proto.h +++ b/proto.h @@ -3938,7 +3938,7 @@ PERL_CALLCONV void Perl_sv_force_normal_flags(pTHX_ SV *const sv, const U32 flag assert(sv) PERL_CALLCONV void Perl_sv_free(pTHX_ SV *const sv); -PERL_CALLCONV void Perl_sv_free2(pTHX_ SV *const sv) +PERL_CALLCONV void Perl_sv_free2(pTHX_ SV *const sv, const U32 refcnt) __attribute__nonnull__(pTHX_1); #define PERL_ARGS_ASSERT_SV_FREE2 \ assert(sv) diff --git a/sv.c b/sv.c index 397d992..72d41ca 100644 --- a/sv.c +++ b/sv.c @@ -6549,76 +6549,85 @@ Normally called via a wrapper macro C. void Perl_sv_free(pTHX_ SV *const sv) { - dVAR; - if (!sv) - return; - if (SvREFCNT(sv) == 0) { - if (SvFLAGS(sv) & SVf_BREAK) - /* this SV's refcnt has been artificially decremented to - * trigger cleanup */ - return; - if (PL_in_clean_all) /* All is fair */ - return; - if (SvREADONLY(sv) && SvIMMORTAL(sv)) { - /* make sure SvREFCNT(sv)==0 happens very seldom */ - SvREFCNT(sv) = (~(U32)0)/2; - return; - } - if (ckWARN_d(WARN_INTERNAL)) { -#ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP - Perl_dump_sv_child(aTHX_ sv); -#else - #ifdef DEBUG_LEAKING_SCALARS - sv_dump(sv); - #endif -#ifdef DEBUG_LEAKING_SCALARS_ABORT - if (PL_warnhook == PERL_WARNHOOK_FATAL - || ckDEAD(packWARN(WARN_INTERNAL))) { - /* Don't let Perl_warner cause us to escape our fate: */ - abort(); - } -#endif - /* This may not return: */ - Perl_warner(aTHX_ packWARN(WARN_INTERNAL), - "Attempt to free unreferenced scalar: SV 0x%"UVxf - pTHX__FORMAT, PTR2UV(sv) pTHX__VALUE); -#endif - } -#ifdef DEBUG_LEAKING_SCALARS_ABORT - abort(); -#endif - return; - } - if (--(SvREFCNT(sv)) > 0) - return; - Perl_sv_free2(aTHX_ sv); + SvREFCNT_dec(sv); } + +/* Private helper function for SvREFCNT_dec(). + * Called with rc set to original SvREFCNT(sv), where rc == 0 or 1 */ + void -Perl_sv_free2(pTHX_ SV *const sv) +Perl_sv_free2(pTHX_ SV *const sv, const U32 rc) { dVAR; PERL_ARGS_ASSERT_SV_FREE2; + if (rc == 1) { + /* normal case */ + SvREFCNT(sv) = 0; + #ifdef DEBUGGING - if (SvTEMP(sv)) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), - "Attempt to free temp prematurely: SV 0x%"UVxf - pTHX__FORMAT, PTR2UV(sv) pTHX__VALUE); - return; - } + if (SvTEMP(sv)) { + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), + "Attempt to free temp prematurely: SV 0x%"UVxf + pTHX__FORMAT, PTR2UV(sv) pTHX__VALUE); + return; + } #endif + if (SvREADONLY(sv) && SvIMMORTAL(sv)) { + /* make sure SvREFCNT(sv)==0 happens very seldom */ + SvREFCNT(sv) = (~(U32)0)/2; + return; + } + sv_clear(sv); + if (! SvREFCNT(sv)) /* may have have been resurrected */ + del_SV(sv); + return; + } + + /* handle exceptional cases */ + + assert(rc == 0); + + if (SvFLAGS(sv) & SVf_BREAK) + /* this SV's refcnt has been artificially decremented to + * trigger cleanup */ + return; + if (PL_in_clean_all) /* All is fair */ + return; if (SvREADONLY(sv) && SvIMMORTAL(sv)) { - /* make sure SvREFCNT(sv)==0 happens very seldom */ - SvREFCNT(sv) = (~(U32)0)/2; - return; + /* make sure SvREFCNT(sv)==0 happens very seldom */ + SvREFCNT(sv) = (~(U32)0)/2; + return; } - sv_clear(sv); - if (! SvREFCNT(sv)) - del_SV(sv); + if (ckWARN_d(WARN_INTERNAL)) { +#ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP + Perl_dump_sv_child(aTHX_ sv); +#else + #ifdef DEBUG_LEAKING_SCALARS + sv_dump(sv); + #endif +#ifdef DEBUG_LEAKING_SCALARS_ABORT + if (PL_warnhook == PERL_WARNHOOK_FATAL + || ckDEAD(packWARN(WARN_INTERNAL))) { + /* Don't let Perl_warner cause us to escape our fate: */ + abort(); + } +#endif + /* This may not return: */ + Perl_warner(aTHX_ packWARN(WARN_INTERNAL), + "Attempt to free unreferenced scalar: SV 0x%"UVxf + pTHX__FORMAT, PTR2UV(sv) pTHX__VALUE); +#endif + } +#ifdef DEBUG_LEAKING_SCALARS_ABORT + abort(); +#endif + } + /* =for apidoc sv_len -- 2.7.4