Process $self in method subs as a subsignature parameter

class.c

@@ -254,9 +254,14 @@ XS(injected_constructor)
 /* TODO: People would probably expect to find this in pp.c  ;) */
 PP(pp_methstart)
 {
-    /* note that if AvREAL(@_), be careful not to leak self:
-     * so keep it in @_ for now, and only shift it later */
-    SV *self = *(av_fetch(GvAV(PL_defgv), 0, 1));
+    bool self_in_pad = PL_op->op_private & OPpSELF_IN_PAD;
+    SV *self;
+    if (self_in_pad)
+        self = PAD_SVl(PADIX_SELF);
+    else
+        /* note that if AvREAL(@_), be careful not to leak self:
+         * so keep it in @_ for now, and only shift it later */
+        self = *(av_fetch(GvAV(PL_defgv), 0, 1));
     SV *rv = NULL;
 
     /* pp_methstart happens before the first OP_NEXTSTATE of the method body,
@@ -285,8 +290,10 @@ PP(pp_methstart)
         croak("Cannot invoke a method of %" HvNAMEf_QUOTEDPREFIX " on an instance of %" HvNAMEf_QUOTEDPREFIX,
             HvNAMEfARG(CvSTASH(curcv)), HvNAMEfARG(SvSTASH(rv)));
 
-    save_clearsv(&PAD_SVl(PADIX_SELF));
-    sv_setsv(PAD_SVl(PADIX_SELF), self);
+    if (!self_in_pad) {
+        save_clearsv(&PAD_SVl(PADIX_SELF));
+        sv_setsv(PAD_SVl(PADIX_SELF), self);
+    }
 
     UNOP_AUX_item *aux = cUNOP_AUX->op_aux;
     if(aux) {
@@ -318,10 +325,12 @@ PP(pp_methstart)
         }
     }
 
-    /* safe to shift and free self now */
-    self = av_shift(GvAV(PL_defgv));
-    if (AvREAL(GvAV(PL_defgv)))
-        SvREFCNT_dec_NN(self);
+    if (!self_in_pad) {
+        /* safe to shift and free self now */
+        self = av_shift(GvAV(PL_defgv));
+        if (AvREAL(GvAV(PL_defgv)))
+            SvREFCNT_dec_NN(self);
+    }
 
     if(PL_op->op_private & OPpINITFIELDS) {
         SV *params = *av_fetch(GvAV(PL_defgv), 0, 0);
@@ -944,6 +953,25 @@ Perl_class_prepare_method_parse(pTHX_ CV *cv)
     CvIsMETHOD_on(cv);
 }
 
+#define find_op_methstart(o)  S_find_op_methstart(aTHX_ o)
+static OP *
+S_find_op_methstart(pTHX_ OP *o)
+{
+    if(o->op_type == OP_METHSTART)
+        return o;
+
+    if(!(o->op_flags & OPf_KIDS))
+        return NULL;
+
+    for(OP *kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid)) {
+        OP *methstart = find_op_methstart(kid);
+        if(methstart)
+            return methstart;
+    }
+
+    return NULL;
+}
+
 OP *
 Perl_class_wrap_method_body(pTHX_ OP *o)
 {
@@ -1001,7 +1029,18 @@ Perl_class_wrap_method_body(pTHX_ OP *o)
     if(o->op_type != OP_LINESEQ)
         o = newLISTOP(OP_LINESEQ, 0, o, NULL);
 
-    op_sibling_splice(o, NULL, 0, newUNOP_AUX(OP_METHSTART, 0, NULL, aux));
+    if(CvSIGNATURE(PL_compcv)) {
+        /* A signatured method has already injected the OP_METHSTART; we just
+         * have to find it and attach the aux structure to it
+         */
+        OP *methstartop = find_op_methstart(o);
+        assert(methstartop);
+        assert(!cUNOP_AUXx(methstartop)->op_aux);
+
+        cUNOP_AUXx(methstartop)->op_aux = aux;
+    }
+    else
+        op_sibling_splice(o, NULL, 0, newUNOP_AUX(OP_METHSTART, 0, NULL, aux));
 
     return o;
 }
@@ -1099,13 +1138,14 @@ apply_field_attribute_reader(pTHX_ PADNAME *pn, SV *value)
 
     I32 save_ix = block_start(TRUE);
 
-    subsignature_start();
-
     PADOFFSET padix;
 
     padix = pad_add_name_pvs("$self", 0, NULL, NULL);
     assert(padix == PADIX_SELF);
 
+    subsignature_start();
+    CvSIGNATURE_on(PL_compcv);
+
     OP *sigop = subsignature_finish();
 
     padix = pad_import_field(pn);
@@ -1166,13 +1206,14 @@ apply_field_attribute_writer(pTHX_ PADNAME *pn, SV *value)
 
     I32 save_ix = block_start(TRUE);
 
-    subsignature_start();
-
     PADOFFSET padix;
 
     padix = pad_add_name_pvs("$self", 0, NULL, NULL);
     assert(padix == PADIX_SELF);
 
