For Perl_magic_methcall() add G_UNDEF_FILL to fill the stack with &PL_sv_undef.

This replaces the previous special case of using a negative argument count to
signify this, allowing the argument count to become unsigned. Rename it from n
to argc.

diff --git a/av.c b/av.c
index a3dc4dd..acedd00 100644 (file)
--- a/av.c
+++ b/av.c
@@ -632,8 +632,8 @@ Perl_av_unshift(pTHX_ register AV *av, register I32 num)
        Perl_croak(aTHX_ "%s", PL_no_modify);
 
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-       magic_methcall(MUTABLE_SV(av), mg, "UNSHIFT", G_DISCARD,
-           -num, NULL, NULL);
+       magic_methcall(MUTABLE_SV(av), mg, "UNSHIFT", G_DISCARD | G_UNDEF_FILL,
+                      num, NULL, NULL);
        return;
     }
 

diff --git a/cop.h b/cop.h
index 6c51d73..f36d5ff 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -783,6 +783,9 @@ L<perlcall>.
 #define G_METHOD      128       /* Calling method. */
 #define G_FAKINGEVAL  256      /* Faking an eval context for call_sv or
                                   fold_constants. */
+#define G_UNDEF_FILL  512      /* Fill the stack with &PL_sv_undef
+                                  A special case for UNSHIFT in
+                                  Perl_magic_methcall().  */
 
 /* flag bits for PL_in_eval */
 #define EVAL_NULL      0       /* not in an eval */

diff --git a/embed.fnc b/embed.fnc
index c1580e0..b48f95e 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -684,7 +684,7 @@ p   |U32    |magic_sizepack |NN SV* sv|NN MAGIC* mg
 p      |int    |magic_wipepack |NN SV* sv|NN MAGIC* mg
 pd     |SV*    |magic_methcall |NN SV *sv|NN const MAGIC *mg \
                                |NN const char *meth|U32 flags \
-                               |int n|NULLOK SV* arg1|NULLOK SV* arg2
+                               |U32 argc|NULLOK SV* arg1|NULLOK SV* arg2
 Ap     |void   |markstack_grow
 #if defined(USE_LOCALE_COLLATE)
 p      |int    |magic_setcollxfrm|NN SV* sv|NN MAGIC* mg

diff --git a/mg.c b/mg.c
index e29b1c6..66d777f 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -1649,10 +1649,12 @@ Invoke a magic method (like FETCH).
 
 * sv and mg are the tied thinggy and the tie magic;
 * meth is the name of the method to call;
-* n, arg1, arg2 are the number of args (in addition to $self) to pass to
-  the method, and the args themselves (negative n is special-cased);
+* argc, arg1, arg2 are the number of args (in addition to $self) to pass to
+  the method, and the args themselves
 * flags:
     G_DISCARD:     invoke method with G_DISCARD flag and don't return a value
+    G_UNDEF_FILL:  fill the stack with argc pointers to PL_sv_undef;
+                   ignore arg1 and arg2.
 
 Returns the SV (if any) returned by the method, or NULL on failure.
 
@@ -1662,7 +1664,7 @@ Returns the SV (if any) returned by the method, or NULL on failure.
 
 SV*
 Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags,
-    int n, SV *arg1, SV *arg2)
+                   U32 argc, SV *arg1, SV *arg2)
 {
     dVAR;
     dSP;
@@ -1674,22 +1676,16 @@ Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags,
     PUSHSTACKi(PERLSI_MAGIC);
     PUSHMARK(SP);
 
-    if (n < 0) {
-       /* special case for UNSHIFT */
-       EXTEND(SP,-n+1);
-       PUSHs(SvTIED_obj(sv, mg));
-       while (n++ < 0) {
+    EXTEND(SP, argc+1);
+    PUSHs(SvTIED_obj(sv, mg));
+    if (flags & G_UNDEF_FILL) {
+       while (argc--) {
            PUSHs(&PL_sv_undef);
        }
-    }
-    else {
-       EXTEND(SP,n+1);
-       PUSHs(SvTIED_obj(sv, mg));
-       if (n > 0) {
-           PUSHs(arg1);
-           if (n > 1) PUSHs(arg2);
-           assert(n <= 2);
-       }
+    } else if (argc > 0) {
+       PUSHs(arg1);
+       if (argc > 1) PUSHs(arg2);
+       assert(argc <= 2);
     }
     PUTBACK;
     if (flags & G_DISCARD) {

diff --git a/proto.h b/proto.h
index 53e103d..207beed 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1904,7 +1904,7 @@ PERL_CALLCONV int Perl_magic_wipepack(pTHX_ SV* sv, MAGIC* mg)
 #define PERL_ARGS_ASSERT_MAGIC_WIPEPACK        \
        assert(sv); assert(mg)
 
-PERL_CALLCONV SV*      Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags, int n, SV* arg1, SV* arg2)
+PERL_CALLCONV SV*      Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags, U32 n, SV* arg1, SV* arg2)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2)
                        __attribute__nonnull__(pTHX_3);