This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Note that certain flags are documented
[perl5.git] / hv.c
diff --git a/hv.c b/hv.c
index 338b17e..eccae62 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -34,7 +34,11 @@ holds the key and hash value.
 #define PERL_HASH_INTERNAL_ACCESS
 #include "perl.h"
 
-#define DO_HSPLIT(xhv) ((xhv)->xhv_keys > (xhv)->xhv_max) /* HvTOTALKEYS(hv) > HvMAX(hv) */
+/* we split when we collide and we have a load factor over 0.667.
+ * NOTE if you change this formula so we split earlier than previously
+ * you MUST change the logic in hv_ksplit()
+ */
+#define DO_HSPLIT(xhv) ( ((xhv)->xhv_keys + ((xhv)->xhv_keys >> 1))  > (xhv)->xhv_max )
 #define HV_FILL_THRESHOLD 31
 
 static const char S_strtab_error[]
@@ -80,7 +84,8 @@ S_save_hek_flags(const char *str, I32 len, U32 hash, int flags)
     HEK *hek;
 
     PERL_ARGS_ASSERT_SAVE_HEK_FLAGS;
-    Newx(k, HEK_BASESIZE + len + 1, char);
+
+    Newx(k, HEK_BASESIZE + len + 2, char);
     hek = (HEK*)k;
     Copy(str, HEK_KEY(hek), len, char);
     HEK_KEY(hek)[len] = 0;
@@ -255,7 +260,9 @@ if all your code does is create SVs then store them in a hash, C<hv_store>
 will own the only reference to the new SV, and your code doesn't need to do
 anything further to tidy up.  Note that C<hv_store_ent> only reads the C<key>;
 unlike C<val> it does not take ownership of it, so maintaining the correct
-reference count on C<key> is entirely the caller's responsibility.  C<hv_store>
+reference count on C<key> is entirely the caller's responsibility.  The reason
+it does not take ownership, is that C<key> is not used after this function
+returns, and so can be freed immediately.  C<hv_store>
 is not implemented as a call to C<hv_store_ent>, and does not create a temporary
 SV for the key, so if your key data is not already in SV form then use
 C<hv_store> in preference to C<hv_store_ent>.
@@ -342,6 +349,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     HE **oentry;
     SV *sv;
     bool is_utf8;
+    bool in_collision;
     int masked_flags;
     const int return_svp = action & HV_FETCH_JUST_SV;
     HEK *keysv_hek = NULL;
