This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
skip trying to constant fold an incomplete op tree
[perl5.git] / hv.c
diff --git a/hv.c b/hv.c
index 04129f8..8f7dbdc 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -17,7 +17,7 @@
  */
 
 /* 
-=head1 Hash Manipulation Functions
+=head1 HV Handling
 A HV structure represents a Perl hash.  It consists mainly of an array
 of pointers, each of which points to a linked list of HE structures.  The
 array is indexed by the hash function of the key, so each linked list
@@ -39,7 +39,6 @@ holds the key and hash value.
  * 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[]
     = "Cannot modify shared string table in hv_%s";
@@ -260,7 +259,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>.
@@ -341,7 +342,6 @@ void *
 Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
               int flags, int action, SV *val, U32 hash)
 {
-    dVAR;
     XPVHV* xhv;
     HE *entry;
     HE **oentry;
@@ -392,7 +392,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
        if (SvIsCOW_shared_hash(keysv)) {
            flags = HVhek_KEYCANONICAL | (is_utf8 ? HVhek_UTF8 : 0);
        } else {
-           flags = is_utf8 ? HVhek_UTF8 : 0;
+           flags = 0;
        }
     } else {
        is_utf8 = cBOOL(flags & HVhek_UTF8);
@@ -400,7 +400,8 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 
     if (action & HV_DELETE) {
        return (void *) hv_delete_common(hv, keysv, key, klen,
-                                        flags, action, hash);
+                                        flags | (is_utf8 ? HVhek_UTF8 : 0),
+                                        action, hash);
     }
 
     xhv = (XPVHV*)SvANY(hv);
@@ -1104,7 +1105,6 @@ STATIC SV *
 S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                   int k_flags, I32 d_flags, U32 hash)
 {
-    dVAR;
     XPVHV* xhv;
     HE *entry;
     HE **oentry;
@@ -1279,7 +1279,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                         sv_2mortal((SV *)gv)
                        );
                }
-               else if (klen == 3 && strBEGINs(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);
 
@@ -1295,7 +1295,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);
@@ -1588,7 +1588,6 @@ Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
 HV *
 Perl_newHVhv(pTHX_ HV *ohv)
 {
-    dVAR;
     HV * const hv = newHV();
     STRLEN hv_max;
 
@@ -1669,7 +1668,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
@@ -1777,7 +1776,7 @@ Perl_hv_delayfree_ent(pTHX_ HV *hv, HE *entry)
 /*
 =for apidoc hv_clear
 
-Frees the all the elements of a hash, leaving it empty.
+Frees all the elements of a hash, leaving it empty.
 The XS equivalent of C<%hash = ()>.  See also L</hv_undef>.
 
 See L</av_clear> for a note about the hash possibly being invalid on
@@ -1789,7 +1788,6 @@ return.
 void
 Perl_hv_clear(pTHX_ HV *hv)
 {
-    dVAR;
     SSize_t orig_ix;
 
     XPVHV* xhv;
@@ -1878,7 +1876,6 @@ Perl_hv_clear_placeholders(pTHX_ HV *hv)
 static void
 S_clear_placeholders(pTHX_ HV *hv, U32 items)
 {
-    dVAR;
     I32 i;
 
     PERL_ARGS_ASSERT_CLEAR_PLACEHOLDERS;
@@ -2379,7 +2376,6 @@ Perl_hv_eiter_set(pTHX_ HV *hv, HE *eiter) {
 void
 Perl_hv_name_set(pTHX_ HV *hv, const char *name, U32 len, U32 flags)
 {
-    dVAR;
     struct xpvhv_aux *iter;
     U32 hash;
     HEK **spot;
@@ -2394,17 +2390,17 @@ Perl_hv_name_set(pTHX_ HV *hv, const char *name, U32 len, U32 flags)
        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;
@@ -2487,7 +2483,6 @@ table.
 void
 Perl_hv_ename_add(pTHX_ HV *hv, const char *name, U32 len, U32 flags)
 {
-    dVAR;
     struct xpvhv_aux *aux = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv);
     U32 hash;
 
@@ -2670,13 +2665,14 @@ 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
 */
 
 HE *
 Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
 {
-    dVAR;
     XPVHV* xhv;
     HE *entry;
     HE *oldentry;
@@ -3062,7 +3058,6 @@ Perl_share_hek(pTHX_ const char *str, SSize_t len, U32 hash)
          we should flag that it needs upgrading on keys or each.  Also flag
          that we need share_hek_flags to free the string.  */
       if (str != save) {
-          dVAR;
           PERL_HASH(hash, str, len);
           flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
       }
@@ -3207,7 +3202,6 @@ Perl_hv_placeholders_set(pTHX_ HV *hv, I32 ph)
 STATIC SV *
 S_refcounted_he_value(pTHX_ const struct refcounted_he *he)
 {
-    dVAR;
     SV *value;
 
     PERL_ARGS_ASSERT_REFCOUNTED_HE_VALUE;
@@ -3247,7 +3241,7 @@ S_refcounted_he_value(pTHX_ const struct refcounted_he *he)
 }
 
 /*
-=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.
@@ -3258,7 +3252,6 @@ C<flags> is currently unused and must be zero.
 HV *
 Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain, U32 flags)
 {
-    dVAR;
     HV *hv;
     U32 placeholders, max;
 
@@ -3355,7 +3348,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>
@@ -3372,7 +3365,6 @@ SV *
 Perl_refcounted_he_fetch_pvn(pTHX_ const struct refcounted_he *chain,
                         const char *keypv, STRLEN keylen, U32 hash, U32 flags)
 {
-    dVAR;
     U8 utf8_flag;
     PERL_ARGS_ASSERT_REFCOUNTED_HE_FETCH_PVN;
 
@@ -3445,7 +3437,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.
@@ -3462,7 +3454,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.
@@ -3489,7 +3481,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
@@ -3525,7 +3517,6 @@ struct refcounted_he *
 Perl_refcounted_he_new_pvn(pTHX_ struct refcounted_he *parent,
        const char *keypv, STRLEN keylen, U32 hash, SV *value, U32 flags)
 {
-    dVAR;
     STRLEN value_len = 0;
     const char *value_p = NULL;
     bool is_pv;
@@ -3633,7 +3624,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.
@@ -3650,7 +3641,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.
@@ -3677,7 +3668,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
@@ -3690,9 +3681,6 @@ no action occurs in this case.
 
 void
 Perl_refcounted_he_free(pTHX_ struct refcounted_he *he) {
-#ifdef USE_ITHREADS
-    dVAR;
-#endif
     PERL_UNUSED_CONTEXT;
 
     while (he) {
@@ -3717,7 +3705,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
@@ -3729,9 +3717,6 @@ to this function: no action occurs and a null pointer is returned.
 struct refcounted_he *
 Perl_refcounted_he_inc(pTHX_ struct refcounted_he *he)
 {
-#ifdef USE_ITHREADS
-    dVAR;
-#endif
     PERL_UNUSED_CONTEXT;
     if (he) {
        HINTS_REFCNT_LOCK;
@@ -3742,10 +3727,17 @@ Perl_refcounted_he_inc(pTHX_ struct refcounted_he *he)
 }
 
 /*
+=for apidoc_section $COP
 =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 C<L</CopLABEL_len_flags>>;
+or if you don't need to know if the label is UTF-8 or not, the macro
+C<L</CopLABEL_len>>;
+or if you additionally dont need to know the length, C<L</CopLABEL>>.
 
 =cut
 */
@@ -3792,7 +3784,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
 */
@@ -3815,6 +3807,7 @@ Perl_cop_store_label(pTHX_ COP *const cop, const char *label, STRLEN len,
 }
 
 /*
+=for apidoc_section $HV
 =for apidoc hv_assert
 
 Check that a hash is in an internally consistent state.
@@ -3827,7 +3820,6 @@ Check that a hash is in an internally consistent state.
 void
 Perl_hv_assert(pTHX_ HV *hv)
 {
-    dVAR;
     HE* entry;
     int withflags = 0;
     int placeholders = 0;