+    subsignature_start();
+    CvSIGNATURE_on(PL_compcv);
+
     /* param pad variable doesn't technically need a name, so don't bother as
      * reusing the field name will provoke a warning */
     PADOFFSET param_padix = padix = pad_add_name_pvn("$", 1, 0, NULL, NULL);

embed.fnc

@@ -3110,6 +3110,8 @@ CRp	|NV	|str_to_version |NN SV *sv
 : Used in pp_ctl.c
 p	|void	|sub_crush_depth|NN CV *cv
 : Used in perly.y
+p	|void	|subsignature_append_fence_op				\
+				|NN OP *o
 p	|void	|subsignature_append_positional 			\
 				|PADOFFSET padix			\
 				|OPCODE defmode 			\

embed.h

@@ -1162,6 +1162,7 @@
 #   define sighandler1                          Perl_sighandler1
 #   define sighandler3                          Perl_sighandler3
 #   define sub_crush_depth(a)                   Perl_sub_crush_depth(aTHX_ a)
+#   define subsignature_append_fence_op(a)      Perl_subsignature_append_fence_op(aTHX_ a)
 #   define subsignature_append_positional(a,b,c) Perl_subsignature_append_positional(aTHX_ a,b,c)
 #   define subsignature_append_slurpy(a,b)      Perl_subsignature_append_slurpy(aTHX_ a,b)
 #   define subsignature_finish()                Perl_subsignature_finish(aTHX)

lib/B/Deparse.pm

@@ -1238,6 +1238,8 @@ sub deparse_argops {
         # skip trailing nextstate
         last if $$o == $$last;
 
+        next if $cv->CvFLAGS & CVf_IsMETHOD and $o->name eq "methstart";
+
         # OP_NEXTSTATE
         return unless $o->name =~ /^(next|db)state$/;
         return if $o->label;
@@ -1296,6 +1298,13 @@ sub deparse_argops {
 
     }
 
+    if ($cv->CvFLAGS & CVf_IsMETHOD) {
+        # Remove the implied `$self` argument
+        warn "Expected first signature argument to be named \$self"
+            unless @sig and $sig[0] eq '$self';
+        shift @sig;
+    }
+
     while (++$last_ix < $params) {
         push @sig, $last_ix <  $mandatory ? '$' : '$=';
     }
@@ -1361,10 +1370,6 @@ Carp::confess("SPECIAL in deparse_sub") if $cv->isa("B::SPECIAL");
         my $is_list = ($lineseq->name eq "lineseq");
         my $firstop = $is_list ? $lineseq->first : $lineseq;
 
-        if ($is_method and $firstop->name eq "methstart") {
-            $firstop = $firstop->sibling;
-        }
-
         # Try to deparse first subtree as a signature if possible.
         # Top of signature subtree has an ex-argcheck as a placeholder
         if (    $has_sig

op.c

@@ -16479,7 +16479,7 @@ struct yy_parser_signature {
     UV          elems;      /* number of signature elements seen so far */
     UV          optelems;   /* number of optional signature elems seen */
     char        slurpy;     /* the sigil of the slurpy var (or null) */
-    OP         *elemops;    /* NULL, or an OP_LINESEQ of individual element ops */
+    OP         *elemops;    /* NULL, or an OP_LINESEQ of individual element and fence ops */
 };
 
 static void
@@ -16516,6 +16516,36 @@ Perl_subsignature_start(pTHX)
 
     SAVEVPTR(PL_parser->signature);
     PL_parser->signature = signature;
+
+    /* TODO: This should ideally be performed by some sort of "magic" or
+     * "hook" mechanism on PL_compcv that class.c installed, thus decoupling
+     * this otherwise tightly-coupled mechanism here
+     */
+    if(CvIsMETHOD(PL_compcv)) {
+        assert(PadnamelistMAX(PL_comppad_name) >= 1);
+        /* PADIX_SELF == 1 */
+        assert(PadnamePV(PadnamelistARRAY(PL_comppad_name)[1])[0] == '$');
+        subsignature_append_positional(1, 0, NULL);
+        subsignature_append_fence_op(newUNOP_AUX(OP_METHSTART, OPpSELF_IN_PAD << 8, NULL, NULL));
+    }
+}
+
+/* Appends another arbitrary optree into the accumulated set of signature-
+ * handling ops. This op will be invoked at some time after all of the
+ * parameters already present have received their values, but before any of
+ * the defaulting expressions for later parameters are executed.
+ */
+
+void
+Perl_subsignature_append_fence_op(pTHX_ OP *o)
+{
+    PERL_ARGS_ASSERT_SUBSIGNATURE_APPEND_FENCE_OP;
+    assert(PL_parser);
+    yy_parser_signature *signature = PL_parser->signature;
+    assert(signature);
+
+    signature->elemops = op_append_elem(OP_LINESEQ, signature->elemops,
+            o);
 }
 
 /* Appends another positional scalar parameter to the accumulated set of