@@ -389,7 +397,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
            flags = is_utf8 ? HVhek_UTF8 : 0;
        }
     } else {
-       is_utf8 = ((flags & HVhek_UTF8) ? TRUE : FALSE);
+       is_utf8 = cBOOL(flags & HVhek_UTF8);
     }
 
     if (action & HV_DELETE) {
@@ -503,7 +511,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                /* This cast somewhat evil, but I'm merely using NULL/
                   not NULL to return the boolean exists.
                   And I know hv is not NULL.  */
-               return SvTRUE(svret) ? (void *)hv : NULL;
+               return SvTRUE_NN(svret) ? (void *)hv : NULL;
                }
 #ifdef ENV_IS_CASELESS
            else if (mg_find((const SV *)hv, PERL_MAGIC_env)) {
@@ -765,7 +773,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 
     if (!entry && SvREADONLY(hv) && !(action & HV_FETCH_ISEXISTS)) {
        hv_notallowed(flags, key, klen,
-                       "Attempt to access disallowed key '%"SVf"' in"
+                       "Attempt to access disallowed key '%" SVf "' in"
                        " a restricted hash");
     }
     if (!(action & (HV_FETCH_LVALUE|HV_FETCH_ISSTORE))) {
@@ -834,6 +842,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
      * making it harder to see if there is a collision. We also
      * reset the iterator randomizer if there is one.
      */
+    in_collision = *oentry != NULL;
     if ( *oentry && PL_HASH_RAND_BITS_ENABLED) {
         PL_hash_rand_bits++;
         PL_hash_rand_bits= ROTL_UV(PL_hash_rand_bits,1);
@@ -876,7 +885,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
        HvHASKFLAGS_on(hv);
 
     xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */
-    if ( DO_HSPLIT(xhv) ) {
+    if ( in_collision && DO_HSPLIT(xhv) ) {
         const STRLEN oldsize = xhv->xhv_max + 1;
         const U32 items = (U32)HvPLACEHOLDERS_get(hv);
 
@@ -960,6 +969,79 @@ Perl_hv_scalar(pTHX_ HV *hv)
     return sv;
 }
 
+
+/*
+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.
+
+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, U32 flags)
+{
+    HE *entry;
+    bool tied = SvRMAGICAL(hv) && (mg_find(MUTABLE_SV(hv), PERL_MAGIC_tied)
+#ifdef DYNAMIC_ENV_FETCH  /* might not know number of keys yet */
+                                   || mg_find(MUTABLE_SV(hv), PERL_MAGIC_env)
+#endif
+                                  );
+    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, ext);
+            if (flags & 1)
+                PUSHs(hv_iterkeysv(entry));
+            if (flags & 2)
+                PUSHs(hv_iterval(hv, entry));
+        }
+    }
+    else {
+        Size_t nkeys = HvUSEDKEYS(hv);
+        SSize_t ext;
+
+        if (!nkeys)
+            return;
+
+        /* 2*nkeys() should never be big enough to truncate or wrap */
+        assert(nkeys <= (SSize_t_MAX >> 1));
+        ext = nkeys * ((flags == 3) ? 2 : 1);
+
+        EXTEND_MORTAL(nkeys);
+        EXTEND(SP, ext);
+
+        while ((entry = hv_iternext(hv))) {
+            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));
+        }
+    }
+
+    PUTBACK;
+}
+
+
 /*
 =for apidoc hv_bucket_ratio
 
@@ -988,12 +1070,13 @@ Perl_hv_bucket_ratio(pTHX_ HV *hv)
             return magic_scalarpack(hv, mg);
     }
 
-    sv = sv_newmortal();
-    if (HvUSEDKEYS((const HV *)hv))
+    if (HvUSEDKEYS((HV *)hv)) {
+        sv = sv_newmortal();
         Perl_sv_setpvf(aTHX_ sv, "%ld/%ld",
                 (long)HvFILL(hv), (long)HvMAX(hv) + 1);
+    }
     else
-        sv_setiv(sv, 0);
+        sv = &PL_sv_zero;
     
     return sv;
 }
@@ -1028,7 +1111,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     HE *entry;
     HE **oentry;
     HE **first_entry;
-    bool is_utf8 = (k_flags & HVhek_UTF8) ? TRUE : FALSE;
+    bool is_utf8 = cBOOL(k_flags & HVhek_UTF8);
     int masked_flags;
     HEK *keysv_hek = NULL;
     U8 mro_changes = 0; /* 1 = isa; 2 = package moved */
@@ -1167,7 +1250,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
        }
        if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
            hv_notallowed(k_flags, key, klen,
-                           "Attempt to delete readonly key '%"SVf"' from"
+                           "Attempt to delete readonly key '%" SVf "' from"
                            " a restricted hash");
        }
         if (k_flags & HVhek_FREEKEY)
@@ -1198,7 +1281,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                         sv_2mortal((SV *)gv)
                        );
                }
