Add packname->stash cache before the check if a packname is a

filehandle or a package, it works because only packnames
that have been resolved to stashes are added to the cache,
and when a newIO is created we clean the cache.
Results in roughly 1.8 speed increase for class->method()
calls.

p4raw-id: //depot/perl@19133

8 files changed, 32 insertions, 0 deletions

diff --git a/embedvar.h b/embedvar.h
index 6e1d615974..920b33148c 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -373,6 +373,7 @@
 #define PL_sort_RealCmp		(vTHX->Isort_RealCmp)
 #define PL_splitstr		(vTHX->Isplitstr)
 #define PL_srand_called		(vTHX->Isrand_called)
+#define PL_stashcache		(vTHX->Istashcache)
 #define PL_statusvalue		(vTHX->Istatusvalue)
 #define PL_statusvalue_vms	(vTHX->Istatusvalue_vms)
 #define PL_stderrgv		(vTHX->Istderrgv)
@@ -665,6 +666,7 @@
 #define PL_Isort_RealCmp	PL_sort_RealCmp
 #define PL_Isplitstr		PL_splitstr
 #define PL_Isrand_called	PL_srand_called
+#define PL_Istashcache		PL_stashcache
 #define PL_Istatusvalue		PL_statusvalue
 #define PL_Istatusvalue_vms	PL_statusvalue_vms
 #define PL_Istderrgv		PL_stderrgv
diff --git a/gv.c b/gv.c
index cf43ae3553..0bedea47f7 100644
--- a/gv.c
+++ b/gv.c
@@ -1121,6 +1121,9 @@ Perl_newIO(pTHX)
     sv_upgrade((SV *)io,SVt_PVIO);
     SvREFCNT(io) = 1;
     SvOBJECT_on(io);
+    /* Clear the stashcache because a new IO could overrule a 
+       package name */
+    hv_clear(PL_stashcache);
     iogv = gv_fetchpv("FileHandle::", FALSE, SVt_PVHV);
     /* unless exists($main::{FileHandle}) and defined(%main::FileHandle::) */
     if (!(iogv && GvHV(iogv) && HvARRAY(GvHV(iogv))))
diff --git a/hv.c b/hv.c
index c798f1b01d..4300e363bb 100644
--- a/hv.c
+++ b/hv.c
@@ -1739,6 +1739,8 @@ Perl_hv_undef(pTHX_ HV *hv)
     hfreeentries(hv);
     Safefree(xhv->xhv_array /* HvARRAY(hv) */);
     if (HvNAME(hv)) {
+        if(PL_stashcache) 
+            hv_delete_ent(PL_stashcache, sv_2mortal(newSVpv(HvNAME(hv),0)), G_DISCARD, 0);
 	Safefree(HvNAME(hv));
 	HvNAME(hv) = 0;
     }
diff --git a/intrpvar.h b/intrpvar.h
index 61d48a2988..db7c19098b 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -506,6 +506,8 @@ PERLVAR(Isignals, U32)	/* Using which pre-5.8 signals */
 
 PERLVAR(IDBassertion,   SV *)
 
+PERLVAR(Istashcache,	HV *)		/* Cache to speed up S_method_common */
+
 /* Don't forget to add your variable also to perl_clone()! */
 
 /* New variables must be added to the very end, before this comment,
diff --git a/perl.c b/perl.c
index b5ed17a866..a93c9200ae 100644
--- a/perl.c
+++ b/perl.c
@@ -272,6 +272,8 @@ perl_construct(pTHXx)
 #endif
 	 PL_clocktick = HZ;
 
+    PL_stashcache = newHV();
+
     ENTER;
 }
 
@@ -457,6 +459,9 @@ perl_destruct(pTHXx)
     PL_regex_pad = NULL;
 #endif
 
+    SvREFCNT_dec((SV*) PL_stashcache);
+    PL_stashcache = NULL;
+
     /* loosen bonds of global variables */
 
     if(PL_rsfp) {
diff --git a/perlapi.h b/perlapi.h
index 0b8e6de6bf..e0e388c67d 100644
--- a/perlapi.h
+++ b/perlapi.h
@@ -504,6 +504,8 @@ END_EXTERN_C
 #define PL_splitstr		(*Perl_Isplitstr_ptr(aTHX))
 #undef  PL_srand_called
 #define PL_srand_called		(*Perl_Isrand_called_ptr(aTHX))
+#undef  PL_stashcache
+#define PL_stashcache		(*Perl_Istashcache_ptr(aTHX))
 #undef  PL_statusvalue
 #define PL_statusvalue		(*Perl_Istatusvalue_ptr(aTHX))
 #undef  PL_statusvalue_vms
diff --git a/pp_hot.c b/pp_hot.c
index a622c53548..3bc448d52a 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2926,6 +2926,15 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
 
 	/* this isn't a reference */
 	packname = Nullch;
+
+        if(SvOK(sv) && (packname = SvPV(sv, packlen))) {
+          HE* he = hv_fetch_ent(PL_stashcache, sv, 0, 0);
+          if (he) { 
+            stash = HeVAL(he);
+            goto fetch;
+          }
+        }
+
 	if (!SvOK(sv) ||
 	    !(packname = SvPV(sv, packlen)) ||
 	    !(iogv = gv_fetchpv(packname, FALSE, SVt_PVIO)) ||
@@ -2946,6 +2955,11 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
 	    stash = gv_stashpvn(packname, packlen, FALSE);
 	    if (!stash)
 		packsv = sv;
+            else {
+              SvREFCNT_inc((SV*)stash);
+              if(!hv_store(PL_stashcache, packname, packlen, stash, 0))
+                SvREFCNT_dec((SV*)stash);
+            }
 	    goto fetch;
 	}
 	/* it _is_ a filehandle name -- replace with a reference */
diff --git a/sv.c b/sv.c
index 2ffa0cad10..6ead8bb0f5 100644
--- a/sv.c
+++ b/sv.c
@@ -11397,6 +11397,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     /* Pluggable optimizer */
     PL_peepp		= proto_perl->Tpeepp;
 
+    PL_stashcache       = newHV();
+
     if (!(flags & CLONEf_KEEP_PTR_TABLE)) {
         ptr_table_free(PL_ptr_table);
         PL_ptr_table = NULL;