In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/d648ffcb179b885089e064ec1d58c60027c80915?hp=f5fdb0259d5e9470e8291544a8b209e202d36334>
- Log ----------------------------------------------------------------- commit d648ffcb179b885089e064ec1d58c60027c80915 Author: syber <[email protected]> Date: Mon Nov 24 18:55:15 2014 +0300 Remove op_const_class; just use the name on the stack Instead of storing the class name in the op_const_class field of the METHOP in addition to pushing it on to the stack, just use the item on the stack. This also makes $class->method faster if $class is already a shared hash string. ----------------------------------------------------------------------- Summary of changes: op.c | 40 +++++++++++----------------------------- op.h | 8 -------- pp_hot.c | 20 ++++++++++---------- 3 files changed, 21 insertions(+), 47 deletions(-) diff --git a/op.c b/op.c index 0bb4140..6489267 100644 --- a/op.c +++ b/op.c @@ -862,16 +862,6 @@ Perl_op_clear(pTHX_ OP *o) o->op_targ = 0; } #endif - case OP_METHOD: -#ifdef USE_ITHREADS - if (cMETHOPx(o)->op_class_targ) { - pad_swipe(cMETHOPx(o)->op_class_targ, 1); - cMETHOPx(o)->op_class_targ = 0; - } -#else - SvREFCNT_dec(cMETHOPx(o)->op_class_sv); - cMETHOPx(o)->op_class_sv = NULL; -#endif break; case OP_CONST: case OP_HINTSEVAL: @@ -4692,11 +4682,6 @@ S_newMETHOP_internal(pTHX_ I32 type, I32 flags, OP* dynamic_meth, SV* const_meth methop->op_next = (OP*)methop; } -#ifdef USE_ITHREADS - methop->op_class_targ = 0; -#else - methop->op_class_sv = NULL; -#endif CHANGE_TYPE(methop, type); methop = (METHOP*) CHECKOP(type, methop); @@ -11592,7 +11577,7 @@ Perl_ck_subr(pTHX_ OP *o) OP *aop, *cvop; CV *cv; GV *namegv; - SV *const_class = NULL; + SV **const_class = NULL; PERL_ARGS_ASSERT_CK_SUBR; @@ -11618,29 +11603,26 @@ Perl_ck_subr(pTHX_ OP *o) case OP_METHOD_NAMED: if (aop->op_type == OP_CONST) { aop->op_private &= ~OPpCONST_STRICT; - const_class = cSVOPx(aop)->op_sv; + const_class = &cSVOPx(aop)->op_sv; } else if (aop->op_type == OP_LIST) { OP * const sib = OP_SIBLING(((UNOP*)aop)->op_first); if (sib && sib->op_type == OP_CONST) { sib->op_private &= ~OPpCONST_STRICT; - const_class = cSVOPx(sib)->op_sv; + const_class = &cSVOPx(sib)->op_sv; } } - /* cache const class' name to speedup class method calls */ - if (const_class) { + /* make class name a shared cow string to speedup method calls */ + /* constant string might be replaced with object, f.e. bigint */ + if (const_class && !SvROK(*const_class)) { STRLEN len; - SV* shared; - const char* str = SvPV(const_class, len); + const char* str = SvPV(*const_class, len); if (len) { - shared = newSVpvn_share( - str, SvUTF8(const_class) ? -len : len, 0 + SV* const shared = newSVpvn_share( + str, SvUTF8(*const_class) ? -len : len, 0 ); -#ifdef USE_ITHREADS - op_relocate_sv(&shared, &cMETHOPx(cvop)->op_class_targ); -#else - cMETHOPx(cvop)->op_class_sv = shared; -#endif + SvREFCNT_dec(*const_class); + *const_class = shared; } } break; diff --git a/op.h b/op.h index f0abfac..e4fadf6 100644 --- a/op.h +++ b/op.h @@ -202,11 +202,6 @@ struct methop { OP* op_first; /* optree for method name */ SV* op_meth_sv; /* static method name */ } op_u; -#ifdef USE_ITHREADS - PADOFFSET op_class_targ; /* pad index for class name if threaded */ -#else - SV* op_class_sv; /* static class name */ -#endif }; struct pmop { @@ -446,8 +441,6 @@ struct loop { ? cSVOPx(v)->op_sv : PAD_SVl((v)->op_targ)) # define cSVOPx_svp(v) (cSVOPx(v)->op_sv \ ? &cSVOPx(v)->op_sv : &PAD_SVl((v)->op_targ)) -# define cMETHOPx_class(v) (cMETHOPx(v)->op_class_targ ? \ - PAD_SVl(cMETHOPx(v)->op_class_targ) : NULL) #else # define cGVOPx_gv(o) ((GV*)cSVOPx(o)->op_sv) # ifndef PERL_CORE @@ -456,7 +449,6 @@ struct loop { # endif # define cSVOPx_sv(v) (cSVOPx(v)->op_sv) # define cSVOPx_svp(v) (&cSVOPx(v)->op_sv) -# define cMETHOPx_class(v) (cMETHOPx(v)->op_class_sv) #endif # define cMETHOPx_meth(v) cSVOPx_sv(v) diff --git a/pp_hot.c b/pp_hot.c index 8ec576a..cde1d9f 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -3006,27 +3006,27 @@ S_method_common(pTHX_ SV* meth, U32* hashp) SV* ob; GV* gv; HV* stash; - SV *packsv = NULL, *const_class, *sv; + SV *packsv = NULL; - PERL_ARGS_ASSERT_METHOD_COMMON; - - if ((const_class = cMETHOPx_class(PL_op))) { - stash = gv_stashsv(const_class, GV_CACHE_ONLY); - if (stash) goto fetch; - } - - sv = PL_stack_base + TOPMARK == PL_stack_sp + SV* const sv = PL_stack_base + TOPMARK == PL_stack_sp ? (Perl_croak(aTHX_ "Can't call method \"%"SVf"\" without a " "package or object reference", SVfARG(meth)), (SV *)NULL) : *(PL_stack_base + TOPMARK + 1); + PERL_ARGS_ASSERT_METHOD_COMMON; + if (UNLIKELY(!sv)) undefined: Perl_croak(aTHX_ "Can't call method \"%"SVf"\" on an undefined value", SVfARG(meth)); - SvGETMAGIC(sv); + if (UNLIKELY(SvGMAGICAL(sv))) mg_get(sv); + else if (SvIsCOW_shared_hash(sv)) { /* MyClass->meth() */ + stash = gv_stashsv(sv, GV_CACHE_ONLY); + if (stash) goto fetch; + } + if (SvROK(sv)) ob = MUTABLE_SV(SvRV(sv)); else if (!SvOK(sv)) goto undefined; -- Perl5 Master Repository
