diff options
| -rw-r--r-- | dump.c | 1 | ||||
| -rw-r--r-- | embed.fnc | 2 | ||||
| -rw-r--r-- | embed.h | 2 | ||||
| -rw-r--r-- | ext/B/B/Concise.pm | 4 | ||||
| -rw-r--r-- | ext/Opcode/Opcode.pm | 4 | ||||
| -rw-r--r-- | lib/B/Deparse.pm | 4 | ||||
| -rw-r--r-- | lib/B/Op_private.pm | 1 | ||||
| -rw-r--r-- | op.c | 43 | ||||
| -rw-r--r-- | opcode.h | 9 | ||||
| -rw-r--r-- | opnames.h | 365 | ||||
| -rw-r--r-- | pp_hot.c | 140 | ||||
| -rw-r--r-- | pp_proto.h | 1 | ||||
| -rw-r--r-- | proto.h | 5 | ||||
| -rw-r--r-- | regen/opcodes | 1 |
14 files changed, 324 insertions, 258 deletions
@@ -955,6 +955,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o) case OP_CONST: case OP_HINTSEVAL: case OP_METHOD_NAMED: + case OP_METHOD_SUPER: #ifndef USE_ITHREADS /* with ITHREADS, consts are stored in the pad, and the right pad * may not be active here, so skip */ @@ -2047,7 +2047,7 @@ s |OP* |do_smartmatch |NULLOK HV* seen_this \ #if defined(PERL_IN_PP_HOT_C) s |void |do_oddball |NN SV **oddkey|NN SV **firstkey -sR |SV* |method_common |NN SV* meth|NULLOK U32* hashp +i |HV* |opmethod_stash |NN SV* meth #endif #if defined(PERL_IN_PP_SORT_C) @@ -1604,7 +1604,7 @@ # endif # if defined(PERL_IN_PP_HOT_C) #define do_oddball(a,b) S_do_oddball(aTHX_ a,b) -#define method_common(a,b) S_method_common(aTHX_ a,b) +#define opmethod_stash(a) S_opmethod_stash(aTHX_ a) # endif # if defined(PERL_IN_PP_PACK_C) #define bytes_to_uni S_bytes_to_uni diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm index 406327fc57..bc236a4bb7 100644 --- a/ext/B/B/Concise.pm +++ b/ext/B/B/Concise.pm @@ -14,7 +14,7 @@ use warnings; # uses #3 and #4, since warnings uses Carp use Exporter (); # use #5 -our $VERSION = "0.995"; +our $VERSION = "0.996"; our @ISA = qw(Exporter); our @EXPORT_OK = qw( set_style set_style_standard add_callback concise_subref concise_cv concise_main @@ -891,7 +891,7 @@ sub concise_op { } } elsif ($h{class} eq "METHOP") { - if ($h{name} eq "method_named") { + if ($h{name} ne "method") { if (${$op->meth_sv}) { $h{arg} = "(" . concise_sv($op->meth_sv, \%h, 1) . ")"; } else { diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm index 7256126227..853795355f 100644 --- a/ext/Opcode/Opcode.pm +++ b/ext/Opcode/Opcode.pm @@ -6,7 +6,7 @@ use strict; our($VERSION, @ISA, @EXPORT_OK); -$VERSION = "1.29"; +$VERSION = "1.30"; use Carp; use Exporter (); @@ -339,7 +339,7 @@ invert_opset function. rv2cv anoncode prototype coreargs - entersub leavesub leavesublv return method method_named + entersub leavesub leavesublv return method method_named method_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 047e090874..9fb73400a3 100644 --- a/lib/B/Deparse.pm +++ b/lib/B/Deparse.pm @@ -563,7 +563,7 @@ sub begin_is_use { return unless $self->const_sv($svop)->PV eq $module; # Pull out the arguments - for ($svop=$svop->sibling; $svop->name ne "method_named"; + for ($svop=$svop->sibling; index($svop->name, "method_") != 0; $svop = $svop->sibling) { $args .= ", " if length($args); $args .= $self->deparse($svop, 6); @@ -3822,6 +3822,8 @@ sub _method { if ($meth->name eq "method_named") { $meth = $self->meth_sv($meth)->PV; + } elsif ($meth->name eq "method_super") { + $meth = "SUPER::".$self->meth_sv($meth)->PV; } else { $meth = $meth->first; if ($meth->name eq "const") { diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm index d3c988841e..55ca8b60dc 100644 --- a/lib/B/Op_private.pm +++ b/lib/B/Op_private.pm @@ -406,6 +406,7 @@ $bits{lvavref}{0} = $bf[0]; $bits{mapwhile}{0} = $bf[0]; $bits{method}{0} = $bf[0]; $bits{method_named}{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]); @{$bits{msgctl}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); @@ -854,6 +854,7 @@ Perl_op_clear(pTHX_ OP *o) } break; case OP_METHOD_NAMED: + case OP_METHOD_SUPER: SvREFCNT_dec(cMETHOPx(o)->op_u.op_meth_sv); cMETHOPx(o)->op_u.op_meth_sv = NULL; #ifdef USE_ITHREADS @@ -2229,6 +2230,7 @@ S_finalize_op(pTHX_ OP* o) #ifdef USE_ITHREADS /* Relocate all the METHOP's SVs to the pad for thread safety. */ case OP_METHOD_NAMED: + case OP_METHOD_SUPER: op_relocate_sv(&cMETHOPx(o)->op_u.op_meth_sv, &o->op_targ); break; #endif @@ -10296,27 +10298,45 @@ Perl_ck_match(pTHX_ OP *o) OP * Perl_ck_method(pTHX_ OP *o) { - SV* sv; + SV *sv, *methsv; const char* method; + char* compatptr; + int utf8; + STRLEN len, nsplit = 0, i; OP * const kid = cUNOPo->op_first; PERL_ARGS_ASSERT_CK_METHOD; if (kid->op_type != OP_CONST) return o; sv = kSVOP->op_sv; + + /* replace ' with :: */ + while ((compatptr = strchr(SvPVX_const(sv), '\''))) { + *compatptr = ':'; + sv_insert(sv, compatptr - SvPVX_const(sv), 0, ":", 1); + } + method = SvPVX_const(sv); - if (!(strchr(method, ':') || strchr(method, '\''))) { - OP *cmop; - if (!SvIsCOW_shared_hash(sv)) { - sv = newSVpvn_share(method, SvUTF8(sv) ? -(I32)SvCUR(sv) : (I32)SvCUR(sv), 0); - } - else { - kSVOP->op_sv = NULL; - } - cmop = newMETHOP_named(OP_METHOD_NAMED, 0, sv); + len = SvCUR(sv); + utf8 = SvUTF8(sv) ? -1 : 1; + + for (i = len - 1; i > 0; --i) if (method[i] == ':') { + nsplit = i+1; + break; + } + + methsv = newSVpvn_share(method+nsplit, utf8*(len - nsplit), 0); + + if (!nsplit) { /* $proto->method() */ op_free(o); - return cmop; + return newMETHOP_named(OP_METHOD_NAMED, 0, methsv); } + + if (nsplit == 7 && memEQ(method, "SUPER::", nsplit)) { /* $proto->SUPER::method() */ + op_free(o); + return newMETHOP_named(OP_METHOD_SUPER, 0, methsv); + } + return o; } @@ -11614,6 +11634,7 @@ Perl_ck_subr(pTHX_ OP *o) break; case OP_METHOD: case OP_METHOD_NAMED: + case OP_METHOD_SUPER: if (aop->op_type == OP_CONST) { aop->op_private &= ~OPpCONST_STRICT; const_class = &cSVOPx(aop)->op_sv; @@ -350,6 +350,7 @@ EXTCONST char* const PL_op_name[] = { "goto", "exit", "method_named", + "method_super", "entergiven", "leavegiven", "enterwhen", @@ -741,6 +742,7 @@ EXTCONST char* const PL_op_desc[] = { "goto", "exit", "method with known name", + "super with known name", "given()", "leave given block", "when()", @@ -1146,6 +1148,7 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */ Perl_pp_goto, Perl_pp_exit, Perl_pp_method_named, + Perl_pp_method_super, Perl_pp_entergiven, Perl_pp_leavegiven, Perl_pp_enterwhen, @@ -1547,6 +1550,7 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */ Perl_ck_null, /* goto */ Perl_ck_fun, /* exit */ Perl_ck_null, /* method_named */ + Perl_ck_null, /* method_super */ Perl_ck_null, /* entergiven */ Perl_ck_null, /* leavegiven */ Perl_ck_null, /* enterwhen */ @@ -1942,6 +1946,7 @@ EXTCONST U32 PL_opargs[] = { 0x00000d04, /* goto */ 0x00009b04, /* exit */ 0x00000e40, /* method_named */ + 0x00000e40, /* method_super */ 0x00000340, /* entergiven */ 0x00000100, /* leavegiven */ 0x00000340, /* enterwhen */ @@ -2563,6 +2568,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 158, /* goto */ 48, /* exit */ 0, /* method_named */ + 0, /* method_super */ 0, /* entergiven */ 0, /* leavegiven */ 0, /* enterwhen */ @@ -2762,7 +2768,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, 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, 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 */ @@ -3036,6 +3042,7 @@ EXTCONST U8 PL_op_private_valid[] = { /* GOTO */ (OPpARG1_MASK|OPpPV_IS_UTF8), /* EXIT */ (OPpARG4_MASK), /* METHOD_NAMED */ (OPpARG1_MASK), + /* METHOD_SUPER */ (OPpARG1_MASK), /* ENTERGIVEN */ (OPpARG1_MASK), /* LEAVEGIVEN */ (OPpARG1_MASK), /* ENTERWHEN */ (OPpARG1_MASK), @@ -216,191 +216,192 @@ typedef enum opcode { OP_GOTO = 199, OP_EXIT = 200, OP_METHOD_NAMED = 201, - OP_ENTERGIVEN = 202, - OP_LEAVEGIVEN = 203, - OP_ENTERWHEN = 204, - OP_LEAVEWHEN = 205, - OP_BREAK = 206, - OP_CONTINUE = 207, - OP_OPEN = 208, - OP_CLOSE = 209, - OP_PIPE_OP = 210, - OP_FILENO = 211, - OP_UMASK = 212, - OP_BINMODE = 213, - OP_TIE = 214, - OP_UNTIE = 215, - OP_TIED = 216, - OP_DBMOPEN = 217, - OP_DBMCLOSE = 218, - OP_SSELECT = 219, - OP_SELECT = 220, - OP_GETC = 221, - OP_READ = 222, - OP_ENTERWRITE = 223, - OP_LEAVEWRITE = 224, - OP_PRTF = 225, - OP_PRINT = 226, - OP_SAY = 227, - OP_SYSOPEN = 228, - OP_SYSSEEK = 229, - OP_SYSREAD = 230, - OP_SYSWRITE = 231, - OP_EOF = 232, - OP_TELL = 233, - OP_SEEK = 234, - OP_TRUNCATE = 235, - OP_FCNTL = 236, - OP_IOCTL = 237, - OP_FLOCK = 238, - OP_SEND = 239, - OP_RECV = 240, - OP_SOCKET = 241, - OP_SOCKPAIR = 242, - OP_BIND = 243, - OP_CONNECT = 244, - OP_LISTEN = 245, - OP_ACCEPT = 246, - OP_SHUTDOWN = 247, - OP_GSOCKOPT = 248, - OP_SSOCKOPT = 249, - OP_GETSOCKNAME = 250, - OP_GETPEERNAME = 251, - OP_LSTAT = 252, - OP_STAT = 253, - OP_FTRREAD = 254, - OP_FTRWRITE = 255, - OP_FTREXEC = 256, - OP_FTEREAD = 257, - OP_FTEWRITE = 258, - OP_FTEEXEC = 259, - OP_FTIS = 260, - OP_FTSIZE = 261, - OP_FTMTIME = 262, - OP_FTATIME = 263, - OP_FTCTIME = 264, - OP_FTROWNED = 265, - OP_FTEOWNED = 266, - OP_FTZERO = 267, - OP_FTSOCK = 268, - OP_FTCHR = 269, - OP_FTBLK = 270, - OP_FTFILE = 271, - OP_FTDIR = 272, - OP_FTPIPE = 273, - OP_FTSUID = 274, - OP_FTSGID = 275, - OP_FTSVTX = 276, - OP_FTLINK = 277, - OP_FTTTY = 278, - OP_FTTEXT = 279, - OP_FTBINARY = 280, - OP_CHDIR = 281, - OP_CHOWN = 282, - OP_CHROOT = 283, - OP_UNLINK = 284, - OP_CHMOD = 285, - OP_UTIME = 286, - OP_RENAME = 287, - OP_LINK = 288, - OP_SYMLINK = 289, - OP_READLINK = 290, - OP_MKDIR = 291, - OP_RMDIR = 292, - OP_OPEN_DIR = 293, - OP_READDIR = 294, - OP_TELLDIR = 295, - OP_SEEKDIR = 296, - OP_REWINDDIR = 297, - OP_CLOSEDIR = 298, - OP_FORK = 299, - OP_WAIT = 300, - OP_WAITPID = 301, - OP_SYSTEM = 302, - OP_EXEC = 303, - OP_KILL = 304, - OP_GETPPID = 305, - OP_GETPGRP = 306, - OP_SETPGRP = 307, - OP_GETPRIORITY = 308, - OP_SETPRIORITY = 309, - OP_TIME = 310, - OP_TMS = 311, - OP_LOCALTIME = 312, - OP_GMTIME = 313, - OP_ALARM = 314, - OP_SLEEP = 315, - OP_SHMGET = 316, - OP_SHMCTL = 317, - OP_SHMREAD = 318, - OP_SHMWRITE = 319, - OP_MSGGET = 320, - OP_MSGCTL = 321, - OP_MSGSND = 322, - OP_MSGRCV = 323, - OP_SEMOP = 324, - OP_SEMGET = 325, - OP_SEMCTL = 326, - OP_REQUIRE = 327, - OP_DOFILE = 328, - OP_HINTSEVAL = 329, - OP_ENTEREVAL = 330, - OP_LEAVEEVAL = 331, - OP_ENTERTRY = 332, - OP_LEAVETRY = 333, - OP_GHBYNAME = 334, - OP_GHBYADDR = 335, - OP_GHOSTENT = 336, - OP_GNBYNAME = 337, - OP_GNBYADDR = 338, - OP_GNETENT = 339, - OP_GPBYNAME = 340, - OP_GPBYNUMBER = 341, - OP_GPROTOENT = 342, - OP_GSBYNAME = 343, - OP_GSBYPORT = 344, - OP_GSERVENT = 345, - OP_SHOSTENT = 346, - OP_SNETENT = 347, - OP_SPROTOENT = 348, - OP_SSERVENT = 349, - OP_EHOSTENT = 350, - OP_ENETENT = 351, - OP_EPROTOENT = 352, - OP_ESERVENT = 353, - OP_GPWNAM = 354, - OP_GPWUID = 355, - OP_GPWENT = 356, - OP_SPWENT = 357, - OP_EPWENT = 358, - OP_GGRNAM = 359, - OP_GGRGID = 360, - OP_GGRENT = 361, - OP_SGRENT = 362, - OP_EGRENT = 363, - OP_GETLOGIN = 364, - OP_SYSCALL = 365, - OP_LOCK = 366, - OP_ONCE = 367, - OP_CUSTOM = 368, - OP_REACH = 369, - OP_RKEYS = 370, - OP_RVALUES = 371, - OP_COREARGS = 372, - OP_RUNCV = 373, - OP_FC = 374, - OP_PADCV = 375, - OP_INTROCV = 376, - OP_CLONECV = 377, - OP_PADRANGE = 378, - OP_REFASSIGN = 379, - OP_LVREF = 380, - OP_LVREFSLICE = 381, - OP_LVAVREF = 382, + 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_max } opcode; -#define MAXO 383 +#define MAXO 384 #define OP_FREED MAXO /* the OP_IS_* macros are optimized to a simple range check because @@ -2973,40 +2973,11 @@ Perl_vivify_ref(pTHX_ SV *sv, U32 to_what) return sv; } -PP(pp_method) -{ - dSP; - SV* const sv = TOPs; - - if (SvROK(sv)) { - SV* const rsv = SvRV(sv); - if (SvTYPE(rsv) == SVt_PVCV) { - SETs(rsv); - RETURN; - } - } - - SETs(method_common(sv, NULL)); - RETURN; -} - -PP(pp_method_named) -{ - dSP; - SV* const meth = cMETHOPx_meth(PL_op); - U32 hash = SvSHARED_HASH(meth); - - XPUSHs(method_common(meth, &hash)); - RETURN; -} - -STATIC SV * -S_method_common(pTHX_ SV* meth, U32* hashp) +PERL_STATIC_INLINE HV * +S_opmethod_stash(pTHX_ SV* meth) { SV* ob; - GV* gv; HV* stash; - SV *packsv = NULL; SV* const sv = PL_stack_base + TOPMARK == PL_stack_sp ? (Perl_croak(aTHX_ "Can't call method \"%"SVf"\" without a " @@ -3014,7 +2985,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp) (SV *)NULL) : *(PL_stack_base + TOPMARK + 1); - PERL_ARGS_ASSERT_METHOD_COMMON; + PERL_ARGS_ASSERT_OPMETHOD_STASH; if (UNLIKELY(!sv)) undefined: @@ -3024,7 +2995,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp) 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 (stash) return stash; } if (SvROK(sv)) @@ -3050,7 +3021,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp) const char * const packname = SvPV_nomg_const(sv, packlen); const U32 packname_utf8 = SvUTF8(sv); stash = gv_stashpvn(packname, packlen, packname_utf8 | GV_CACHE_ONLY); - if (stash) goto fetch; + if (stash) return stash; if (!(iogv = gv_fetchpvn_flags( packname, packlen, packname_utf8, SVt_PVIO @@ -3066,8 +3037,8 @@ S_method_common(pTHX_ SV* meth, U32* hashp) } /* assume it's a package name */ stash = gv_stashpvn(packname, packlen, packname_utf8); - if (!stash) packsv = sv; - goto fetch; + if (stash) return stash; + else return MUTABLE_HV(sv); } /* it _is_ a filehandle name -- replace with a reference */ *(PL_stack_base + TOPMARK + 1) = sv_2mortal(newRV(MUTABLE_SV(iogv))); @@ -3085,31 +3056,92 @@ S_method_common(pTHX_ SV* meth, U32* hashp) : meth)); } - stash = SvSTASH(ob); + return SvSTASH(ob); +} + +PP(pp_method) +{ + dSP; + GV* gv; + HV* stash; + SV* const meth = TOPs; + + if (SvROK(meth)) { + SV* const rmeth = SvRV(meth); + if (SvTYPE(rmeth) == SVt_PVCV) { + SETs(rmeth); + RETURN; + } + } - fetch: - /* NOTE: stash may be null, hope hv_fetch_ent and - gv_fetchmethod can cope (it seems they can) */ + stash = opmethod_stash(meth); - /* shortcut for simple names */ - if (hashp) { - const HE* const he = hv_fetch_ent(stash, meth, 0, *hashp); - if (he) { - gv = MUTABLE_GV(HeVAL(he)); - assert(stash); - if (isGV(gv) && GvCV(gv) && - (!GvCVGEN(gv) || GvCVGEN(gv) + gv = gv_fetchmethod_sv_flags(stash, meth, GV_AUTOLOAD|GV_CROAK); + assert(gv); + + SETs(isGV(gv) ? MUTABLE_SV(GvCV(gv)) : MUTABLE_SV(gv)); + RETURN; +} + +PP(pp_method_named) +{ + dSP; + GV* gv; + SV* const meth = cMETHOPx_meth(PL_op); + 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))) - return MUTABLE_SV(GvCV(gv)); - } + { + XPUSHs(MUTABLE_SV(GvCV(gv))); + RETURN; + } + } } - assert(stash || packsv); - gv = gv_fetchmethod_sv_flags(stash ? stash : MUTABLE_HV(packsv), - meth, GV_AUTOLOAD | GV_CROAK); + gv = gv_fetchmethod_sv_flags(stash, meth, GV_AUTOLOAD|GV_CROAK); assert(gv); - return isGV(gv) ? MUTABLE_SV(GvCV(gv)) : MUTABLE_SV(gv); + XPUSHs(isGV(gv) ? MUTABLE_SV(GvCV(gv)) : MUTABLE_SV(gv)); + RETURN; +} + +PP(pp_method_super) +{ + dSP; + GV* gv; + HV* cache; + SV* const meth = cMETHOPx_meth(PL_op); + HV* const stash = CopSTASH(PL_curcop); + /* Actually, SUPER doesn't need real object's (or class') stash at all, + * as it uses CopSTASH. However, we must ensure that object(class) is + * correct (this check is done by S_opmethod_stash) */ + 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; + } + } + } + + 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; } /* diff --git a/pp_proto.h b/pp_proto.h index 9a399645e4..781050a865 100644 --- a/pp_proto.h +++ b/pp_proto.h @@ -152,6 +152,7 @@ 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_super(pTHX); PERL_CALLCONV OP *Perl_pp_mkdir(pTHX); PERL_CALLCONV OP *Perl_pp_modulo(pTHX); PERL_CALLCONV OP *Perl_pp_multiply(pTHX); @@ -6605,10 +6605,9 @@ STATIC void S_do_oddball(pTHX_ SV **oddkey, SV **firstkey) #define PERL_ARGS_ASSERT_DO_ODDBALL \ assert(oddkey); assert(firstkey) -STATIC SV* S_method_common(pTHX_ SV* meth, U32* hashp) - __attribute__warn_unused_result__ +PERL_STATIC_INLINE HV* S_opmethod_stash(pTHX_ SV* meth) __attribute__nonnull__(pTHX_1); -#define PERL_ARGS_ASSERT_METHOD_COMMON \ +#define PERL_ARGS_ASSERT_OPMETHOD_STASH \ assert(meth) #endif diff --git a/regen/opcodes b/regen/opcodes index d3da20176e..f46264d2e1 100644 --- a/regen/opcodes +++ b/regen/opcodes @@ -308,6 +308,7 @@ dump dump ck_null ds} 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. entergiven given() ck_null d| leavegiven leave given block ck_null 1 |