Use new subsignature API in class.c

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);
@@ -1080,11 +1089,17 @@ 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_append_positional(padix, 0, NULL);
+
+    OP *sigop = subsignature_finish();
+
     padix = pad_add_name_pvn(PadnamePV(pn), PadnameLEN(pn), 0, NULL, NULL);
     intro_my();
 
@@ -1101,19 +1116,7 @@ apply_field_attribute_reader(pTHX_ PADNAME *pn, SV *value)
         (ap++)->uv = padix;
         (ap++)->uv = fieldix;
 
-        methstartop = newUNOP_AUX(OP_METHSTART, 0, NULL, aux);
-    }
-
-    OP *argcheckop;
-    {
-        struct op_argcheck_aux *aux = (struct op_argcheck_aux *)
-            PerlMemShared_malloc(sizeof(*aux));
-
-        aux->params     = 0;
-        aux->opt_params = 0;
-        aux->slurpy     = 0;
-
-        argcheckop = newUNOP_AUX(OP_ARGCHECK, 0, NULL, (UNOP_AUX_item *)aux);
+        methstartop = newUNOP_AUX(OP_METHSTART, OPpSELF_IN_PAD << 8, NULL, aux);
     }
 
     OP *retop;
@@ -1132,8 +1135,8 @@ apply_field_attribute_reader(pTHX_ PADNAME *pn, SV *value)
     }
 
     OP *ops = newLISTOPn(OP_LINESEQ, 0,
+            sigop,
             methstartop,
-            argcheckop,
             retop,
             NULL);
 
@@ -1147,18 +1150,6 @@ apply_field_attribute_reader(pTHX_ PADNAME *pn, SV *value)
         CvIsMETHOD_on(cv);
 }
 
