diff options
| -rw-r--r-- | embed.fnc | 4 | ||||
| -rw-r--r-- | inline.h | 11 | ||||
| -rw-r--r-- | proto.h | 2 | ||||
| -rw-r--r-- | sv.c | 121 |
4 files changed, 72 insertions, 66 deletions
@@ -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 @@ -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); } } @@ -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) @@ -6549,76 +6549,85 @@ Normally called via a wrapper macro C<SvREFCNT_dec>. 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 |