X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=hv.c;h=adb5a4d777f32498b1365cf5e4dc3b7bcab65e06;hb=0d86688dc4cee41db564627f19bab42e3d945cb6;hp=3d4d3af1830da74c41bb60f94a3b3070cd86dd4b;hpb=cd1d2f8a20b8a9f92576c0e00d1dc723574ea002;p=p5sagit%2Fp5-mst-13.2.git diff --git a/hv.c b/hv.c index 3d4d3af..adb5a4d 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"] */ /* @@ -169,7 +173,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 +361,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 +374,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; @@ -399,7 +403,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 +414,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 +423,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 +432,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 +444,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 +479,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 +492,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 +505,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 +535,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 +547,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 +570,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; @@ -707,7 +714,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 +868,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 +938,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 +973,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)) { @@ -1094,7 +1102,7 @@ S_hsplit(pTHX_ HV *hv) return; } if (SvOOK(hv)) { - Copy(&a[oldsize * sizeof(HE*)], &a[newsize * sizeof(HE*)], 1, struct xpvhv_aux); + Move(&a[oldsize * sizeof(HE*)], &a[newsize * sizeof(HE*)], 1, struct xpvhv_aux); } #else Newx(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize) @@ -1332,7 +1340,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); @@ -1525,7 +1533,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); @@ -1670,7 +1678,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; @@ -1688,6 +1697,7 @@ S_hfreeentries(pTHX_ HV *hv) 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_nextmethod) SvREFCNT_dec(meta->mro_nextmethod); + SvREFCNT_dec(meta->isa); Safefree(meta); iter->xhv_mro_meta = NULL; } @@ -1792,7 +1802,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* @@ -1984,7 +1994,8 @@ 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); } } @@ -2044,7 +2055,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)); @@ -2057,12 +2068,12 @@ 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)); @@ -2077,7 +2088,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 @@ -2201,12 +2213,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; } } @@ -2488,12 +2500,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"); @@ -2504,10 +2516,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; @@ -2518,14 +2530,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. */ @@ -2766,7 +2778,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)) { @@ -2799,7 +2811,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, @@ -2829,9 +2841,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); @@ -2981,7 +2993,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); @@ -3002,7 +3014,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);