X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=hv.c;h=eb2a1a5aa71e98b0c47a259ff90a433e4b44f811;hb=89e33a0587050e7ef2e88ba45c87444d8506f821;hp=68ef67e9027ee243c30b2c7ae2441d6ff8fd3bb1;hpb=b464bac0b70c4876af1296864220315edde8461d;p=p5sagit%2Fp5-mst-13.2.git diff --git a/hv.c b/hv.c index 68ef67e..eb2a1a5 100644 --- a/hv.c +++ b/hv.c @@ -33,6 +33,9 @@ holds the key and hash value. #define HV_MAX_LENGTH_BEFORE_SPLIT 14 +static const char *const S_strtab_error + = "Cannot modify shared string table in hv_%s"; + STATIC void S_more_he(pTHX) { @@ -126,19 +129,20 @@ Perl_free_tied_hv_pool(pTHX) HEK * Perl_hek_dup(pTHX_ HEK *source, CLONE_PARAMS* param) { - HE *shared = (HE*)ptr_table_fetch(PL_shared_hek_table, source); + HEK *shared = (HEK*)ptr_table_fetch(PL_ptr_table, source); (void)param; if (shared) { /* We already shared this hash key. */ - ++HeVAL(shared); + (void)share_hek_hek(shared); } else { - shared = share_hek_flags(HEK_KEY(source), HEK_LEN(source), - HEK_HASH(source), HEK_FLAGS(source)); - ptr_table_store(PL_shared_hek_table, source, shared); + shared + = share_hek_flags(HEK_KEY(source), HEK_LEN(source), + HEK_HASH(source), HEK_FLAGS(source)); + ptr_table_store(PL_ptr_table, source, shared); } - return HeKEY_hek(shared); + return shared; } HE * @@ -168,18 +172,19 @@ Perl_he_dup(pTHX_ HE *e, bool shared, CLONE_PARAMS* param) /* This is hek_dup inlined, which seems to be important for speed reasons. */ HEK *source = HeKEY_hek(e); - HE *shared = (HE*)ptr_table_fetch(PL_shared_hek_table, source); + HEK *shared = (HEK*)ptr_table_fetch(PL_ptr_table, source); if (shared) { /* We already shared this hash key. */ - ++HeVAL(shared); + (void)share_hek_hek(shared); } else { - shared = share_hek_flags(HEK_KEY(source), HEK_LEN(source), - HEK_HASH(source), HEK_FLAGS(source)); - ptr_table_store(PL_shared_hek_table, source, shared); + shared + = share_hek_flags(HEK_KEY(source), HEK_LEN(source), + HEK_HASH(source), HEK_FLAGS(source)); + ptr_table_store(PL_ptr_table, source, shared); } - HeKEY_hek(ret) = HeKEY_hek(shared); + HeKEY_hek(ret) = shared; } else HeKEY_hek(ret) = save_hek_flags(HeKEY(e), HeKLEN(e), HeHASH(e), @@ -426,7 +431,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, if (keysv) { if (flags & HVhek_FREEKEY) Safefree(key); - key = SvPV(keysv, klen); + key = SvPV_const(keysv, klen); flags = 0; is_utf8 = (SvUTF8(keysv) != 0); } else { @@ -650,7 +655,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, flags |= HVhek_REHASH; } else if (!hash) { if (keysv && (SvIsCOW_shared_hash(keysv))) { - hash = SvUVX(keysv); + hash = SvSHARED_HASH(keysv); } else { PERL_HASH(hash, key, klen); } @@ -685,11 +690,19 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, /* Need to swap the key we have for a key with the flags we need. As keys are shared we can't just write to the flag, so we share the new one, unshare the old one. */ - HEK *new_hek = HeKEY_hek(share_hek_flags(key, klen, hash, - masked_flags)); + HEK *new_hek = share_hek_flags(key, klen, hash, + masked_flags); unshare_hek (HeKEY_hek(entry)); HeKEY_hek(entry) = new_hek; } + else if (hv == PL_strtab) { + /* PL_strtab is usually the only hash without HvSHAREKEYS, + so putting this test here is cheap */ + if (flags & HVhek_FREEKEY) + Safefree(key); + Perl_croak(aTHX_ S_strtab_error, + action & HV_FETCH_LVALUE ? "fetch" : "store"); + } else HeKFLAGS(entry) = masked_flags; if (masked_flags & HVhek_ENABLEHVKFLAGS) @@ -790,7 +803,15 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, /* share_hek_flags will do the free for us. This might be considered bad API design. */ if (HvSHAREKEYS(hv)) - HeKEY_hek(entry) = HeKEY_hek(share_hek_flags(key, klen, hash, flags)); + HeKEY_hek(entry) = share_hek_flags(key, klen, hash, flags); + else if (hv == PL_strtab) { + /* PL_strtab is usually the only hash without HvSHAREKEYS, so putting + this test here is cheap */ + if (flags & HVhek_FREEKEY) + Safefree(key); + Perl_croak(aTHX_ S_strtab_error, + action & HV_FETCH_LVALUE ? "fetch" : "store"); + } else /* gotta do the real thing */ HeKEY_hek(entry) = save_hek_flags(key, klen, hash, flags); HeVAL(entry) = val; @@ -942,7 +963,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, if (keysv) { if (k_flags & HVhek_FREEKEY) Safefree(key); - key = SvPV(keysv, klen); + key = SvPV_const(keysv, klen); k_flags = 0; is_utf8 = (SvUTF8(keysv) != 0); } else { @@ -1014,7 +1035,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, PERL_HASH_INTERNAL(hash, key, klen); } else if (!hash) { if (keysv && (SvIsCOW_shared_hash(keysv))) { - hash = SvUVX(keysv); + hash = SvSHARED_HASH(keysv); } else { PERL_HASH(hash, key, klen); } @@ -1034,6 +1055,12 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, if ((HeKFLAGS(entry) ^ masked_flags) & HVhek_UTF8) continue; + if (hv == PL_strtab) { + if (k_flags & HVhek_FREEKEY) + Safefree(key); + Perl_croak(aTHX_ S_strtab_error, "delete"); + } + /* if placeholder is here, it's already been deleted.... */ if (HeVAL(entry) == &PL_sv_placeholder) { @@ -1417,7 +1444,7 @@ Perl_newHVhv(pTHX_ HV *ohv) ent = new_HE(); HeVAL(ent) = newSVsv(HeVAL(oent)); HeKEY_hek(ent) - = shared ? HeKEY_hek(share_hek_flags(key, len, hash, flags)) + = shared ? share_hek_flags(key, len, hash, flags) : save_hek_flags(key, len, hash, flags); if (prev) HeNEXT(prev) = ent; @@ -1767,12 +1794,10 @@ value, you can get it through the macro C. I32 Perl_hv_iterinit(pTHX_ HV *hv) { - register XPVHV* xhv; HE *entry; if (!hv) Perl_croak(aTHX_ "Bad hash"); - xhv = (XPVHV*)SvANY(hv); if (SvOOK(hv)) { struct xpvhv_aux *iter = HvAUX(hv); @@ -2059,39 +2084,7 @@ see C. SV * Perl_hv_iterkeysv(pTHX_ register HE *entry) { - if (HeKLEN(entry) != HEf_SVKEY) { - HEK *hek = HeKEY_hek(entry); - const int flags = HEK_FLAGS(hek); - SV *sv; - - if (flags & HVhek_WASUTF8) { - /* Trouble :-) - Andreas would like keys he put in as utf8 to come back as utf8 - */ - STRLEN utf8_len = HEK_LEN(hek); - U8 *as_utf8 = bytes_to_utf8 ((U8*)HEK_KEY(hek), &utf8_len); - - sv = newSVpvn ((char*)as_utf8, utf8_len); - SvUTF8_on (sv); - Safefree (as_utf8); /* bytes_to_utf8() allocates a new string */ - } else if (flags & HVhek_REHASH) { - /* We don't have a pointer to the hv, so we have to replicate the - flag into every HEK. This hv is using custom a hasing - algorithm. Hence we can't return a shared string scalar, as - that would contain the (wrong) hash value, and might get passed - into an hv routine with a regular hash */ - - sv = newSVpvn (HEK_KEY(hek), HEK_LEN(hek)); - if (HEK_UTF8(hek)) - SvUTF8_on (sv); - } else { - sv = newSVpvn_share(HEK_KEY(hek), - (HEK_UTF8(hek) ? -HEK_LEN(hek) : HEK_LEN(hek)), - HEK_HASH(hek)); - } - return sv_2mortal(sv); - } - return sv_mortalcopy(HeKEY_sv(entry)); + return sv_2mortal(newSVhek(HeKEY_hek(entry))); } /* @@ -2183,7 +2176,7 @@ Perl_unshare_hek(pTHX_ HEK *hek) are used. If so, len and hash must both be valid for str. */ STATIC void -S_unshare_hek_or_pvn(pTHX_ HEK *hek, const char *str, I32 len, U32 hash) +S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash) { register XPVHV* xhv; register HE *entry; @@ -2193,8 +2186,26 @@ S_unshare_hek_or_pvn(pTHX_ HEK *hek, const char *str, I32 len, U32 hash) bool is_utf8 = FALSE; int k_flags = 0; const char *save = str; + struct shared_he *he = 0; if (hek) { + /* Find the shared he which is just before us in memory. */ + he = (struct shared_he *)(((char *)hek) + - STRUCT_OFFSET(struct shared_he, + shared_he_hek)); + + /* Assert that the caller passed us a genuine (or at least consistent) + shared hek */ + assert (he->shared_he_he.hent_hek == hek); + + LOCK_STRTAB_MUTEX; + if (he->shared_he_he.hent_val - 1) { + --he->shared_he_he.hent_val; + UNLOCK_STRTAB_MUTEX; + return; + } + UNLOCK_STRTAB_MUTEX; + hash = HEK_HASH(hek); } else if (len < 0) { STRLEN tmplen = -len; @@ -2217,9 +2228,10 @@ S_unshare_hek_or_pvn(pTHX_ HEK *hek, const char *str, I32 len, U32 hash) /* assert(xhv_array != 0) */ LOCK_STRTAB_MUTEX; first = oentry = &(HvARRAY(PL_strtab))[hash & (I32) HvMAX(PL_strtab)]; - if (hek) { + if (he) { + const HE *const he_he = &(he->shared_he_he); for (entry = *oentry; entry; oentry = &HeNEXT(entry), entry = *oentry) { - if (HeKEY_hek(entry) != hek) + if (entry != he_he) continue; found = 1; break; @@ -2247,8 +2259,7 @@ S_unshare_hek_or_pvn(pTHX_ HEK *hek, const char *str, I32 len, U32 hash) /* There are now no entries in our slot. */ xhv->xhv_fill--; /* HvFILL(hv)-- */ } - Safefree(HeKEY_hek(entry)); - del_HE(entry); + Safefree(entry); xhv->xhv_keys--; /* HvKEYS(hv)-- */ } } @@ -2292,10 +2303,10 @@ Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash) flags |= HVhek_WASUTF8 | HVhek_FREEKEY; } - return HeKEY_hek(share_hek_flags (str, len, hash, flags)); + return share_hek_flags (str, len, hash, flags); } -STATIC HE * +STATIC HEK * S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags) { register XPVHV* xhv; @@ -2333,11 +2344,35 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags) If this is NULL, then we're the first entry for this slot, which means we need to increate fill. */ const HE *old_first = *oentry; - entry = new_HE(); - HeKEY_hek(entry) = save_hek_flags(str, len, hash, flags_masked); + struct shared_he *new_entry; + HEK *hek; + char *k; + + /* We don't actually store a HE from the arena and a regular HEK. + Instead we allocate one chunk of memory big enough for both, + and put the HEK straight after the HE. This way we can find the + HEK directly from the HE. + */ + + New(0, k, STRUCT_OFFSET(struct shared_he, + shared_he_hek.hek_key[0]) + len + 2, char); + new_entry = (struct shared_he *)k; + entry = &(new_entry->shared_he_he); + hek = &(new_entry->shared_he_hek); + + Copy(str, HEK_KEY(hek), len, char); + HEK_KEY(hek)[len] = 0; + HEK_LEN(hek) = len; + HEK_HASH(hek) = hash; + HEK_FLAGS(hek) = (unsigned char)flags_masked; + + /* Still "point" to the HEK, so that other code need not know what + we're up to. */ + HeKEY_hek(entry) = hek; HeVAL(entry) = Nullsv; HeNEXT(entry) = *oentry; *oentry = entry; + xhv->xhv_keys++; /* HvKEYS(hv)++ */ if (!old_first) { /* initial entry? */ xhv->xhv_fill++; /* HvFILL(hv)++ */ @@ -2352,7 +2387,7 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags) if (flags & HVhek_FREEKEY) Safefree(str); - return entry; + return HeKEY_hek(entry); } I32 *