-/* If '@_' is called "snail", then elements of it can be called "slugs"; i.e.
- * snails out of their container. */
-#define newSLUGOP(idx)  S_newSLUGOP(aTHX_ idx)
-static OP *
-S_newSLUGOP(pTHX_ IV idx)
-{
-    assert(idx >= 0 && idx <= 255);
-    OP *op = newGVOP(OP_AELEMFAST, 0, PL_defgv);
-    op->op_private = idx;
-    return op;
-}
-
 static void
 apply_field_attribute_writer(pTHX_ PADNAME *pn, SV *value)
 {
@@ -1185,11 +1176,24 @@ 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_append_positional(padix, 0, NULL);
+
+    /* 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);
+    intro_my();
+
+    subsignature_append_positional(param_padix, 0, NULL);
+
+    OP *sigop = subsignature_finish();
+
     padix = pad_add_name_pvn(PadnamePV(pn), PadnameLEN(pn), 0, NULL, NULL);
     intro_my();
 
@@ -1206,32 +1210,20 @@ apply_field_attribute_writer(pTHX_ PADNAME *pn, SV *value)
         (ap++)->uv = padix;
         (ap++)->uv = fieldix;
 
-        methstartop = newUNOP_AUX(OP_METHSTART, 0, NULL, aux);
-    }
-
-    OP *argcheckop;
-    {
-        struct op_argcheck_aux *aux = (struct op_argcheck_aux *)
-            PerlMemShared_malloc(sizeof(*aux));
-
-        aux->params     = 1;
-        aux->opt_params = 0;
-        aux->slurpy     = 0;
-
-        argcheckop = newUNOP_AUX(OP_ARGCHECK, 0, NULL, (UNOP_AUX_item *)aux);
+        methstartop = newUNOP_AUX(OP_METHSTART, OPpSELF_IN_PAD << 8, NULL, aux);
     }
 
     OP *assignop = newBINOP(OP_SASSIGN, 0,
-            newSLUGOP(0),
+            newPADxVOP(OP_PADSV, 0, param_padix),
             newPADxVOP(OP_PADSV, OPf_MOD|OPf_REF, padix));
 
     OP *retop = newLISTOP(OP_RETURN, 0,
             newOP(OP_PUSHMARK, 0),
             newPADxVOP(OP_PADSV, 0, PADIX_SELF));
 
     OP *ops = newLISTOPn(OP_LINESEQ, 0,
+            sigop,
             methstartop,
-            argcheckop,
             assignop,
             retop,
             NULL);

embed.fnc

@@ -3104,12 +3104,12 @@ CRp	|NV	|str_to_version |NN SV *sv
 p	|void	|sub_crush_depth|NN CV *cv
 : Used in perly.y
 p	|void	|subsignature_append_positional 			\
-				|NULLOK OP *varop			\
+				|PADOFFSET padix			\
 				|OPCODE defmode 			\
 				|NULLOK OP *defexpr
 p	|void	|subsignature_append_slurpy				\
 				|I32 sigil				\
-				|NULLOK OP *varop
+				|PADOFFSET padix
 p	|OP *	|subsignature_finish
 p	|void	|subsignature_start
 Adp	|void	|suspend_compcv |NN struct suspended_compcv *buffer

op.c

@@ -16516,17 +16516,15 @@ Perl_subsignature_start(pTHX)
 }
 
 /* Appends another positional scalar parameter to the accumulated set of
- * subroutine params. `varop` may be NULL, but if not it must be an OP_ARGELEM
- * whose op_targ refers to an already-declared pad lexical. That lexical must
- * be a scalar. It is not necessary to set the argument index in the op_aux
- * field; that will be filled in by this function.
+ * subroutine params. `padix` may be zero, but if not it must be the pad
+ * index of a scalar pad lexical to store the incoming argument value into.
  * If `defexpr` is not NULL, it gives a defaulting expression to be evaluated
  * if required, according to `defmode` - one of zero, `OP_DORASSIGN` or
  * `OP_ORASSIGN`.
  */
 
 void
-Perl_subsignature_append_positional(pTHX_ OP *varop, OPCODE defmode, OP *defexpr)
+Perl_subsignature_append_positional(pTHX_ PADOFFSET padix, OPCODE defmode, OP *defexpr)
 {
     PERL_ARGS_ASSERT_SUBSIGNATURE_APPEND_POSITIONAL;
     assert(PL_parser);
@@ -16538,13 +16536,13 @@ Perl_subsignature_append_positional(pTHX_ OP *varop, OPCODE defmode, OP *defexpr
 
     UV argix = signature->elems;
 
-    if(varop) {
-        assert(varop->op_type == OP_ARGELEM);
-        assert((varop->op_private & OPpARGELEM_MASK) == OPpARGELEM_SV);
-        assert(varop->op_targ);
-        assert(PadnamePV(PadnamelistARRAY(PL_comppad_name)[varop->op_targ])[0] == '$');
+    OP *varop = NULL;
+    if(padix) {
+        assert(PadnamePV(PadnamelistARRAY(PL_comppad_name)[padix])[0] == '$');
 
-        /* Now fill in the argix */
+        varop = newUNOP_AUX(OP_ARGELEM, 0, NULL, NULL);
+        varop->op_private |= OPpARGELEM_SV;
+        varop->op_targ = padix;
         cUNOP_AUXx(varop)->op_aux = INT2PTR(UNOP_AUX_item *, argix);
     }
 
@@ -16601,14 +16599,13 @@ Perl_subsignature_append_positional(pTHX_ OP *varop, OPCODE defmode, OP *defexpr
 }
 
 /* Appends a final slurpy parameter to the accumulated set of subroutine
- * params. `varop` may be NULL, but if not it must be an OP_ARGELEM whose
- * op_targ refers to an already-declared pad lexical. That lexical must match
- * the `sigil` parameter. It is not necessary to set the argument index in the
- * op_aux field; that will be filled in by this function.
+ * params. `padix` may be zero, but if not it must be the pad index of an
+ * array or hash lexical to store the remaining argument values into. Its
+ * sigil must match the `sigil` parameter.
  */
 
 void
-Perl_subsignature_append_slurpy(pTHX_ I32 sigil, OP *varop)
+Perl_subsignature_append_slurpy(pTHX_ I32 sigil, PADOFFSET padix)
 {
     PERL_ARGS_ASSERT_SUBSIGNATURE_APPEND_SLURPY;
     assert(PL_parser);
@@ -16621,21 +16618,19 @@ Perl_subsignature_append_slurpy(pTHX_ I32 sigil, OP *varop)
 
     UV argix = signature->elems;
 
-    if(varop) {
-        assert(varop->op_type == OP_ARGELEM);
-        assert((varop->op_private & OPpARGELEM_MASK) ==
-                ((sigil == '@') ? OPpARGELEM_AV : OPpARGELEM_HV));
-        assert(varop->op_targ);
-        assert(PadnamePV(PadnamelistARRAY(PL_comppad_name)[varop->op_targ])[0] == sigil);
+    signature->slurpy = (char)sigil;
 
-        /* Now fill in the argix */
-        cUNOP_AUXx(varop)->op_aux = INT2PTR(UNOP_AUX_item *, argix);
-    }
+    if(padix) {
+        assert(PadnamePV(PadnamelistARRAY(PL_comppad_name)[padix])[0] == sigil);
 
-    signature->slurpy = (char)sigil;
+        OP *varop = newUNOP_AUX(OP_ARGELEM, 0, NULL, NULL);
+        if(sigil == '@')
+            varop->op_private |= OPpARGELEM_AV;
+        if(sigil == '%')
+            varop->op_private |= OPpARGELEM_HV;
+        varop->op_targ = padix;
+        cUNOP_AUXx(varop)->op_aux = INT2PTR(UNOP_AUX_item *, argix);
 
-    if(varop) {
-        /* TODO: assert() the sigil of the pad variable matches */
         signature->elemops = op_append_list(OP_LINESEQ, signature->elemops,
                 newSTATEOP(0, NULL, varop));
     }