This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
speedup for SUPER::method() calls.
authorsyber <syber@crazypanda.ru>
Fri, 28 Nov 2014 18:22:25 +0000 (21:22 +0300)
committerFather Chrysostomos <sprout@cpan.org>
Sat, 29 Nov 2014 02:10:58 +0000 (18:10 -0800)
In ck_method:
Scan for '/::. If found SUPER::, create OP_METHOD_SUPER op
with precomputed hash value for method name.

In B::*, added support for method_super

In pp_hot.c, pp_method_*:
S_method_common removed, code related to getting stash is
moved to S_opmethod_stash, other code is moved to
pp_method_* functions.

As a result, SUPER::func() calls speeded up by 50%.

14 files changed:
dump.c
embed.fnc
embed.h
ext/B/B/Concise.pm
ext/Opcode/Opcode.pm
lib/B/Deparse.pm
lib/B/Op_private.pm
op.c
opcode.h
opnames.h
pp_hot.c
pp_proto.h
proto.h
regen/opcodes

diff --git a/dump.c b/dump.c
index 9090f30..9209d06 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -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 */
index 2b4ea7b..590e7d0 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -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)
diff --git a/embed.h b/embed.h
index 4d6ca12..c8dfde3 100644 (file)
--- a/embed.h
+++ b/embed.h
 #  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
index 406327f..bc236a4 100644 (file)
@@ -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 {
index 7256126..8537953 100644 (file)
@@ -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
index 047e090..9fb7340 100644 (file)
@@ -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") {
index d3c9888..55ca8b6 100644 (file)
@@ -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]);
diff --git a/op.c b/op.c
index 55f52c3..208a52c 100644 (file)
--- a/op.c
+++ b/op.c
@@ -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)
 {
-    SVsv;
+    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;
index 105dcbf..82b3519 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -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),
index de230b5..a0b7785 100644 (file)
--- a/opnames.h
+++ b/opnames.h
@@ -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
index cde1d9f..28eb987 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -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;
 }
 
 /*
index 9a39964..781050a 100644 (file)
@@ -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);
diff --git a/proto.h b/proto.h
index a0ce383..b39d4db 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -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
index d3da201..f46264d 100644 (file)
@@ -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