In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/52ec28d5ff5fcb874bd7ffac4db0609315227668?hp=3028eff14993a097a4926fa6b0b6058cabb9abd3>
- Log ----------------------------------------------------------------- commit 52ec28d5ff5fcb874bd7ffac4db0609315227668 Author: Daniel Dragan <[email protected]> Date: Wed Oct 29 02:56:16 2014 -0400 refactor Perl_cv_undef_flags On VC 2003 32bits size of this function decreased from 0x321 bytes of machine code to 0x2d8. cv.h: - partially reorder Cv* macros to match XPVCV member order - create CvDEPTHunsafe which never uses SV head except for SvANY ptr since Perl_cv_undef_flags uses a fake SV head pad.c - remove var slabbed, frees a C auto/non-vol register, there are only 2 uses, on CvSTART branch, CvFLAGS is reused frm CvISXSUB test by optimizer - use a CV struct to fake a CV, to avoid rereading SvANY ptr after each func call, CVs can't be upgraded or have their bodies realloced - dont write NULL to CvFILE if CvFILE is NULL, also move NULL assignment so CPU address generation can be reused by compiler - refactor CvROOT/CvSTART/CvXSUB freeing conditionals to simplify code and dont check CvISXSUB twice - CvDEPTH requires a real CV*/CV*, since it checks the SV head with an assert, use CvDEPTHunsafe instead, and inline the assert using the real CV*. Also move runtime, non-debug "SvTYPE(cv) == SVt_PVCV" check to debug builds per ML post "about FC commit "CV-based slab allocation for ops"" - Perl_croak->Perl_croak_nocontext, remove push arg my_perl instruction - refactor CvPADLIST freeing for provision for future XSUB sub usage of CvPADLIST in a union - in CvOUTSIDE freeing, move NULL assignment so CPU address generation can be reused by compiler ----------------------------------------------------------------------- Summary of changes: cv.h | 9 +++-- pad.c | 118 ++++++++++++++++++++++++++++++++++++++---------------------------- 2 files changed, 74 insertions(+), 53 deletions(-) diff --git a/cv.h b/cv.h index 7f6dea2..2068ca0 100644 --- a/cv.h +++ b/cv.h @@ -62,10 +62,13 @@ See L<perlguts/Autoloading with XSUBs>. #endif #define CvFILEGV(sv) (gv_fetchfile(CvFILE(sv))) #define CvDEPTH(sv) (*S_CvDEPTHp((const CV *)sv)) -#define CvPADLIST(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_padlist -#define CvOUTSIDE(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_outside -#define CvFLAGS(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_flags +/* For use when you only have a XPVCV*, not a real CV*. + Must be assert protected as in S_CvDEPTHp before use. */ +#define CvDEPTHunsafe(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_depth +#define CvPADLIST(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_padlist +#define CvOUTSIDE(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_outside #define CvOUTSIDE_SEQ(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_outside_seq +#define CvFLAGS(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_flags /* These two are sometimes called on non-CVs */ #define CvPROTO(sv) \ diff --git a/pad.c b/pad.c index 3981ac1..309418c 100644 --- a/pad.c +++ b/pad.c @@ -326,8 +326,10 @@ Perl_cv_undef(pTHX_ CV *cv) void Perl_cv_undef_flags(pTHX_ CV *cv, U32 flags) { - const PADLIST *padlist = CvPADLIST(cv); - bool const slabbed = !!CvSLABBED(cv); + CV cvbody;/*CV body will never be realloced inside this func, + so dont read it more than once, use fake CV so existing macros + will work, the indirection and CV head struct optimized away*/ + SvANY(&cvbody) = SvANY(cv); PERL_ARGS_ASSERT_CV_UNDEF_FLAGS; @@ -336,46 +338,59 @@ Perl_cv_undef_flags(pTHX_ CV *cv, U32 flags) PTR2UV(cv), PTR2UV(PL_comppad)) ); - if (CvFILE(cv) && CvDYNFILE(cv)) { - Safefree(CvFILE(cv)); + if (CvFILE(&cvbody)) { + char * file = CvFILE(&cvbody); + CvFILE(&cvbody) = NULL; + if(CvDYNFILE(&cvbody)) + Safefree(file); } - CvFILE(cv) = NULL; - CvSLABBED_off(cv); - if (!CvISXSUB(cv) && CvROOT(cv)) { - if (SvTYPE(cv) == SVt_PVCV && CvDEPTH(cv)) - Perl_croak(aTHX_ "Can't undef active subroutine"); - ENTER; - - PAD_SAVE_SETNULLPAD(); - - if (slabbed) OpslabREFCNT_dec_padok(OpSLAB(CvROOT(cv))); - op_free(CvROOT(cv)); - CvROOT(cv) = NULL; - CvSTART(cv) = NULL; - LEAVE; - } - else if (slabbed && CvSTART(cv)) { - ENTER; - PAD_SAVE_SETNULLPAD(); - - /* discard any leaked ops */ - if (PL_parser) - parser_free_nexttoke_ops(PL_parser, (OPSLAB *)CvSTART(cv)); - opslab_force_free((OPSLAB *)CvSTART(cv)); - CvSTART(cv) = NULL; - - LEAVE; - } + /* CvSLABBED_off(&cvbody); *//* turned off below */ + /* release the sub's body */ + if (!CvISXSUB(&cvbody)) { + if(CvROOT(&cvbody)) { + assert(SvTYPE(cv) == SVt_PVCV || SvTYPE(cv) == SVt_PVFM); /*unsafe is safe */ + if (CvDEPTHunsafe(&cvbody)) { + assert(SvTYPE(cv) == SVt_PVCV); + Perl_croak_nocontext("Can't undef active subroutine"); + } + ENTER; + + PAD_SAVE_SETNULLPAD(); + + if (CvSLABBED(&cvbody)) OpslabREFCNT_dec_padok(OpSLAB(CvROOT(&cvbody))); + op_free(CvROOT(&cvbody)); + CvROOT(&cvbody) = NULL; + CvSTART(&cvbody) = NULL; + LEAVE; + } + else if (CvSLABBED(&cvbody)) { + if( CvSTART(&cvbody)) { + ENTER; + PAD_SAVE_SETNULLPAD(); + + /* discard any leaked ops */ + if (PL_parser) + parser_free_nexttoke_ops(PL_parser, (OPSLAB *)CvSTART(&cvbody)); + opslab_force_free((OPSLAB *)CvSTART(&cvbody)); + CvSTART(&cvbody) = NULL; + + LEAVE; + } #ifdef DEBUGGING - else if (slabbed) Perl_warn(aTHX_ "Slab leaked from cv %p", (void*)cv); + else Perl_warn(aTHX_ "Slab leaked from cv %p", (void*)cv); #endif + } + } + else { /* dont bother checking if CvXSUB(cv) is true, less branching */ + CvXSUB(&cvbody) = NULL; + } SvPOK_off(MUTABLE_SV(cv)); /* forget prototype */ sv_unmagic((SV *)cv, PERL_MAGIC_checkcall); if (!(flags & CV_UNDEF_KEEP_NAME)) { - if (CvNAMED(cv)) { - CvNAME_HEK_set(cv, NULL); - CvNAMED_off(cv); + if (CvNAMED(&cvbody)) { + CvNAME_HEK_set(&cvbody, NULL); + CvNAMED_off(&cvbody); } else CvGV_set(cv, NULL); } @@ -383,8 +398,9 @@ Perl_cv_undef_flags(pTHX_ CV *cv, U32 flags) /* This statement and the subsequence if block was pad_undef(). */ pad_peg("pad_undef"); - if (padlist) { + if (!CvISXSUB(&cvbody) && CvPADLIST(&cvbody)) { I32 ix; + const PADLIST *padlist = CvPADLIST(&cvbody); /* Free the padlist associated with a CV. If parts of it happen to be current, we null the relevant PL_*pad* @@ -404,8 +420,8 @@ Perl_cv_undef_flags(pTHX_ CV *cv, U32 flags) * children, or integrate this loop with general cleanup */ if (PL_phase != PERL_PHASE_DESTRUCT) { /* don't bother during global destruction */ - CV * const outercv = CvOUTSIDE(cv); - const U32 seq = CvOUTSIDE_SEQ(cv); + CV * const outercv = CvOUTSIDE(&cvbody); + const U32 seq = CvOUTSIDE_SEQ(&cvbody); PAD * const comppad_name = PadlistARRAY(padlist)[0]; SV ** const namepad = AvARRAY(comppad_name); PAD * const comppad = PadlistARRAY(padlist)[1]; @@ -463,27 +479,29 @@ Perl_cv_undef_flags(pTHX_ CV *cv, U32 flags) } if (PadlistARRAY(padlist)) Safefree(PadlistARRAY(padlist)); Safefree(padlist); - CvPADLIST(cv) = NULL; + CvPADLIST(&cvbody) = NULL; } + else /* future union */ + CvPADLIST(&cvbody) = NULL; /* remove CvOUTSIDE unless this is an undef rather than a free */ - if (!SvREFCNT(cv) && CvOUTSIDE(cv)) { - if (!CvWEAKOUTSIDE(cv)) - SvREFCNT_dec(CvOUTSIDE(cv)); - CvOUTSIDE(cv) = NULL; - } - if (CvCONST(cv)) { - SvREFCNT_dec(MUTABLE_SV(CvXSUBANY(cv).any_ptr)); - CvCONST_off(cv); + if (!SvREFCNT(cv)) { + CV * outside = CvOUTSIDE(&cvbody); + if(outside) { + CvOUTSIDE(&cvbody) = NULL; + if (!CvWEAKOUTSIDE(&cvbody)) + SvREFCNT_dec_NN(outside); + } } - if (CvISXSUB(cv) && CvXSUB(cv)) { - CvXSUB(cv) = NULL; + if (CvCONST(&cvbody)) { + SvREFCNT_dec(MUTABLE_SV(CvXSUBANY(&cvbody).any_ptr)); + /* CvCONST_off(cv); *//* turned off below */ } /* delete all flags except WEAKOUTSIDE and CVGV_RC, which indicate the * ref status of CvOUTSIDE and CvGV, and ANON, NAMED and * LEXICAL, which are used to determine the sub's name. */ - CvFLAGS(cv) &= (CVf_WEAKOUTSIDE|CVf_CVGV_RC|CVf_ANON|CVf_LEXICAL + CvFLAGS(&cvbody) &= (CVf_WEAKOUTSIDE|CVf_CVGV_RC|CVf_ANON|CVf_LEXICAL |CVf_NAMED); } -- Perl5 Master Repository
