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

diff --git a/embedvar.h b/embedvar.h
index 6e1d615..920b331 100644 (file)
--- 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 cf43ae3..0bedea4 100644 (file)
--- 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 c798f1b..4300e36 100644 (file)
--- 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 61d48a2..db7c190 100644 (file)
--- 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 b5ed17a..a93c920 100644 (file)
--- 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 0b8e6de..e0e388c 100644 (file)
--- 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 a622c53..3bc448d 100644 (file)
--- 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 2ffa0ca..6ead8bb 100644 (file)
--- 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;