Skip to content

Commit 75a9bf9

Browse files
iabyniabyn
committed
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.
1 parent b492a59 commit 75a9bf9

File tree

4 files changed

+72
-66
lines changed

4 files changed

+72
-66
lines changed

‎embed.fnc‎

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1294,9 +1294,7 @@ ApdR |bool |sv_does_pvn |NN SV* sv|NN const char *const name|const STRLEN len \
12941294
Amd |I32 |sv_eq |NULLOK SV* sv1|NULLOK SV* sv2
12951295
Apd |I32 |sv_eq_flags |NULLOK SV* sv1|NULLOK SV* sv2|const U32 flags
12961296
Apd |void |sv_free |NULLOK SV *const sv
1297-
: FIXME Used in SvREFCNT_dec() but only
1298-
: if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
1299-
poMX |void |sv_free2 |NN SV *const sv
1297+
poMX |void |sv_free2 |NN SV *const sv|const U32 refcnt
13001298
: Used only in perl.c
13011299
pd |void |sv_free_arenas
13021300
Apd |char* |sv_gets |NN SV *const sv|NN PerlIO *const fp|I32 append

‎inline.h‎

Lines changed: 5 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -55,12 +55,11 @@ PERL_STATIC_INLINE void
5555
S_SvREFCNT_dec(pTHX_ SV *sv)
5656
{
5757
if (sv) {
58-
if (SvREFCNT(sv)) {
59-
if (--(SvREFCNT(sv)) == 0)
60-
Perl_sv_free2(aTHX_ sv);
61-
} else {
62-
sv_free(sv);
63-
}
58+
U32 rc = SvREFCNT(sv);
59+
if (rc > 1)
60+
SvREFCNT(sv) = rc - 1;
61+
else
62+
Perl_sv_free2(aTHX_ sv, rc);
6463
}
6564
}
6665

‎proto.h‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3938,7 +3938,7 @@ PERL_CALLCONV void Perl_sv_force_normal_flags(pTHX_ SV *const sv, const U32 flag
39383938
assert(sv)
39393939

39403940
PERL_CALLCONV void Perl_sv_free(pTHX_ SV *const sv);
3941-
PERL_CALLCONV void Perl_sv_free2(pTHX_ SV *const sv)
3941+
PERL_CALLCONV void Perl_sv_free2(pTHX_ SV *const sv, const U32 refcnt)
39423942
__attribute__nonnull__(pTHX_1);
39433943
#define PERL_ARGS_ASSERT_SV_FREE2 \
39443944
assert(sv)

‎sv.c‎

Lines changed: 65 additions & 56 deletions
Original file line numberDiff line numberDiff line change
@@ -6549,76 +6549,85 @@ Normally called via a wrapper macro C<SvREFCNT_dec>.
65496549
void
65506550
Perl_sv_free(pTHX_ SV *const sv)
65516551
{
6552-
dVAR;
6553-
if (!sv)
6554-
return;
6555-
if (SvREFCNT(sv) == 0) {
6556-
if (SvFLAGS(sv) & SVf_BREAK)
6557-
/* this SV's refcnt has been artificially decremented to
6558-
* trigger cleanup */
6559-
return;
6560-
if (PL_in_clean_all) /* All is fair */
6561-
return;
6562-
if (SvREADONLY(sv) && SvIMMORTAL(sv)) {
6563-
/* make sure SvREFCNT(sv)==0 happens very seldom */
6564-
SvREFCNT(sv) = (~(U32)0)/2;
6565-
return;
6566-
}
6567-
if (ckWARN_d(WARN_INTERNAL)) {
6568-
#ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
6569-
Perl_dump_sv_child(aTHX_ sv);
6570-
#else
6571-
#ifdef DEBUG_LEAKING_SCALARS
6572-
sv_dump(sv);
6573-
#endif
6574-
#ifdef DEBUG_LEAKING_SCALARS_ABORT
6575-
if (PL_warnhook == PERL_WARNHOOK_FATAL
6576-
|| ckDEAD(packWARN(WARN_INTERNAL))) {
6577-
/* Don't let Perl_warner cause us to escape our fate: */
6578-
abort();
6579-
}
6580-
#endif
6581-
/* This may not return: */
6582-
Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
6583-
"Attempt to free unreferenced scalar: SV 0x%"UVxf
6584-
pTHX__FORMAT, PTR2UV(sv) pTHX__VALUE);
6585-
#endif
6586-
}
6587-
#ifdef DEBUG_LEAKING_SCALARS_ABORT
6588-
abort();
6589-
#endif
6590-
return;
6591-
}
6592-
if (--(SvREFCNT(sv)) > 0)
6593-
return;
6594-
Perl_sv_free2(aTHX_ sv);
6552+
SvREFCNT_dec(sv);
65956553
}
65966554

