create Perl_hv_pushkv() function
authorDavid Mitchell <davem@iabyn.com>
Mon, 17 Jul 2017 16:51:57 +0000 (17:51 +0100)
committerDavid Mitchell <davem@iabyn.com>
Thu, 27 Jul 2017 10:30:24 +0000 (11:30 +0100)
...and make pp_padhv(), pp_rv2hv() use it rather than using Perl_do_kv()

Both pp_padhv() and pp_rv2hv() (via S_padhv_rv2hv_common()), outsource to
Perl_do_kv(), the list-context pushing/flattening of a hash onto the
stack.

Perl_do_kv() is a big function that handles all the actions of
keys, values etc. Instead, create a new function which does just the
pushing of a hash onto the stack.

At the same time, split it out into two loops, one for tied, one for
normal: the untied one can skip extending the stack on each iteration,
and use a cheaper HeVAL() instead of calling hv_iterval().

doop.c
embed.fnc
embed.h
hv.c
pp_hot.c
proto.h
t/perf/benchmarks

diff --git a/doop.c b/doop.c
index f10269f..88f8439 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -1243,8 +1243,6 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
 
 /* Perl_do_kv() may be:
  *  * called directly as the pp function for pp_keys() and pp_values();
- *  * called indirectly by pp_padhv() and pp_rv2hv() to implement their
- *       key-value list context functionality.
  *  * It may also be called directly when the op is OP_AVHVSWITCH, to
  *       implement CORE::keys(), CORE::values().
  *
@@ -1261,24 +1259,17 @@ Perl_do_kv(pTHX)
     SSize_t extend_size;
     const U8 gimme = GIMME_V;
 
-    const I32 dokv     = (   PL_op->op_type == OP_RV2HV
-                          || PL_op->op_type == OP_PADHV);
-
-    const I32 dokeys   =     dokv
-                          || (PL_op->op_type == OP_KEYS)
+    const I32 dokeys   =     (PL_op->op_type == OP_KEYS)
                           || (    PL_op->op_type == OP_AVHVSWITCH
                               && (PL_op->op_private & OPpAVHVSWITCH_MASK)
                                     + OP_EACH == OP_KEYS);
 
-    const I32 dovalues =     dokv
-                          || (PL_op->op_type == OP_VALUES)
+    const I32 dovalues =     (PL_op->op_type == OP_VALUES)
                           || (    PL_op->op_type == OP_AVHVSWITCH
                               && (PL_op->op_private & OPpAVHVSWITCH_MASK)
                                      + OP_EACH == OP_VALUES);
 
-    assert(   PL_op->op_type == OP_PADHV
-           || PL_op->op_type == OP_RV2HV
-           || PL_op->op_type == OP_KEYS
+    assert(   PL_op->op_type == OP_KEYS
            || PL_op->op_type == OP_VALUES
            || PL_op->op_type == OP_AVHVSWITCH);
 
@@ -1302,6 +1293,11 @@ Perl_do_kv(pTHX)
            IV i;
            dTARGET;
 
+            /* note that in 'scalar(keys %h)' the OP_KEYS is usually
+             * optimised away and the action is performed directly by the
+             * padhv or rv2hv op. We now only get here via OP_AVHVSWITCH
+             * and \&CORE::keys
+             */
            if (! SvTIED_mg((const SV *)keys, PERL_MAGIC_tied) ) {
                i = HvUSEDKEYS(keys);
            }
index 8dc61d8..0a47b47 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2943,6 +2943,7 @@ Apod      |void   |hv_assert      |NN HV *hv
 #endif
 
 ApdR   |SV*    |hv_scalar      |NN HV *hv
+p      |void   |hv_pushkv      |NN HV *hv
 ApdRM  |SV*    |hv_bucket_ratio|NN HV *hv
 ApoR   |I32*   |hv_riter_p     |NN HV *hv
 ApoR   |HE**   |hv_eiter_p     |NN HV *hv
diff --git a/embed.h b/embed.h
index 15d63bd..5bc0228 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define gv_try_downgrade(a)    Perl_gv_try_downgrade(aTHX_ a)
 #define hv_ename_add(a,b,c,d)  Perl_hv_ename_add(aTHX_ a,b,c,d)
 #define hv_ename_delete(a,b,c,d)       Perl_hv_ename_delete(aTHX_ a,b,c,d)
