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.

4 files changed, 34 insertions, 17 deletions

diff --git a/cop.h b/cop.h
index 122e2d75e0..e33dc15493 100644
--- 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 10e026e3e6..dbf5f5f7f1 100644
--- 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 1f8bae51a0..41b0a6403c 100644
--- 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 f6c20d0e10..e8a49f23eb 100644
--- 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) {