6555+
6556+
/* Private helper function for SvREFCNT_dec().
6557+
* Called with rc set to original SvREFCNT(sv), where rc == 0 or 1 */
6558+
65976559
void
6598-
Perl_sv_free2(pTHX_ SV *const sv)
6560+
Perl_sv_free2(pTHX_ SV *const sv, const U32 rc)
65996561
{
66006562
dVAR;
66016563

66026564
PERL_ARGS_ASSERT_SV_FREE2;
66036565

6566+
if (rc == 1) {
6567+
/* normal case */
6568+
SvREFCNT(sv) = 0;
6569+
66046570
#ifdef DEBUGGING
6605-
if (SvTEMP(sv)) {
6606-
Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING),
6607-
"Attempt to free temp prematurely: SV 0x%"UVxf
6608-
pTHX__FORMAT, PTR2UV(sv) pTHX__VALUE);
6609-
return;
6610-
}
6571+
if (SvTEMP(sv)) {
6572+
Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING),
6573+
"Attempt to free temp prematurely: SV 0x%"UVxf
6574+
pTHX__FORMAT, PTR2UV(sv) pTHX__VALUE);
6575+
return;
6576+
}
66116577
#endif
6578+
if (SvREADONLY(sv) && SvIMMORTAL(sv)) {
6579+
/* make sure SvREFCNT(sv)==0 happens very seldom */
6580+
SvREFCNT(sv) = (~(U32)0)/2;
6581+
return;
6582+
}
6583+
sv_clear(sv);
6584+
if (! SvREFCNT(sv)) /* may have have been resurrected */
6585+
del_SV(sv);
6586+
return;
6587+
}
6588+
6589+
/* handle exceptional cases */
6590+
6591+
assert(rc == 0);
6592+
6593+
if (SvFLAGS(sv) & SVf_BREAK)
6594+
/* this SV's refcnt has been artificially decremented to
6595+
* trigger cleanup */
6596+
return;
6597+
if (PL_in_clean_all) /* All is fair */
6598+
return;
66126599
if (SvREADONLY(sv) && SvIMMORTAL(sv)) {
6613-
/* make sure SvREFCNT(sv)==0 happens very seldom */
6614-
SvREFCNT(sv) = (~(U32)0)/2;
6615-
return;
6600+
/* make sure SvREFCNT(sv)==0 happens very seldom */
6601+
SvREFCNT(sv) = (~(U32)0)/2;
6602+
return;
66166603
}
6617-
sv_clear(sv);
6618-
if (! SvREFCNT(sv))
6619-
del_SV(sv);
6604+
if (ckWARN_d(WARN_INTERNAL)) {
6605+
#ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
6606+
Perl_dump_sv_child(aTHX_ sv);
6607+
#else
6608+
#ifdef DEBUG_LEAKING_SCALARS
6609+
sv_dump(sv);
6610+
#endif
6611+
#ifdef DEBUG_LEAKING_SCALARS_ABORT
6612+
if (PL_warnhook == PERL_WARNHOOK_FATAL
6613+
|| ckDEAD(packWARN(WARN_INTERNAL))) {
6614+
/* Don't let Perl_warner cause us to escape our fate: */
6615+
abort();
6616+
}
6617+
#endif
6618+
/* This may not return: */
6619+
Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
6620+
"Attempt to free unreferenced scalar: SV 0x%"UVxf
6621+
pTHX__FORMAT, PTR2UV(sv) pTHX__VALUE);
6622+
#endif
6623+
}
6624+
#ifdef DEBUG_LEAKING_SCALARS_ABORT
6625+
abort();
6626+
#endif
6627+
66206628
}
66216629

6630+
66226631
/*
66236632
=for apidoc sv_len
66246633

0 commit comments

Comments
 (0)