X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=hv.c;h=0d087676c5bc33d470d8886d5a745e61ef6c151b;hb=5a8d6028c6d5f13b627f851521248150c0c6f242;hp=d5b7274c91d9b1533545199be9c7f6e745f9f066;hpb=2e5dfef704409bca4fd49ccb8a392cd0c49c6fd0;p=p5sagit%2Fp5-mst-13.2.git diff --git a/hv.c b/hv.c index d5b7274..0d08767 100644 --- a/hv.c +++ b/hv.c @@ -189,7 +189,7 @@ Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen, I32 lval) return hv_fetch_flags (hv, key, klen, lval, flags); } -SV** +STATIC SV** S_hv_fetch_flags(pTHX_ HV *hv, const char *key, I32 klen, I32 lval, int flags) { register XPVHV* xhv; @@ -216,7 +216,7 @@ S_hv_fetch_flags(pTHX_ HV *hv, const char *key, I32 klen, I32 lval, int flags) } #ifdef ENV_IS_CASELESS else if (mg_find((SV*)hv, PERL_MAGIC_env)) { - U32 i; + I32 i; for (i = 0; i < klen; ++i) if (isLOWER(key[i])) { char *nkey = strupr(SvPVX(sv_2mortal(newSVpvn(key,klen)))); @@ -258,7 +258,7 @@ S_hv_fetch_flags(pTHX_ HV *hv, const char *key, I32 klen, I32 lval, int flags) for (; entry; entry = HeNEXT(entry)) { if (HeHASH(entry) != hash) /* strings can't be equal */ continue; - if (HeKLEN(entry) != klen) + if (HeKLEN(entry) != (I32)klen) continue; if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; @@ -299,7 +299,7 @@ S_hv_fetch_flags(pTHX_ HV *hv, const char *key, I32 klen, I32 lval, int flags) if (env) { sv = newSVpvn(env,len); SvTAINTED_on(sv); - if (key != keysave) + if (flags & HVhek_FREEKEY) Safefree(key); return hv_store(hv,key,klen,sv,hash); } @@ -409,15 +409,20 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash) flags |= HVhek_WASUTF8 | HVhek_FREEKEY; } - if (!hash) - PERL_HASH(hash, key, klen); + if (!hash) { + if SvIsCOW_shared_hash(keysv) { + hash = SvUVX(keysv); + } else { + PERL_HASH(hash, key, klen); + } + } /* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */ entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; for (; entry; entry = HeNEXT(entry)) { if (HeHASH(entry) != hash) /* strings can't be equal */ continue; - if (HeKLEN(entry) != klen) + if (HeKLEN(entry) != (I32)klen) continue; if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; @@ -516,6 +521,11 @@ Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen, SV *val, U32 hash) const char *keysave = key; int flags = 0; + if (klen < 0) { + klen = -klen; + is_utf8 = TRUE; + } + if (is_utf8) { STRLEN tmplen = klen; /* Just casting the &klen to (STRLEN) won't work well @@ -536,7 +546,7 @@ Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen, SV *val, U32 hash) } SV** -S_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val, +Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val, register U32 hash, int flags) { register XPVHV* xhv; @@ -587,7 +597,7 @@ S_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val, for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) { if (HeHASH(entry) != hash) /* strings can't be equal */ continue; - if (HeKLEN(entry) != klen) + if (HeKLEN(entry) != (I32)klen) continue; if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; @@ -597,7 +607,13 @@ S_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val, xhv->xhv_placeholders--; /* yes, can store into placeholder slot */ else SvREFCNT_dec(HeVAL(entry)); - HeVAL(entry) = val; + if (flags & HVhek_PLACEHOLD) { + /* We have been requested to insert a placeholder. Currently + only Storable is allowed to do this. */ + xhv->xhv_placeholders++; + HeVAL(entry) = &PL_sv_undef; + } else + HeVAL(entry) = val; if (HeKFLAGS(entry) != flags) { /* We match if HVhek_UTF8 bit in our flags and hash key's match. @@ -634,14 +650,20 @@ S_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val, HeKEY_hek(entry) = share_hek_flags(key, klen, hash, flags); else /* gotta do the real thing */ HeKEY_hek(entry) = save_hek_flags(key, klen, hash, flags); - HeVAL(entry) = val; + if (flags & HVhek_PLACEHOLD) { + /* We have been requested to insert a placeholder. Currently + only Storable is allowed to do this. */ + xhv->xhv_placeholders++; + HeVAL(entry) = &PL_sv_undef; + } else + HeVAL(entry) = val; HeNEXT(entry) = *oentry; *oentry = entry; xhv->xhv_keys++; /* HvKEYS(hv)++ */ if (i) { /* initial entry? */ xhv->xhv_fill++; /* HvFILL(hv)++ */ - if (xhv->xhv_keys > xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */) + if (xhv->xhv_keys > (IV)xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */) hsplit(hv); } @@ -720,8 +742,13 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash) HvHASKFLAGS_on((SV*)hv); } - if (!hash) - PERL_HASH(hash, key, klen); + if (!hash) { + if SvIsCOW_shared_hash(keysv) { + hash = SvUVX(keysv); + } else { + PERL_HASH(hash, key, klen); + } + } if (!xhv->xhv_array /* !HvARRAY(hv) */) Newz(505, xhv->xhv_array /* HvARRAY(hv) */, @@ -735,7 +762,7 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash) for (; entry; i=0, entry = HeNEXT(entry)) { if (HeHASH(entry) != hash) /* strings can't be equal */ continue; - if (HeKLEN(entry) != klen) + if (HeKLEN(entry) != (I32)klen) continue; if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; @@ -788,7 +815,7 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash) xhv->xhv_keys++; /* HvKEYS(hv)++ */ if (i) { /* initial entry? */ xhv->xhv_fill++; /* HvFILL(hv)++ */ - if (xhv->xhv_keys > xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */) + if (xhv->xhv_keys > (IV)xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */) hsplit(hv); } @@ -874,7 +901,7 @@ Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags) for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) { if (HeHASH(entry) != hash) /* strings can't be equal */ continue; - if (HeKLEN(entry) != klen) + if (HeKLEN(entry) != (I32)klen) continue; if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; @@ -1030,7 +1057,7 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash) for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) { if (HeHASH(entry) != hash) /* strings can't be equal */ continue; - if (HeKLEN(entry) != klen) + if (HeKLEN(entry) != (I32)klen) continue; if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; @@ -1141,7 +1168,7 @@ Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen) sv = sv_newmortal(); mg_copy((SV*)hv, sv, key, klen); magic_existspack(sv, mg_find(sv, PERL_MAGIC_tiedelem)); - return SvTRUE(sv); + return (bool)SvTRUE(sv); } #ifdef ENV_IS_CASELESS else if (mg_find((SV*)hv, PERL_MAGIC_env)) { @@ -1245,7 +1272,7 @@ Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash) keysv = sv_2mortal(newSVsv(keysv)); mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY); magic_existspack(svret, mg_find(sv, PERL_MAGIC_tiedelem)); - return SvTRUE(svret); + return (bool)SvTRUE(svret); } #ifdef ENV_IS_CASELESS else if (mg_find((SV*)hv, PERL_MAGIC_env)) { @@ -1284,7 +1311,7 @@ Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash) for (; entry; entry = HeNEXT(entry)) { if (HeHASH(entry) != hash) /* strings can't be equal */ continue; - if (HeKLEN(entry) != klen) + if (HeKLEN(entry) != (I32)klen) continue; if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; @@ -1362,7 +1389,7 @@ S_hsplit(pTHX_ HV *hv) continue; bep = aep+oldsize; for (oentry = aep, entry = *aep; entry; entry = *oentry) { - if ((HeHASH(entry) & newsize) != i) { + if ((HeHASH(entry) & newsize) != (U32)i) { *oentry = HeNEXT(entry); HeNEXT(entry) = *bep; if (!*bep) @@ -1498,7 +1525,8 @@ Perl_newHVhv(pTHX_ HV *ohv) if (!SvMAGICAL((SV *)ohv)) { /* It's an ordinary hash, so copy it fast. AMS 20010804 */ - int i, shared = !!HvSHAREKEYS(ohv); + STRLEN i; + bool shared = !!HvSHAREKEYS(ohv); HE **ents, **oents = (HE **)HvARRAY(ohv); char *a; New(0, a, PERL_HV_ARRAY_ALLOC_BYTES(hv_max+1), char); @@ -1551,7 +1579,7 @@ Perl_newHVhv(pTHX_ HV *ohv) HvMAX(hv) = hv_max; hv_iterinit(ohv); - while ((entry = hv_iternext(ohv))) { + while ((entry = hv_iternext_flags(ohv, 0))) { hv_store_flags(hv, HeKEY(entry), HeKLEN(entry), newSVsv(HeVAL(entry)), HeHASH(entry), HeKFLAGS(entry)); @@ -1713,6 +1741,7 @@ NOTE: Before version 5.004_65, C used to return the number of hash buckets that happen to be in use. If you still need that esoteric value, you can get it through the macro C. + =cut */ @@ -1735,18 +1764,47 @@ Perl_hv_iterinit(pTHX_ HV *hv) /* used to be xhv->xhv_fill before 5.004_65 */ return XHvTOTALKEYS(xhv); } - /* =for apidoc hv_iternext Returns entries from a hash iterator. See C. +You may call C or C on the hash entry that the +iterator currently points to, without losing your place or invalidating your +iterator. Note that in this case the current entry is deleted from the hash +with your iterator holding the last reference to it. Your iterator is flagged +to free the entry on the next call to C, so you must not discard +your iterator immediately else the entry will leak - call C to +trigger the resource deallocation. + =cut */ HE * Perl_hv_iternext(pTHX_ HV *hv) { + return hv_iternext_flags(hv, 0); +} + +/* +=for apidoc hv_iternext_flags + +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. +Currently a placeholder is implemented with a value that is literally +<&Perl_sv_undef> (a regular C value is a normal read-write SV for which +C is false). Note that the implementation of placeholders and +restricted hashes may change, and the implementation currently is +insufficiently abstracted for any change to be tidy. + +=cut +*/ + +HE * +Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) +{ register XPVHV* xhv; register HE *entry; HE *oldentry; @@ -1800,27 +1858,30 @@ Perl_hv_iternext(pTHX_ HV *hv) if (entry) { entry = HeNEXT(entry); - /* - * Skip past any placeholders -- don't want to include them in - * any iteration. - */ - while (entry && HeVAL(entry) == &PL_sv_undef) { - entry = HeNEXT(entry); + if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) { + /* + * Skip past any placeholders -- don't want to include them in + * any iteration. + */ + while (entry && HeVAL(entry) == &PL_sv_undef) { + entry = HeNEXT(entry); + } } } while (!entry) { xhv->xhv_riter++; /* HvRITER(hv)++ */ - if (xhv->xhv_riter > xhv->xhv_max /* HvRITER(hv) > HvMAX(hv) */) { + if (xhv->xhv_riter > (I32)xhv->xhv_max /* HvRITER(hv) > HvMAX(hv) */) { xhv->xhv_riter = -1; /* HvRITER(hv) = -1 */ break; } /* entry = (HvARRAY(hv))[HvRITER(hv)]; */ entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter]; - /* if we have an entry, but it's a placeholder, don't count it */ - if (entry && HeVAL(entry) == &PL_sv_undef) - entry = 0; - + if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) { + /* if we have an entry, but it's a placeholder, don't count it */ + if (entry && HeVAL(entry) == &PL_sv_undef) + entry = 0; + } } if (oldentry && HvLAZYDEL(hv)) { /* was deleted earlier? */ @@ -1884,6 +1945,7 @@ Perl_hv_iterkeysv(pTHX_ register HE *entry) sv = newSVpvn ((char*)as_utf8, utf8_len); SvUTF8_on (sv); + Safefree (as_utf8); /* bytes_to_utf8() allocates a new string */ } else { sv = newSVpvn_share(HEK_KEY(hek), (HEK_UTF8(hek) ? -HEK_LEN(hek) : HEK_LEN(hek)), @@ -1931,7 +1993,7 @@ SV * Perl_hv_iternextsv(pTHX_ HV *hv, char **key, I32 *retlen) { HE *he; - if ( (he = hv_iternext(hv)) == NULL) + if ( (he = hv_iternext_flags(hv, 0)) == NULL) return NULL; *key = hv_iterkey(he, retlen); return hv_iterval(hv, he); @@ -1981,7 +2043,7 @@ Perl_unshare_hek(pTHX_ HEK *hek) hek if non-NULL takes priority over the other 3, else str, len and hash are used. If so, len and hash must both be valid for str. */ -void +STATIC void S_unshare_hek_or_pvn(pTHX_ HEK *hek, const char *str, I32 len, U32 hash) { register XPVHV* xhv; @@ -2092,7 +2154,7 @@ Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash) return share_hek_flags (str, len, hash, flags); } -HEK * +STATIC HEK * S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags) { register XPVHV* xhv; @@ -2133,7 +2195,7 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags) xhv->xhv_keys++; /* HvKEYS(hv)++ */ if (i) { /* initial entry? */ xhv->xhv_fill++; /* HvFILL(hv)++ */ - if (xhv->xhv_keys > xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */) + if (xhv->xhv_keys > (IV)xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */) hsplit(PL_strtab); } }