skip trying to constant fold an incomplete op tree

[perl5.git] / hv.c

diff --git a/hv.c b/hv.c
index 6f27876..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
 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 )
  * 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";
 
 static const char S_strtab_error[]
     = "Cannot modify shared string table in hv_%s";


@@ -343,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)
 {
 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;
     XPVHV* xhv;
     HE *entry;
     HE **oentry;


@@ -394,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 {
        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);
        }
     } else {
        is_utf8 = cBOOL(flags & HVhek_UTF8);


@@ -402,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,
 
     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);
     }
 
     xhv = (XPVHV*)SvANY(hv);


@@ -1106,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)
 {
 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;
     XPVHV* xhv;
     HE *entry;
     HE **oentry;


@@ -1590,7 +1588,6 @@ Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
 HV *
 Perl_newHVhv(pTHX_ HV *ohv)
 {
 HV *
 Perl_newHVhv(pTHX_ HV *ohv)
 {

-    dVAR;

     HV * const hv = newHV();
     STRLEN hv_max;
 
     HV * const hv = newHV();
     STRLEN hv_max;
 


@@ -1779,7 +1776,7 @@ Perl_hv_delayfree_ent(pTHX_ HV *hv, HE *entry)
 /*
 =for apidoc hv_clear
 
 /*
 =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
 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


@@ -1791,7 +1788,6 @@ return.
 void
 Perl_hv_clear(pTHX_ HV *hv)
 {
 void
 Perl_hv_clear(pTHX_ HV *hv)
 {

-    dVAR;

     SSize_t orig_ix;
 
     XPVHV* xhv;
     SSize_t orig_ix;
 
     XPVHV* xhv;


@@ -1880,7 +1876,6 @@ Perl_hv_clear_placeholders(pTHX_ HV *hv)
 static void
 S_clear_placeholders(pTHX_ HV *hv, U32 items)
 {
 static void
 S_clear_placeholders(pTHX_ HV *hv, U32 items)
 {

-    dVAR;

     I32 i;
 
     PERL_ARGS_ASSERT_CLEAR_PLACEHOLDERS;
     I32 i;
 
     PERL_ARGS_ASSERT_CLEAR_PLACEHOLDERS;


@@ -2381,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)
 {
 void
 Perl_hv_name_set(pTHX_ HV *hv, const char *name, U32 len, U32 flags)
 {

-    dVAR;

     struct xpvhv_aux *iter;
     U32 hash;
     HEK **spot;
     struct xpvhv_aux *iter;
     U32 hash;
     HEK **spot;


@@ -2396,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) {
        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
                   );
                    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. */
                    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;
                 iter = HvAUX(hv); /* may been realloced */
                spot = &iter->xhv_name_u.xhvnameu_name;
                iter->xhv_name_count = 0;


@@ -2489,7 +2483,6 @@ table.
 void
 Perl_hv_ename_add(pTHX_ HV *hv, const char *name, U32 len, U32 flags)
 {
 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;
 
     struct xpvhv_aux *aux = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv);
     U32 hash;
 


@@ -2672,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.
 
 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)
 {
 =cut
 */
 
 HE *
 Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
 {

-    dVAR;

     XPVHV* xhv;
     HE *entry;
     HE *oldentry;
     XPVHV* xhv;
     HE *entry;
     HE *oldentry;


@@ -3064,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) {
          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;
       }
           PERL_HASH(hash, str, len);
           flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
       }


@@ -3209,7 +3202,6 @@ Perl_hv_placeholders_set(pTHX_ HV *hv, I32 ph)
 STATIC SV *
 S_refcounted_he_value(pTHX_ const struct refcounted_he *he)
 {
 STATIC SV *
 S_refcounted_he_value(pTHX_ const struct refcounted_he *he)
 {

-    dVAR;

     SV *value;
 
     PERL_ARGS_ASSERT_REFCOUNTED_HE_VALUE;
     SV *value;
 
     PERL_ARGS_ASSERT_REFCOUNTED_HE_VALUE;


@@ -3260,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)
 {
 HV *
 Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain, U32 flags)
 {

-    dVAR;

     HV *hv;
     U32 placeholders, max;
 
     HV *hv;
     U32 placeholders, max;
 


@@ -3374,7 +3365,6 @@ SV *
 Perl_refcounted_he_fetch_pvn(pTHX_ const struct refcounted_he *chain,
                         const char *keypv, STRLEN keylen, U32 hash, U32 flags)
 {
 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;
 
     U8 utf8_flag;
     PERL_ARGS_ASSERT_REFCOUNTED_HE_FETCH_PVN;
 


@@ -3527,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)
 {
 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;
     STRLEN value_len = 0;
     const char *value_p = NULL;
     bool is_pv;


@@ -3692,9 +3681,6 @@ no action occurs in this case.
 
 void
 Perl_refcounted_he_free(pTHX_ struct refcounted_he *he) {
 
 void
 Perl_refcounted_he_free(pTHX_ struct refcounted_he *he) {

-#ifdef USE_ITHREADS
-    dVAR;
-#endif

     PERL_UNUSED_CONTEXT;
 
     while (he) {
     PERL_UNUSED_CONTEXT;
 
     while (he) {


@@ -3731,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)
 {
 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;
     PERL_UNUSED_CONTEXT;
     if (he) {
        HINTS_REFCNT_LOCK;


@@ -3744,10 +3727,17 @@ Perl_refcounted_he_inc(pTHX_ struct refcounted_he *he)
 }
 
 /*
 }
 
 /*

+=for apidoc_section $COP

 =for apidoc cop_fetch_label
 
 =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
 */
 
 =cut
 */


@@ -3794,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>
 
 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
 */
 
 =cut
 */


@@ -3817,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.
 =for apidoc hv_assert
 
 Check that a hash is in an internally consistent state.


@@ -3829,7 +3820,6 @@ Check that a hash is in an internally consistent state.
 void
 Perl_hv_assert(pTHX_ HV *hv)
 {
 void
 Perl_hv_assert(pTHX_ HV *hv)
 {

-    dVAR;

     HE* entry;
     int withflags = 0;
     int placeholders = 0;
     HE* entry;
     int withflags = 0;
     int placeholders = 0;