G_METHOD_NAMED flag for call_method and call_sv

Can be used when it's known that method name has no
package part - just method name.

With flag set SV with precomputed hash value is used
and pp_method_named is called instead of pp_method.
Method lookup is faster.

diff --git a/cop.h b/cop.h
index 122e2d7..e33dc15 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -1058,6 +1058,7 @@ L<perlcall>.
 #define G_WRITING_TO_STDERR 1024 /* Perl_write_to_stderr() is calling
                                    Perl_magic_methcall().  */
 #define G_RE_REPARSING 0x800     /* compiling a run-time /(?{..})/ */
+#define G_METHOD_NAMED 4096    /* calling named method, eg without :: or ' */
 
 /* flag bits for PL_in_eval */
 #define EVAL_NULL      0       /* not in an eval */

diff --git a/mg.c b/mg.c
index 10e026e..dbf5f5f 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -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);
+       call_method(meth, G_SCALAR|G_DISCARD|G_METHOD_NAMED);
     }
     else {
-       if (call_method(meth, G_SCALAR))
+       if (call_method(meth, G_SCALAR|G_METHOD_NAMED))
            ret = *PL_stack_sp--;
     }
     POPSTACK;

diff --git a/perl.c b/perl.c
index 1f8bae5..41b0a64 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -2674,12 +2674,15 @@ Perl_call_method(pTHX_ const char *methname, I32 flags)
                        /* See G_* flags in cop.h */
 {
     STRLEN len;
+    SV* sv;
     PERL_ARGS_ASSERT_CALL_METHOD;
 
     len = strlen(methname);
+    sv = flags & G_METHOD_NAMED
+        ? sv_2mortal(newSVpvn_share(methname, len,0))
+        : newSVpvn_flags(methname, len, SVs_TEMP);
 
-    /* XXX: sv_2mortal(newSVpvn_share(methname, len)) can be faster */
-    return call_sv(newSVpvn_flags(methname, len, SVs_TEMP), flags | G_METHOD);
+    return call_sv(sv, flags | G_METHOD);
 }
 
 /* May be called with any of a CV, a GV, or an SV containing the name. */
@@ -2698,7 +2701,9 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
 {
     dVAR; dSP;
     LOGOP myop;                /* fake syntax tree node */
-    UNOP method_op;
+    OP* method;
+    UNOP method_unop;
+    SVOP method_svop;
     I32 oldmark;
     VOL I32 retval = 0;
     I32 oldscope;
@@ -2727,7 +2732,8 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
     PL_op = (OP*)&myop;
 
     EXTEND(PL_stack_sp, 1);
-    *++PL_stack_sp = sv;
+    if (!(flags & G_METHOD_NAMED))
+        *++PL_stack_sp = sv;
     oldmark = TOPMARK;
     oldscope = PL_scopestack_ix;
 
@@ -2740,14 +2746,24 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
          && !(flags & G_NODEBUG))
        myop.op_private |= OPpENTERSUB_DB;
 
-    if (flags & G_METHOD) {
-       Zero(&method_op, 1, UNOP);
-       method_op.op_next = (OP*)&myop;
-       method_op.op_ppaddr = PL_ppaddr[OP_METHOD];
-       method_op.op_type = OP_METHOD;
-       myop.op_ppaddr = PL_ppaddr[OP_ENTERSUB];
-       myop.op_type = OP_ENTERSUB;
-       PL_op = (OP*)&method_op;
+    if (flags & (G_METHOD|G_METHOD_NAMED)) {
+        if ( flags & G_METHOD_NAMED ) {
+            Zero(&method_svop, 1, SVOP);
+            method_svop.op_next = (OP*)&myop;
+            method_svop.op_ppaddr = PL_ppaddr[OP_METHOD_NAMED];
+            method_svop.op_type = OP_METHOD_NAMED;
+            method_svop.op_sv = sv;
+            PL_op = (OP*)&method_svop;
+        } else {
+            Zero(&method_unop, 1, UNOP);
+            method_unop.op_next = (OP*)&myop;
+            method_unop.op_ppaddr = PL_ppaddr[OP_METHOD];
+            method_unop.op_type = OP_METHOD;
+            PL_op = (OP*)&method_unop;
+        }
+        myop.op_ppaddr = PL_ppaddr[OP_ENTERSUB];
+        myop.op_type = OP_ENTERSUB;
+
     }
 
     if (!(flags & G_EVAL)) {

diff --git a/pp.c b/pp.c
index f6c20d0..e8a49f2 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -5100,7 +5100,7 @@ PP(pp_push)
        PUSHMARK(MARK);
        PUTBACK;
        ENTER_with_name("call_PUSH");
-       call_method("PUSH",G_SCALAR|G_DISCARD);
+       call_method("PUSH",G_SCALAR|G_DISCARD|G_METHOD_NAMED);
        LEAVE_with_name("call_PUSH");
        SPAGAIN;
     }
@@ -5153,7 +5153,7 @@ PP(pp_unshift)
        PUSHMARK(MARK);
        PUTBACK;
        ENTER_with_name("call_UNSHIFT");
-       call_method("UNSHIFT",G_SCALAR|G_DISCARD);
+       call_method("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);
+           call_method("PUSH",G_SCALAR|G_DISCARD|G_METHOD_NAMED);
            LEAVE_with_name("call_PUSH");
            SPAGAIN;
            if (gimme == G_ARRAY) {