-               else if (klen == 3 && strEQs(key, "ISA") && GvAV(gv)) {
+               else if (memEQs(key, klen, "ISA") && GvAV(gv)) {
                     AV *isa = GvAV(gv);
                     MAGIC *mg = mg_find((SV*)isa, PERL_MAGIC_isa);
 
@@ -1214,7 +1297,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                             SV **svp, **end;
                         strip_magic:
                             svp = AvARRAY(isa);
-                            end = svp + AvFILLp(isa)+1;
+                            end = svp + (AvFILLp(isa)+1);
                             while (svp < end) {
                                 if (*svp)
                                     mg_free_type(*svp, PERL_MAGIC_isaelem);
@@ -1316,7 +1399,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
   not_found:
     if (SvREADONLY(hv)) {
        hv_notallowed(k_flags, key, klen,
-                       "Attempt to delete disallowed key '%"SVf"' from"
+                       "Attempt to delete disallowed key '%" SVf "' from"
                        " a restricted hash");
     }
 
@@ -1449,29 +1532,42 @@ void
 Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
 {
     XPVHV* xhv = (XPVHV*)SvANY(hv);
-    const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
+    const I32 oldsize = (I32) xhv->xhv_max+1;       /* HvMAX(hv)+1 */
     I32 newsize;
+    I32 wantsize;
+    I32 trysize;
     char *a;
 
     PERL_ARGS_ASSERT_HV_KSPLIT;
 
-    newsize = (I32) newmax;                    /* possible truncation here */
-    if (newsize != newmax || newmax <= oldsize)
+    wantsize = (I32) newmax;                            /* possible truncation here */
+    if (wantsize != newmax)
        return;
-    while ((newsize & (1 + ~newsize)) != newsize) {
-       newsize &= ~(newsize & (1 + ~newsize)); /* get proper power of 2 */
+
+    wantsize= wantsize + (wantsize >> 1);           /* wantsize *= 1.5 */
+    if (wantsize < newmax)                          /* overflow detection */
+        return;
+
+    newsize = oldsize;
+    while (wantsize > newsize) {
+        trysize = newsize << 1;
+        if (trysize > newsize) {
+            newsize = trysize;
+        } else {
+            /* we overflowed */
+            return;
+        }
     }
-    if (newsize < newmax)
-       newsize *= 2;
-    if (newsize < newmax)
-       return;                                 /* overflow detection */
+
+    if (newsize <= oldsize)
+        return;                                            /* overflow detection */
 
     a = (char *) HvARRAY(hv);
     if (a) {
         hsplit(hv, oldsize, newsize);
     } else {
         Newxz(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
-        xhv->xhv_max = --newsize;
+        xhv->xhv_max = newsize - 1;
         HvARRAY(hv) = (HE **) a;
     }
 }
@@ -1575,7 +1671,7 @@ Perl_newHVhv(pTHX_ HV *ohv)
 }
 
 /*
-=for apidoc Am|HV *|hv_copy_hints_hv|HV *ohv
+=for apidoc hv_copy_hints_hv
 
 A specialised version of L</newHVhv> for copying C<%^H>.  C<ohv> must be
 a pointer to a hash (which may have C<%^H> magic, but should be generally
@@ -1696,6 +1792,8 @@ void
 Perl_hv_clear(pTHX_ HV *hv)
 {
     dVAR;
+    SSize_t orig_ix;
+
     XPVHV* xhv;
     if (!hv)
        return;
@@ -1704,8 +1802,10 @@ Perl_hv_clear(pTHX_ HV *hv)
 
     xhv = (XPVHV*)SvANY(hv);
 
-    ENTER;
-    SAVEFREESV(SvREFCNT_inc_simple_NN(hv));
+    /* avoid hv being freed when calling destructors below */
+    EXTEND_MORTAL(1);
+    PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple_NN(hv);
+    orig_ix = PL_tmps_ix;
     if (SvREADONLY(hv) && HvARRAY(hv) != NULL) {
        /* restricted hash: convert all keys to placeholders */
        STRLEN i;
@@ -1718,7 +1818,7 @@ Perl_hv_clear(pTHX_ HV *hv)
                        if (SvREADONLY(HeVAL(entry))) {
                            SV* const keysv = hv_iterkeysv(entry);
                            Perl_croak_nocontext(
-                               "Attempt to delete readonly key '%"SVf"' from a restricted hash",
+                               "Attempt to delete readonly key '%" SVf "' from a restricted hash",
                                (void*)keysv);
                        }
                        SvREFCNT_dec_NN(HeVAL(entry));
@@ -1730,7 +1830,7 @@ Perl_hv_clear(pTHX_ HV *hv)
        }
     }
     else {
-       hfreeentries(hv);
+       hv_free_entries(hv);
        HvPLACEHOLDERS_set(hv, 0);
 
        if (SvRMAGICAL(hv))
@@ -1743,7 +1843,12 @@ Perl_hv_clear(pTHX_ HV *hv)
             mro_isa_changed_in(hv);
        HvEITER_set(hv, NULL);
     }
-    LEAVE;
+    /* disarm hv's premature free guard */
+    if (LIKELY(PL_tmps_ix == orig_ix))
+        PL_tmps_ix--;
+    else
+        PL_tmps_stack[orig_ix] = &PL_sv_undef;
+    SvREFCNT_dec_NN(hv);
 }
 
 /*
@@ -1822,13 +1927,13 @@ S_clear_placeholders(pTHX_ HV *hv, U32 items)
 }
 
 STATIC void
-S_hfreeentries(pTHX_ HV *hv)
+S_hv_free_entries(pTHX_ HV *hv)
 {
     STRLEN index = 0;
     XPVHV * const xhv = (XPVHV*)SvANY(hv);
     SV *sv;
 
-    PERL_ARGS_ASSERT_HFREEENTRIES;
+    PERL_ARGS_ASSERT_HV_FREE_ENTRIES;
 
     while ((sv = Perl_hfree_next_entry(aTHX_ hv, &index))||xhv->xhv_keys) {
        SvREFCNT_dec(sv);
@@ -1837,7 +1942,7 @@ S_hfreeentries(pTHX_ HV *hv)
 
 
 /* hfree_next_entry()
- * For use only by S_hfreeentries() and sv_clear().
+ * For use only by S_hv_free_entries() and sv_clear().
  * Delete the next available HE from hv and return the associated SV.
  * Returns null on empty hash. Nevertheless null is not a reliable
  * indicator that the hash is empty, as the deleted entry may have a
@@ -1926,14 +2031,15 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
 {
     XPVHV* xhv;
     bool save;
+    SSize_t orig_ix = PL_tmps_ix; /* silence compiler warning about unitialized vars */
 
     if (!hv)
        return;
-    save = !!SvREFCNT(hv);
+    save = cBOOL(SvREFCNT(hv));
     DEBUG_A(Perl_hv_assert(aTHX_ hv));
     xhv = (XPVHV*)SvANY(hv);
 
-    /* The name must be deleted before the call to hfreeeeentries so that
+    /* The name must be deleted before the call to hv_free_entries so that
        CVs are anonymised properly. But the effective name must be pre-
        served until after that call (and only deleted afterwards if the
        call originated from sv_clear). For stashes with one name that is
@@ -1941,21 +2047,23 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
        allocate an array for storing the effective name. We can skip that
        during global destruction, as it does not matter where the CVs point
        if they will be freed anyway. */
-    /* note that the code following prior to hfreeentries is duplicated
+    /* note that the code following prior to hv_free_entries is duplicated
      * in sv_clear(), and changes here should be done there too */
     if (PL_phase != PERL_PHASE_DESTRUCT && HvNAME(hv)) {
         if (PL_stashcache) {
             DEBUG_o(Perl_deb(aTHX_ "hv_undef_flags clearing PL_stashcache for '%"
-                             HEKf"'\n", HEKfARG(HvNAME_HEK(hv))));
+                             HEKf "'\n", HEKfARG(HvNAME_HEK(hv))));
            (void)hv_deletehek(PL_stashcache, HvNAME_HEK(hv), G_DISCARD);
         }
        hv_name_set(hv, NULL, 0, 0);
     }
     if (save) {
-       ENTER;
-       SAVEFREESV(SvREFCNT_inc_simple_NN(hv));
+        /* avoid hv being freed when calling destructors below */
+        EXTEND_MORTAL(1);
+        PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple_NN(hv);
+        orig_ix = PL_tmps_ix;
     }
