hv_pushkv(): handle keys() and values() too
authorDavid Mitchell <davem@iabyn.com>
Fri, 21 Jul 2017 13:32:57 +0000 (14:32 +0100)
committerDavid Mitchell <davem@iabyn.com>
Thu, 27 Jul 2017 10:30:24 +0000 (11:30 +0100)
The newish function hv_pushkv() currently just pushes all key/value pairs on
the stack. i.e. it does the equivalent of the perl code '() = %h'.
Extend it so that it can handle 'keys %h' and values %h' too.

This is basically moving the remaining list-context functionality out of
do_kv() and into hv_pushkv().

The rationale for this is that hv_pushkv() is a pure HV-related function,
while do_kv() is a pp function for several ops including OP_KEYS/VALUES,
and expects PL_op->op_flags/op_private to be valid.

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 88f8439..5234e26 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -1255,8 +1255,6 @@ Perl_do_kv(pTHX)
 {
     dSP;
     HV * const keys = MUTABLE_HV(POPs);
-    HE *entry;
-    SSize_t extend_size;
     const U8 gimme = GIMME_V;
 
     const I32 dokeys   =     (PL_op->op_type == OP_KEYS)
@@ -1317,22 +1315,9 @@ Perl_do_kv(pTHX)
            Perl_croak(aTHX_ "Can't modify keys in list assignment");
     }
 
-    /* 2*HvUSEDKEYS() should never be big enough to truncate or wrap */
-    assert(HvUSEDKEYS(keys) <= (SSize_t_MAX >> 1));
-    extend_size = (SSize_t)HvUSEDKEYS(keys) * (dokeys + dovalues);
-    EXTEND(SP, extend_size);
-
-    while ((entry = hv_iternext(keys))) {
-       if (dokeys) {
-           SV* const sv = hv_iterkeysv(entry);
-           XPUSHs(sv);
-       }
-       if (dovalues) {
-           SV *const sv = hv_iterval(keys,entry);
-           XPUSHs(sv);
-       }
-    }
-    RETURN;
+    PUTBACK;
+    hv_pushkv(keys, (dokeys | (dovalues << 1)));
+    return NORMAL;
 }
 
 /*
index 0a47b47..2dd73bf 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2943,7 +2943,7 @@ Apod      |void   |hv_assert      |NN HV *hv
 #endif
 
 ApdR   |SV*    |hv_scalar      |NN HV *hv
-p      |void   |hv_pushkv      |NN HV *hv
+p      |void   |hv_pushkv      |NN HV *hv|U32 flags
 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 5bc0228..a41020d 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 hv_pushkv(a,b)         Perl_hv_pushkv(aTHX_ a,b)
 #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 96228b3..20b4ece 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -969,47 +969,66 @@ Perl_hv_scalar(pTHX_ HV *hv)
 
 
 /*
-Pushes all the keys and values of a hash onto the stack.
+hv_pushkv(): push all the keys and/or values of a hash onto the stack.
+The rough Perl equivalents:
+    () = %hash;
+    () = keys %hash;
+    () = values %hash;
+
 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
+
+flags : 1   = push keys
+        2   = push values
+        1|2 = push keys and values
+        XXX use symbolic flag constants at some point?
+I might unroll the non-tied hv_iternext() in here at some point - DAPM
 */
 
 void
