This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
make scalar(keys(%lexical)) less slow.
authorDavid Mitchell <davem@iabyn.com>
Sun, 23 Jul 2017 15:31:38 +0000 (16:31 +0100)
committerDavid Mitchell <davem@iabyn.com>
Thu, 27 Jul 2017 10:30:25 +0000 (11:30 +0100)
A recent commit in this branch made OP_PADHV / OP_RV2HV in void/scalar
context, followed by OP_KEYS, optimise away the OP_KEYS op and set the
OPpPADHV_ISKEYS or OPpRV2HV_ISKEYS flag on the OP_PADHV / OP_RV2HV op.

However, in scalar but non-boolean context with OP_PADHV, this actually
makes it slower, because the OP_KEYS op has a target, while the OP_PADHV
op doesn't, thus it has to create a new mortal each time to return the
integer value.

This commit fixes that by, in the case of scalar padhv, retaining the
OP_KEYS node (although still not keeping it in the execution path), then
at runtime using that op's otherwise unused target.

This only works on PERL_OP_PARENT builds (now the default) as the OP_KEYS
is the parent of the OP_PADHV, so would be hard to find at runtime
otherwise.

This commit also fixes pp_padhv/pp_rv2hv in void context - formerly it
was needlessly pushing a scalar-valued count like scalar context.

lib/B/Deparse.pm
op.c
pp_hot.c
t/perf/benchmarks

index f214081..fe4e249 100644 (file)
@@ -4115,7 +4115,13 @@ sub pp_padav { pp_padsv(@_) }
 
 sub pp_padhv {
     my $op = $_[1];
-    (($op->private & OPpPADHV_ISKEYS) ? 'keys ' : '') . pp_padsv(@_);
+    my $keys = '';
+    # with OPpPADHV_ISKEYS the keys op is optimised away, except
+    # in scalar context the old op is kept (but not executed) so its targ
+    # can be used.
+    $keys = 'keys ' if (     ($op->private & OPpPADHV_ISKEYS)
+                            && !(($op->flags & OPf_WANT) == OPf_WANT_SCALAR));
+    $keys . pp_padsv(@_);
 }
 
 sub gv_or_padgv {
diff --git a/op.c b/op.c
index 3be0e56..69cc693 100644 (file)
--- a/op.c
+++ b/op.c
@@ -14413,19 +14413,24 @@ Perl_rpeep(pTHX_ OP *o)
              */
             if (o->op_flags & OPf_REF) {
                 OP *k = o->op_next;
+                U8 want = (k->op_flags & OPf_WANT);
                 if (   k
                     && k->op_type == OP_KEYS
-                    && (   (k->op_flags & OPf_WANT) == OPf_WANT_VOID
-                        || (k->op_flags & OPf_WANT) == OPf_WANT_SCALAR)
+                    && (   want == OPf_WANT_VOID
+                        || want == OPf_WANT_SCALAR)
                     && !(k->op_private & OPpMAYBE_LVSUB)
                     && !(k->op_flags & OPf_MOD)
                 ) {
                     o->op_next     = k->op_next;
                     o->op_flags   &= ~(OPf_REF|OPf_WANT);
-                    o->op_flags   |= (k->op_flags & OPf_WANT);
+                    o->op_flags   |= want;
                     o->op_private |= (o->op_type == OP_PADHV ?
                                       OPpRV2HV_ISKEYS : OPpRV2HV_ISKEYS);
-                    op_null(k);
+                    /* for keys(%lex), hold onto the OP_KEYS's targ
+                     * since padhv doesn't have its own targ to return
+                     * an int with */
+                    if (!(o->op_type ==OP_PADHV && want == OPf_WANT_SCALAR))
+                        op_null(k);
                 }
             }
 
index e1e151b..528817f 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -991,6 +991,9 @@ S_padhv_rv2hv_common(pTHX_ HV *hv, U8 gimme, bool is_keys, bool has_targ)
         /* 'keys %h' masquerading as '%h': reset iterator */
         (void)hv_iterinit(hv);
 
+    if (gimme == G_VOID)
+        return NORMAL;
+
     is_bool = (     PL_op->op_private & OPpTRUEBOOL
               || (  PL_op->op_private & OPpMAYBE_TRUEBOOL
                   && block_gimme() == G_VOID));
@@ -1022,6 +1025,21 @@ S_padhv_rv2hv_common(pTHX_ HV *hv, U8 gimme, bool is_keys, bool has_targ)
                 PUSHi(i);
             }
             else
