Make OP_METHOD* to be of new class METHOP

Introduce a new opcode class, METHOP, which will hold class/method related
info needed at runtime to improve performance of class/object method
calls, then change OP_METHOD and OP_METHOD_NAMED from being UNOP/SVOP to
being METHOP.

Note that because OP_METHOD is a UNOP with an op_first, while
OP_METHOD_NAMED is an SVOP, the first field of the METHOP structure
is a union holding either op_first or op_sv. This was seen as less messy
than having to introduce two new op classes.

The new op class's character is '.'

Nothing has changed in functionality and/or performance by this commit.
It just introduces new structure which will be extended with extra
fields and used in later commits.

Added METHOP constructors:
- newMETHOP() for method ops with dynamic method names.
  The only optype for this op is OP_METHOD.
- newMETHOP_named() for method ops with constant method names.
  Optypes for this op are: OP_METHOD_NAMED (currently) and (later)
  OP_METHOD_SUPER, OP_METHOD_REDIR, OP_METHOD_NEXT, OP_METHOD_NEXTCAN,
  OP_METHOD_MAYBENEXT

(This commit includes fixups by davem)

4 files changed, 85 insertions, 31 deletions

diff --git a/ext/B/B.pm b/ext/B/B.pm
index f0dd77a287..838854127a 100644
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -69,10 +69,11 @@ push @B::EXPORT_OK, (qw(minus_c ppname save_BEGINs
 @B::LOOP::ISA = 'B::LISTOP';
 @B::PMOP::ISA = 'B::LISTOP';
 @B::COP::ISA = 'B::OP';
+@B::METHOP::ISA = 'B::OP';
 
 @B::SPECIAL::ISA = 'B::OBJECT';
 
-@B::optype = qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP);
+@B::optype = qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP METHOP);
 # bytecode.pl contained the following comment:
 # Nullsv *must* come first in the following so that the condition
 # ($$sv == 0) can continue to be used to test (sv == Nullsv).
@@ -1065,7 +1066,7 @@ information is no longer stored directly in the hash.
 =head2 OP-RELATED CLASSES
 
 C<B::OP>, C<B::UNOP>, C<B::BINOP>, C<B::LOGOP>, C<B::LISTOP>, C<B::PMOP>,
-C<B::SVOP>, C<B::PADOP>, C<B::PVOP>, C<B::LOOP>, C<B::COP>.
+C<B::SVOP>, C<B::PADOP>, C<B::PVOP>, C<B::LOOP>, C<B::COP>, C<B::METHOP>.
 
 These classes correspond in the obvious way to the underlying C
 structures of similar names.  The inheritance hierarchy mimics the
@@ -1073,9 +1074,9 @@ underlying C "inheritance":
 
                                  B::OP
                                    |
