This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Convert Perl_magic_methcall() to varargs.
authorNicholas Clark <nick@ccl4.org>
Mon, 26 Apr 2010 10:52:25 +0000 (11:52 +0100)
committerNicholas Clark <nick@ccl4.org>
Mon, 26 Apr 2010 20:09:54 +0000 (21:09 +0100)
This means removing its macro wrapper, as there's no portable way to do varargs
macros.

av.c
embed.fnc
embed.h
mg.c
proto.h

diff --git a/av.c b/av.c
index acedd00..b93a6d5 100644 (file)
--- a/av.c
+++ b/av.c
@@ -76,7 +76,8 @@ Perl_av_extend(pTHX_ AV *av, I32 key)
     if (mg) {
        SV *arg1 = sv_newmortal();
        sv_setiv(arg1, (IV)(key + 1));
-       magic_methcall(MUTABLE_SV(av), mg, "EXTEND", G_DISCARD, 1, arg1, NULL);
+       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "EXTEND", G_DISCARD, 1,
+                           arg1);
        return;
     }
     if (key > AvMAX(av)) {
@@ -544,7 +545,8 @@ Perl_av_push(pTHX_ register AV *av, SV *val)
        Perl_croak(aTHX_ "%s", PL_no_modify);
 
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-       magic_methcall(MUTABLE_SV(av), mg, "PUSH", G_DISCARD, 1, val, NULL);
+       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "PUSH", G_DISCARD, 1,
+                           val);
        return;
     }
     av_store(av,AvFILLp(av)+1,val);
@@ -572,7 +574,7 @@ Perl_av_pop(pTHX_ register AV *av)
     if (SvREADONLY(av))
        Perl_croak(aTHX_ "%s", PL_no_modify);
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-       retval = magic_methcall(MUTABLE_SV(av), mg, "POP", 0, 0, NULL, NULL);
+       retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "POP", 0, 0);
        if (retval)
            retval = newSVsv(retval);
        return retval;
@@ -632,8 +634,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 | G_UNDEF_FILL,
-                      num, NULL, NULL);
+       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "UNSHIFT",
+                           G_DISCARD | G_UNDEF_FILL, num);
        return;
     }
 
@@ -693,7 +695,7 @@ Perl_av_shift(pTHX_ register AV *av)
     if (SvREADONLY(av))
        Perl_croak(aTHX_ "%s", PL_no_modify);
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-       retval = magic_methcall(MUTABLE_SV(av), mg, "SHIFT", 0, 0, NULL, NULL);
+       retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "SHIFT", 0, 0);
        if (retval)
            retval = newSVsv(retval);
        return retval;
@@ -757,8 +759,8 @@ Perl_av_fill(pTHX_ register AV *av, I32 fill)
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
        SV *arg1 = sv_newmortal();
        sv_setiv(arg1, (IV)(fill + 1));
-       magic_methcall(MUTABLE_SV(av), mg, "STORESIZE", G_DISCARD,
-               1, arg1, NULL);
+       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "STORESIZE", G_DISCARD,
+                           1, arg1);
        return;
     }
     if (fill <= AvMAX(av)) {
index b48f95e..be7debe 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -682,9 +682,9 @@ p   |int    |magic_setutf8  |NN SV* sv|NN MAGIC* mg
 p      |int    |magic_set_all_env|NN SV* sv|NN MAGIC* mg
 p      |U32    |magic_sizepack |NN SV* sv|NN MAGIC* mg
 p      |int    |magic_wipepack |NN SV* sv|NN MAGIC* mg
-p    |SV*    |magic_methcall |NN SV *sv|NN const MAGIC *mg \
+pod    |SV*    |magic_methcall |NN SV *sv|NN const MAGIC *mg \
                                |NN const char *meth|U32 flags \
-                               |U32 argc|NULLOK SV* arg1|NULLOK SV* arg2
+                               |U32 argc|...
 Ap     |void   |markstack_grow
 #if defined(USE_LOCALE_COLLATE)
 p      |int    |magic_setcollxfrm|NN SV* sv|NN MAGIC* mg
diff --git a/embed.h b/embed.h
index 7df5930..a3f7408 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define magic_set_all_env      Perl_magic_set_all_env
 #define magic_sizepack         Perl_magic_sizepack
 #define magic_wipepack         Perl_magic_wipepack
-#define magic_methcall         Perl_magic_methcall
 #endif
 #define markstack_grow         Perl_markstack_grow
 #if defined(USE_LOCALE_COLLATE)
 #define magic_set_all_env(a,b) Perl_magic_set_all_env(aTHX_ a,b)
 #define magic_sizepack(a,b)    Perl_magic_sizepack(aTHX_ a,b)
 #define magic_wipepack(a,b)    Perl_magic_wipepack(aTHX_ a,b)
-#define magic_methcall(a,b,c,d,e,f,g)  Perl_magic_methcall(aTHX_ a,b,c,d,e,f,g)
 #endif
 #define markstack_grow()       Perl_markstack_grow(aTHX)
 #if defined(USE_LOCALE_COLLATE)
diff --git a/mg.c b/mg.c
index 66d777f..c89be40 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -1664,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,
-                   U32 argc, SV *arg1, SV *arg2)
+                   U32 argc, ...)
 {
     dVAR;
     dSP;
@@ -1683,9 +1683,15 @@ Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags,
            PUSHs(&PL_sv_undef);
        }
     } else if (argc > 0) {
-       PUSHs(arg1);
-       if (argc > 1) PUSHs(arg2);
-       assert(argc <= 2);
+       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) {
@@ -1724,10 +1730,9 @@ S_magic_methcall1(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags,
        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
@@ -1821,7 +1826,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;
 }
 
@@ -1833,10 +1838,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;
@@ -1873,7 +1876,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;
diff --git a/proto.h b/proto.h
index 207beed..9f89783 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, U32 n, SV* arg1, SV* arg2)
+PERL_CALLCONV SV*      Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags, U32 argc, ...)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2)
                        __attribute__nonnull__(pTHX_3);