+#define hv_pushkv(a)           Perl_hv_pushkv(aTHX_ a)
 #define init_argv_symbols(a,b) Perl_init_argv_symbols(aTHX_ a,b)
 #define init_constants()       Perl_init_constants(aTHX)
 #define init_debugger()                Perl_init_debugger(aTHX)
diff --git a/hv.c b/hv.c
index 1c339d5..37518c4 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -967,6 +967,50 @@ Perl_hv_scalar(pTHX_ HV *hv)
     return sv;
 }
 
+
+/*
+Pushes all the keys and values of a hash onto the stack.
+Resets the hash's iterator.
+The rough Perl equivalent: C< () = %hash; >
+XXX this may at some point be extended to push 'keys %h' and 'values %h'
+too. I might also unroll hv_iternext() - DAPM
+*/
+
+void
+Perl_hv_pushkv(pTHX_ HV *hv)
+{
+    HE *entry;
+    bool tied = SvRMAGICAL(hv) && mg_find(MUTABLE_SV(hv), PERL_MAGIC_tied);
+    dSP;
+
+    PERL_ARGS_ASSERT_HV_PUSHKV;
+
+    (void)hv_iterinit(hv);
+
+    if (tied) {
+        while ((entry = hv_iternext(hv))) {
+            EXTEND(SP, 2);
+            PUSHs(hv_iterkeysv(entry));
+            PUSHs(hv_iterval(hv, entry));
+        }
+    }
+    else {
+        SSize_t extend_size;
+        /* 2*HvUSEDKEYS() should never be big enough to truncate or wrap */
+        assert(HvUSEDKEYS(hv) <= (SSize_t_MAX >> 1));
+        extend_size = (SSize_t)HvUSEDKEYS(hv) * 2;
+        EXTEND(SP, extend_size);
+
+        while ((entry = hv_iternext(hv))) {
+            PUSHs(hv_iterkeysv(entry));
+            PUSHs(HeVAL(entry));
+        }
+    }
+
+    PUTBACK;
+}
+
+
 /*
 =for apidoc hv_bucket_ratio
 
index 6772969..079fe35 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -968,7 +968,7 @@ PP(pp_print)
 
 /* do the common parts of pp_padhv() and pp_rv2hv()
  * It assumes the caller has done EXTEND(SP, 1) or equivalent.
- * 'is_keys' indicates the OPpPADHV_ISKEYS/OPpRV2HV_ISKEYS flag is set
+ * 'is_keys' indicates the OPpPADHV_ISKEYS/OPpRV2HV_ISKEYS flag is set.
  * 'has_targ' indicates that the op has a target - this should
  * be a compile-time constant so that the code can constant-folded as
  * appropriate
@@ -983,9 +983,8 @@ S_padhv_rv2hv_common(pTHX_ HV *hv, U8 gimme, bool is_keys, bool has_targ)
     assert(PL_op->op_type == OP_PADHV || PL_op->op_type == OP_RV2HV);
 
     if (gimme == G_ARRAY) {
-        PUSHs(MUTABLE_SV(hv));
-        PUTBACK;
-        return Perl_do_kv(aTHX);
+        hv_pushkv(hv);
+        return NORMAL;
     }
 
     if (is_keys)
diff --git a/proto.h b/proto.h
index 3888d39..c0831a4 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1299,6 +1299,9 @@ PERL_CALLCONV SSize_t*    Perl_hv_placeholders_p(pTHX_ HV *hv)
 PERL_CALLCONV void     Perl_hv_placeholders_set(pTHX_ HV *hv, I32 ph);
 #define PERL_ARGS_ASSERT_HV_PLACEHOLDERS_SET   \
        assert(hv)
+PERL_CALLCONV void     Perl_hv_pushkv(pTHX_ HV *hv);
+#define PERL_ARGS_ASSERT_HV_PUSHKV     \
+       assert(hv)
 PERL_CALLCONV void     Perl_hv_rand_set(pTHX_ HV *hv, U32 new_xhv_rand);
 #define PERL_ARGS_ASSERT_HV_RAND_SET   \
        assert(hv)
index 87f7704..3f7c9a9 100644 (file)
         code    => '($x,$y,$z) = @_',
     },
 
+    # (....) = %lexical
+
+    'expr::aassign::ma_lh' => {
+        desc    => 'my array assigned lexical hash',
+        setup   => 'my %h = qw(aardvark 1 banana 2 cucumber 3)',
+        code    => 'my @a = %h',
+    },
+
 
     # (....) = ($lex1,$lex2,$lex3);