From 6ea72b3a1069e5b7ba4f03a9fb27f685d3ac4733 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Sat, 25 Aug 2012 13:22:46 -0700
Subject: [PATCH] Optimise %hash in sub { %hash || ... }
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

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.)
---
 dump.c             | 4 ++++
 ext/B/B/Concise.pm | 1 +
 op.c               | 5 +++++
 op.h               | 3 +++
 pp.c               | 3 +++
 pp_hot.c           | 3 +++
 6 files changed, 19 insertions(+)

diff --git a/dump.c b/dump.c
index 3b3a74f..6ac3d33 100644
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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));
-- 
1.8.3.1