X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=hv.c;h=032f4c2b4f602cbf38d1a2cf84753419a3862383;hb=dfa4e5d386dd8c5329351699b02085856cdd140e;hp=cb4eda99521e3a68018c5bcaee2bb9913be0882a;hpb=abc25d8c4f3e0ad18f7a95f0bea31aeb63a459a2;p=p5sagit%2Fp5-mst-13.2.git diff --git a/hv.c b/hv.c index cb4eda9..032f4c2 100644 --- a/hv.c +++ b/hv.c @@ -40,12 +40,9 @@ STATIC void S_more_he(pTHX) { dVAR; - HE* he; - HE* heend; - - he = (HE*) Perl_get_arena(aTHX_ PERL_ARENA_SIZE, HE_SVSLOT); + HE* he = (HE*) Perl_get_arena(aTHX_ PERL_ARENA_SIZE, HE_SVSLOT); + HE * const heend = &he[PERL_ARENA_SIZE / sizeof(HE) - 1]; - heend = &he[PERL_ARENA_SIZE / sizeof(HE) - 1]; PL_body_roots[HE_SVSLOT] = he; while (he < heend) { HeNEXT(he) = (HE*)(he + 1); @@ -216,11 +213,6 @@ S_hv_notallowed(pTHX_ int flags, const char *key, I32 klen, /* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot * contains an SV* */ -#define HV_FETCH_ISSTORE 0x01 -#define HV_FETCH_ISEXISTS 0x02 -#define HV_FETCH_LVALUE 0x04 -#define HV_FETCH_JUST_SV 0x08 - /* =for apidoc hv_store @@ -963,7 +955,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, if (keysv) { if (SvSMAGICAL(hv) && SvGMAGICAL(hv)) - keysv = hv_magic_uvar_xkey(hv, keysv, -1); + keysv = hv_magic_uvar_xkey(hv, keysv, HV_DELETE); if (k_flags & HVhek_FREEKEY) Safefree(key); key = SvPV_const(keysv, klen); @@ -1129,7 +1121,7 @@ STATIC void S_hsplit(pTHX_ HV *hv) { dVAR; - register XPVHV* xhv = (XPVHV*)SvANY(hv); + register XPVHV* const xhv = (XPVHV*)SvANY(hv); const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */ register I32 newsize = oldsize * 2; register I32 i; @@ -1531,7 +1523,7 @@ Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry) return; val = HeVAL(entry); if (val && isGV(val) && GvCVu(val) && HvNAME_get(hv)) - PL_sub_generation++; /* may be deletion of method from stash */ + mro_method_changed_in(hv); /* deletion of method from stash */ SvREFCNT_dec(val); if (HeKLEN(entry) == HEf_SVKEY) { SvREFCNT_dec(HeKEY_sv(entry)); @@ -1613,6 +1605,8 @@ Perl_hv_clear(pTHX_ HV *hv) HvREHASH_off(hv); reset: if (SvOOK(hv)) { + if(HvNAME_get(hv)) + mro_isa_changed_in(hv); HvEITER_set(hv, NULL); } } @@ -1726,6 +1720,7 @@ S_hfreeentries(pTHX_ HV *hv) if (SvOOK(hv)) { HE *entry; + struct mro_meta *meta; struct xpvhv_aux *iter = HvAUX(hv); /* If there are weak references to this HV, we need to avoid freeing them up here. In particular we need to keep the AV @@ -1757,6 +1752,14 @@ S_hfreeentries(pTHX_ HV *hv) iter->xhv_riter = -1; /* HvRITER(hv) = -1 */ 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_nextmethod) SvREFCNT_dec(meta->mro_nextmethod); + Safefree(meta); + iter->xhv_mro_meta = NULL; + } + /* There are now no allocated pointers in the aux structure. */ SvFLAGS(hv) &= ~SVf_OOK; /* Goodbye, aux structure. */ @@ -1840,8 +1843,12 @@ Perl_hv_undef(pTHX_ HV *hv) return; DEBUG_A(Perl_hv_assert(aTHX_ hv)); xhv = (XPVHV*)SvANY(hv); + + if ((name = HvNAME_get(hv)) && !PL_dirty) + mro_isa_changed_in(hv); + hfreeentries(hv); - if ((name = HvNAME_get(hv))) { + if (name) { if(PL_stashcache) hv_delete(PL_stashcache, name, HvNAMELEN_get(hv), G_DISCARD); hv_name_set(hv, NULL, 0, 0); @@ -1878,6 +1885,7 @@ S_hv_auxinit(HV *hv) { iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */ iter->xhv_name = 0; iter->xhv_backreferences = 0; + iter->xhv_mro_meta = NULL; return iter; } @@ -2289,6 +2297,7 @@ Perl_unsharepvn(pTHX_ const char *str, I32 len, U32 hash) void Perl_unshare_hek(pTHX_ HEK *hek) { + assert(hek); unshare_hek_or_pvn(hek, NULL, 0, 0); } @@ -2580,11 +2589,13 @@ S_refcounted_he_value(pTHX_ const struct refcounted_he *he) value = &PL_sv_placeholder; break; case HVrhek_IV: - value = (he->refcounted_he_data[0] & HVrhek_UV) - ? newSVuv(he->refcounted_he_val.refcounted_he_u_iv) - : newSViv(he->refcounted_he_val.refcounted_he_u_uv); + value = newSViv(he->refcounted_he_val.refcounted_he_u_iv); + break; + case HVrhek_UV: + value = newSVuv(he->refcounted_he_val.refcounted_he_u_uv); break; case HVrhek_PV: + case HVrhek_PV_UTF8: /* Create a string SV that directly points to the bytes in our structure. */ value = newSV_type(SVt_PV); @@ -2594,7 +2605,7 @@ S_refcounted_he_value(pTHX_ const struct refcounted_he *he) SvLEN_set(value, 0); SvPOK_on(value); SvREADONLY_on(value); - if (he->refcounted_he_data[0] & HVrhek_UTF8) + if ((he->refcounted_he_data[0] & HVrhek_typemask) == HVrhek_PV_UTF8) SvUTF8_on(value); break; default: @@ -2604,14 +2615,6 @@ S_refcounted_he_value(pTHX_ const struct refcounted_he *he) return value; } -#ifdef USE_ITHREADS -/* A big expression to find the key offset */ -#define REF_HE_KEY(chain) \ - ((((chain->refcounted_he_data[0] & HVrhek_typemask) == HVrhek_PV) \ - ? chain->refcounted_he_val.refcounted_he_u_len + 1 : 0) \ - + 1 + chain->refcounted_he_data) -#endif - /* =for apidoc refcounted_he_chain_2hv @@ -2820,7 +2823,6 @@ Perl_refcounted_he_new(pTHX_ struct refcounted_he *const parent, value_len = 0; key_offset = 1; } - flags = value_type; #ifdef USE_ITHREADS he = (struct refcounted_he*) @@ -2839,17 +2841,19 @@ Perl_refcounted_he_new(pTHX_ struct refcounted_he *const parent, if (value_type == HVrhek_PV) { Copy(value_p, he->refcounted_he_data + 1, value_len + 1, char); he->refcounted_he_val.refcounted_he_u_len = value_len; - if (SvUTF8(value)) { - flags |= HVrhek_UTF8; - } + /* Do it this way so that the SvUTF8() test is after the SvPV, in case + the value is overloaded, and doesn't yet have the UTF-8flag set. */ + if (SvUTF8(value)) + value_type = HVrhek_PV_UTF8; } else if (value_type == HVrhek_IV) { if (SvUOK(value)) { he->refcounted_he_val.refcounted_he_u_uv = SvUVX(value); - flags |= HVrhek_UV; + value_type = HVrhek_UV; } else { he->refcounted_he_val.refcounted_he_u_iv = SvIVX(value); } } + flags = value_type; if (is_utf8) { /* Hash keys are always stored normalised to (yes) ISO-8859-1.