X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mg.c;h=7c7c03ea30c062e48febe09238cdedaa0d6362ca;hb=842c41230043ce99d4bf7b2c79aed85ce2908e89;hp=24d2b986a589404b81e399da990ff0a87097541e;hpb=efaf36747029c85b4d8825318cb4d485a0bb350e;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/mg.c b/mg.c
index 24d2b98..7c7c03e 100644
--- a/mg.c
+++ b/mg.c
@@ -178,6 +178,8 @@ S_is_container_magic(const MAGIC *mg)
     case PERL_MAGIC_arylen_p:
     case PERL_MAGIC_rhash:
     case PERL_MAGIC_symtab:
+    case PERL_MAGIC_tied: /* treat as value, so 'local @tied' isn't tied */
+    case PERL_MAGIC_tiedscalar: /* so 'local $scalar' isn't tied */
 	return 0;
     default:
 	return 1;
@@ -1649,10 +1651,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.
 
@@ -1661,8 +1665,8 @@ 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, I32 flags,
-    int n, SV *arg1, SV *arg2)
+Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags,
+		    U32 argc, ...)
 {
     dVAR;
     dSP;
@@ -1674,22 +1678,22 @@ Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, I32 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) {
+	va_list args;
+	va_start(args, argc);
+
+	do {
+	    SV *const sv = va_arg(args, SV *);
+	    PUSHs(sv);
+	} while (--argc);
+
+	va_end(args);
     }
     PUTBACK;
     if (flags & G_DISCARD) {
@@ -1708,7 +1712,7 @@ Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, I32 flags,
 /* wrapper for magic_methcall that creates the first arg */
 
 STATIC SV*
-S_magic_methcall1(pTHX_ SV *sv, const MAGIC *mg, const char *meth, I32 flags,
+S_magic_methcall1(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags,
     int n, SV *val)
 {
     dVAR;
@@ -1718,22 +1722,19 @@ S_magic_methcall1(pTHX_ SV *sv, const MAGIC *mg, const char *meth, I32 flags,
 
     if (mg->mg_ptr) {
 	if (mg->mg_len >= 0) {
-	    arg1 = newSVpvn(mg->mg_ptr, mg->mg_len);
-	    sv_2mortal(arg1);
+	    arg1 = newSVpvn_flags(mg->mg_ptr, mg->mg_len, SVs_TEMP);
 	}
 	else if (mg->mg_len == HEf_SVKEY)
 	    arg1 = MUTABLE_SV(mg->mg_ptr);
     }
     else if (mg->mg_type == PERL_MAGIC_tiedelem) {
-	arg1 = newSV_type(SVt_IV);
-	sv_setiv(arg1, (IV)(mg->mg_len));
+	arg1 = newSViv((IV)(mg->mg_len));
 	sv_2mortal(arg1);
     }
     if (!arg1) {
-	arg1 = val;
-	n--;
+	return Perl_magic_methcall(aTHX_ sv, mg, meth, flags, n - 1, val);
     }
-    return magic_methcall(sv, mg, meth, flags, n, arg1, val);
+    return Perl_magic_methcall(aTHX_ sv, mg, meth, flags, n, arg1, val);
 }
 
 STATIC int
@@ -1827,7 +1828,7 @@ Perl_magic_wipepack(pTHX_ SV *sv, MAGIC *mg)
 
     PERL_ARGS_ASSERT_MAGIC_WIPEPACK;
 
-    magic_methcall(sv, mg, "CLEAR", G_DISCARD, 0, NULL, NULL);
+    Perl_magic_methcall(aTHX_ sv, mg, "CLEAR", G_DISCARD, 0);
     return 0;
 }
 
@@ -1839,10 +1840,8 @@ Perl_magic_nextpack(pTHX_ SV *sv, MAGIC *mg, SV *key)
 
     PERL_ARGS_ASSERT_MAGIC_NEXTPACK;
 
-    ret = magic_methcall(sv, mg,
-	    (SvOK(key) ? "NEXTKEY" : "FIRSTKEY"),
-	    0,
-	    (SvOK(key) ? 1 : 0), key, NULL);
+    ret = SvOK(key) ? Perl_magic_methcall(aTHX_ sv, mg, "NEXTKEY", 0, 1, key)
+	: Perl_magic_methcall(aTHX_ sv, mg, "FIRSTKEY", 0, 0);
     if (ret)
 	sv_setsv(key,ret);
     return 0;
@@ -1879,7 +1878,7 @@ Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg)
     }
    
     /* there is a SCALAR method that we can call */
-    retval = magic_methcall(MUTABLE_SV(hv), mg, "SCALAR", 0, 0, NULL, NULL);
+    retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(hv), mg, "SCALAR", 0, 0);
     if (!retval)
 	retval = &PL_sv_undef;
     return retval;
@@ -3007,7 +3006,7 @@ Perl_sighandler(int sig)
 	(void)rsignal(sig, PL_csighandlerp);
 #endif
 #endif /* !PERL_MICRO */
-	Perl_die(aTHX_ NULL);
+	die_sv(ERRSV);
     }
 cleanup:
     if (flags & 1)
@@ -3074,13 +3073,12 @@ S_restore_magic(pTHX_ const void *p)
      */
     if (PL_savestack_ix == mgs->mgs_ss_ix)
     {
-	I32 popval = SSPOPINT;
+	UV popval = SSPOPUV;
         assert(popval == SAVEt_DESTRUCTOR_X);
         PL_savestack_ix -= 2;
-	popval = SSPOPINT;
-        assert(popval == SAVEt_ALLOC);
-	popval = SSPOPINT;
-        PL_savestack_ix -= popval;
+	popval = SSPOPUV;
+        assert((popval & SAVE_MASK) == SAVEt_ALLOC);
+        PL_savestack_ix -= popval >> SAVE_TIGHT_SHIFT;
     }
 
 }