-Perl_hv_pushkv(pTHX_ HV *hv)
+Perl_hv_pushkv(pTHX_ HV *hv, U32 flags)
 {
     HE *entry;
     bool tied = SvRMAGICAL(hv) && mg_find(MUTABLE_SV(hv), PERL_MAGIC_tied);
     dSP;
 
     PERL_ARGS_ASSERT_HV_PUSHKV;
+    assert(flags); /* must be pushing at least one of keys and values */
 
     (void)hv_iterinit(hv);
 
     if (tied) {
+        SSize_t ext = (flags == 3) ? 2 : 1;
         while ((entry = hv_iternext(hv))) {
-            EXTEND(SP, 2);
-            PUSHs(hv_iterkeysv(entry));
-            PUSHs(hv_iterval(hv, entry));
+            EXTEND(SP, ext);
+            if (flags & 1)
+                PUSHs(hv_iterkeysv(entry));
+            if (flags & 2)
+                PUSHs(hv_iterval(hv, entry));
         }
     }
     else {
         Size_t nkeys = HvUSEDKEYS(hv);
-        SSize_t nkv;
+        SSize_t ext;
+
+        if (!nkeys)
+            return;
+
         /* 2*nkeys() should never be big enough to truncate or wrap */
         assert(nkeys <= (SSize_t_MAX >> 1));
-        nkv = nkeys * 2;
+        ext = nkeys * ((flags == 3) ? 2 : 1);
 
         EXTEND_MORTAL(nkeys);
-        EXTEND(SP, nkv);
+        EXTEND(SP, ext);
 
         while ((entry = hv_iternext(hv))) {
-            SV *keysv = newSVhek(HeKEY_hek(entry));
-            SvTEMP_on(keysv);
-            PL_tmps_stack[++PL_tmps_ix] = keysv;
-            PUSHs(keysv);
-            PUSHs(HeVAL(entry));
+            if (flags & 1) {
+                SV *keysv = newSVhek(HeKEY_hek(entry));
+                SvTEMP_on(keysv);
+                PL_tmps_stack[++PL_tmps_ix] = keysv;
+                PUSHs(keysv);
+            }
+            if (flags & 2)
+                PUSHs(HeVAL(entry));
         }
     }
 
index eebed8c..e1e151b 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -983,7 +983,7 @@ 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) {
-        hv_pushkv(hv);
+        hv_pushkv(hv, 3);
         return NORMAL;
     }
 
diff --git a/proto.h b/proto.h
index c0831a4..5988bf6 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1299,7 +1299,7 @@ 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);
+PERL_CALLCONV void     Perl_hv_pushkv(pTHX_ HV *hv, U32 flags);
 #define PERL_ARGS_ASSERT_HV_PUSHKV     \
        assert(hv)
 PERL_CALLCONV void     Perl_hv_rand_set(pTHX_ HV *hv, U32 new_xhv_rand);
index 3f7c9a9..36782ec 100644 (file)
         code    => 'index $x, "b"',
     },
 
+
+    'func::keys::scalar_cxt_empty' => {
+        desc    => ' keys() on an empty 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',
+        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',
+        setup   => 'my %h = ()',
+        code    => '() = keys %h',
+    },
+    'func::keys::list_cxt' => {
+        desc    => ' keys() on a non-empty hash in list context',
+        setup   => 'my %h = qw(aardvark 1 banana 2 cucumber 3)',
+        code    => '() = keys %h',
+    },
+
+
     'func::length::bool0' => {
         desc    => 'length==0 in boolean context',
         setup   => 'my $s = "";',
     },
 
 
+    'func::values::scalar_cxt_empty' => {
+        desc    => ' values() on an empty hash in scalar context',
+        setup   => 'my $k; my %h = ()',
+        code    => '$k = values %h',
+    },
+    'func::values::scalar_cxt' => {
+        desc    => ' values() on a non-empty hash in scalar context',
+        setup   => 'my $k; my %h = qw(aardvark 1 banana 2 cucumber 3)',
+        code    => '$k = values %h',
+    },
+    'func::values::list_cxt_empty' => {
+        desc    => ' values() on an empty hash in list context',
+        setup   => 'my %h = ()',
+        code    => '() = values %h',
+    },
+    'func::values::list_cxt' => {
+        desc    => ' values() on a non-empty hash in list context',
+        setup   => 'my %h = qw(aardvark 1 banana 2 cucumber 3)',
+        code    => '() = values %h',
+    },
+
+
+
     'loop::block' => {
         desc    => 'empty basic loop',
         setup   => '',