-    hfreeentries(hv);
+    hv_free_entries(hv);
     if (SvOOK(hv)) {
       struct mro_meta *meta;
       const char *name;
@@ -1965,7 +2073,7 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
            mro_isa_changed_in(hv);
         if (PL_stashcache) {
             DEBUG_o(Perl_deb(aTHX_ "hv_undef_flags clearing PL_stashcache for effective name '%"
-                             HEKf"'\n", HEKfARG(HvENAME_HEK(hv))));
+                             HEKf "'\n", HEKfARG(HvENAME_HEK(hv))));
            (void)hv_deletehek(PL_stashcache, HvENAME_HEK(hv), G_DISCARD);
         }
       }
@@ -1976,7 +2084,7 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
       if (flags & HV_NAME_SETALL ? !!HvAUX(hv)->xhv_name_u.xhvnameu_name : !!name) {
         if (name && PL_stashcache) {
             DEBUG_o(Perl_deb(aTHX_ "hv_undef_flags clearing PL_stashcache for name '%"
-                             HEKf"'\n", HEKfARG(HvNAME_HEK(hv))));
+                             HEKf "'\n", HEKfARG(HvNAME_HEK(hv))));
            (void)hv_deletehek(PL_stashcache, HvNAME_HEK(hv), G_DISCARD);
         }
        hv_name_set(hv, NULL, 0, flags);
@@ -2012,7 +2120,15 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
 
     if (SvRMAGICAL(hv))
        mg_clear(MUTABLE_SV(hv));
-    if (save) LEAVE;
+
+    if (save) {
+        /* disarm hv's premature free guard */
+        if (LIKELY(PL_tmps_ix == orig_ix))
+            PL_tmps_ix--;
+        else
+            PL_tmps_stack[orig_ix] = &PL_sv_undef;
+        SvREFCNT_dec_NN(hv);
+    }
 }
 
 /*
@@ -2037,6 +2153,7 @@ Perl_hv_fill(pTHX_ HV *const hv)
     STRLEN count = 0;
     HE **ents = HvARRAY(hv);
 
+    PERL_UNUSED_CONTEXT;
     PERL_ARGS_ASSERT_HV_FILL;
 
     /* No keys implies no buckets used.
@@ -2150,8 +2267,8 @@ S_hv_auxinit(pTHX_ HV *hv) {
 =for apidoc hv_iterinit
 
 Prepares a starting point to traverse a hash table.  Returns the number of
-keys in the hash (i.e. the same as C<HvUSEDKEYS(hv)>).  The return value is
-currently only meaningful for hashes without tie magic.
+keys in the hash, including placeholders (i.e. the same as C<HvTOTALKEYS(hv)>).
+The return value is currently only meaningful for hashes without tie magic.
 
 NOTE: Before version 5.004_65, C<hv_iterinit> used to return the number of
 hash buckets that happen to be in use.  If you still need that esoteric
@@ -2272,24 +2389,24 @@ Perl_hv_name_set(pTHX_ HV *hv, const char *name, U32 len, U32 flags)
     PERL_ARGS_ASSERT_HV_NAME_SET;
 
     if (len > I32_MAX)
-       Perl_croak(aTHX_ "panic: hv name too long (%"UVuf")", (UV) len);
+       Perl_croak(aTHX_ "panic: hv name too long (%" UVuf ")", (UV) len);
 
     if (SvOOK(hv)) {
        iter = HvAUX(hv);
        if (iter->xhv_name_u.xhvnameu_name) {
            if(iter->xhv_name_count) {
              if(flags & HV_NAME_SETALL) {
-               HEK ** const name = HvAUX(hv)->xhv_name_u.xhvnameu_names;
-               HEK **hekp = name + (
+               HEK ** const this_name = HvAUX(hv)->xhv_name_u.xhvnameu_names;
+               HEK **hekp = this_name + (
                    iter->xhv_name_count < 0
                     ? -iter->xhv_name_count
                     :  iter->xhv_name_count
                   );
-               while(hekp-- > name+1) 
+               while(hekp-- > this_name+1)
                    unshare_hek_or_pvn(*hekp, 0, 0, 0);
                /* The first elem may be null. */
