speedup for SUPER::method() calls.

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%.

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 */

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)

embed.h

@@ -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

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 {

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

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") {

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]);

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)
 {
-    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;

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),