Skip to content

Commit

Permalink
Remove op_const_class; just use the name on the stack
Browse files Browse the repository at this point in the history
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.
  • Loading branch information
syber authored and Father Chrysostomos committed Nov 25, 2014
1 parent f5fdb02 commit d648ffc
Show file tree
Hide file tree
Showing 3 changed files with 21 additions and 47 deletions.
40 changes: 11 additions & 29 deletions op.c
Original file line number Diff line number Diff line change
Expand Up @@ -861,16 +861,6 @@ Perl_op_clear(pTHX_ OP *o)
pad_swipe(o->op_targ, 1);
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:
Expand Down Expand Up @@ -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);

Expand Down Expand Up @@ -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;

Expand All @@ -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;
Expand Down
8 changes: 0 additions & 8 deletions op.h
Original file line number Diff line number Diff line change
Expand Up @@ -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 {
Expand Down Expand Up @@ -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
Expand All @@ -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)
Expand Down
20 changes: 10 additions & 10 deletions pp_hot.c
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down

0 comments on commit d648ffc

Please sign in to comment.