X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/a49ba3fcbe357fbacf7b9898df08daa2cbdfc8c4..b4222fa9a30f89a491b9910b750d8aa7895a0e77:/hv.c diff --git a/hv.c b/hv.c index 0cbb483..cabaac7 100644 --- a/hv.c +++ b/hv.c @@ -1,7 +1,7 @@ /* hv.c * - * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, - * 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, by Larry Wall and others + * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, + * 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -9,7 +9,11 @@ */ /* - * "I sit beside the fire and think of all that I have seen." --Bilbo + * I sit beside the fire and think + * of all that I have seen. + * --Bilbo + * + * [p.278 of _The Lord of the Rings_, II/iii: "The Ring Goes South"] */ /* @@ -130,11 +134,15 @@ Perl_free_tied_hv_pool(pTHX) HEK * Perl_hek_dup(pTHX_ HEK *source, CLONE_PARAMS* param) { - HEK *shared = (HEK*)ptr_table_fetch(PL_ptr_table, source); + HEK *shared; PERL_ARGS_ASSERT_HEK_DUP; PERL_UNUSED_ARG(param); + if (!source) + return NULL; + + shared = (HEK*)ptr_table_fetch(PL_ptr_table, source); if (shared) { /* We already shared this hash key. */ (void)share_hek_hek(shared); @@ -169,7 +177,7 @@ Perl_he_dup(pTHX_ const HE *e, bool shared, CLONE_PARAMS* param) HeNEXT(ret) = he_dup(HeNEXT(e),shared, param); if (HeKLEN(e) == HEf_SVKEY) { char *k; - Newx(k, HEK_BASESIZE + sizeof(SV*), char); + Newx(k, HEK_BASESIZE + sizeof(const SV *), char); HeKEY_hek(ret) = (HEK*)k; HeKEY_sv(ret) = SvREFCNT_inc(sv_dup(HeKEY_sv(e), param)); } @@ -357,7 +365,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, if (SvSMAGICAL(hv) && SvGMAGICAL(hv) && !(action & HV_DISABLE_UVAR_XKEY)) { MAGIC* mg; - if ((mg = mg_find((SV*)hv, PERL_MAGIC_uvar))) { + if ((mg = mg_find((const SV *)hv, PERL_MAGIC_uvar))) { struct ufuncs * const uf = (struct ufuncs *)mg->mg_ptr; if (uf->uf_set == NULL) { SV* obj = mg->mg_obj; @@ -370,7 +378,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, mg->mg_obj = keysv; /* pass key */ uf->uf_index = action; /* pass action */ - magic_getuvar((SV*)hv, mg); + magic_getuvar(MUTABLE_SV(hv), mg); keysv = mg->mg_obj; /* may have changed */ mg->mg_obj = obj; @@ -384,8 +392,12 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, if (flags & HVhek_FREEKEY) Safefree(key); key = SvPV_const(keysv, klen); - flags = 0; is_utf8 = (SvUTF8(keysv) != 0); + if (SvIsCOW_shared_hash(keysv)) { + flags = HVhek_KEYCANONICAL | (is_utf8 ? HVhek_UTF8 : 0); + } else { + flags = 0; + } } else { is_utf8 = ((flags & HVhek_UTF8) ? TRUE : FALSE); } @@ -399,7 +411,8 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, xhv = (XPVHV*)SvANY(hv); if (SvMAGICAL(hv)) { if (SvRMAGICAL(hv) && !(action & (HV_FETCH_ISSTORE|HV_FETCH_ISEXISTS))) { - if ( mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) + if (mg_find((const SV *)hv, PERL_MAGIC_tied) + || SvGMAGICAL((const SV *)hv)) { /* FIXME should be able to skimp on the HE/HEK here when HV_FETCH_JUST_SV is true. */ @@ -409,7 +422,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, keysv = newSVsv(keysv); } sv = sv_newmortal(); - mg_copy((SV*)hv, sv, (char *)keysv, HEf_SVKEY); + mg_copy(MUTABLE_SV(hv), sv, (char *)keysv, HEf_SVKEY); /* grab a fake HE/HEK pair from the pool or make a new one */ entry = PL_hv_fetch_ent_mh; @@ -418,7 +431,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, else { char *k; entry = new_HE(); - Newx(k, HEK_BASESIZE + sizeof(SV*), char); + Newx(k, HEK_BASESIZE + sizeof(const SV *), char); HeKEY_hek(entry) = (HEK*)k; } HeNEXT(entry) = NULL; @@ -427,7 +440,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, sv_upgrade(sv, SVt_PVLV); LvTYPE(sv) = 'T'; /* so we can free entry when freeing sv */ - LvTARG(sv) = (SV*)entry; + LvTARG(sv) = MUTABLE_SV(entry); /* XXX remove at some point? */ if (flags & HVhek_FREEKEY) @@ -439,7 +452,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, return (void *) entry; } #ifdef ENV_IS_CASELESS - else if (mg_find((SV*)hv, PERL_MAGIC_env)) { + else if (mg_find((const SV *)hv, PERL_MAGIC_env)) { U32 i; for (i = 0; i < klen; ++i) if (isLOWER(key[i])) { @@ -474,7 +487,8 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, #endif } /* ISFETCH */ else if (SvRMAGICAL(hv) && (action & HV_FETCH_ISEXISTS)) { - if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) { + if (mg_find((const SV *)hv, PERL_MAGIC_tied) + || SvGMAGICAL((const SV *)hv)) { /* I don't understand why hv_exists_ent has svret and sv, whereas hv_exists only had one. */ SV * const svret = sv_newmortal(); @@ -486,9 +500,9 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, } else { keysv = newSVsv(keysv); } - mg_copy((SV*)hv, sv, (char *)sv_2mortal(keysv), HEf_SVKEY); + mg_copy(MUTABLE_SV(hv), sv, (char *)sv_2mortal(keysv), HEf_SVKEY); } else { - mg_copy((SV*)hv, sv, key, klen); + mg_copy(MUTABLE_SV(hv), sv, key, klen); } if (flags & HVhek_FREEKEY) Safefree(key); @@ -499,7 +513,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, return SvTRUE(svret) ? (void *)hv : NULL; } #ifdef ENV_IS_CASELESS - else if (mg_find((SV*)hv, PERL_MAGIC_env)) { + else if (mg_find((const SV *)hv, PERL_MAGIC_env)) { /* XXX This code isn't UTF8 clean. */ char * const keysave = (char * const)key; /* Will need to free this, so set FREEKEY flag. */ @@ -529,9 +543,9 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, if (PL_tainting) PL_tainted = SvTAINTED(keysv); keysv = sv_2mortal(newSVsv(keysv)); - mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY); + mg_copy(MUTABLE_SV(hv), val, (char*)keysv, HEf_SVKEY); } else { - mg_copy((SV*)hv, val, key, klen); + mg_copy(MUTABLE_SV(hv), val, key, klen); } TAINT_IF(save_taint); @@ -541,7 +555,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, return NULL; } #ifdef ENV_IS_CASELESS - else if (mg_find((SV*)hv, PERL_MAGIC_env)) { + else if (mg_find((const SV *)hv, PERL_MAGIC_env)) { /* XXX This code isn't UTF8 clean. */ const char *keysave = key; /* Will need to free this, so set FREEKEY flag. */ @@ -564,7 +578,8 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, if (!HvARRAY(hv)) { if ((action & (HV_FETCH_LVALUE | HV_FETCH_ISSTORE)) #ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */ - || (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) + || (SvRMAGICAL((const SV *)hv) + && mg_find((const SV *)hv, PERL_MAGIC_env)) #endif ) { char *array; @@ -588,7 +603,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, } } - if (is_utf8) { + if (is_utf8 & !(flags & HVhek_KEYCANONICAL)) { char * const keysave = (char *)key; key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8); if (is_utf8) @@ -599,6 +614,11 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, if (flags & HVhek_FREEKEY) Safefree(keysave); flags |= HVhek_WASUTF8 | HVhek_FREEKEY; + /* If the caller calculated a hash, it was on the sequence of + octets that are the UTF-8 form. We've now changed the sequence + of octets stored to that of the equivalent byte representation, + so the hash we need is different. */ + hash = 0; } } @@ -707,7 +727,8 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, } #ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */ if (!(action & HV_FETCH_ISSTORE) - && SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) { + && SvRMAGICAL((const SV *)hv) + && mg_find((const SV *)hv, PERL_MAGIC_env)) { unsigned long len; const char * const env = PerlEnv_ENVgetenv_len(key,&len); if (env) { @@ -860,13 +881,13 @@ Perl_hv_scalar(pTHX_ HV *hv) PERL_ARGS_ASSERT_HV_SCALAR; if (SvRMAGICAL(hv)) { - MAGIC * const mg = mg_find((SV*)hv, PERL_MAGIC_tied); + MAGIC * const mg = mg_find((const SV *)hv, PERL_MAGIC_tied); if (mg) return magic_scalarpack(hv, mg); } sv = sv_newmortal(); - if (HvFILL((HV*)hv)) + if (HvFILL((const HV *)hv)) Perl_sv_setpvf(aTHX_ sv, "%ld/%ld", (long)HvFILL(hv), (long)HvMAX(hv) + 1); else @@ -930,7 +951,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, return NULL; /* element cannot be deleted */ } #ifdef ENV_IS_CASELESS - else if (mg_find((SV*)hv, PERL_MAGIC_env)) { + else if (mg_find((const SV *)hv, PERL_MAGIC_env)) { /* XXX This code isn't UTF8 clean. */ keysv = newSVpvn_flags(key, klen, SVs_TEMP); if (k_flags & HVhek_FREEKEY) { @@ -965,7 +986,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, } k_flags |= HVhek_WASUTF8 | HVhek_FREEKEY; } - HvHASKFLAGS_on((SV*)hv); + HvHASKFLAGS_on(MUTABLE_SV(hv)); } if (HvREHASH(hv)) { @@ -1332,7 +1353,7 @@ Perl_newHVhv(pTHX_ HV *ohv) return hv; hv_max = HvMAX(ohv); - if (!SvMAGICAL((SV *)ohv)) { + if (!SvMAGICAL((const SV *)ohv)) { /* It's an ordinary hash, so copy it fast. AMS 20010804 */ STRLEN i; const bool shared = !!HvSHAREKEYS(ohv); @@ -1358,8 +1379,9 @@ Perl_newHVhv(pTHX_ HV *ohv) const STRLEN len = HeKLEN(oent); const int flags = HeKFLAGS(oent); HE * const ent = new_HE(); + SV *const val = HeVAL(oent); - HeVAL(ent) = newSVsv(HeVAL(oent)); + HeVAL(ent) = SvIMMORTAL(val) ? val : newSVsv(val); HeKEY_hek(ent) = shared ? share_hek_flags(key, len, hash, flags) : save_hek_flags(key, len, hash, flags); @@ -1390,9 +1412,10 @@ Perl_newHVhv(pTHX_ HV *ohv) hv_iterinit(ohv); while ((entry = hv_iternext_flags(ohv, 0))) { + SV *const val = HeVAL(entry); (void)hv_store_flags(hv, HeKEY(entry), HeKLEN(entry), - newSVsv(HeVAL(entry)), HeHASH(entry), - HeKFLAGS(entry)); + SvIMMORTAL(val) ? val : newSVsv(val), + HeHASH(entry), HeKFLAGS(entry)); } HvRITER_set(ohv, riter); HvEITER_set(ohv, eiter); @@ -1422,8 +1445,10 @@ Perl_hv_copy_hints_hv(pTHX_ HV *const ohv) hv_iterinit(ohv); while ((entry = hv_iternext_flags(ohv, 0))) { SV *const sv = newSVsv(HeVAL(entry)); + SV *heksv = newSVhek(HeKEY_hek(entry)); sv_magic(sv, NULL, PERL_MAGIC_hintselem, - (char *)newSVhek (HeKEY_hek(entry)), HEf_SVKEY); + (char *)heksv, HEf_SVKEY); + SvREFCNT_dec(heksv); (void)hv_store_flags(hv, HeKEY(entry), HeKLEN(entry), sv, HeHASH(entry), HeKFLAGS(entry)); } @@ -1445,8 +1470,8 @@ Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry) if (!entry) return; val = HeVAL(entry); - if (val && isGV(val) && isGV_with_GP(val) && GvCVu(val) && HvNAME_get(hv)) - mro_method_changed_in(hv); /* deletion of method from stash */ + if (HvNAME(hv) && anonymise_cv(HvNAME_HEK(hv), val) && GvCVu(val)) + mro_method_changed_in(hv); SvREFCNT_dec(val); if (HeKLEN(entry) == HEf_SVKEY) { SvREFCNT_dec(HeKEY_sv(entry)); @@ -1459,6 +1484,34 @@ Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry) del_HE(entry); } +static I32 +S_anonymise_cv(pTHX_ HEK *stash, SV *val) +{ + CV *cv; + + PERL_ARGS_ASSERT_ANONYMISE_CV; + + if (val && isGV(val) && isGV_with_GP(val) && (cv = GvCV(val))) { + if ((SV *)CvGV(cv) == val) { + GV *anongv; + + if (stash) { + SV *gvname = newSVhek(stash); + sv_catpvs(gvname, "::__ANON__"); + anongv = gv_fetchsv(gvname, GV_ADDMULTI, SVt_PVCV); + SvREFCNT_dec(gvname); + } else { + anongv = gv_fetchpvs("__ANON__::__ANON__", GV_ADDMULTI, + SVt_PVCV); + } + CvGV(cv) = anongv; + CvANON_on(cv); + return 1; + } + } + return 0; +} + void Perl_hv_delayfree_ent(pTHX_ HV *hv, register HE *entry) { @@ -1525,7 +1578,7 @@ Perl_hv_clear(pTHX_ HV *hv) Zero(HvARRAY(hv), xhv->xhv_max+1 /* HvMAX(hv)+1 */, HE*); if (SvRMAGICAL(hv)) - mg_clear((SV*)hv); + mg_clear(MUTABLE_SV(hv)); HvHASKFLAGS_off(hv); HvREHASH_off(hv); @@ -1623,6 +1676,22 @@ S_hfreeentries(pTHX_ HV *hv) if (!orig_array) return; + if (HvNAME(hv) && orig_array != NULL) { + /* symbol table: make all the contained subs ANON */ + STRLEN i; + XPVHV *xhv = (XPVHV*)SvANY(hv); + + for (i = 0; i <= xhv->xhv_max; i++) { + HE *entry = (HvARRAY(hv))[i]; + for (; entry; entry = HeNEXT(entry)) { + SV *val = HeVAL(entry); + /* we need to put the subs in the __ANON__ symtable, as + * this one is being cleared. */ + anonymise_cv(NULL, val); + } + } + } + if (SvOOK(hv)) { /* If the hash is actually a symbol table with a name, look after the name. */ @@ -1670,7 +1739,8 @@ S_hfreeentries(pTHX_ HV *hv) SvREFCNT_dec(iter->xhv_backreferences); } else { - sv_magic((SV*)hv, (SV*)iter->xhv_backreferences, + sv_magic(MUTABLE_SV(hv), + MUTABLE_SV(iter->xhv_backreferences), PERL_MAGIC_backref, NULL, 0); } iter->xhv_backreferences = NULL; @@ -1685,8 +1755,17 @@ S_hfreeentries(pTHX_ HV *hv) iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */ if((meta = iter->xhv_mro_meta)) { - if(meta->mro_linear_dfs) SvREFCNT_dec(meta->mro_linear_dfs); - if(meta->mro_linear_c3) SvREFCNT_dec(meta->mro_linear_c3); + if (meta->mro_linear_all) { + SvREFCNT_dec(MUTABLE_SV(meta->mro_linear_all)); + meta->mro_linear_all = NULL; + /* This is just acting as a shortcut pointer. */ + meta->mro_linear_current = NULL; + } else if (meta->mro_linear_current) { + /* Only the current MRO is stored, so this owns the data. + */ + SvREFCNT_dec(meta->mro_linear_current); + meta->mro_linear_current = NULL; + } if(meta->mro_nextmethod) SvREFCNT_dec(meta->mro_nextmethod); SvREFCNT_dec(meta->isa); Safefree(meta); @@ -1793,7 +1872,7 @@ Perl_hv_undef(pTHX_ HV *hv) HvPLACEHOLDERS_set(hv, 0); if (SvRMAGICAL(hv)) - mg_clear((SV*)hv); + mg_clear(MUTABLE_SV(hv)); } static struct xpvhv_aux* @@ -1985,7 +2064,7 @@ Perl_hv_kill_backrefs(pTHX_ HV *hv) { if (av) { HvAUX(hv)->xhv_backreferences = 0; - Perl_sv_kill_backrefs(aTHX_ (SV*) hv, av); + Perl_sv_kill_backrefs(aTHX_ MUTABLE_SV(hv), av); SvREFCNT_dec(av); } } @@ -2046,7 +2125,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) oldentry = entry = iter->xhv_eiter; /* HvEITER(hv) */ if (SvMAGICAL(hv) && SvRMAGICAL(hv)) { - if ( ( mg = mg_find((SV*)hv, PERL_MAGIC_tied) ) ) { + if ( ( mg = mg_find((const SV *)hv, PERL_MAGIC_tied) ) ) { SV * const key = sv_newmortal(); if (entry) { sv_setsv(key, HeSVKEY_force(entry)); @@ -2059,19 +2138,18 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) /* one HE per MAGICAL hash */ iter->xhv_eiter = entry = new_HE(); /* HvEITER(hv) = new_HE() */ Zero(entry, 1, HE); - Newxz(k, HEK_BASESIZE + sizeof(SV*), char); + Newxz(k, HEK_BASESIZE + sizeof(const SV *), char); hek = (HEK*)k; HeKEY_hek(entry) = hek; HeKLEN(entry) = HEf_SVKEY; } - magic_nextpack((SV*) hv,mg,key); + magic_nextpack(MUTABLE_SV(hv),mg,key); if (SvOK(key)) { /* force key to stay around until next time */ HeSVKEY_set(entry, SvREFCNT_inc_simple_NN(key)); return entry; /* beware, hent_val is not set */ } - if (HeVAL(entry)) - SvREFCNT_dec(HeVAL(entry)); + SvREFCNT_dec(HeVAL(entry)); Safefree(HeKEY_hek(entry)); del_HE(entry); iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */ @@ -2079,7 +2157,8 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) } } #if defined(DYNAMIC_ENV_FETCH) && !defined(__riscos__) /* set up %ENV for iteration */ - if (!entry && SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) { + if (!entry && SvRMAGICAL((const SV *)hv) + && mg_find((const SV *)hv, PERL_MAGIC_env)) { prime_env_iter(); #ifdef VMS /* The prime_env_iter() on VMS just loaded up new hash values @@ -2109,26 +2188,31 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) } } } - while (!entry) { - /* OK. Come to the end of the current list. Grab the next one. */ - iter->xhv_riter++; /* HvRITER(hv)++ */ - if (iter->xhv_riter > (I32)xhv->xhv_max /* HvRITER(hv) > HvMAX(hv) */) { - /* There is no next one. End of the hash. */ - iter->xhv_riter = -1; /* HvRITER(hv) = -1 */ - break; - } - entry = (HvARRAY(hv))[iter->xhv_riter]; + /* Skip the entire loop if the hash is empty. */ + if ((flags & HV_ITERNEXT_WANTPLACEHOLDERS) + ? HvTOTALKEYS(hv) : HvUSEDKEYS(hv)) { + while (!entry) { + /* OK. Come to the end of the current list. Grab the next one. */ - if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) { - /* If we have an entry, but it's a placeholder, don't count it. - Try the next. */ - while (entry && HeVAL(entry) == &PL_sv_placeholder) - entry = HeNEXT(entry); + iter->xhv_riter++; /* HvRITER(hv)++ */ + if (iter->xhv_riter > (I32)xhv->xhv_max /* HvRITER(hv) > HvMAX(hv) */) { + /* There is no next one. End of the hash. */ + iter->xhv_riter = -1; /* HvRITER(hv) = -1 */ + break; + } + entry = (HvARRAY(hv))[iter->xhv_riter]; + + if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) { + /* If we have an entry, but it's a placeholder, don't count it. + Try the next. */ + while (entry && HeVAL(entry) == &PL_sv_placeholder) + entry = HeNEXT(entry); + } + /* Will loop again if this linked list starts NULL + (for HV_ITERNEXT_WANTPLACEHOLDERS) + or if we run through it and find only placeholders. */ } - /* Will loop again if this linked list starts NULL - (for HV_ITERNEXT_WANTPLACEHOLDERS) - or if we run through it and find only placeholders. */ } if (oldentry && HvLAZYDEL(hv)) { /* was deleted earlier? */ @@ -2203,12 +2287,12 @@ Perl_hv_iterval(pTHX_ HV *hv, register HE *entry) PERL_ARGS_ASSERT_HV_ITERVAL; if (SvRMAGICAL(hv)) { - if (mg_find((SV*)hv, PERL_MAGIC_tied)) { + if (mg_find((const SV *)hv, PERL_MAGIC_tied)) { SV* const sv = sv_newmortal(); if (HeKLEN(entry) == HEf_SVKEY) - mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY); + mg_copy(MUTABLE_SV(hv), sv, (char*)HeKEY_sv(entry), HEf_SVKEY); else - mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry)); + mg_copy(MUTABLE_SV(hv), sv, HeKEY(entry), HeKLEN(entry)); return sv; } } @@ -2292,13 +2376,10 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash) shared hek */ assert (he->shared_he_he.hent_hek == hek); - LOCK_STRTAB_MUTEX; if (he->shared_he_he.he_valu.hent_refcount - 1) { --he->shared_he_he.he_valu.hent_refcount; - UNLOCK_STRTAB_MUTEX; return; } - UNLOCK_STRTAB_MUTEX; hash = HEK_HASH(hek); } else if (len < 0) { @@ -2320,7 +2401,6 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash) } */ xhv = (XPVHV*)SvANY(PL_strtab); /* assert(xhv_array != 0) */ - LOCK_STRTAB_MUTEX; first = oentry = &(HvARRAY(PL_strtab))[hash & (I32) HvMAX(PL_strtab)]; if (he) { const HE *const he_he = &(he->shared_he_he); @@ -2355,13 +2435,12 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash) } } - UNLOCK_STRTAB_MUTEX; - if (!entry && ckWARN_d(WARN_INTERNAL)) - Perl_warner(aTHX_ packWARN(WARN_INTERNAL), - "Attempt to free non-existent shared string '%s'%s" - pTHX__FORMAT, - hek ? HEK_KEY(hek) : str, - ((k_flags & HVhek_UTF8) ? " (utf8)" : "") pTHX__VALUE); + if (!entry) + Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), + "Attempt to free non-existent shared string '%s'%s" + pTHX__FORMAT, + hek ? HEK_KEY(hek) : str, + ((k_flags & HVhek_UTF8) ? " (utf8)" : "") pTHX__VALUE); if (k_flags & HVhek_FREEKEY) Safefree(str); } @@ -2420,7 +2499,6 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags) */ /* assert(xhv_array != 0) */ - LOCK_STRTAB_MUTEX; entry = (HvARRAY(PL_strtab))[hindex]; for (;entry; entry = HeNEXT(entry)) { if (HeHASH(entry) != hash) /* strings can't be equal */ @@ -2478,7 +2556,6 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags) } ++entry->he_valu.hent_refcount; - UNLOCK_STRTAB_MUTEX; if (flags & HVhek_FREEKEY) Safefree(str); @@ -2490,12 +2567,12 @@ I32 * Perl_hv_placeholders_p(pTHX_ HV *hv) { dVAR; - MAGIC *mg = mg_find((SV*)hv, PERL_MAGIC_rhash); + MAGIC *mg = mg_find((const SV *)hv, PERL_MAGIC_rhash); PERL_ARGS_ASSERT_HV_PLACEHOLDERS_P; if (!mg) { - mg = sv_magicext((SV*)hv, 0, PERL_MAGIC_rhash, 0, 0, 0); + mg = sv_magicext(MUTABLE_SV(hv), 0, PERL_MAGIC_rhash, 0, 0, 0); if (!mg) { Perl_die(aTHX_ "panic: hv_placeholders_p"); @@ -2506,10 +2583,10 @@ Perl_hv_placeholders_p(pTHX_ HV *hv) I32 -Perl_hv_placeholders_get(pTHX_ HV *hv) +Perl_hv_placeholders_get(pTHX_ const HV *hv) { dVAR; - MAGIC * const mg = mg_find((SV*)hv, PERL_MAGIC_rhash); + MAGIC * const mg = mg_find((const SV *)hv, PERL_MAGIC_rhash); PERL_ARGS_ASSERT_HV_PLACEHOLDERS_GET; @@ -2520,14 +2597,14 @@ void Perl_hv_placeholders_set(pTHX_ HV *hv, I32 ph) { dVAR; - MAGIC * const mg = mg_find((SV*)hv, PERL_MAGIC_rhash); + MAGIC * const mg = mg_find((const SV *)hv, PERL_MAGIC_rhash); PERL_ARGS_ASSERT_HV_PLACEHOLDERS_SET; if (mg) { mg->mg_len = ph; } else if (ph) { - if (!sv_magicext((SV*)hv, 0, PERL_MAGIC_rhash, 0, 0, ph)) + if (!sv_magicext(MUTABLE_SV(hv), 0, PERL_MAGIC_rhash, 0, 0, ph)) Perl_die(aTHX_ "panic: hv_placeholders_set"); } /* else we don't need to add magic to record 0 placeholders. */ @@ -2768,7 +2845,7 @@ Perl_refcounted_he_new(pTHX_ struct refcounted_he *const parent, if (SvPOK(value)) { value_type = HVrhek_PV; } else if (SvIOK(value)) { - value_type = SvUOK((SV*)value) ? HVrhek_UV : HVrhek_IV; + value_type = SvUOK((const SV *)value) ? HVrhek_UV : HVrhek_IV; } else if (value == &PL_sv_placeholder) { value_type = HVrhek_delete; } else if (!SvOK(value)) { @@ -2801,7 +2878,7 @@ Perl_refcounted_he_new(pTHX_ struct refcounted_he *const parent, value_len); } -struct refcounted_he * +static struct refcounted_he * S_refcounted_he_new_common(pTHX_ struct refcounted_he *const parent, const char *const key_p, const STRLEN key_len, const char flags, char value_type, @@ -2831,9 +2908,9 @@ S_refcounted_he_new_common(pTHX_ struct refcounted_he *const parent, Copy((char *)value, he->refcounted_he_data + 1, value_len + 1, char); he->refcounted_he_val.refcounted_he_u_len = value_len; } else if (value_type == HVrhek_IV) { - he->refcounted_he_val.refcounted_he_u_iv = SvIVX((SV *)value); + he->refcounted_he_val.refcounted_he_u_iv = SvIVX((const SV *)value); } else if (value_type == HVrhek_UV) { - he->refcounted_he_val.refcounted_he_u_uv = SvUVX((SV *)value); + he->refcounted_he_val.refcounted_he_u_uv = SvUVX((const SV *)value); } PERL_HASH(hash, key_p, key_len); @@ -2983,7 +3060,7 @@ Perl_hv_assert(pTHX_ HV *hv) } else if (HeKWASUTF8(entry)) withflags++; } - if (!SvTIED_mg((SV*)hv, PERL_MAGIC_tied)) { + if (!SvTIED_mg((const SV *)hv, PERL_MAGIC_tied)) { static const char bad_count[] = "Count %d %s(s), but hash reports %d\n"; const int nhashkeys = HvUSEDKEYS(hv); const int nhashplaceholders = HvPLACEHOLDERS_get(hv); @@ -3004,7 +3081,7 @@ Perl_hv_assert(pTHX_ HV *hv) bad = 1; } if (bad) { - sv_dump((SV *)hv); + sv_dump(MUTABLE_SV(hv)); } HvRITER_set(hv, riter); /* Restore hash iterator state */ HvEITER_set(hv, eiter);