-               if(*name) unshare_hek_or_pvn(*name, 0, 0, 0);
-               Safefree(name);
+               if(*this_name) unshare_hek_or_pvn(*this_name, 0, 0, 0);
+               Safefree(this_name);
                 iter = HvAUX(hv); /* may been realloced */
                spot = &iter->xhv_name_u.xhvnameu_name;
                iter->xhv_name_count = 0;
@@ -2379,7 +2496,7 @@ Perl_hv_ename_add(pTHX_ HV *hv, const char *name, U32 len, U32 flags)
     PERL_ARGS_ASSERT_HV_ENAME_ADD;
 
     if (len > I32_MAX)
-       Perl_croak(aTHX_ "panic: hv name too long (%"UVuf")", (UV) len);
+       Perl_croak(aTHX_ "panic: hv name too long (%" UVuf ")", (UV) len);
 
     PERL_HASH(hash, name, len);
 
@@ -2441,7 +2558,7 @@ Perl_hv_ename_delete(pTHX_ HV *hv, const char *name, U32 len, U32 flags)
     PERL_ARGS_ASSERT_HV_ENAME_DELETE;
 
     if (len > I32_MAX)
-       Perl_croak(aTHX_ "panic: hv name too long (%"UVuf")", (UV) len);
+       Perl_croak(aTHX_ "panic: hv name too long (%" UVuf ")", (UV) len);
 
     if (!SvOOK(hv)) return;
 
@@ -2555,6 +2672,8 @@ C<&PL_sv_placeholder>.  Note that the implementation of placeholders and
 restricted hashes may change, and the implementation currently is
 insufficiently abstracted for any change to be tidy.
 
+=for apidoc Amnh||HV_ITERNEXT_WANTPLACEHOLDERS
+
 =cut
 */
 
@@ -2925,7 +3044,7 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
  * len and hash must both be valid for str.
  */
 HEK *
-Perl_share_hek(pTHX_ const char *str, I32 len, U32 hash)
+Perl_share_hek(pTHX_ const char *str, SSize_t len, U32 hash)
 {
     bool is_utf8 = FALSE;
     int flags = 0;
@@ -2957,7 +3076,7 @@ Perl_share_hek(pTHX_ const char *str, I32 len, U32 hash)
 }
 
 STATIC HEK *
-S_share_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags)
+S_share_hek_flags(pTHX_ const char *str, STRLEN len, U32 hash, int flags)
 {
     HE *entry;
     const int flags_masked = flags & HVhek_MASK;
@@ -2966,6 +3085,10 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags)
 
     PERL_ARGS_ASSERT_SHARE_HEK_FLAGS;
 
+    if (UNLIKELY(len > (STRLEN) I32_MAX)) {
+        Perl_croak_nocontext("Sorry, hash keys must be smaller than 2**31 bytes");
+    }
+
     /* what follows is the moral equivalent of:
 
     if (!(Svp = hv_fetch(PL_strtab, str, len, FALSE)))
@@ -2980,7 +3103,7 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags)
     for (;entry; entry = HeNEXT(entry)) {
        if (HeHASH(entry) != hash)              /* strings can't be equal */
            continue;
-       if (HeKLEN(entry) != len)
+       if (HeKLEN(entry) != (SSize_t) len)
            continue;
        if (HeKEY(entry) != str && memNE(HeKEY(entry),str,len)) /* is this it? */
            continue;
@@ -3121,14 +3244,14 @@ S_refcounted_he_value(pTHX_ const struct refcounted_he *he)
            SvUTF8_on(value);
        break;
     default:
-       Perl_croak(aTHX_ "panic: refcounted_he_value bad flags %"UVxf,
+       Perl_croak(aTHX_ "panic: refcounted_he_value bad flags %" UVxf,
                   (UV)he->refcounted_he_data[0]);
     }
     return value;
 }
 
 /*
-=for apidoc m|HV *|refcounted_he_chain_2hv|const struct refcounted_he *c|U32 flags
+=for apidoc refcounted_he_chain_2hv
 
 Generates and returns a C<HV *> representing the content of a
 C<refcounted_he> chain.
@@ -3144,7 +3267,7 @@ Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain, U32 flags)
     U32 placeholders, max;
 
     if (flags)
-       Perl_croak(aTHX_ "panic: refcounted_he_chain_2hv bad flags %"UVxf,
+       Perl_croak(aTHX_ "panic: refcounted_he_chain_2hv bad flags %" UVxf,
            (UV)flags);
 
     /* We could chase the chain once to get an idea of the number of keys,
@@ -3236,7 +3359,7 @@ Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain, U32 flags)
 }
 
 /*
-=for apidoc m|SV *|refcounted_he_fetch_pvn|const struct refcounted_he *chain|const char *keypv|STRLEN keylen|U32 hash|U32 flags
+=for apidoc refcounted_he_fetch_pvn
 
 Search along a C<refcounted_he> chain for an entry with the key specified
 by C<keypv> and C<keylen>.  If C<flags> has the C<REFCOUNTED_HE_KEY_UTF8>
@@ -3258,7 +3381,7 @@ Perl_refcounted_he_fetch_pvn(pTHX_ const struct refcounted_he *chain,
     PERL_ARGS_ASSERT_REFCOUNTED_HE_FETCH_PVN;
 
     if (flags & ~(REFCOUNTED_HE_KEY_UTF8|REFCOUNTED_HE_EXISTS))
-       Perl_croak(aTHX_ "panic: refcounted_he_fetch_pvn bad flags %"UVxf,
+       Perl_croak(aTHX_ "panic: refcounted_he_fetch_pvn bad flags %" UVxf,
            (UV)flags);
     if (!chain)
        goto ret;
@@ -3326,7 +3449,7 @@ Perl_refcounted_he_fetch_pvn(pTHX_ const struct refcounted_he *chain,
 }
 
 /*
-=for apidoc m|SV *|refcounted_he_fetch_pv|const struct refcounted_he *chain|const char *key|U32 hash|U32 flags
+=for apidoc refcounted_he_fetch_pv
 
 Like L</refcounted_he_fetch_pvn>, but takes a nul-terminated string
 instead of a string/length pair.
@@ -3343,7 +3466,7 @@ Perl_refcounted_he_fetch_pv(pTHX_ const struct refcounted_he *chain,
 }
 
 /*
-=for apidoc m|SV *|refcounted_he_fetch_sv|const struct refcounted_he *chain|SV *key|U32 hash|U32 flags
+=for apidoc refcounted_he_fetch_sv
 
 Like L</refcounted_he_fetch_pvn>, but takes a Perl scalar instead of a
 string/length pair.
@@ -3359,7 +3482,7 @@ Perl_refcounted_he_fetch_sv(pTHX_ const struct refcounted_he *chain,
     STRLEN keylen;
     PERL_ARGS_ASSERT_REFCOUNTED_HE_FETCH_SV;
     if (flags & REFCOUNTED_HE_KEY_UTF8)
-       Perl_croak(aTHX_ "panic: refcounted_he_fetch_sv bad flags %"UVxf,
+       Perl_croak(aTHX_ "panic: refcounted_he_fetch_sv bad flags %" UVxf,
            (UV)flags);
     keypv = SvPV_const(key, keylen);
     if (SvUTF8(key))
@@ -3370,7 +3493,7 @@ Perl_refcounted_he_fetch_sv(pTHX_ const struct refcounted_he *chain,
 }
 
 /*
-=for apidoc m|struct refcounted_he *|refcounted_he_new_pvn|struct refcounted_he *parent|const char *keypv|STRLEN keylen|U32 hash|SV *value|U32 flags
+=for apidoc refcounted_he_new_pvn
 
 Creates a new C<refcounted_he>.  This consists of a single key/value
 pair and a reference to an existing C<refcounted_he> chain (which may
@@ -3514,7 +3637,7 @@ Perl_refcounted_he_new_pvn(pTHX_ struct refcounted_he *parent,
 }
 
 /*
-=for apidoc m|struct refcounted_he *|refcounted_he_new_pv|struct refcounted_he *parent|const char *key|U32 hash|SV *value|U32 flags
+=for apidoc refcounted_he_new_pv
 
 Like L</refcounted_he_new_pvn>, but takes a nul-terminated string instead
 of a string/length pair.
@@ -3531,7 +3654,7 @@ Perl_refcounted_he_new_pv(pTHX_ struct refcounted_he *parent,
 }
 
 /*
-=for apidoc m|struct refcounted_he *|refcounted_he_new_sv|struct refcounted_he *parent|SV *key|U32 hash|SV *value|U32 flags
+=for apidoc refcounted_he_new_sv
 
 Like L</refcounted_he_new_pvn>, but takes a Perl scalar instead of a
 string/length pair.
@@ -3547,7 +3670,7 @@ Perl_refcounted_he_new_sv(pTHX_ struct refcounted_he *parent,
     STRLEN keylen;
     PERL_ARGS_ASSERT_REFCOUNTED_HE_NEW_SV;
     if (flags & REFCOUNTED_HE_KEY_UTF8)
-       Perl_croak(aTHX_ "panic: refcounted_he_new_sv bad flags %"UVxf,
+       Perl_croak(aTHX_ "panic: refcounted_he_new_sv bad flags %" UVxf,
            (UV)flags);
     keypv = SvPV_const(key, keylen);
     if (SvUTF8(key))
@@ -3558,7 +3681,7 @@ Perl_refcounted_he_new_sv(pTHX_ struct refcounted_he *parent,
 }
 
 /*
-=for apidoc m|void|refcounted_he_free|struct refcounted_he *he
+=for apidoc refcounted_he_free
 
 Decrements the reference count of a C<refcounted_he> by one.  If the
 reference count reaches zero the structure's memory is freed, which
@@ -3598,7 +3721,7 @@ Perl_refcounted_he_free(pTHX_ struct refcounted_he *he) {
 }
 
 /*
-=for apidoc m|struct refcounted_he *|refcounted_he_inc|struct refcounted_he *he
+=for apidoc refcounted_he_inc
 
 Increment the reference count of a C<refcounted_he>.  The pointer to the
 C<refcounted_he> is also returned.  It is safe to pass a null pointer
@@ -3625,8 +3748,14 @@ Perl_refcounted_he_inc(pTHX_ struct refcounted_he *he)
 /*
 =for apidoc cop_fetch_label
 
-Returns the label attached to a cop.
-The flags pointer may be set to C<SVf_UTF8> or 0.
+Returns the label attached to a cop, and stores its length in bytes into
+C<*len>.
+Upon return, C<*flags> will be set to either C<SVf_UTF8> or 0.
+
+Alternatively, use the macro L</C<CopLABEL_len_flags>>;
+or if you don't need to know if the label is UTF-8 or not, the macro
+L</C<CopLABEL_len>>;
+or if you additionally dont need to know the length, L</C<CopLABEL>>.
 
 =cut
 */
@@ -3673,7 +3802,7 @@ Perl_cop_fetch_label(pTHX_ COP *const cop, STRLEN *len, U32 *flags) {
 
 Save a label into a C<cop_hints_hash>.
 You need to set flags to C<SVf_UTF8>
-for a UTF-8 label.
+for a UTF-8 label.  Any other flag is ignored.
 
 =cut
 */