-                   +---------------+--------+--------+-------+
-                   |               |        |        |       |
-                B::UNOP          B::SVOP B::PADOP  B::COP  B::PVOP
+                   +----------+---------+--------+-------+---------+
+                   |          |         |        |       |         |
+                B::UNOP    B::SVOP  B::PADOP  B::COP  B::PVOP  B::METHOP
                  ,'  `-.
                 /       `--.
            B::BINOP     B::LOGOP
@@ -1263,6 +1264,16 @@ Since perl 5.17.1
 
 =back
 
+=head2 B::METHOP Methods (Since Perl 5.22)
+
+=over 4
+
+=item first
+
+=item meth_sv
+
+=back
+
 =head2 OTHER CLASSES
 
 Perl 5.18 introduces a new class, B::PADLIST, returned by B::CV's
diff --git a/ext/B/B.xs b/ext/B/B.xs
index bc423cc4af..716e444ada 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -60,7 +60,8 @@ typedef enum {
     OPc_PADOP,	/* 8 */
     OPc_PVOP,	/* 9 */
     OPc_LOOP,	/* 10 */
-    OPc_COP	/* 11 */
+    OPc_COP,	/* 11 */
+    OPc_METHOP	/* 12 */
 } opclass;
 
 static const char* const opclassnames[] = {
@@ -75,7 +76,8 @@ static const char* const opclassnames[] = {
     "B::PADOP",
     "B::PVOP",
     "B::LOOP",
-    "B::COP"	
+    "B::COP",
+    "B::METHOP"
 };
 
 static const size_t opsizes[] = {
@@ -90,7 +92,8 @@ static const size_t opsizes[] = {
     sizeof(PADOP),
     sizeof(PVOP),
     sizeof(LOOP),
-    sizeof(COP)	
+    sizeof(COP),
+    sizeof(METHOP)
 };
 
 #define MY_CXT_KEY "B::_guts" XS_VERSION
@@ -232,6 +235,8 @@ cc_opclass(pTHX_ const OP *o)
 	    return OPc_BASEOP;
 	else
 	    return OPc_PVOP;
+    case OA_METHOP:
+	return OPc_METHOP;
     }
     warn("can't determine class of operator %s, assuming BASEOP\n",
 	 OP_NAME(o));
@@ -586,6 +591,7 @@ typedef PADOP	*B__PADOP;
 typedef PVOP	*B__PVOP;
 typedef LOOP	*B__LOOP;
 typedef COP	*B__COP;
+typedef METHOP  *B__METHOP;
 
 typedef SV	*B__SV;
 typedef SV	*B__IV;
@@ -735,6 +741,10 @@ struct OP_methods {
   { STR_WITH_LEN("parent"),  op_offset_special, 0,                     },/*52*/
 #  endif
 #endif
+#if PERL_VERSION >= 21
+  { STR_WITH_LEN("first"),   op_offset_special, 0,                     },/*53*/
+  { STR_WITH_LEN("meth_sv"), op_offset_special, 0,                     },/*54*/
+#endif
 };
 
 #include "const-c.inc"
@@ -1012,6 +1022,8 @@ next(o)
 	B::OP::folded        = 50
 	B::OP::lastsib       = 51
 	B::OP::parent        = 52
+	B::METHOP::first     = 53
+	B::METHOP::meth_sv   = 54
     PREINIT:
 	SV *ret;
     PPCODE:
@@ -1208,6 +1220,25 @@ next(o)
 	    case 52: /* B::OP::parent */
 		ret = make_op_object(aTHX_ op_parent(o));
 		break;
+	    case 53: /* B::METHOP::first   */
+                /* METHOP struct has an op_first/op_meth_sv union
+                 * as its first extra field. How to interpret the
+                 * union depends on the op type. For the purposes of
+                 * B, we treat it as a struct with both fields present,
+                 * where one of the fields always happens to be null
+                 * (i.e. we return NULL in preference to croaking with
+                 * 'method not implemented').
+                 */
+		ret = make_op_object(aTHX_
+                            o->op_type == OP_METHOD
+                                ? cMETHOPx(o)->op_u.op_first : NULL);
+		break;
+	    case 54: /* B::METHOP::meth_sv */
+                /* see comment above about METHOP */
+		ret = make_sv_object(aTHX_
+                            o->op_type == OP_METHOD
+                                ? NULL : cMETHOPx(o)->op_u.op_meth_sv);
+		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 b531ce85af..51ef7a746a 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.993";
+our $VERSION   = "0.994";
 our @ISA       = qw(Exporter);
 our @EXPORT_OK = qw( set_style set_style_standard add_callback
 		     concise_subref concise_cv concise_main
@@ -400,7 +400,8 @@ my $lastnext;	# remembers op-chain, used to insert gotos
 
 my %opclass = ('OP' => "0", 'UNOP' => "1", 'BINOP' => "2", 'LOGOP' => "|",
 	       'LISTOP' => "@", 'PMOP' => "/", 'SVOP' => "\$", 'GVOP' => "*",
-	       'PVOP' => '"', 'LOOP' => "{", 'COP' => ";", 'PADOP' => "#");
+	       'PVOP' => '"', 'LOOP' => "{", 'COP' => ";", 'PADOP' => "#",
+	       'METHOP' => '.');
 
 no warnings 'qw'; # "Possible attempt to put comments..."; use #7
 my @linenoise =
@@ -891,16 +892,26 @@ sub concise_op {
     elsif ($h{class} eq "SVOP" or $h{class} eq "PADOP") {
 	unless ($h{name} eq 'aelemfast' and $op->flags & OPf_SPECIAL) {
 	    my $idx = ($h{class} eq "SVOP") ? $op->targ : $op->padix;
-	    my $preferpv = $h{name} eq "method_named";
 	    if ($h{class} eq "PADOP" or !${$op->sv}) {
 		my $sv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$idx];
-		$h{arg} = "[" . concise_sv($sv, \%h, $preferpv) . "]";
+		$h{arg} = "[" . concise_sv($sv, \%h, 0) . "]";
 		$h{targarglife} = $h{targarg} = "";
 	    } else {
-		$h{arg} = "(" . concise_sv($op->sv, \%h, $preferpv) . ")";
+		$h{arg} = "(" . concise_sv($op->sv, \%h, 0) . ")";
 	    }
 	}
     }
+    elsif ($h{class} eq "METHOP") {
+        if ($h{name} eq "method_named") {
+            if (${$op->meth_sv}) {
+                $h{arg} = "(" . 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{targarglife} = $h{targarg} = "";
+            }
+        }
+    }
     $h{seq} = $h{hyphseq} = seq($op);
     $h{seq} = "" if $h{seq} eq "-";
     $h{opt} = $op->opt;
@@ -1379,6 +1390,7 @@ B:: namespace that represents the ops in your Perl code.
     {      LOOP             An OP that holds pointers for a loop
     ;      COP              An OP that marks the start of a statement
     #      PADOP            An OP with a GV on the pad
+    .      METHOP           An OP with method call info
 
 =head2 OP flags abbreviations
 
diff --git a/ext/B/t/optree_specials.t b/ext/B/t/optree_specials.t
index 414fa79ce2..f22b77fd11 100644
--- a/ext/B/t/optree_specials.t
+++ b/ext/B/t/optree_specials.t
@@ -52,7 +52,7 @@ checkOptree ( name	=> 'BEGIN',
 # 5              <0> pushmark s ->6
 # 6              <$> const[PV "strict"] sM ->7
 # 7              <$> const[PV "refs"] sM ->8
-# 8              <$> method_named[PV "unimport"] ->9
+# 8              <.> method_named[PV "unimport"] ->9
 # BEGIN 2:
 # k  <1> leavesub[1 ref] K/REFC,1 ->(end)
 # -     <@> lineseq K ->k
@@ -66,7 +66,7 @@ checkOptree ( name	=> 'BEGIN',
 # f              <0> pushmark s ->g
 # g              <$> const[PV "strict"] sM ->h
 # h              <$> const[PV "refs"] sM ->i
-# i              <$> method_named[PV "unimport"] ->j
+# i              <.> method_named[PV "unimport"] ->j
 # BEGIN 3:
 # u  <1> leavesub[1 ref] K/REFC,1 ->(end)
 # -     <@> lineseq KP ->u
@@ -80,7 +80,7 @@ checkOptree ( name	=> 'BEGIN',
 # p              <0> pushmark s ->q
 # q              <$> const[PV "warnings"] sM ->r
 # r              <$> const[PV "qw"] sM ->s
-# s              <$> method_named[PV "unimport"] ->t
+# s              <.> method_named[PV "unimport"] ->t
 # BEGIN 4:
 # y  <1> leavesub[1 ref] K/REFC,1 ->(end)
 # -     <@> lineseq KP ->y
@@ -102,7 +102,7 @@ EOT_EOT
 # 5              <0> pushmark s ->6
 # 6              <$> const(PV "strict") sM ->7
 # 7              <$> const(PV "refs") sM ->8
-# 8              <$> method_named(PV "unimport") ->9
+# 8              <.> method_named(PV "unimport") ->9
 # BEGIN 2:
 # k  <1> leavesub[1 ref] K/REFC,1 ->(end)
 # -     <@> lineseq K ->k
@@ -116,7 +116,7 @@ EOT_EOT
 # f              <0> pushmark s ->g
 # g              <$> const(PV "strict") sM ->h
 # h              <$> const(PV "refs") sM ->i
-# i              <$> method_named(PV "unimport") ->j
+# i              <.> method_named(PV "unimport") ->j
 # BEGIN 3:
 # u  <1> leavesub[1 ref] K/REFC,1 ->(end)
 # -     <@> lineseq KP ->u
@@ -130,7 +130,7 @@ EOT_EOT
 # p              <0> pushmark s ->q
 # q              <$> const(PV "warnings") sM ->r
 # r              <$> const(PV "qw") sM ->s
-# s              <$> method_named(PV "unimport") ->t
+# s              <.> method_named(PV "unimport") ->t
 # BEGIN 4:
 # y  <1> leavesub[1 ref] K/REFC,1 ->(end)
 # -     <@> lineseq KP ->y
@@ -245,7 +245,7 @@ checkOptree ( name	=> 'all of BEGIN END INIT CHECK UNITCHECK -exec',
 # 5  <0> pushmark s
 # 6  <$> const[PV "strict"] sM
 # 7  <$> const[PV "refs"] sM
-# 8  <$> method_named[PV "unimport"] 
+# 8  <.> method_named[PV "unimport"] 
 # 9  <1> entersub[t1] KS*/TARG,STRICT
 # a  <1> leavesub[1 ref] K/REFC,1
 # BEGIN 2:
@@ -256,7 +256,7 @@ checkOptree ( name	=> 'all of BEGIN END INIT CHECK UNITCHECK -exec',
 # f  <0> pushmark s
 # g  <$> const[PV "strict"] sM
 # h  <$> const[PV "refs"] sM
-# i  <$> method_named[PV "unimport"] 
+# i  <.> method_named[PV "unimport"] 
 # j  <1> entersub[t1] KS*/TARG,STRICT
 # k  <1> leavesub[1 ref] K/REFC,1
 # BEGIN 3:
@@ -267,7 +267,7 @@ checkOptree ( name	=> 'all of BEGIN END INIT CHECK UNITCHECK -exec',
 # p  <0> pushmark s
 # q  <$> const[PV "warnings"] sM
 # r  <$> const[PV "qw"] sM
-# s  <$> method_named[PV "unimport"] 
+# s  <.> method_named[PV "unimport"] 
 # t  <1> entersub[t1] KS*/TARG,STRICT
 # u  <1> leavesub[1 ref] K/REFC,1
 # BEGIN 4:
@@ -304,7 +304,7 @@ EOT_EOT
 # 5  <0> pushmark s
 # 6  <$> const(PV "strict") sM
 # 7  <$> const(PV "refs") sM
-# 8  <$> method_named(PV "unimport") 
+# 8  <.> method_named(PV "unimport") 
 # 9  <1> entersub[t1] KS*/TARG,STRICT
 # a  <1> leavesub[1 ref] K/REFC,1
 # BEGIN 2:
@@ -315,7 +315,7 @@ EOT_EOT
 # f  <0> pushmark s
 # g  <$> const(PV "strict") sM
 # h  <$> const(PV "refs") sM
-# i  <$> method_named(PV "unimport") 
+# i  <.> method_named(PV "unimport") 
 # j  <1> entersub[t1] KS*/TARG,STRICT
 # k  <1> leavesub[1 ref] K/REFC,1
 # BEGIN 3:
@@ -326,7 +326,7 @@ EOT_EOT
 # p  <0> pushmark s
 # q  <$> const(PV "warnings") sM
 # r  <$> const(PV "qw") sM
-# s  <$> method_named(PV "unimport") 
+# s  <.> method_named(PV "unimport") 
 # t  <1> entersub[t1] KS*/TARG,STRICT
 # u  <1> leavesub[1 ref] K/REFC,1
 # BEGIN 4:
@@ -373,7 +373,7 @@ checkOptree ( name	=> 'regression test for patch 25352',
 # 5  <0> pushmark s
 # 6  <$> const[PV "strict"] sM
 # 7  <$> const[PV "refs"] sM
-# 8  <$> method_named[PV "unimport"] 
+# 8  <.> method_named[PV "unimport"] 
 # 9  <1> entersub[t1] KS*/TARG,STRICT
 # a  <1> leavesub[1 ref] K/REFC,1
 # BEGIN 2:
@@ -384,7 +384,7 @@ checkOptree ( name	=> 'regression test for patch 25352',
 # f  <0> pushmark s
 # g  <$> const[PV "strict"] sM
 # h  <$> const[PV "refs"] sM
-# i  <$> method_named[PV "unimport"] 
+# i  <.> method_named[PV "unimport"] 
 # j  <1> entersub[t1] KS*/TARG,STRICT
 # k  <1> leavesub[1 ref] K/REFC,1
 # BEGIN 3:
@@ -395,7 +395,7 @@ checkOptree ( name	=> 'regression test for patch 25352',
 # p  <0> pushmark s
 # q  <$> const[PV "warnings"] sM
 # r  <$> const[PV "qw"] sM
-# s  <$> method_named[PV "unimport"] 
+# s  <.> method_named[PV "unimport"] 
 # t  <1> entersub[t1] KS*/TARG,STRICT
 # u  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
@@ -407,7 +407,7 @@ EOT_EOT
 # 5  <0> pushmark s
 # 6  <$> const(PV "strict") sM
 # 7  <$> const(PV "refs") sM
-# 8  <$> method_named(PV "unimport") 
+# 8  <.> method_named(PV "unimport") 
 # 9  <1> entersub[t1] KS*/TARG,STRICT
 # a  <1> leavesub[1 ref] K/REFC,1
 # BEGIN 2:
@@ -418,7 +418,7 @@ EOT_EOT
 # f  <0> pushmark s
 # g  <$> const(PV "strict") sM
 # h  <$> const(PV "refs") sM
-# i  <$> method_named(PV "unimport") 
+# i  <.> method_named(PV "unimport") 
 # j  <1> entersub[t1] KS*/TARG,STRICT
 # k  <1> leavesub[1 ref] K/REFC,1
 # BEGIN 3:
@@ -429,7 +429,7 @@ EOT_EOT
 # p  <0> pushmark s
 # q  <$> const(PV "warnings") sM
 # r  <$> const(PV "qw") sM
-# s  <$> method_named(PV "unimport") 
+# s  <.> method_named(PV "unimport") 
 # t  <1> entersub[t1] KS*/TARG,STRICT
 # u  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT