change magic_methcall to use SV with shared hash value

Perl_magic_methcall is not public API, so there is no
need to add another function and we can just change
function's arguments.

diff --git a/av.c b/av.c
index 44b5fbc..fb01f48 100644 (file)
--- a/av.c
+++ b/av.c
@@ -76,7 +76,7 @@ Perl_av_extend(pTHX_ AV *av, I32 key)
     if (mg) {
        SV *arg1 = sv_newmortal();
        sv_setiv(arg1, (IV)(key + 1));
-       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "EXTEND", G_DISCARD, 1,
+       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(EXTEND), G_DISCARD, 1,
                            arg1);
        return;
     }
@@ -561,7 +561,7 @@ Perl_av_push(pTHX_ AV *av, SV *val)
        Perl_croak_no_modify();
 
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "PUSH", G_DISCARD, 1,
+       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(PUSH), G_DISCARD, 1,
                            val);
        return;
     }
@@ -593,7 +593,7 @@ Perl_av_pop(pTHX_ AV *av)
     if (SvREADONLY(av))
        Perl_croak_no_modify();
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-       retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "POP", 0, 0);
+       retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(POP), 0, 0);
        if (retval)
            retval = newSVsv(retval);
        return retval;
@@ -655,7 +655,7 @@ Perl_av_unshift(pTHX_ AV *av, I32 num)
        Perl_croak_no_modify();
 
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "UNSHIFT",
+       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(UNSHIFT),
                            G_DISCARD | G_UNDEF_FILL, num);
        return;
     }
@@ -719,7 +719,7 @@ Perl_av_shift(pTHX_ AV *av)
     if (SvREADONLY(av))
        Perl_croak_no_modify();
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-       retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "SHIFT", 0, 0);
+       retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(SHIFT), 0, 0);
        if (retval)
            retval = newSVsv(retval);
        return retval;
@@ -792,7 +792,7 @@ Perl_av_fill(pTHX_ AV *av, I32 fill)
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
        SV *arg1 = sv_newmortal();
        sv_setiv(arg1, (IV)(fill + 1));
-       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "STORESIZE", G_DISCARD,
+       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(STORESIZE), G_DISCARD,
                            1, arg1);
        return;
     }

diff --git a/embed.fnc b/embed.fnc
index a906eae..38b499f 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -819,7 +819,7 @@ 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
 pod    |SV*    |magic_methcall |NN SV *sv|NN const MAGIC *mg \
-                               |NN const char *meth|U32 flags \
+                               |NN SV *meth|U32 flags \
                                |U32 argc|...
 Ap     |void   |markstack_grow
 #if defined(USE_LOCALE_COLLATE)
@@ -1788,9 +1788,9 @@ sM        |void   |clear_placeholders     |NN HV *hv|U32 items
 
 #if defined(PERL_IN_MG_C)
 s      |void   |save_magic     |I32 mgs_ix|NN SV *sv
--s     |int    |magic_methpack |NN SV *sv|NN const MAGIC *mg|NN const char *meth
+-s     |int    |magic_methpack |NN SV *sv|NN const MAGIC *mg|NN SV *meth
 s      |SV*    |magic_methcall1|NN SV *sv|NN const MAGIC *mg \
-                               |NN const char *meth|U32 flags \
+                               |NN SV *meth|U32 flags \
                                |int n|NULLOK SV *val
 s      |void   |restore_magic  |NULLOK const void *p
 s      |void   |unwind_handler_stack|NULLOK const void *p

diff --git a/mg.c b/mg.c
index dbf5f5f..7ff78c1 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -1704,7 +1704,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,
+Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, SV *meth, U32 flags,
                    U32 argc, ...)
 {
     dVAR;
@@ -1745,10 +1745,10 @@ Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags,
     }
     PUTBACK;
     if (flags & G_DISCARD) {
-       call_method(meth, G_SCALAR|G_DISCARD|G_METHOD_NAMED);
+       call_sv(meth, G_SCALAR|G_DISCARD|G_METHOD_NAMED);
     }
     else {
-       if (call_method(meth, G_SCALAR|G_METHOD_NAMED))
+       if (call_sv(meth, G_SCALAR|G_METHOD_NAMED))
            ret = *PL_stack_sp--;
     }
     POPSTACK;
@@ -1758,11 +1758,10 @@ Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags,
     return ret;
 }
 
-
 /* wrapper for magic_methcall that creates the first arg */
 
 STATIC SV*
-S_magic_methcall1(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags,
+S_magic_methcall1(pTHX_ SV *sv, const MAGIC *mg, SV *meth, U32 flags,
     int n, SV *val)
 {
     dVAR;
@@ -1788,7 +1787,7 @@ S_magic_methcall1(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags,
 }
 
 STATIC int
-S_magic_methpack(pTHX_ SV *sv, const MAGIC *mg, const char *meth)
+S_magic_methpack(pTHX_ SV *sv, const MAGIC *mg, SV *meth)
 {
     dVAR;
     SV* ret;
@@ -1808,7 +1807,7 @@ Perl_magic_getpack(pTHX_ SV *sv, MAGIC *mg)
 
     if (mg->mg_type == PERL_MAGIC_tiedelem)
        mg->mg_flags |= MGf_GSKIP;
-    magic_methpack(sv,mg,"FETCH");
+    magic_methpack(sv,mg,SV_CONST(FETCH));
     return 0;
 }
 
@@ -1840,7 +1839,7 @@ Perl_magic_setpack(pTHX_ SV *sv, MAGIC *mg)
     else
        val = sv;
 
-    magic_methcall1(sv, mg, "STORE", G_DISCARD, 2, val);
+    magic_methcall1(sv, mg, SV_CONST(STORE), G_DISCARD, 2, val);
     return 0;
 }
 
@@ -1850,7 +1849,7 @@ Perl_magic_clearpack(pTHX_ SV *sv, MAGIC *mg)
     PERL_ARGS_ASSERT_MAGIC_CLEARPACK;
 
     if (mg->mg_type == PERL_MAGIC_tiedscalar) return 0;
-    return magic_methpack(sv,mg,"DELETE");
+    return magic_methpack(sv,mg,SV_CONST(DELETE));
 }
 
 
@@ -1863,7 +1862,7 @@ Perl_magic_sizepack(pTHX_ SV *sv, MAGIC *mg)
 
     PERL_ARGS_ASSERT_MAGIC_SIZEPACK;
 
-    retsv = magic_methcall1(sv, mg, "FETCHSIZE", 0, 1, NULL);
+    retsv = magic_methcall1(sv, mg, SV_CONST(FETCHSIZE), 0, 1, NULL);
     if (retsv) {
        retval = SvIV(retsv)-1;
        if (retval < -1)
@@ -1879,7 +1878,7 @@ Perl_magic_wipepack(pTHX_ SV *sv, MAGIC *mg)
 
     PERL_ARGS_ASSERT_MAGIC_WIPEPACK;
 
-    Perl_magic_methcall(aTHX_ sv, mg, "CLEAR", G_DISCARD, 0);
+    Perl_magic_methcall(aTHX_ sv, mg, SV_CONST(CLEAR), G_DISCARD, 0);
     return 0;
 }
 
@@ -1891,8 +1890,8 @@ Perl_magic_nextpack(pTHX_ SV *sv, MAGIC *mg, SV *key)
 
     PERL_ARGS_ASSERT_MAGIC_NEXTPACK;
 
-    ret = SvOK(key) ? Perl_magic_methcall(aTHX_ sv, mg, "NEXTKEY", 0, 1, key)
-       : Perl_magic_methcall(aTHX_ sv, mg, "FIRSTKEY", 0, 0);
+    ret = SvOK(key) ? Perl_magic_methcall(aTHX_ sv, mg, SV_CONST(NEXTKEY), 0, 1, key)
+       : Perl_magic_methcall(aTHX_ sv, mg, SV_CONST(FIRSTKEY), 0, 0);
     if (ret)
        sv_setsv(key,ret);
     return 0;
@@ -1903,7 +1902,7 @@ Perl_magic_existspack(pTHX_ SV *sv, const MAGIC *mg)
 {
     PERL_ARGS_ASSERT_MAGIC_EXISTSPACK;
 
-    return magic_methpack(sv,mg,"EXISTS");
+    return magic_methpack(sv,mg,SV_CONST(EXISTS));
 }
 
 SV *
@@ -1929,7 +1928,7 @@ Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg)
     }
    
     /* there is a SCALAR method that we can call */
-    retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(hv), mg, "SCALAR", 0, 0);
+    retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(hv), mg, SV_CONST(SCALAR), 0, 0);
     if (!retval)
        retval = &PL_sv_undef;
     return retval;

diff --git a/pp.c b/pp.c
index e8a49f2..96414c9 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -5153,7 +5153,7 @@ PP(pp_unshift)
        PUSHMARK(MARK);
        PUTBACK;
        ENTER_with_name("call_UNSHIFT");
-       call_method("UNSHIFT",G_SCALAR|G_DISCARD|G_METHOD_NAMED);
+       call_sv(SV_CONST(UNSHIFT),G_SCALAR|G_DISCARD|G_METHOD_NAMED);
        LEAVE_with_name("call_UNSHIFT");
        SPAGAIN;
     }
@@ -5711,7 +5711,7 @@ PP(pp_split)
        else {
            PUTBACK;
            ENTER_with_name("call_PUSH");
-           call_method("PUSH",G_SCALAR|G_DISCARD|G_METHOD_NAMED);
+           call_sv(SV_CONST(PUSH),G_SCALAR|G_DISCARD|G_METHOD_NAMED);
            LEAVE_with_name("call_PUSH");
            SPAGAIN;
            if (gimme == G_ARRAY) {

diff --git a/proto.h b/proto.h
index 86dffce..eda326d 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -2280,7 +2280,7 @@ PERL_CALLCONV int Perl_magic_killbackrefs(pTHX_ SV *sv, MAGIC *mg)
 #define PERL_ARGS_ASSERT_MAGIC_KILLBACKREFS    \
        assert(sv); assert(mg)
 
-PERL_CALLCONV SV*      Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags, U32 argc, ...)
+PERL_CALLCONV SV*      Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, SV *meth, U32 flags, U32 argc, ...)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2)
                        __attribute__nonnull__(pTHX_3);
@@ -5771,14 +5771,14 @@ STATIC char*    S_stdize_locale(pTHX_ char* locs)
 #  endif
 #endif
 #if defined(PERL_IN_MG_C)
-STATIC SV*     S_magic_methcall1(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags, int n, SV *val)
+STATIC SV*     S_magic_methcall1(pTHX_ SV *sv, const MAGIC *mg, SV *meth, U32 flags, int n, SV *val)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2)
                        __attribute__nonnull__(pTHX_3);
 #define PERL_ARGS_ASSERT_MAGIC_METHCALL1       \
        assert(sv); assert(mg); assert(meth)
 
-STATIC int     S_magic_methpack(pTHX_ SV *sv, const MAGIC *mg, const char *meth)
+STATIC int     S_magic_methpack(pTHX_ SV *sv, const MAGIC *mg, SV *meth)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2)
                        __attribute__nonnull__(pTHX_3);

diff --git a/util.c b/util.c
index 11a7863..01f441b 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1340,7 +1340,7 @@ Perl_write_to_stderr(pTHX_ SV* msv)
     if (PL_stderrgv && SvREFCNT(PL_stderrgv) 
        && (io = GvIO(PL_stderrgv))
        && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) 
-       Perl_magic_methcall(aTHX_ MUTABLE_SV(io), mg, "PRINT",
+       Perl_magic_methcall(aTHX_ MUTABLE_SV(io), mg, SV_CONST(PRINT),
                            G_SCALAR | G_DISCARD | G_WRITING_TO_STDERR, 1, msv);
     else {
 #ifdef USE_SFIO