This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Cache HvFILL() for larger hashes, and update on insertion/deletion.
authorNicholas Clark <nick@ccl4.org>
Mon, 11 Mar 2013 11:42:32 +0000 (11:42 +0000)
committerNicholas Clark <nick@ccl4.org>
Wed, 29 May 2013 08:52:50 +0000 (10:52 +0200)
This avoids HvFILL() being O(n) for large n on large hashes, but also avoids
storing the value of HvFILL() in smaller hashes (ie a memory overhead on
every single object built using a hash.)

dump.c
embed.fnc
ext/Devel-Peek/t/Peek.t
hv.c
hv.h
pod/perldelta.pod
proto.h
sv.c

diff --git a/dump.c b/dump.c
index 70ac487..93094a4 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -1803,7 +1803,30 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        }
        PerlIO_putc(file, '\n');
        Perl_dump_indent(aTHX_ level, file, "  KEYS = %"IVdf"\n", (IV)HvUSEDKEYS(sv));
-       Perl_dump_indent(aTHX_ level, file, "  FILL = %"IVdf"\n", (IV)HvFILL(sv));
+        {
+            STRLEN count = 0;
+            HE **ents = HvARRAY(sv);
+
+            if (ents) {
+                HE *const *const last = ents + HvMAX(sv);
+                count = last + 1 - ents;
+                
+                do {
+                    if (!*ents)
+                        --count;
+                } while (++ents <= last);
+            }
+
+            if (SvOOK(sv)) {
+                struct xpvhv_aux *const aux = HvAUX(sv);
+                Perl_dump_indent(aTHX_ level, file, "  FILL = %"UVuf
+                                 " (cached = %"UVuf")\n",
+                                 (UV)count, (UV)aux->xhv_fill_lazy);
+            } else {
+                Perl_dump_indent(aTHX_ level, file, "  FILL = %"UVuf"\n",
+                                 (UV)count);
+            }
+        }
        Perl_dump_indent(aTHX_ level, file, "  MAX = %"IVdf"\n", (IV)HvMAX(sv));
         if (SvOOK(sv)) {
            Perl_dump_indent(aTHX_ level, file, "  RITER = %"IVdf"\n", (IV)HvRITER_get(sv));
index 0e2d854..61b7af8 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -530,7 +530,7 @@ Ap  |void*  |hv_common      |NULLOK HV *hv|NULLOK SV *keysv \
 Ap     |void*  |hv_common_key_len|NULLOK HV *hv|NN const char *key \
                                |I32 klen_i32|const int action|NULLOK SV *val \
                                |const U32 hash
-Apod   |STRLEN |hv_fill        |NN HV const *const hv
+Apod   |STRLEN |hv_fill        |NN HV *const hv
 Ap     |void   |hv_free_ent    |NN HV *hv|NULLOK HE *entry
 Apd    |I32    |hv_iterinit    |NN HV *hv
 ApdR   |char*  |hv_iterkey     |NN HE* entry|NN I32* retlen
index 3de4600..ecef607 100644 (file)
@@ -736,7 +736,7 @@ do_test('ENAME on a stash',
     NV = $FLOAT                                        # $] < 5.009
     ARRAY = $ADDR
     KEYS = 0
-    FILL = 0
+    FILL = 0 \(cached = 0\)
     MAX = 7
     RITER = -1
     EITER = 0x0
@@ -760,7 +760,7 @@ do_test('ENAMEs on a stash',
     NV = $FLOAT                                        # $] < 5.009
     ARRAY = $ADDR
     KEYS = 0
-    FILL = 0
+    FILL = 0 \(cached = 0\)
     MAX = 7
     RITER = -1
     EITER = 0x0
@@ -786,7 +786,7 @@ do_test('ENAMEs on a stash with no NAME',
     NV = $FLOAT                                        # $] < 5.009
     ARRAY = $ADDR
     KEYS = 0
-    FILL = 0
+    FILL = 0 \(cached = 0\)
     MAX = 7
     RITER = -1
     EITER = 0x0
@@ -795,6 +795,118 @@ do_test('ENAMEs on a stash with no NAME',
     ENAME = "RWOM", "KLANK"                    # $] > 5.012
 ');
 
+my %small = ("Perl", "Rules", "Beer", "Foamy");
+my $b = %small;
+do_test('small hash',
+        \%small,
+'SV = $RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PVHV\\($ADDR\\) at $ADDR
+    REFCNT = 2
+    FLAGS = \\(PADMY,SHAREKEYS\\)
+    IV = 1                                     # $] < 5.009
+    NV = $FLOAT                                        # $] < 5.009
+    ARRAY = $ADDR  \\(0:[67],.*\\)
+    hash quality = [0-9.]+%
+    KEYS = 2
+    FILL = [12]
+    MAX = 7
+(?:    Elt "(?:Perl|Beer)" HASH = $ADDR
+    SV = PV\\($ADDR\\) at $ADDR
+      REFCNT = 1
+      FLAGS = \\(POK,pPOK\\)
+      PV = $ADDR "(?:Rules|Foamy)"\\\0
+      CUR = \d+
+      LEN = \d+
+){2}');
+
+$b = keys %small;
+
+do_test('small hash after keys',
+        \%small,
+'SV = $RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PVHV\\($ADDR\\) at $ADDR
+    REFCNT = 2
+    FLAGS = \\(PADMY,OOK,SHAREKEYS\\)
+    IV = 1                                     # $] < 5.009
+    NV = $FLOAT                                        # $] < 5.009
+    ARRAY = $ADDR  \\(0:[67],.*\\)
+    hash quality = [0-9.]+%
+    KEYS = 2
+    FILL = [12] \\(cached = 0\\)
+    MAX = 7
+    RITER = -1
+    EITER = 0x0
+    RAND = $ADDR
+(?:    Elt "(?:Perl|Beer)" HASH = $ADDR
+    SV = PV\\($ADDR\\) at $ADDR
+      REFCNT = 1
+      FLAGS = \\(POK,pPOK\\)
+      PV = $ADDR "(?:Rules|Foamy)"\\\0
+      CUR = \d+
+      LEN = \d+
+){2}');
+
+$b = %small;
+
+do_test('small hash after keys and scalar',
+        \%small,
+'SV = $RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PVHV\\($ADDR\\) at $ADDR
+    REFCNT = 2
+    FLAGS = \\(PADMY,OOK,SHAREKEYS\\)
+    IV = 1                                     # $] < 5.009
+    NV = $FLOAT                                        # $] < 5.009
+    ARRAY = $ADDR  \\(0:[67],.*\\)
+    hash quality = [0-9.]+%
+    KEYS = 2
+    FILL = ([12]) \\(cached = \1\\)
+    MAX = 7
+    RITER = -1
+    EITER = 0x0
+    RAND = $ADDR
+(?:    Elt "(?:Perl|Beer)" HASH = $ADDR
+    SV = PV\\($ADDR\\) at $ADDR
+      REFCNT = 1
+      FLAGS = \\(POK,pPOK\\)
+      PV = $ADDR "(?:Rules|Foamy)"\\\0
+      CUR = \d+
+      LEN = \d+
+){2}');
+
+# This should immediately start with the FILL cached correctly.
+my %large = (0..1999);
+$b = %large;
+do_test('large hash',
+        \%large,
+'SV = $RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PVHV\\($ADDR\\) at $ADDR
+    REFCNT = 2
+    FLAGS = \\(PADMY,OOK,SHAREKEYS\\)
+    IV = 1                                     # $] < 5.009
+    NV = $FLOAT                                        # $] < 5.009
+    ARRAY = $ADDR  \\(0:\d+,.*\\)
+    hash quality = \d+\\.\d+%
+    KEYS = 1000
+    FILL = (\d+) \\(cached = \1\\)
+    MAX = 1023
+    RITER = -1
+    EITER = 0x0
+    RAND = $ADDR
+    Elt .*
+');
+
 SKIP: {
     skip "Not built with usemymalloc", 1
       unless $Config{usemymalloc} eq 'y';
diff --git a/hv.c b/hv.c
index 916b64b..cbeed30 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -36,6 +36,7 @@ holds the key and hash value.
 #include "perl.h"
 
 #define DO_HSPLIT(xhv) ((xhv)->xhv_keys > (xhv)->xhv_max) /* HvTOTALKEYS(hv) > HvMAX(hv) */
+#define HV_FILL_THRESHOLD 31
 
 static const char S_strtab_error[]
     = "Cannot modify shared string table in hv_%s";
@@ -790,6 +791,13 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
        HeKEY_hek(entry) = save_hek_flags(key, klen, hash, flags);
     HeVAL(entry) = val;
 
+    if (!*oentry && SvOOK(hv)) {
+        /* initial entry, and aux struct present.  */
+        struct xpvhv_aux *const aux = HvAUX(hv);
+        if (aux->xhv_fill_lazy)
+            ++aux->xhv_fill_lazy;
+    }
+
 #ifdef PERL_HASH_RANDOMIZE_KEYS
     /* This logic semi-randomizes the insert order in a bucket.
      * Either we insert into the top, or the slot below the top,
@@ -948,6 +956,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     XPVHV* xhv;
     HE *entry;
     HE **oentry;
+    HE *const *first_entry;
     bool is_utf8 = (k_flags & HVhek_UTF8) ? TRUE : FALSE;
     int masked_flags;
 
@@ -1023,7 +1032,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 
     masked_flags = (k_flags & HVhek_MASK);
 
-    oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)];
+    first_entry = oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)];
     entry = *oentry;
     for (; entry; oentry = &HeNEXT(entry), entry = *oentry) {
        SV *sv;
@@ -1111,6 +1120,12 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
            HvPLACEHOLDERS(hv)++;
        else {
            *oentry = HeNEXT(entry);
+            if(!*first_entry && SvOOK(hv)) {
+                /* removed last entry, and aux struct present.  */
+                struct xpvhv_aux *const aux = HvAUX(hv);
+                if (aux->xhv_fill_lazy)
+                    --aux->xhv_fill_lazy;
+            }
            if (SvOOK(hv) && entry == HvAUX(hv)->xhv_eiter /* HvEITER(hv) */)
                HvLAZYDEL_on(hv);
            else {
@@ -1187,6 +1202,10 @@ S_hsplit(pTHX_ HV *hv, STRLEN const oldsize, STRLEN newsize)
 #ifdef PERL_HASH_RANDOMIZE_KEYS
         dest->xhv_rand = (U32)PL_hash_rand_bits;
 #endif
+        /* For now, just reset the lazy fill counter.
+           It would be possible to update the counter in the code below
+           instead.  */
+        dest->xhv_fill_lazy = 0;
     }
 
     PL_nomemok = FALSE;
@@ -1657,22 +1676,28 @@ Perl_hfree_next_entry(pTHX_ HV *hv, STRLEN *indexp)
 
     PERL_ARGS_ASSERT_HFREE_NEXT_ENTRY;
 
-    if (SvOOK(hv) && ((iter = HvAUX(hv)))
-       && ((entry = iter->xhv_eiter)) )
-    {
-       /* the iterator may get resurrected after each
-        * destructor call, so check each time */
-       if (entry && HvLAZYDEL(hv)) {   /* was deleted earlier? */
-           HvLAZYDEL_off(hv);
-           hv_free_ent(hv, entry);
-           /* warning: at this point HvARRAY may have been
-            * re-allocated, HvMAX changed etc */
-       }
-       iter->xhv_riter = -1;   /* HvRITER(hv) = -1 */
-       iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */
+    if (SvOOK(hv) && ((iter = HvAUX(hv)))) {
+       if ((entry = iter->xhv_eiter)) {
+            /* the iterator may get resurrected after each
+             * destructor call, so check each time */
+            if (entry && HvLAZYDEL(hv)) {      /* was deleted earlier? */
+                HvLAZYDEL_off(hv);
+                hv_free_ent(hv, entry);
+                /* warning: at this point HvARRAY may have been
+                 * re-allocated, HvMAX changed etc */
+            }
+            iter->xhv_riter = -1;      /* HvRITER(hv) = -1 */
+            iter->xhv_eiter = NULL;    /* HvEITER(hv) = NULL */
 #ifdef PERL_HASH_RANDOMIZE_KEYS
-        iter->xhv_last_rand = iter->xhv_rand;
+            iter->xhv_last_rand = iter->xhv_rand;
 #endif
+        }
+        /* Reset any cached HvFILL() to "unknown".  It's unlikely that anyone
+           will actually call HvFILL() on a hash under destruction, so it
+           seems pointless attempting to track the number of keys remaining.
+           But if they do, we want to reset it again.  */
+        if (iter->xhv_fill_lazy)
+            iter->xhv_fill_lazy = 0;
     }
 
     if (!((XPVHV*)SvANY(hv))->xhv_keys)
@@ -1830,17 +1855,22 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
 Returns the number of hash buckets that happen to be in use. This function is
 wrapped by the macro C<HvFILL>.
 
-Previously this value was stored in the HV structure, rather than being
-calculated on demand.
+Previously this value was always stored in the HV structure, which created an
+overhead on every hash (and pretty much every object) for something that was
+rarely used. Now we calculate it on demand the first time that it is needed,
+and cache it if that calculation is going to be costly to repeat. The cached
+value is updated by insertions and deletions, but (currently) discarded if
+the hash is split.
 
 =cut
 */
 
 STRLEN
-Perl_hv_fill(pTHX_ HV const *const hv)
+Perl_hv_fill(pTHX_ HV *const hv)
 {
     STRLEN count = 0;
     HE **ents = HvARRAY(hv);
+    struct xpvhv_aux *aux = SvOOK(hv) ? HvAUX(hv) : NULL;
 
     PERL_ARGS_ASSERT_HV_FILL;
 
@@ -1849,6 +1879,11 @@ Perl_hv_fill(pTHX_ HV const *const hv)
     if (HvTOTALKEYS(hv) < 2)
         return HvTOTALKEYS(hv);
 
+#ifndef DEBUGGING
+    if (aux && aux->xhv_fill_lazy)
+        return aux->xhv_fill_lazy;
+#endif
+
     if (ents) {
        HE *const *const last = ents + HvMAX(hv);
        count = last + 1 - ents;
@@ -1858,6 +1893,16 @@ Perl_hv_fill(pTHX_ HV const *const hv)
                --count;
        } while (++ents <= last);
     }
+    if (aux) {
+#ifdef DEBUGGING
+        if (aux->xhv_fill_lazy)
+            assert(aux->xhv_fill_lazy == count);
+#endif
+        aux->xhv_fill_lazy = count;
+    } else if (HvMAX(hv) >= HV_FILL_THRESHOLD) {
+        aux = hv_auxinit(hv);
+        aux->xhv_fill_lazy = count;
+    }        
     return count;
 }
 
@@ -1932,6 +1977,7 @@ S_hv_auxinit(pTHX_ HV *hv) {
 #ifdef PERL_HASH_RANDOMIZE_KEYS
     iter->xhv_last_rand = iter->xhv_rand;
 #endif
+    iter->xhv_fill_lazy = 0;
     iter->xhv_name_u.xhvnameu_name = 0;
     iter->xhv_name_count = 0;
     iter->xhv_backreferences = 0;
diff --git a/hv.h b/hv.h
index 2eea477..6ebd5d5 100644 (file)
--- a/hv.h
+++ b/hv.h
@@ -117,6 +117,7 @@ struct xpvhv_aux {
     U32         xhv_last_rand;  /* last random value for hash traversal,
                                    used to detect each() after insert for warnings */
 #endif
+    U32         xhv_fill_lazy;
 };
 
 /* hash structure: */
@@ -239,7 +240,7 @@ C<SV*>.
 #  define Nullhv Null(HV*)
 #endif
 #define HvARRAY(hv)    ((hv)->sv_u.svu_hash)
-#define HvFILL(hv)     Perl_hv_fill(aTHX_ (const HV *)(hv))
+#define HvFILL(hv)     Perl_hv_fill(aTHX_ MUTABLE_HV(hv))
 #define HvMAX(hv)      ((XPVHV*)  SvANY(hv))->xhv_max
 /* This quite intentionally does no flag checking first. That's your
    responsibility.  */
index 6ea5651..969aa3d 100644 (file)
@@ -460,6 +460,13 @@ The debugger's C<man> command been fixed. It was broken in the v5.18.0
 release. The C<man> command is aliased to the names C<doc> and C<perldoc> -
 all now work again.
 
+=item *
+
+Evaluating large hashes in scalar context is now much faster, as the number
+of used chains in the hash is now cached for larger hashes. Smaller hashes
+continue not to store it and calculate it when needed, as this saves one IV.
+That would be 1 IV overhead for every object built from a hash. [RT #114576]
+
 =back
 
 =head1 Known Problems
diff --git a/proto.h b/proto.h
index f1d303f..8eaf3fa 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1548,7 +1548,7 @@ PERL_CALLCONV void        Perl_hv_ename_delete(pTHX_ HV *hv, const char *name, U32 len,
 #define PERL_ARGS_ASSERT_HV_FETCH_ENT  \
        assert(keysv)
 
-PERL_CALLCONV STRLEN   Perl_hv_fill(pTHX_ HV const *const hv)
+PERL_CALLCONV STRLEN   Perl_hv_fill(pTHX_ HV *const hv)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_HV_FILL       \
        assert(hv)
diff --git a/sv.c b/sv.c
index ba09305..ee5a9d6 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -12349,6 +12349,7 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
                        }
                        daux->xhv_name_count = saux->xhv_name_count;
 
+                       daux->xhv_fill_lazy = saux->xhv_fill_lazy;
                        daux->xhv_riter = saux->xhv_riter;
                        daux->xhv_eiter = saux->xhv_eiter
                            ? he_dup(saux->xhv_eiter,