speed up (non)overloaded derefs

Consider a class that has some minimal overloading added - e.g. to give
pretty stringification of objects - but which *doesn't* overload
dereference methods such as '@[]'. '%[]' etc.

In this case, simple dereferencing, such as $obj->[0] or  $obj->{foo}
becomes much slower than if the object was blessed into a non-overloaded
class.

This is because every time a dereferencing is performed in pp_rv2av for
example, the "normal" code path has to go through the full checking of:

  * is the stash into which the referent is blessed overloaded? If so,
  * retrieve the overload magic from the stash;
  * check whether the overload method cache has been invalidated and if so
    rebuild it;
  * check whether we are in the scope of 'no overloading', and if so
    is the current method disabled in this scope?
  * Is there a '@{}' or whatever (or 'nomethod') method in the cache?
    If not, then process the ref as normal.

That's a lot of extra overhead to decide that an overloaded method doesn't
in fact need to be called.

This commit adds a new flag to the newish xhv_aux_flags field,
HvAUXf_NO_DEREF, which signals that the overloading of this stash
contains no deref (nor 'nomethod') overloaded methods. Thus a quick check
for this flag in the common case allows us to short-circuit all the above
checks except the first one.

Before this commit, a simple $obj->[0] was about 40-50% slower if the
class it was blessed into was overloaded (but didn't have deref methods);
after the commit, the slowdown is 0-10%. (These timings are very
approximate, given the vagaries of nano benchmarks.)

1 files changed, 37 insertions, 2 deletions

diff --git a/gv.c b/gv.c
index baf9804b84..c1b1639d8a 100644
--- a/gv.c
+++ b/gv.c
@@ -2493,6 +2493,9 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
   {
     int filled = 0;
     int i;
+    struct xpvhv_aux *aux;
+    bool deref_seen = 0;
+
 
     /* Work with "fallback" key, which we assume to be first in PL_AMG_names */
 
@@ -2523,6 +2526,11 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
         filled = 1;
     }
 
+    assert(SvOOK(stash));
+    aux = HvAUX(stash);
+    /* initially assume the worst */
+    aux->xhv_aux_flags &= ~HvAUXf_NO_DEREF;
+
     for (i = 1; i < NofAMmeth; i++) {
 	const char * const cooky = PL_AMG_names[i];
 	/* Human-readable form, for debugging: */
@@ -2589,7 +2597,24 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
 	    filled = 1;
 	}
 	amt.table[i]=MUTABLE_CV(SvREFCNT_inc_simple(cv));
+
+        if (gv) {
+            switch (i) {
+            case to_sv_amg:
+            case to_av_amg:
+            case to_hv_amg:
+            case to_gv_amg:
+            case to_cv_amg:
+            case nomethod_amg:
+                deref_seen = 1;
+                break;
+            }
+        }
     }
+    if (!deref_seen)
+        /* none of @{} etc overloaded; we can do $obj->[N] quicker */
+        aux->xhv_aux_flags |= HvAUXf_NO_DEREF;
+
     if (filled) {
       AMT_AMAGIC_on(&amt);
       sv_magic(MUTABLE_SV(stash), 0, PERL_MAGIC_overload_table,
@@ -2759,11 +2784,19 @@ Perl_try_amagic_bin(pTHX_ int method, int flags) {
 SV *
 Perl_amagic_deref_call(pTHX_ SV *ref, int method) {
     SV *tmpsv = NULL;
+    HV *stash;
 
     PERL_ARGS_ASSERT_AMAGIC_DEREF_CALL;
 
-    while (SvAMAGIC(ref) && 
-	   (tmpsv = amagic_call(ref, &PL_sv_undef, method,
+    if (!SvAMAGIC(ref))
+        return ref;
+    /* return quickly if none of the deref ops are overloaded */
+    stash = SvSTASH(SvRV(ref));
+    assert(SvOOK(stash));
+    if (HvAUX(stash)->xhv_aux_flags & HvAUXf_NO_DEREF)
+        return ref;
+
+    while ((tmpsv = amagic_call(ref, &PL_sv_undef, method,
 				AMGf_noright | AMGf_unary))) { 
 	if (!SvROK(tmpsv))
 	    Perl_croak(aTHX_ "Overloaded dereference did not return a reference");
@@ -2772,6 +2805,8 @@ Perl_amagic_deref_call(pTHX_ SV *ref, int method) {
 	    return tmpsv;
 	}
 	ref = tmpsv;
+        if (!SvAMAGIC(ref))
+            break;
     }
     return tmpsv ? tmpsv : ref;
 }