speed up (non)overloaded derefs
authorDavid Mitchell <davem@iabyn.com>
Sat, 15 Feb 2014 22:47:16 +0000 (22:47 +0000)
committerDavid Mitchell <davem@iabyn.com>
Fri, 28 Feb 2014 13:42:49 +0000 (13:42 +0000)
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.)

gv.c
hv.h
mro.c

diff --git a/gv.c b/gv.c
index baf9804..c1b1639 100644 (file)
--- 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;
 }
diff --git a/hv.h b/hv.h
index 5ad1459..5b52f98 100644 (file)
--- a/hv.h
+++ b/hv.h
@@ -123,6 +123,7 @@ struct xpvhv_aux {
 };
 
 #define HvAUXf_SCAN_STASH   0x1   /* stash is being scanned by gv_check */
+#define HvAUXf_NO_DEREF     0x2   /* @{}, %{} etc (and nomethod) not present */
 
 /* hash structure: */
 /* This structure must match the beginning of struct xpvmg in sv.h. */
diff --git a/mro.c b/mro.c
index d041052..1b37ca7 100644 (file)
--- a/mro.c
+++ b/mro.c
@@ -545,6 +545,8 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash)
 
     /* Changes to @ISA might turn overloading on */
     HvAMAGIC_on(stash);
+    /* pessimise derefs for now. Will get recalculated by Gv_AMupdate() */
+    HvAUX(stash)->xhv_aux_flags &= ~HvAUXf_NO_DEREF;
 
     /* DESTROY can be cached in SvSTASH. */
     if (!SvOBJECT(stash)) SvSTASH(stash) = NULL;
@@ -1359,6 +1361,8 @@ Perl_mro_method_changed_in(pTHX_ HV *stash)
     /* The method change may be due to *{$package . "::()"} = \&nil; in
        overload.pm. */
     HvAMAGIC_on(stash);
+    /* pessimise derefs for now. Will get recalculated by Gv_AMupdate() */
+    HvAUX(stash)->xhv_aux_flags &= ~HvAUXf_NO_DEREF;
 }
 
 void