diff options
| -rw-r--r-- | op.c | 52 | ||||
| -rw-r--r-- | op.h | 5 | ||||
| -rw-r--r-- | pp_hot.c | 14 |
3 files changed, 56 insertions, 15 deletions
@@ -862,6 +862,14 @@ Perl_op_clear(pTHX_ OP *o) o->op_targ = 0; } #endif + case OP_METHOD: + SvREFCNT_dec(cMETHOPx(o)->op_class_sv); +#ifdef USE_ITHREADS + if (cMETHOPx(o)->op_class_targ) { + pad_swipe(cMETHOPx(o)->op_class_targ, 1); + cMETHOPx(o)->op_class_targ = 0; + } +#endif break; case OP_CONST: case OP_HINTSEVAL: @@ -2230,6 +2238,9 @@ S_finalize_op(pTHX_ OP* o) /* Relocate all the METHOP's SVs to the pad for thread safety. */ case OP_METHOD_NAMED: op_relocate_sv(&cMETHOPx(o)->op_u.op_meth_sv, &o->op_targ); + case OP_METHOD: + if (cMETHOPx(o)->op_class_sv) + op_relocate_sv(&cMETHOPx(o)->op_class_sv, &cMETHOPx(o)->op_class_targ); break; #endif @@ -4682,6 +4693,8 @@ S_newMETHOP_internal(pTHX_ I32 type, I32 flags, OP* dynamic_meth, SV* const_meth methop->op_next = (OP*)methop; } + methop->op_class_sv = NULL; + methop->op_class_targ = 0; CHANGE_TYPE(methop, type); methop = (METHOP*) CHECKOP(type, methop); @@ -11576,6 +11589,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 +11606,33 @@ 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; + const char* str = SvPV(const_class, len); + if (len) cMETHOPx(cvop)->op_class_sv = newSVpvn_share( + str, SvUTF8(const_class) ? -len : len, 0 + ); + } + break; } if (!cv) { @@ -202,6 +202,8 @@ struct methop { OP* op_first; /* optree for method name */ SV* op_meth_sv; /* static method name */ } op_u; + SV* op_class_sv; /* static class name */ + PADOFFSET op_class_targ; /* pad index for class name if threaded */ }; struct pmop { @@ -441,6 +443,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) : cMETHOPx(v)->op_class_sv) #else # define cGVOPx_gv(o) ((GV*)cSVOPx(o)->op_sv) # ifndef PERL_CORE @@ -449,6 +453,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) @@ -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", |