From: Nicholas Clark <nick@ccl4.org>
Date: Sun, 25 Apr 2010 14:41:48 +0000 (+0100)
Subject: For Perl_magic_methcall() add G_UNDEF_FILL to fill the stack with &PL_sv_undef.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=67549bd2d9da9e6710cdab4542e708ef4d4346b6;p=p5sagit%2Fp5-mst-13.2.git

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