+#ifdef PERL_OP_PARENT
+            if (is_keys) {
+                /* parent op should be an unused OP_KEYS whose targ we can
+                 * use */
+                dTARG;
+                OP *k;
+
+                assert(!OpHAS_SIBLING(PL_op));
+                k = PL_op->op_sibparent;
+                assert(k->op_type == OP_KEYS);
+                TARG = PAD_SV(k->op_targ);
+                PUSHi(i);
+            }
+            else
+#endif
                 mPUSHi(i);
         }
     }
index 36782ec..08063b6 100644 (file)
     },
 
 
-    'func::keys::scalar_cxt_empty' => {
-        desc    => ' keys() on an empty hash in scalar context',
+    'func::keys::lex::void_cxt_empty' => {
+        desc    => ' keys() on an empty lexical hash in void context',
+        setup   => 'my %h = ()',
+        code    => 'keys %h',
+    },
+    'func::keys::lex::void_cxt' => {
+        desc    => ' keys() on a non-empty lexical hash in void context',
+        setup   => 'my %h = qw(aardvark 1 banana 2 cucumber 3)',
+        code    => 'keys %h',
+    },
+    'func::keys::lex::scalar_cxt_empty' => {
+        desc    => ' keys() on an empty lexical hash in scalar context',
         setup   => 'my $k; my %h = ()',
         code    => '$k = keys %h',
     },
-    'func::keys::scalar_cxt' => {
-        desc    => ' keys() on a non-empty hash in scalar context',
+    'func::keys::lex::scalar_cxt' => {
+        desc    => ' keys() on a non-empty lexical hash in scalar context',
         setup   => 'my $k; my %h = qw(aardvark 1 banana 2 cucumber 3)',
         code    => '$k = keys %h',
     },
-    'func::keys::list_cxt_empty' => {
-        desc    => ' keys() on an empty hash in list context',
+    'func::keys::lex::list_cxt_empty' => {
+        desc    => ' keys() on an empty lexical hash in list context',
         setup   => 'my %h = ()',
         code    => '() = keys %h',
     },
-    'func::keys::list_cxt' => {
-        desc    => ' keys() on a non-empty hash in list context',
+    'func::keys::lex::list_cxt' => {
+        desc    => ' keys() on a non-empty lexical hash in list context',
         setup   => 'my %h = qw(aardvark 1 banana 2 cucumber 3)',
         code    => '() = keys %h',
     },
 
+    'func::keys::pkg::void_cxt_empty' => {
+        desc    => ' keys() on an empty package hash in void context',
+        setup   => 'our %h = ()',
+        code    => 'keys %h',
+    },
+    'func::keys::pkg::void_cxt' => {
+        desc    => ' keys() on a non-empty package hash in void context',
+        setup   => 'our %h = qw(aardvark 1 banana 2 cucumber 3)',
+        code    => 'keys %h',
+    },
+    'func::keys::pkg::scalar_cxt_empty' => {
+        desc    => ' keys() on an empty package hash in scalar context',
+        setup   => 'my $k; our %h = ()',
+        code    => '$k = keys %h',
+    },
+    'func::keys::pkg::scalar_cxt' => {
+        desc    => ' keys() on a non-empty package hash in scalar context',
+        setup   => 'my $k; our %h = qw(aardvark 1 banana 2 cucumber 3)',
+        code    => '$k = keys %h',
+    },
+    'func::keys::pkg::list_cxt_empty' => {
+        desc    => ' keys() on an empty package hash in list context',
+        setup   => 'our %h = ()',
+        code    => '() = keys %h',
+    },
+    'func::keys::pkg::list_cxt' => {
+        desc    => ' keys() on a non-empty package hash in list context',
+        setup   => 'our %h = qw(aardvark 1 banana 2 cucumber 3)',
+        code    => '() = keys %h',
+    },
+
 
     'func::length::bool0' => {
         desc    => 'length==0 in boolean context',