X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/e8e5e5b33e8b014d1b66f2a313ac50e677f6cdb4..d98ae4a6b04a455a18f2704a66dbe21fb352baf8:/hv.c diff --git a/hv.c b/hv.c index 3cb0b07..5bab2d7 100644 --- a/hv.c +++ b/hv.c @@ -18,7 +18,6 @@ /* =head1 Hash Manipulation Functions - 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 @@ -51,7 +50,6 @@ static const char S_strtab_error[] STATIC HE* S_new_he(pTHX) { - dVAR; HE* he; void ** const root = &PL_body_roots[HE_SVSLOT]; @@ -102,7 +100,6 @@ S_save_hek_flags(const char *str, I32 len, U32 hash, int flags) void Perl_free_tied_hv_pool(pTHX) { - dVAR; HE *he = PL_hv_fetch_ent_mh; while (he) { HE * const ohe = he; @@ -348,6 +345,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, bool is_utf8; int masked_flags; const int return_svp = action & HV_FETCH_JUST_SV; + HEK *keysv_hek = NULL; if (!hv) return NULL; @@ -617,12 +615,13 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, } } - if (!hash) { - if (keysv && (SvIsCOW_shared_hash(keysv))) - hash = SvSHARED_HASH(keysv); - else - PERL_HASH(hash, key, klen); + if (keysv && (SvIsCOW_shared_hash(keysv))) { + if (HvSHAREKEYS(hv)) + keysv_hek = SvSHARED_HEK_FROM_PV(SvPVX_const(keysv)); + hash = SvSHARED_HASH(keysv); } + else if (!hash) + PERL_HASH(hash, key, klen); masked_flags = (flags & HVhek_MASK); @@ -633,16 +632,48 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, { entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; } + + if (!entry) + goto not_found; + + if (keysv_hek) { + /* keysv is actually a HEK in disguise, so we can match just by + * comparing the HEK pointers in the HE chain. There is a slight + * caveat: on something like "\x80", which has both plain and utf8 + * representations, perl's hashes do encoding-insensitive lookups, + * but preserve the encoding of the stored key. Thus a particular + * key could map to two different HEKs in PL_strtab. We only + * conclude 'not found' if all the flags are the same; otherwise + * we fall back to a full search (this should only happen in rare + * cases). + */ + int keysv_flags = HEK_FLAGS(keysv_hek); + HE *orig_entry = entry; + + for (; entry; entry = HeNEXT(entry)) { + HEK *hek = HeKEY_hek(entry); + if (hek == keysv_hek) + goto found; + if (HEK_FLAGS(hek) != keysv_flags) + break; /* need to do full match */ + } + if (!entry) + goto not_found; + /* failed on shortcut - do full search loop */ + entry = orig_entry; + } + for (; entry; entry = HeNEXT(entry)) { if (HeHASH(entry) != hash) /* strings can't be equal */ continue; if (HeKLEN(entry) != (I32)klen) continue; - if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */ + if (memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; if ((HeKFLAGS(entry) ^ masked_flags) & HVhek_UTF8) continue; + found: if (action & (HV_FETCH_LVALUE|HV_FETCH_ISSTORE)) { if (HeKFLAGS(entry) != masked_flags) { /* We match if HVhek_UTF8 bit in our flags and hash key's @@ -711,6 +742,8 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, } return entry; } + + not_found: #ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */ if (!(action & HV_FETCH_ISSTORE) && SvRMAGICAL((const SV *)hv) @@ -900,7 +933,8 @@ S_hv_magic_check(HV *hv, bool *needs_copy, bool *needs_store) /* =for apidoc hv_scalar -Evaluates the hash in scalar context and returns the result. Handles magic when the hash is tied. +Evaluates the hash in scalar context and returns the result. Handles magic +when the hash is tied. =cut */ @@ -957,9 +991,14 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, XPVHV* xhv; HE *entry; HE **oentry; - HE *const *first_entry; + HE **first_entry; bool is_utf8 = (k_flags & HVhek_UTF8) ? TRUE : FALSE; int masked_flags; + HEK *keysv_hek = NULL; + U8 mro_changes = 0; /* 1 = isa; 2 = package moved */ + SV *sv; + GV *gv = NULL; + HV *stash = NULL; if (SvRMAGICAL(hv)) { bool needs_copy; @@ -1024,32 +1063,60 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, HvHASKFLAGS_on(MUTABLE_SV(hv)); } - if (!hash) { - if (keysv && (SvIsCOW_shared_hash(keysv))) - hash = SvSHARED_HASH(keysv); - else - PERL_HASH(hash, key, klen); + if (keysv && (SvIsCOW_shared_hash(keysv))) { + if (HvSHAREKEYS(hv)) + keysv_hek = SvSHARED_HEK_FROM_PV(SvPVX_const(keysv)); + hash = SvSHARED_HASH(keysv); } + else if (!hash) + PERL_HASH(hash, key, klen); masked_flags = (k_flags & HVhek_MASK); first_entry = oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; entry = *oentry; - for (; entry; oentry = &HeNEXT(entry), entry = *oentry) { - SV *sv; - U8 mro_changes = 0; /* 1 = isa; 2 = package moved */ - GV *gv = NULL; - HV *stash = NULL; + if (!entry) + goto not_found; + + if (keysv_hek) { + /* keysv is actually a HEK in disguise, so we can match just by + * comparing the HEK pointers in the HE chain. There is a slight + * caveat: on something like "\x80", which has both plain and utf8 + * representations, perl's hashes do encoding-insensitive lookups, + * but preserve the encoding of the stored key. Thus a particular + * key could map to two different HEKs in PL_strtab. We only + * conclude 'not found' if all the flags are the same; otherwise + * we fall back to a full search (this should only happen in rare + * cases). + */ + int keysv_flags = HEK_FLAGS(keysv_hek); + + for (; entry; oentry = &HeNEXT(entry), entry = *oentry) { + HEK *hek = HeKEY_hek(entry); + if (hek == keysv_hek) + goto found; + if (HEK_FLAGS(hek) != keysv_flags) + break; /* need to do full match */ + } + if (!entry) + goto not_found; + /* failed on shortcut - do full search loop */ + oentry = first_entry; + entry = *oentry; + } + + for (; entry; oentry = &HeNEXT(entry), entry = *oentry) { if (HeHASH(entry) != hash) /* strings can't be equal */ continue; if (HeKLEN(entry) != (I32)klen) continue; - if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */ + if (memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; if ((HeKFLAGS(entry) ^ masked_flags) & HVhek_UTF8) continue; + found: if (hv == PL_strtab) { if (k_flags & HVhek_FREEKEY) Safefree(key); @@ -1150,6 +1217,8 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, return sv; } + + not_found: if (SvREADONLY(hv)) { hv_notallowed(k_flags, key, klen, "Attempt to delete disallowed key '%"SVf"' from" @@ -1161,26 +1230,33 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, return NULL; } + STATIC void S_hsplit(pTHX_ HV *hv, STRLEN const oldsize, STRLEN newsize) { - dVAR; STRLEN i = 0; char *a = (char*) HvARRAY(hv); HE **aep; - PERL_ARGS_ASSERT_HSPLIT; + bool do_aux= ( + /* already have an HvAUX(hv) so we have to move it */ + SvOOK(hv) || + /* no HvAUX() but array we are going to allocate is large enough + * there is no point in saving the space for the iterator, and + * speeds up later traversals. */ + ( ( hv != PL_strtab ) && ( newsize >= PERL_HV_ALLOC_AUX_SIZE ) ) + ); - /*PerlIO_printf(PerlIO_stderr(), "hsplit called for %p which had %d\n", - (void*)hv, (int) oldsize);*/ + PERL_ARGS_ASSERT_HSPLIT; PL_nomemok = TRUE; Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize) - + (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0), char); + + (do_aux ? sizeof(struct xpvhv_aux) : 0), char); + PL_nomemok = FALSE; if (!a) { - PL_nomemok = FALSE; return; } + #ifdef PERL_HASH_RANDOMIZE_KEYS /* the idea of this is that we create a "random" value by hashing the address of * the array, we then use the low bit to decide if we insert at the top, or insert @@ -1193,29 +1269,46 @@ S_hsplit(pTHX_ HV *hv, STRLEN const oldsize, STRLEN newsize) PL_hash_rand_bits = ROTL_UV(PL_hash_rand_bits,1); } #endif - - if (SvOOK(hv)) { + HvARRAY(hv) = (HE**) a; + HvMAX(hv) = newsize - 1; + /* before we zero the newly added memory, we + * need to deal with the aux struct that may be there + * or have been allocated by us*/ + if (do_aux) { struct xpvhv_aux *const dest = (struct xpvhv_aux*) &a[newsize * sizeof(HE*)]; - Move(&a[oldsize * sizeof(HE*)], dest, 1, struct xpvhv_aux); - /* we reset the iterator's xhv_rand as well, so they get a totally new ordering */ + if (SvOOK(hv)) { + /* alread have an aux, copy the old one in place. */ + Move(&a[oldsize * sizeof(HE*)], dest, 1, struct xpvhv_aux); + /* we reset the iterator's xhv_rand as well, so they get a totally new ordering */ +#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; + } else { + /* no existing aux structure, but we allocated space for one + * so intialize it properly. This unrolls hv_auxinit() a bit, + * since we have to do the realloc anyway. */ + /* first we set the iterator's xhv_rand so it can be copied into lastrand below */ #ifdef PERL_HASH_RANDOMIZE_KEYS - dest->xhv_rand = (U32)PL_hash_rand_bits; + 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; + /* this is the "non realloc" part of the hv_auxinit() */ + (void)hv_auxinit_internal(dest); + /* Turn on the OOK flag */ + SvOOK_on(hv); + } } - - PL_nomemok = FALSE; + /* now we can safely clear the second half */ Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/ - HvMAX(hv) = --newsize; - HvARRAY(hv) = (HE**) a; if (!HvTOTALKEYS(hv)) /* skip rest if no entries */ return; + newsize--; aep = (HE**)a; do { HE **oentry = aep + i; @@ -1233,7 +1326,7 @@ S_hsplit(pTHX_ HV *hv, STRLEN const oldsize, STRLEN newsize) * and use the new low bit to decide if we insert at top, * or next from top. IOW, we only rotate on a collision.*/ if (aep[j] && PL_HASH_RAND_BITS_ENABLED) { - PL_hash_rand_bits+= ROTL_UV(HeHASH(entry), 17); + PL_hash_rand_bits+= ROTL32(HeHASH(entry), 17); PL_hash_rand_bits= ROTL_UV(PL_hash_rand_bits,1); if (PL_hash_rand_bits & 1) { HeNEXT(entry)= HeNEXT(aep[j]); @@ -1264,7 +1357,6 @@ S_hsplit(pTHX_ HV *hv, STRLEN const oldsize, STRLEN newsize) void Perl_hv_ksplit(pTHX_ HV *hv, IV newmax) { - dVAR; XPVHV* xhv = (XPVHV*)SvANY(hv); const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */ I32 newsize; @@ -1450,7 +1542,6 @@ Perl_hv_copy_hints_hv(pTHX_ HV *const ohv) STATIC SV* S_hv_free_ent_ret(pTHX_ HV *hv, HE *entry) { - dVAR; SV *val; PERL_ARGS_ASSERT_HV_FREE_ENT_RET; @@ -1472,7 +1563,6 @@ S_hv_free_ent_ret(pTHX_ HV *hv, HE *entry) void Perl_hv_free_ent(pTHX_ HV *hv, HE *entry) { - dVAR; SV *val; PERL_ARGS_ASSERT_HV_FREE_ENT; @@ -1487,8 +1577,6 @@ Perl_hv_free_ent(pTHX_ HV *hv, HE *entry) void Perl_hv_delayfree_ent(pTHX_ HV *hv, HE *entry) { - dVAR; - PERL_ARGS_ASSERT_HV_DELAYFREE_ENT; if (!entry) @@ -1584,7 +1672,6 @@ See Hash::Util::lock_keys() for an example of its use. void Perl_hv_clear_placeholders(pTHX_ HV *hv) { - dVAR; const U32 items = (U32)HvPLACEHOLDERS_get(hv); PERL_ARGS_ASSERT_HV_CLEAR_PLACEHOLDERS; @@ -1624,8 +1711,10 @@ S_clear_placeholders(pTHX_ HV *hv, U32 items) if (--items == 0) { /* Finished. */ - HvTOTALKEYS(hv) -= (IV)HvPLACEHOLDERS_get(hv); - if (HvUSEDKEYS(hv) == 0) + I32 placeholders = HvPLACEHOLDERS_get(hv); + HvTOTALKEYS(hv) -= (IV)placeholders; + /* HvUSEDKEYS expanded */ + if ((HvTOTALKEYS(hv) - placeholders) == 0) HvHASKFLAGS_off(hv); HvPLACEHOLDERS_set(hv, 0); return; @@ -1637,7 +1726,7 @@ S_clear_placeholders(pTHX_ HV *hv, U32 items) } while (--i >= 0); /* You can't get here, hence assertion should always fail. */ assert (items == 0); - assert (0); + NOT_REACHED; } STATIC void @@ -1686,6 +1775,7 @@ Perl_hfree_next_entry(pTHX_ HV *hv, STRLEN *indexp) /* warning: at this point HvARRAY may have been * re-allocated, HvMAX changed etc */ } + iter = HvAUX(hv); /* may have been realloced */ iter->xhv_riter = -1; /* HvRITER(hv) = -1 */ iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */ #ifdef PERL_HASH_RANDOMIZE_KEYS @@ -1750,13 +1840,12 @@ See also L. void Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags) { - dVAR; XPVHV* xhv; - const char *name; - const bool save = !!SvREFCNT(hv); + bool save; if (!hv) return; + save = !!SvREFCNT(hv); DEBUG_A(Perl_hv_assert(aTHX_ hv)); xhv = (XPVHV*)SvANY(hv); @@ -1770,14 +1859,11 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags) if they will be freed anyway. */ /* note that the code following prior to hfreeentries is duplicated * in sv_clear(), and changes here should be done there too */ - if (PL_phase != PERL_PHASE_DESTRUCT && (name = HvNAME(hv))) { + 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", HvNAME_HEK(hv))); - (void)hv_delete(PL_stashcache, name, - HEK_UTF8(HvNAME_HEK(hv)) ? -HvNAMELEN_get(hv) : HvNAMELEN_get(hv), - G_DISCARD - ); + HEKf"'\n", HEKfARG(HvNAME_HEK(hv)))); + (void)hv_deletehek(PL_stashcache, HvNAME_HEK(hv), G_DISCARD); } hv_name_set(hv, NULL, 0, 0); } @@ -1787,35 +1873,31 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags) } hfreeentries(hv); if (SvOOK(hv)) { - struct xpvhv_aux * const aux = HvAUX(hv); struct mro_meta *meta; + const char *name; - if ((name = HvENAME_get(hv))) { + if (HvENAME_get(hv)) { if (PL_phase != PERL_PHASE_DESTRUCT) mro_isa_changed_in(hv); if (PL_stashcache) { DEBUG_o(Perl_deb(aTHX_ "hv_undef_flags clearing PL_stashcache for effective name '%" - HEKf"'\n", HvENAME_HEK(hv))); - (void)hv_delete( - PL_stashcache, name, - HEK_UTF8(HvENAME_HEK(hv)) ? -HvENAMELEN_get(hv) : HvENAMELEN_get(hv), - G_DISCARD - ); + HEKf"'\n", HEKfARG(HvENAME_HEK(hv)))); + (void)hv_deletehek(PL_stashcache, HvENAME_HEK(hv), G_DISCARD); } } /* If this call originated from sv_clear, then we must check for * effective names that need freeing, as well as the usual name. */ name = HvNAME(hv); - if (flags & HV_NAME_SETALL ? !!aux->xhv_name_u.xhvnameu_name : !!name) { + 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", HvNAME_HEK(hv))); - (void)hv_delete(PL_stashcache, name, (HEK_UTF8(HvNAME_HEK(hv)) ? -HvNAMELEN_get(hv) : HvNAMELEN_get(hv)), G_DISCARD); + HEKf"'\n", HEKfARG(HvNAME_HEK(hv)))); + (void)hv_deletehek(PL_stashcache, HvNAME_HEK(hv), G_DISCARD); } hv_name_set(hv, NULL, 0, flags); } - if((meta = aux->xhv_mro_meta)) { + if((meta = HvAUX(hv)->xhv_mro_meta)) { if (meta->mro_linear_all) { SvREFCNT_dec_NN(meta->mro_linear_all); /* mro_linear_current is just acting as a shortcut pointer, @@ -1829,9 +1911,9 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags) SvREFCNT_dec(meta->isa); SvREFCNT_dec(meta->super); Safefree(meta); - aux->xhv_mro_meta = NULL; + HvAUX(hv)->xhv_mro_meta = NULL; } - if (!aux->xhv_name_u.xhvnameu_name && ! aux->xhv_backreferences) + if (!HvAUX(hv)->xhv_name_u.xhvnameu_name && ! HvAUX(hv)->xhv_backreferences) SvFLAGS(hv) &= ~SVf_OOK; } if (!SvOOK(hv)) { @@ -1852,13 +1934,15 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags) /* =for apidoc hv_fill -Returns the number of hash buckets that happen to be in use. This function is +Returns the number of hash buckets that +happen to be in use. This function is wrapped by the macro C. 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 +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. @@ -1939,6 +2023,23 @@ PERL_STATIC_INLINE U32 S_ptr_hash(PTRV u) { return (U32)u; } +static struct xpvhv_aux* +S_hv_auxinit_internal(struct xpvhv_aux *iter) { + PERL_ARGS_ASSERT_HV_AUXINIT_INTERNAL; + 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; +#endif + iter->xhv_fill_lazy = 0; + iter->xhv_name_u.xhvnameu_name = 0; + iter->xhv_name_count = 0; + iter->xhv_backreferences = 0; + iter->xhv_mro_meta = NULL; + iter->xhv_aux_flags = 0; + return iter; +} + static struct xpvhv_aux* S_hv_auxinit(pTHX_ HV *hv) { @@ -1972,17 +2073,7 @@ S_hv_auxinit(pTHX_ HV *hv) { iter = HvAUX(hv); } - 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; -#endif - iter->xhv_fill_lazy = 0; - iter->xhv_name_u.xhvnameu_name = 0; - iter->xhv_name_count = 0; - iter->xhv_backreferences = 0; - iter->xhv_mro_meta = NULL; - return iter; + return hv_auxinit_internal(iter); } /* @@ -2011,12 +2102,13 @@ Perl_hv_iterinit(pTHX_ HV *hv) Perl_croak(aTHX_ "Bad hash"); if (SvOOK(hv)) { - struct xpvhv_aux * const iter = HvAUX(hv); + struct xpvhv_aux * iter = HvAUX(hv); HE * const entry = iter->xhv_eiter; /* HvEITER(hv) */ if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */ HvLAZYDEL_off(hv); hv_free_ent(hv, entry); } + iter = HvAUX(hv); /* may have been reallocated */ iter->xhv_riter = -1; /* HvRITER(hv) = -1 */ iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */ #ifdef PERL_HASH_RANDOMIZE_KEYS @@ -2148,6 +2240,7 @@ Perl_hv_name_set(pTHX_ HV *hv, const char *name, U32 len, U32 flags) /* The first elem may be null. */ if(*name) unshare_hek_or_pvn(*name, 0, 0, 0); Safefree(name); + iter = HvAUX(hv); /* may been realloced */ spot = &iter->xhv_name_u.xhvnameu_name; iter->xhv_name_count = 0; } @@ -2169,6 +2262,7 @@ Perl_hv_name_set(pTHX_ HV *hv, const char *name, U32 len, U32 flags) } else if (flags & HV_NAME_SETALL) { unshare_hek_or_pvn(iter->xhv_name_u.xhvnameu_name, 0, 0, 0); + iter = HvAUX(hv); /* may been realloced */ spot = &iter->xhv_name_u.xhvnameu_name; } else { @@ -2289,7 +2383,6 @@ This is called when a stash is deleted from the symbol table. void Perl_hv_ename_delete(pTHX_ HV *hv, const char *name, U32 len, U32 flags) { - dVAR; struct xpvhv_aux *aux; PERL_ARGS_ASSERT_HV_ENAME_DELETE; @@ -2313,6 +2406,7 @@ Perl_hv_ename_delete(pTHX_ HV *hv, const char *name, U32 len, U32 flags) : (HEK_LEN(*victim) == (I32)len && memEQ(HEK_KEY(*victim), name, len)) ) { unshare_hek_or_pvn(*victim, 0, 0, 0); + aux = HvAUX(hv); /* may been realloced */ if (count < 0) ++aux->xhv_name_count; else --aux->xhv_name_count; if ( @@ -2356,7 +2450,6 @@ Perl_hv_backreferences_p(pTHX_ HV *hv) { struct xpvhv_aux * const iter = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv); PERL_ARGS_ASSERT_HV_BACKREFERENCES_P; - PERL_UNUSED_CONTEXT; return &(iter->xhv_backreferences); } @@ -2400,7 +2493,7 @@ trigger the resource deallocation. Returns entries from a hash iterator. See C and C. The C value will normally be zero; if HV_ITERNEXT_WANTPLACEHOLDERS is set the placeholders keys (for restricted hashes) will be returned in addition -to normal keys. By default placeholders are automatically skipped over. +to normal keys. By default placeholders are automatically skipped over. Currently a placeholder is implemented with a value that is C<&PL_sv_placeholder>. Note that the implementation of placeholders and restricted hashes may change, and the implementation currently is @@ -2465,6 +2558,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) SvREFCNT_dec(HeVAL(entry)); Safefree(HeKEY_hek(entry)); del_HE(entry); + iter = HvAUX(hv); /* may been realloced */ iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */ HvLAZYDEL_off(hv); return NULL; @@ -2511,6 +2605,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) pTHX__FORMAT pTHX__VALUE); } + iter = HvAUX(hv); /* may been realloced */ iter->xhv_last_rand = iter->xhv_rand; } #endif @@ -2555,6 +2650,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) hv_free_ent(hv, oldentry); } + iter = HvAUX(hv); /* may been realloced */ iter->xhv_eiter = entry; /* HvEITER(hv) = entry */ return entry; } @@ -2688,7 +2784,6 @@ Perl_unshare_hek(pTHX_ HEK *hek) STATIC void S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash) { - dVAR; XPVHV* xhv; HE *entry; HE **oentry; @@ -2811,7 +2906,6 @@ 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) { - dVAR; HE *entry; const int flags_masked = flags & HVhek_MASK; const U32 hindex = hash & (I32) HvMAX(PL_strtab); @@ -2896,7 +2990,6 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags) SSize_t * Perl_hv_placeholders_p(pTHX_ HV *hv) { - dVAR; MAGIC *mg = mg_find((const SV *)hv, PERL_MAGIC_rhash); PERL_ARGS_ASSERT_HV_PLACEHOLDERS_P; @@ -2915,10 +3008,10 @@ Perl_hv_placeholders_p(pTHX_ HV *hv) I32 Perl_hv_placeholders_get(pTHX_ const HV *hv) { - dVAR; MAGIC * const mg = mg_find((const SV *)hv, PERL_MAGIC_rhash); PERL_ARGS_ASSERT_HV_PLACEHOLDERS_GET; + PERL_UNUSED_CONTEXT; return mg ? mg->mg_len : 0; } @@ -2926,7 +3019,6 @@ Perl_hv_placeholders_get(pTHX_ const HV *hv) void Perl_hv_placeholders_set(pTHX_ HV *hv, I32 ph) { - dVAR; MAGIC * const mg = mg_find((const SV *)hv, PERL_MAGIC_rhash); PERL_ARGS_ASSERT_HV_PLACEHOLDERS_SET; @@ -3425,7 +3517,9 @@ 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) { @@ -3462,7 +3556,10 @@ 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; he->refcounted_he_refcnt++; @@ -3487,6 +3584,7 @@ Perl_cop_fetch_label(pTHX_ COP *const cop, STRLEN *len, U32 *flags) { struct refcounted_he *const chain = cop->cop_hints_hash; PERL_ARGS_ASSERT_COP_FETCH_LABEL; + PERL_UNUSED_CONTEXT; if (!chain) return NULL; @@ -3519,7 +3617,8 @@ Perl_cop_fetch_label(pTHX_ COP *const cop, STRLEN *len, U32 *flags) { /* =for apidoc cop_store_label -Save a label into a C. You need to set flags to C +Save a label into a C. +You need to set flags to C for a utf-8 label. =cut