diff options
| -rw-r--r-- | dump.c | 2 | ||||
| -rw-r--r-- | ext/B/B.xs | 21 | ||||
| -rw-r--r-- | ext/B/B/Concise.pm | 11 | ||||
| -rw-r--r-- | ext/Opcode/Opcode.pm | 2 | ||||
| -rw-r--r-- | lib/B/Deparse.pm | 14 | ||||
| -rw-r--r-- | lib/B/Op_private.pm | 2 | ||||
| -rw-r--r-- | op.c | 40 | ||||
| -rw-r--r-- | op.h | 7 | ||||
| -rw-r--r-- | opcode.h | 16 | ||||
| -rw-r--r-- | opnames.h | 366 | ||||
| -rw-r--r-- | pp_hot.c | 75 | ||||
| -rw-r--r-- | pp_proto.h | 2 | ||||
| -rw-r--r-- | regen/opcodes | 2 |
13 files changed, 350 insertions, 210 deletions
@@ -956,6 +956,8 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o) case OP_HINTSEVAL: case OP_METHOD_NAMED: case OP_METHOD_SUPER: + case OP_METHOD_REDIR: + case OP_METHOD_REDIR_SUPER: #ifndef USE_ITHREADS /* with ITHREADS, consts are stored in the pad, and the right pad * may not be active here, so skip */ diff --git a/ext/B/B.xs b/ext/B/B.xs index d08750c4bf..da05cc18f2 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -751,6 +751,11 @@ struct OP_methods { { STR_WITH_LEN("first"), op_offset_special, 0, },/*53*/ { STR_WITH_LEN("meth_sv"), op_offset_special, 0, },/*54*/ { STR_WITH_LEN("pmregexp"),op_offset_special, 0, },/*55*/ +# ifdef USE_ITHREADS + { STR_WITH_LEN("rclass"), op_offset_special, 0, },/*56*/ +# else + { STR_WITH_LEN("rclass"), op_offset_special, 0, },/*56*/ +# endif #endif }; @@ -1032,6 +1037,7 @@ next(o) B::METHOP::first = 53 B::METHOP::meth_sv = 54 B::PMOP::pmregexp = 55 + B::METHOP::rclass = 56 PREINIT: SV *ret; PPCODE: @@ -1250,6 +1256,21 @@ next(o) case 55: /* B::PMOP::pmregexp */ ret = make_sv_object(aTHX_ (SV *)PM_GETRE(cPMOPo)); break; + case 56: /* B::METHOP::rclass */ +#ifdef USE_ITHREADS + ret = sv_2mortal(newSVuv( + (o->op_type == OP_METHOD_REDIR || + o->op_type == OP_METHOD_REDIR_SUPER) ? + cMETHOPx(o)->op_rclass_targ : 0 + )); +#else + ret = make_sv_object(aTHX_ + (o->op_type == OP_METHOD_REDIR || + o->op_type == OP_METHOD_REDIR_SUPER) ? + cMETHOPx(o)->op_rclass_sv : NULL + ); +#endif + break; default: croak("method %s not implemented", op_methods[ix].name); } else { diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm index dcca4af4ef..5e068b72e2 100644 --- a/ext/B/B/Concise.pm +++ b/ext/B/B/Concise.pm @@ -898,12 +898,19 @@ sub concise_op { } } elsif ($h{class} eq "METHOP") { + my $prefix = ''; + if ($h{name} eq 'method_redir' or $h{name} eq 'method_redir_super') { + my $rclass_sv = $op->rclass; + $rclass_sv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$rclass_sv] + unless ref $rclass_sv; + $prefix .= 'PACKAGE "'.$rclass_sv->PV.'", '; + } if ($h{name} ne "method") { if (${$op->meth_sv}) { - $h{arg} = "(" . concise_sv($op->meth_sv, \%h, 1) . ")"; + $h{arg} = "($prefix" . concise_sv($op->meth_sv, \%h, 1) . ")"; } else { my $sv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$op->targ]; - $h{arg} = "[" . concise_sv($sv, \%h, 1) . "]"; + $h{arg} = "[$prefix" . concise_sv($sv, \%h, 1) . "]"; $h{targarglife} = $h{targarg} = ""; } } diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm index f22f97701c..b1813e072c 100644 --- a/ext/Opcode/Opcode.pm +++ b/ext/Opcode/Opcode.pm @@ -340,7 +340,7 @@ invert_opset function. rv2cv anoncode prototype coreargs entersub leavesub leavesublv return method method_named - method_super + method_super method_redir method_redir_super -- XXX loops via recursion? leaveeval -- needed for Safe to operate, is safe diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm index 0e26aca6c7..7feb52be9c 100644 --- a/lib/B/Deparse.pm +++ b/lib/B/Deparse.pm @@ -3946,6 +3946,11 @@ sub _method { $meth = $self->meth_sv($meth)->PV; } elsif ($meth->name eq "method_super") { $meth = "SUPER::".$self->meth_sv($meth)->PV; + } elsif ($meth->name eq "method_redir") { + $meth = $self->meth_rclass_sv($meth)->PV.'::'.$self->meth_sv($meth)->PV; + } elsif ($meth->name eq "method_redir_super") { + $meth = $self->meth_rclass_sv($meth)->PV.'::SUPER::'. + $self->meth_sv($meth)->PV; } else { $meth = $meth->first; if ($meth->name eq "const") { @@ -4586,6 +4591,15 @@ sub meth_sv { return $sv; } +sub meth_rclass_sv { + my $self = shift; + my $op = shift; + my $sv = $op->rclass; + # the constant could be in the pad (under useithreads) + $sv = $self->padval($sv) unless ref $sv; + return $sv; +} + sub pp_const { my $self = shift; my($op, $cx) = @_; diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm index 55ca8b60dc..e8e63a2e32 100644 --- a/lib/B/Op_private.pm +++ b/lib/B/Op_private.pm @@ -406,6 +406,8 @@ $bits{lvavref}{0} = $bf[0]; $bits{mapwhile}{0} = $bf[0]; $bits{method}{0} = $bf[0]; $bits{method_named}{0} = $bf[0]; +$bits{method_redir}{0} = $bf[0]; +$bits{method_redir_super}{0} = $bf[0]; $bits{method_super}{0} = $bf[0]; @{$bits{mkdir}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); @{$bits{modulo}}{1,0} = ($bf[1], $bf[1]); @@ -852,6 +852,17 @@ Perl_op_clear(pTHX_ OP *o) } } break; + case OP_METHOD_REDIR: + case OP_METHOD_REDIR_SUPER: +#ifdef USE_ITHREADS + if (cMETHOPx(o)->op_rclass_targ) { + pad_swipe(cMETHOPx(o)->op_rclass_targ, 1); + cMETHOPx(o)->op_rclass_targ = 0; + } +#else + SvREFCNT_dec(cMETHOPx(o)->op_rclass_sv); + cMETHOPx(o)->op_rclass_sv = NULL; +#endif case OP_METHOD_NAMED: case OP_METHOD_SUPER: SvREFCNT_dec(cMETHOPx(o)->op_u.op_meth_sv); @@ -2234,6 +2245,8 @@ S_finalize_op(pTHX_ OP* o) /* Relocate all the METHOP's SVs to the pad for thread safety. */ case OP_METHOD_NAMED: case OP_METHOD_SUPER: + case OP_METHOD_REDIR: + case OP_METHOD_REDIR_SUPER: op_relocate_sv(&cMETHOPx(o)->op_u.op_meth_sv, &o->op_targ); break; #endif @@ -4692,6 +4705,12 @@ S_newMETHOP_internal(pTHX_ I32 type, I32 flags, OP* dynamic_meth, SV* const_meth methop->op_next = (OP*)methop; } +#ifdef USE_ITHREADS + methop->op_rclass_targ = 0; +#else + methop->op_rclass_sv = NULL; +#endif + CHANGE_TYPE(methop, type); methop = (METHOP*) CHECKOP(type, methop); @@ -10307,11 +10326,12 @@ Perl_ck_match(pTHX_ OP *o) OP * Perl_ck_method(pTHX_ OP *o) { - SV *sv, *methsv; + SV *sv, *methsv, *rclass; const char* method; char* compatptr; int utf8; STRLEN len, nsplit = 0, i; + OP* new_op; OP * const kid = cUNOPo->op_first; PERL_ARGS_ASSERT_CK_METHOD; @@ -10346,7 +10366,21 @@ Perl_ck_method(pTHX_ OP *o) return newMETHOP_named(OP_METHOD_SUPER, 0, methsv); } - return o; + /* $proto->MyClass::method() and $proto->MyClass::SUPER::method() */ + if (nsplit >= 9 && strnEQ(method+nsplit-9, "::SUPER::", 9)) { + rclass = newSVpvn_share(method, utf8*(nsplit-9), 0); + new_op = newMETHOP_named(OP_METHOD_REDIR_SUPER, 0, methsv); + } else { + rclass = newSVpvn_share(method, utf8*(nsplit-2), 0); + new_op = newMETHOP_named(OP_METHOD_REDIR, 0, methsv); + } +#ifdef USE_ITHREADS + op_relocate_sv(&rclass, &cMETHOPx(new_op)->op_rclass_targ); +#else + cMETHOPx(new_op)->op_rclass_sv = rclass; +#endif + op_free(o); + return new_op; } OP * @@ -11644,6 +11678,8 @@ Perl_ck_subr(pTHX_ OP *o) case OP_METHOD: case OP_METHOD_NAMED: case OP_METHOD_SUPER: + case OP_METHOD_REDIR: + case OP_METHOD_REDIR_SUPER: if (aop->op_type == OP_CONST) { aop->op_private &= ~OPpCONST_STRICT; const_class = &cSVOPx(aop)->op_sv; @@ -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_rclass_targ; /* pad index for redirect class */ +#else + SV* op_rclass_sv; /* static redirect class $o->A::meth() */ +#endif }; struct pmop { @@ -441,6 +446,7 @@ 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_rclass(v) PAD_SVl(cMETHOPx(v)->op_rclass_targ) #else # define cGVOPx_gv(o) ((GV*)cSVOPx(o)->op_sv) # ifndef PERL_CORE @@ -449,6 +455,7 @@ struct loop { # endif # define cSVOPx_sv(v) (cSVOPx(v)->op_sv) # define cSVOPx_svp(v) (&cSVOPx(v)->op_sv) +# define cMETHOPx_rclass(v) (cMETHOPx(v)->op_rclass_sv) #endif # define cMETHOPx_meth(v) cSVOPx_sv(v) @@ -351,6 +351,8 @@ EXTCONST char* const PL_op_name[] = { "exit", "method_named", "method_super", + "method_redir", + "method_redir_super", "entergiven", "leavegiven", "enterwhen", @@ -743,6 +745,8 @@ EXTCONST char* const PL_op_desc[] = { "exit", "method with known name", "super with known name", + "redirect method with known name", + "redirect super method with known name", "given()", "leave given block", "when()", @@ -1149,6 +1153,8 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */ Perl_pp_exit, Perl_pp_method_named, Perl_pp_method_super, + Perl_pp_method_redir, + Perl_pp_method_redir_super, Perl_pp_entergiven, Perl_pp_leavegiven, Perl_pp_enterwhen, @@ -1551,6 +1557,8 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */ Perl_ck_fun, /* exit */ Perl_ck_null, /* method_named */ Perl_ck_null, /* method_super */ + Perl_ck_null, /* method_redir */ + Perl_ck_null, /* method_redir_super */ Perl_ck_null, /* entergiven */ Perl_ck_null, /* leavegiven */ Perl_ck_null, /* enterwhen */ @@ -1947,6 +1955,8 @@ EXTCONST U32 PL_opargs[] = { 0x00009b04, /* exit */ 0x00000e40, /* method_named */ 0x00000e40, /* method_super */ + 0x00000e40, /* method_redir */ + 0x00000e40, /* method_redir_super */ 0x00000340, /* entergiven */ 0x00000100, /* leavegiven */ 0x00000340, /* enterwhen */ @@ -2569,6 +2579,8 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 48, /* exit */ 0, /* method_named */ 0, /* method_super */ + 0, /* method_redir */ + 0, /* method_redir_super */ 0, /* entergiven */ 0, /* leavegiven */ 0, /* enterwhen */ @@ -2768,7 +2780,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { */ EXTCONST U16 PL_op_private_bitdefs[] = { - 0x0003, /* scalar, prototype, refgen, srefgen, ref, readline, regcmaybe, regcreset, regcomp, chop, schop, defined, undef, study, preinc, i_preinc, predec, i_predec, postinc, i_postinc, postdec, i_postdec, negate, i_negate, not, complement, ucfirst, lcfirst, uc, lc, quotemeta, aeach, akeys, avalues, each, values, pop, shift, range, and, or, dor, andassign, orassign, dorassign, method, method_named, method_super, entergiven, leavegiven, enterwhen, leavewhen, untie, tied, dbmclose, getsockname, getpeername, lstat, stat, readlink, readdir, telldir, rewinddir, closedir, localtime, alarm, require, dofile, entertry, ghbyname, gnbyname, gpbyname, shostent, snetent, sprotoent, sservent, gpwnam, gpwuid, ggrnam, ggrgid, lock, once, reach, rvalues, fc */ + 0x0003, /* scalar, prototype, refgen, srefgen, ref, readline, regcmaybe, regcreset, regcomp, chop, schop, defined, undef, study, preinc, i_preinc, predec, i_predec, postinc, i_postinc, postdec, i_postdec, negate, i_negate, not, complement, ucfirst, lcfirst, uc, lc, quotemeta, aeach, akeys, avalues, each, values, pop, shift, range, and, or, dor, andassign, orassign, dorassign, method, method_named, method_super, method_redir, method_redir_super, entergiven, leavegiven, enterwhen, leavewhen, untie, tied, dbmclose, getsockname, getpeername, lstat, stat, readlink, readdir, telldir, rewinddir, closedir, localtime, alarm, require, dofile, entertry, ghbyname, gnbyname, gpbyname, shostent, snetent, sprotoent, sservent, gpwnam, gpwuid, ggrnam, ggrgid, lock, once, reach, rvalues, fc */ 0x281c, 0x3a19, /* pushmark */ 0x00bd, /* wantarray, runcv */ 0x03b8, 0x1490, 0x3acc, 0x3588, 0x2be5, /* const */ @@ -3043,6 +3055,8 @@ EXTCONST U8 PL_op_private_valid[] = { /* EXIT */ (OPpARG4_MASK), /* METHOD_NAMED */ (OPpARG1_MASK), /* METHOD_SUPER */ (OPpARG1_MASK), + /* METHOD_REDIR */ (OPpARG1_MASK), + /* METHOD_REDIR_SUPER */ (OPpARG1_MASK), /* ENTERGIVEN */ (OPpARG1_MASK), /* LEAVEGIVEN */ (OPpARG1_MASK), /* ENTERWHEN */ (OPpARG1_MASK), @@ -217,191 +217,193 @@ typedef enum opcode { OP_EXIT = 200, OP_METHOD_NAMED = 201, OP_METHOD_SUPER = 202, - OP_ENTERGIVEN = 203, - OP_LEAVEGIVEN = 204, - OP_ENTERWHEN = 205, - OP_LEAVEWHEN = 206, - OP_BREAK = 207, - OP_CONTINUE = 208, - OP_OPEN = 209, - OP_CLOSE = 210, - OP_PIPE_OP = 211, - OP_FILENO = 212, - OP_UMASK = 213, - OP_BINMODE = 214, - OP_TIE = 215, - OP_UNTIE = 216, - OP_TIED = 217, - OP_DBMOPEN = 218, - OP_DBMCLOSE = 219, - OP_SSELECT = 220, - OP_SELECT = 221, - OP_GETC = 222, - OP_READ = 223, - OP_ENTERWRITE = 224, - OP_LEAVEWRITE = 225, - OP_PRTF = 226, - OP_PRINT = 227, - OP_SAY = 228, - OP_SYSOPEN = 229, - OP_SYSSEEK = 230, - OP_SYSREAD = 231, - OP_SYSWRITE = 232, - OP_EOF = 233, - OP_TELL = 234, - OP_SEEK = 235, - OP_TRUNCATE = 236, - OP_FCNTL = 237, - OP_IOCTL = 238, - OP_FLOCK = 239, - OP_SEND = 240, - OP_RECV = 241, - OP_SOCKET = 242, - OP_SOCKPAIR = 243, - OP_BIND = 244, - OP_CONNECT = 245, - OP_LISTEN = 246, - OP_ACCEPT = 247, - OP_SHUTDOWN = 248, - OP_GSOCKOPT = 249, - OP_SSOCKOPT = 250, - OP_GETSOCKNAME = 251, - OP_GETPEERNAME = 252, - OP_LSTAT = 253, - OP_STAT = 254, - OP_FTRREAD = 255, - OP_FTRWRITE = 256, - OP_FTREXEC = 257, - OP_FTEREAD = 258, - OP_FTEWRITE = 259, - OP_FTEEXEC = 260, - OP_FTIS = 261, - OP_FTSIZE = 262, - OP_FTMTIME = 263, - OP_FTATIME = 264, - OP_FTCTIME = 265, - OP_FTROWNED = 266, - OP_FTEOWNED = 267, - OP_FTZERO = 268, - OP_FTSOCK = 269, - OP_FTCHR = 270, - OP_FTBLK = 271, - OP_FTFILE = 272, - OP_FTDIR = 273, - OP_FTPIPE = 274, - OP_FTSUID = 275, - OP_FTSGID = 276, - OP_FTSVTX = 277, - OP_FTLINK = 278, - OP_FTTTY = 279, - OP_FTTEXT = 280, - OP_FTBINARY = 281, - OP_CHDIR = 282, - OP_CHOWN = 283, - OP_CHROOT = 284, - OP_UNLINK = 285, - OP_CHMOD = 286, - OP_UTIME = 287, - OP_RENAME = 288, - OP_LINK = 289, - OP_SYMLINK = 290, - OP_READLINK = 291, - OP_MKDIR = 292, - OP_RMDIR = 293, - OP_OPEN_DIR = 294, - OP_READDIR = 295, - OP_TELLDIR = 296, - OP_SEEKDIR = 297, - OP_REWINDDIR = 298, - OP_CLOSEDIR = 299, - OP_FORK = 300, - OP_WAIT = 301, - OP_WAITPID = 302, - OP_SYSTEM = 303, - OP_EXEC = 304, - OP_KILL = 305, - OP_GETPPID = 306, - OP_GETPGRP = 307, - OP_SETPGRP = 308, - OP_GETPRIORITY = 309, - OP_SETPRIORITY = 310, - OP_TIME = 311, - OP_TMS = 312, - OP_LOCALTIME = 313, - OP_GMTIME = 314, - OP_ALARM = 315, - OP_SLEEP = 316, - OP_SHMGET = 317, - OP_SHMCTL = 318, - OP_SHMREAD = 319, - OP_SHMWRITE = 320, - OP_MSGGET = 321, - OP_MSGCTL = 322, - OP_MSGSND = 323, - OP_MSGRCV = 324, - OP_SEMOP = 325, - OP_SEMGET = 326, - OP_SEMCTL = 327, - OP_REQUIRE = 328, - OP_DOFILE = 329, - OP_HINTSEVAL = 330, - OP_ENTEREVAL = 331, - OP_LEAVEEVAL = 332, - OP_ENTERTRY = 333, - OP_LEAVETRY = 334, - OP_GHBYNAME = 335, - OP_GHBYADDR = 336, - OP_GHOSTENT = 337, - OP_GNBYNAME = 338, - OP_GNBYADDR = 339, - OP_GNETENT = 340, - OP_GPBYNAME = 341, - OP_GPBYNUMBER = 342, - OP_GPROTOENT = 343, - OP_GSBYNAME = 344, - OP_GSBYPORT = 345, - OP_GSERVENT = 346, - OP_SHOSTENT = 347, - OP_SNETENT = 348, - OP_SPROTOENT = 349, - OP_SSERVENT = 350, - OP_EHOSTENT = 351, - OP_ENETENT = 352, - OP_EPROTOENT = 353, - OP_ESERVENT = 354, - OP_GPWNAM = 355, - OP_GPWUID = 356, - OP_GPWENT = 357, - OP_SPWENT = 358, - OP_EPWENT = 359, - OP_GGRNAM = 360, - OP_GGRGID = 361, - OP_GGRENT = 362, - OP_SGRENT = 363, - OP_EGRENT = 364, - OP_GETLOGIN = 365, - OP_SYSCALL = 366, - OP_LOCK = 367, - OP_ONCE = 368, - OP_CUSTOM = 369, - OP_REACH = 370, - OP_RKEYS = 371, - OP_RVALUES = 372, - OP_COREARGS = 373, - OP_RUNCV = 374, - OP_FC = 375, - OP_PADCV = 376, - OP_INTROCV = 377, - OP_CLONECV = 378, - OP_PADRANGE = 379, - OP_REFASSIGN = 380, - OP_LVREF = 381, - OP_LVREFSLICE = 382, - OP_LVAVREF = 383, + OP_METHOD_REDIR = 203, + OP_METHOD_REDIR_SUPER = 204, + OP_ENTERGIVEN = 205, + OP_LEAVEGIVEN = 206, + OP_ENTERWHEN = 207, + OP_LEAVEWHEN = 208, + OP_BREAK = 209, + OP_CONTINUE = 210, + OP_OPEN = 211, + OP_CLOSE = 212, + OP_PIPE_OP = 213, + OP_FILENO = 214, + OP_UMASK = 215, + OP_BINMODE = 216, + OP_TIE = 217, + OP_UNTIE = 218, + OP_TIED = 219, + OP_DBMOPEN = 220, + OP_DBMCLOSE = 221, + OP_SSELECT = 222, + OP_SELECT = 223, + OP_GETC = 224, + OP_READ = 225, + OP_ENTERWRITE = 226, + OP_LEAVEWRITE = 227, + OP_PRTF = 228, + OP_PRINT = 229, + OP_SAY = 230, + OP_SYSOPEN = 231, + OP_SYSSEEK = 232, + OP_SYSREAD = 233, + OP_SYSWRITE = 234, + OP_EOF = 235, + OP_TELL = 236, + OP_SEEK = 237, + OP_TRUNCATE = 238, + OP_FCNTL = 239, + OP_IOCTL = 240, + OP_FLOCK = 241, + OP_SEND = 242, + OP_RECV = 243, + OP_SOCKET = 244, + OP_SOCKPAIR = 245, + OP_BIND = 246, + OP_CONNECT = 247, + OP_LISTEN = 248, + OP_ACCEPT = 249, + OP_SHUTDOWN = 250, + OP_GSOCKOPT = 251, + OP_SSOCKOPT = 252, + OP_GETSOCKNAME = 253, + OP_GETPEERNAME = 254, + OP_LSTAT = 255, + OP_STAT = 256, + OP_FTRREAD = 257, + OP_FTRWRITE = 258, + OP_FTREXEC = 259, + OP_FTEREAD = 260, + OP_FTEWRITE = 261, + OP_FTEEXEC = 262, + OP_FTIS = 263, + OP_FTSIZE = 264, + OP_FTMTIME = 265, + OP_FTATIME = 266, + OP_FTCTIME = 267, + OP_FTROWNED = 268, + OP_FTEOWNED = 269, + OP_FTZERO = 270, + OP_FTSOCK = 271, + OP_FTCHR = 272, + OP_FTBLK = 273, + OP_FTFILE = 274, + OP_FTDIR = 275, + OP_FTPIPE = 276, + OP_FTSUID = 277, + OP_FTSGID = 278, + OP_FTSVTX = 279, + OP_FTLINK = 280, + OP_FTTTY = 281, + OP_FTTEXT = 282, + OP_FTBINARY = 283, + OP_CHDIR = 284, + OP_CHOWN = 285, + OP_CHROOT = 286, + OP_UNLINK = 287, + OP_CHMOD = 288, + OP_UTIME = 289, + OP_RENAME = 290, + OP_LINK = 291, + OP_SYMLINK = 292, + OP_READLINK = 293, + OP_MKDIR = 294, + OP_RMDIR = 295, + OP_OPEN_DIR = 296, + OP_READDIR = 297, + OP_TELLDIR = 298, + OP_SEEKDIR = 299, + OP_REWINDDIR = 300, + OP_CLOSEDIR = 301, + OP_FORK = 302, + OP_WAIT = 303, + OP_WAITPID = 304, + OP_SYSTEM = 305, + OP_EXEC = 306, + OP_KILL = 307, + OP_GETPPID = 308, + OP_GETPGRP = 309, + OP_SETPGRP = 310, + OP_GETPRIORITY = 311, + OP_SETPRIORITY = 312, + OP_TIME = 313, + OP_TMS = 314, + OP_LOCALTIME = 315, + OP_GMTIME = 316, + OP_ALARM = 317, + OP_SLEEP = 318, + OP_SHMGET = 319, + OP_SHMCTL = 320, + OP_SHMREAD = 321, + OP_SHMWRITE = 322, + OP_MSGGET = 323, + OP_MSGCTL = 324, + OP_MSGSND = 325, + OP_MSGRCV = 326, + OP_SEMOP = 327, + OP_SEMGET = 328, + OP_SEMCTL = 329, + OP_REQUIRE = 330, + OP_DOFILE = 331, + OP_HINTSEVAL = 332, + OP_ENTEREVAL = 333, + OP_LEAVEEVAL = 334, + OP_ENTERTRY = 335, + OP_LEAVETRY = 336, + OP_GHBYNAME = 337, + OP_GHBYADDR = 338, + OP_GHOSTENT = 339, + OP_GNBYNAME = 340, + OP_GNBYADDR = 341, + OP_GNETENT = 342, + OP_GPBYNAME = 343, + OP_GPBYNUMBER = 344, + OP_GPROTOENT = 345, + OP_GSBYNAME = 346, + OP_GSBYPORT = 347, + OP_GSERVENT = 348, + OP_SHOSTENT = 349, + OP_SNETENT = 350, + OP_SPROTOENT = 351, + OP_SSERVENT = 352, + OP_EHOSTENT = 353, + OP_ENETENT = 354, + OP_EPROTOENT = 355, + OP_ESERVENT = 356, + OP_GPWNAM = 357, + OP_GPWUID = 358, + OP_GPWENT = 359, + OP_SPWENT = 360, + OP_EPWENT = 361, + OP_GGRNAM = 362, + OP_GGRGID = 363, + OP_GGRENT = 364, + OP_SGRENT = 365, + OP_EGRENT = 366, + OP_GETLOGIN = 367, + OP_SYSCALL = 368, + OP_LOCK = 369, + OP_ONCE = 370, + OP_CUSTOM = 371, + OP_REACH = 372, + OP_RKEYS = 373, + OP_RVALUES = 374, + OP_COREARGS = 375, + OP_RUNCV = 376, + OP_FC = 377, + OP_PADCV = 378, + OP_INTROCV = 379, + OP_CLONECV = 380, + OP_PADRANGE = 381, + OP_REFASSIGN = 382, + OP_LVREF = 383, + OP_LVREFSLICE = 384, + OP_LVAVREF = 385, OP_max } opcode; -#define MAXO 384 +#define MAXO 386 #define OP_FREED MAXO /* the OP_IS_* macros are optimized to a simple range check because @@ -3083,6 +3083,18 @@ PP(pp_method) RETURN; } +#define METHOD_CHECK_CACHE(stash,cache,meth) \ + const HE* const he = hv_fetch_ent(cache, meth, 0, 0); \ + if (he) { \ + gv = MUTABLE_GV(HeVAL(he)); \ + if (isGV(gv) && GvCV(gv) && (!GvCVGEN(gv) || GvCVGEN(gv) \ + == (PL_sub_generation + HvMROMETA(stash)->cache_gen))) \ + { \ + XPUSHs(MUTABLE_SV(GvCV(gv))); \ + RETURN; \ + } \ + } \ + PP(pp_method_named) { dSP; @@ -3091,17 +3103,7 @@ PP(pp_method_named) HV* const stash = opmethod_stash(meth); if (LIKELY(SvTYPE(stash) == SVt_PVHV)) { - const HE* const he = hv_fetch_ent(stash, meth, 0, 0); - if (he) { - gv = MUTABLE_GV(HeVAL(he)); - if (isGV(gv) && GvCV(gv) && - (!GvCVGEN(gv) || GvCVGEN(gv) - == (PL_sub_generation + HvMROMETA(stash)->cache_gen))) - { - XPUSHs(MUTABLE_SV(GvCV(gv))); - RETURN; - } - } + METHOD_CHECK_CACHE(stash, stash, meth); } gv = gv_fetchmethod_sv_flags(stash, meth, GV_AUTOLOAD|GV_CROAK); @@ -3124,17 +3126,46 @@ PP(pp_method_super) opmethod_stash(meth); if ((cache = HvMROMETA(stash)->super)) { - const HE* const he = hv_fetch_ent(cache, meth, 0, 0); - if (he) { - gv = MUTABLE_GV(HeVAL(he)); - if (isGV(gv) && GvCV(gv) && - (!GvCVGEN(gv) || GvCVGEN(gv) - == (PL_sub_generation + HvMROMETA(stash)->cache_gen))) - { - XPUSHs(MUTABLE_SV(GvCV(gv))); - RETURN; - } - } + METHOD_CHECK_CACHE(stash, cache, meth); + } + + gv = gv_fetchmethod_sv_flags(stash, meth, GV_AUTOLOAD|GV_CROAK|GV_SUPER); + assert(gv); + + XPUSHs(isGV(gv) ? MUTABLE_SV(GvCV(gv)) : MUTABLE_SV(gv)); + RETURN; +} + +PP(pp_method_redir) +{ + dSP; + GV* gv; + SV* const meth = cMETHOPx_meth(PL_op); + HV* stash = gv_stashsv(cMETHOPx_rclass(PL_op), 0); + opmethod_stash(meth); /* not used but needed for error checks */ + + if (stash) { METHOD_CHECK_CACHE(stash, stash, meth); } + else stash = MUTABLE_HV(cMETHOPx_rclass(PL_op)); + + gv = gv_fetchmethod_sv_flags(stash, meth, GV_AUTOLOAD|GV_CROAK); + assert(gv); + + XPUSHs(isGV(gv) ? MUTABLE_SV(GvCV(gv)) : MUTABLE_SV(gv)); + RETURN; +} + +PP(pp_method_redir_super) +{ + dSP; + GV* gv; + HV* cache; + SV* const meth = cMETHOPx_meth(PL_op); + HV* stash = gv_stashsv(cMETHOPx_rclass(PL_op), 0); + opmethod_stash(meth); /* not used but needed for error checks */ + + if (UNLIKELY(!stash)) stash = MUTABLE_HV(cMETHOPx_rclass(PL_op)); + else if ((cache = HvMROMETA(stash)->super)) { + METHOD_CHECK_CACHE(stash, cache, meth); } gv = gv_fetchmethod_sv_flags(stash, meth, GV_AUTOLOAD|GV_CROAK|GV_SUPER); diff --git a/pp_proto.h b/pp_proto.h index 781050a865..6959357dd2 100644 --- a/pp_proto.h +++ b/pp_proto.h @@ -152,6 +152,8 @@ PERL_CALLCONV OP *Perl_pp_mapwhile(pTHX); PERL_CALLCONV OP *Perl_pp_match(pTHX); PERL_CALLCONV OP *Perl_pp_method(pTHX); PERL_CALLCONV OP *Perl_pp_method_named(pTHX); +PERL_CALLCONV OP *Perl_pp_method_redir(pTHX); +PERL_CALLCONV OP *Perl_pp_method_redir_super(pTHX); PERL_CALLCONV OP *Perl_pp_method_super(pTHX); PERL_CALLCONV OP *Perl_pp_mkdir(pTHX); PERL_CALLCONV OP *Perl_pp_modulo(pTHX); diff --git a/regen/opcodes b/regen/opcodes index f46264d2e1..62c3b45e70 100644 --- a/regen/opcodes +++ b/regen/opcodes @@ -309,6 +309,8 @@ goto goto ck_null s} exit exit ck_fun s% S? method_named method with known name ck_null d. method_super super with known name ck_null d. +method_redir redirect method with known name ck_null d. +method_redir_super redirect super method with known name ck_null d. entergiven given() ck_null d| leavegiven leave given block ck_null 1 |