Optimise %hash in sub { %hash || ... }

In %hash || $foo, the %hash is in scalar context, so it has to iterate
through the buckets to produce statistics on bucket usage.

If the || is in void context, the value returned by hash is only ever
used as a boolean (as || doesn’t have to return it).  We already opti-
mise it by adding a boolkeys op when it is known at compile time that
|| will be in void context.

In sub { %hash || $foo } it is not known at compile time that it will
be in void context, so it wasn’t optimised.

This commit optimises it by flagging the %hash at compile time as
being possibly in ‘true boolean’ context.  When that flag is set,
the rv2hv and padhv ops call block_gimme() to see whether || is in
void context.

This speeds things up signficantly.  Here is what I got after optimis-
ing rv2hv but before doing padhv:

$ time ./miniperl -e '%hash = 1..10000; sub { %hash || 1 }->() for 1..100000'

real	0m0.179s
user	0m0.101s
sys	0m0.005s
$ time ./miniperl -e 'my %hash = 1..10000; sub { %hash || 1 }->() for 1..100000'

real	0m5.446s
user	0m2.419s
sys	0m0.015s

(That example is slightly misleading because of the closure, but the
closure version takes 1 sec. when optimised.)

diff --git a/dump.c b/dump.c
index 3b3a74f..6ac3d33 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -943,6 +943,10 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
                if (o->op_private & OPpLVAL_DEFER)
                    sv_catpv(tmpsv, ",LVAL_DEFER");
            }
+           else if ((optype == OP_RV2HV || optype == OP_PADHV)
+                 && o->op_private & OpMAYBE_TRUEBOOL) {
+               sv_catpvs(tmpsv, ",OpMAYBE_TRUEBOOL");
+           }
            else {
                if (o->op_private & HINT_STRICT_REFS)
                    sv_catpv(tmpsv, ",STRICT_REFS");

diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index f0a1b44..3f2a93d 100644 (file)
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -629,6 +629,7 @@ $priv{$_}{16} = "OURINTR" for ("gvsv", "rv2sv", "rv2av", "rv2hv", "r2gv",
        "enteriter");
 $priv{$_}{8} = 'LVSUB' for qw(rv2av rv2gv rv2hv padav padhv aelem helem
                         aslice hslice av2arylen keys rkeys substr pos vec);
+$priv{$_}{64} = 'BOOL' for 'rv2hv', 'padhv';
 $priv{substr}{16} = 'REPL1ST';
 $priv{$_}{16} = "TARGMY"
   for (map(($_,"s$_"),"chop", "chomp"),

diff --git a/op.c b/op.c
index dd61cff..c62e943 100644 (file)
--- a/op.c
+++ b/op.c
@@ -10580,6 +10580,11 @@ Perl_rpeep(pTHX_ register OP *o)
                       || o->op_type == OP_AND  )
                    && fopishv)
                         cLOGOP->op_first = opt_scalarhv(fop);
+                else if (!(lop->op_flags & OPf_WANT)) {
+                    if (fop->op_type == OP_SCALAR)
+                        fop = cUNOPx(fop)->op_first;
+                    fop->op_private |= OpMAYBE_TRUEBOOL;
+                }
                 if (  (lop->op_flags & OPf_WANT) == OPf_WANT_VOID
                    && sopishv)
                         cLOGOP->op_first->op_sibling = opt_scalarhv(sop);

diff --git a/op.h b/op.h
index c4147ce..d977e57 100644 (file)
--- a/op.h
+++ b/op.h
@@ -221,6 +221,9 @@ Deprecated.  Use C<GIMME_V> instead.
   /* OP_RV2[AGH]V, OP_PAD[AH]V, OP_[AH]ELEM, OP_[AH]SLICE OP_AV2ARYLEN,
      OP_R?KEYS, OP_SUBSTR, OP_POS, OP_VEC */
 #define OPpMAYBE_LVSUB         8       /* We might be an lvalue to return */
+  /* OP_RV2HV and OP_PADHV */
+#define OpMAYBE_TRUEBOOL       64      /* %hash in (%hash || $foo) where
+                                          cx is not known till run time */
 
   /* OP_SUBSTR only */
 #define OPpSUBSTR_REPL_FIRST   16      /* 1st arg is replacement string */

diff --git a/pp.c b/pp.c
index eba4e22..e61894a 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -131,6 +131,9 @@ PP(pp_padhv)
     if (gimme == G_ARRAY) {
        RETURNOP(Perl_do_kv(aTHX));
     }
+    else if (PL_op->op_private & OpMAYBE_TRUEBOOL
+         && block_gimme() == G_VOID)
+       SETs(boolSV(HvUSEDKEYS(TARG)));
     else if (gimme == G_SCALAR) {
        SV* const sv = Perl_hv_scalar(aTHX_ MUTABLE_HV(TARG));
        SETs(sv);

diff --git a/pp_hot.c b/pp_hot.c
index 2493ae5..754536a 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -873,6 +873,9 @@ PP(pp_rv2av)
            *PL_stack_sp = sv;
            return Perl_do_kv(aTHX);
        }
+       else if (PL_op->op_private & OpMAYBE_TRUEBOOL
+             && block_gimme() == G_VOID)
+           SETs(boolSV(HvUSEDKEYS(sv)));
        else if (gimme == G_SCALAR) {
            dTARGET;
            TARG = Perl_hv_scalar(aTHX_ MUTABLE_HV(sv));