In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/e3384dcea386322f748cca779e4b8d80c8644024?hp=3ea8bc937be5cc09bfcc0beabb3ac6c672b01b67>
- Log ----------------------------------------------------------------- commit e3384dcea386322f748cca779e4b8d80c8644024 Author: syber <[email protected]> Date: Sun Nov 23 02:30:32 2014 +0300 op_class_sv removed for threaded perls op_class_targ removed for non-threaded perls M op.c M op.h commit b55b14d0f234ed20e6c2a0b6fd8609fa418cddf3 Author: syber <[email protected]> Date: Fri Nov 21 20:21:00 2014 +0300 This commit speeds up class method calls when class name is constant. I.e. MyClass->method() and MyClass->$dynamic_method() By about 30%. It was done by saving class name (as shared COW string) in METHOP and later checking it in method_common(). If it was set, then it fetches stash via gv_stashsv using precomputed hash value instead of falling into a bunch of conditions and fetching stash without hash value. M op.c M op.h M pp_hot.c ----------------------------------------------------------------------- Summary of changes: op.c | 62 +++++++++++++++++++++++++++++++++++++++++++++++++++----------- op.h | 8 ++++++++ pp_hot.c | 14 ++++++++++---- 3 files changed, 69 insertions(+), 15 deletions(-) diff --git a/op.c b/op.c index 104d30f..d44a7ea 100644 --- a/op.c +++ b/op.c @@ -862,6 +862,16 @@ 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: @@ -4682,6 +4692,11 @@ 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); @@ -11576,6 +11591,7 @@ Perl_ck_subr(pTHX_ OP *o) OP *aop, *cvop; CV *cv; GV *namegv; + SV *const_class = NULL; PERL_ARGS_ASSERT_CK_SUBR; @@ -11592,17 +11608,41 @@ Perl_ck_subr(pTHX_ OP *o) o->op_private |= (PL_hints & HINT_STRICT_REFS); if (PERLDB_SUB && PL_curstash != PL_debstash) o->op_private |= OPpENTERSUB_DB; - if (cvop->op_type == OP_RV2CV) { - o->op_private |= (cvop->op_private & OPpENTERSUB_AMPER); - op_null(cvop); - } else if (cvop->op_type == OP_METHOD || cvop->op_type == OP_METHOD_NAMED) { - if (aop->op_type == OP_CONST) - aop->op_private &= ~OPpCONST_STRICT; - 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; - } + switch (cvop->op_type) { + case OP_RV2CV: + o->op_private |= (cvop->op_private & OPpENTERSUB_AMPER); + op_null(cvop); + break; + case OP_METHOD: + case OP_METHOD_NAMED: + if (aop->op_type == OP_CONST) { + aop->op_private &= ~OPpCONST_STRICT; + 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; + } + } + /* cache const class' name to speedup class method calls */ + if (const_class) { + STRLEN len; + SV* shared; + const char* str = SvPV(const_class, len); + if (len) { + 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 + } + } + break; } if (!cv) { diff --git a/op.h b/op.h index e4fadf6..f0abfac 100644 --- a/op.h +++ b/op.h @@ -202,6 +202,11 @@ 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 { @@ -441,6 +446,8 @@ 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 @@ -449,6 +456,7 @@ 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 4908525..8ec576a 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -3006,15 +3006,21 @@ S_method_common(pTHX_ SV* meth, U32* hashp) SV* ob; GV* gv; HV* stash; - SV *packsv = NULL; - SV * const sv = PL_stack_base + TOPMARK == PL_stack_sp + SV *packsv = NULL, *const_class, *sv; + + 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 ? (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", -- Perl5 Master Repository
