/*
=head1 Hash Manipulation Functions
-A HV structure represents a Perl hash. It consists mainly of an array
-of pointers, each of which points to a linked list of HE structures. The
+A HV structure represents a Perl hash. It consists mainly of an array
+of pointers, each of which points to a linked list of HE structures. The
array is indexed by the hash function of the key, so each linked list
-represents all the hash entries with the same hash value. Each HE contains
+represents all the hash entries with the same hash value. Each HE contains
a pointer to the actual value, plus a pointer to a HEK structure which
holds the key and hash value.
#define PERL_HASH_INTERNAL_ACCESS
#include "perl.h"
-#define HV_MAX_LENGTH_BEFORE_SPLIT 14
+#define DO_HSPLIT(xhv) ((xhv)->xhv_keys > (xhv)->xhv_max) /* HvTOTALKEYS(hv) > HvMAX(hv) */
static const char S_strtab_error[]
= "Cannot modify shared string table in hv_%s";
{
const int flags_masked = flags & HVhek_MASK;
char *k;
- register HEK *hek;
+ HEK *hek;
PERL_ARGS_ASSERT_SAVE_HEK_FLAGS;
Returns the SV which corresponds to the specified key in the hash.
The absolute value of C<klen> is the length of the key. If C<klen> is
negative the key is assumed to be in UTF-8-encoded Unicode. If
-C<lval> is set then the fetch will be part of a store. Check that the
+C<lval> is set then the fetch will be part of a store. This means that if
+there is no value in the hash associated with the given key, then one is
+created and a pointer to it is returned. The C<SV*> it points to can be
+assigned to. But always check that the
return value is non-null before dereferencing it to an C<SV*>.
See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
=for apidoc hv_exists_ent
-Returns a boolean indicating whether the specified hash key exists. C<hash>
+Returns a boolean indicating whether
+the specified hash key exists. C<hash>
can be a valid precomputed hash value, or 0 to ask for it to be
computed.
void *
Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
- int flags, int action, SV *val, register U32 hash)
+ int flags, int action, SV *val, U32 hash)
{
dVAR;
XPVHV* xhv;
if (SvIsCOW_shared_hash(keysv)) {
flags = HVhek_KEYCANONICAL | (is_utf8 ? HVhek_UTF8 : 0);
} else {
- flags = 0;
+ flags = is_utf8 ? HVhek_UTF8 : 0;
}
} else {
is_utf8 = ((flags & HVhek_UTF8) ? TRUE : FALSE);
if (action & HV_DELETE) {
return (void *) hv_delete_common(hv, keysv, key, klen,
- flags | (is_utf8 ? HVhek_UTF8 : 0),
- action, hash);
+ flags, action, hash);
}
xhv = (XPVHV*)SvANY(hv);
bool needs_store;
hv_magic_check (hv, &needs_copy, &needs_store);
if (needs_copy) {
- const bool save_taint = PL_tainted;
+ const bool save_taint = TAINT_get; /* Unused var warning under NO_TAINT_SUPPORT */
if (keysv || is_utf8) {
if (!keysv) {
keysv = newSVpvn_utf8(key, klen, TRUE);
}
- if (PL_tainting)
- PL_tainted = SvTAINTED(keysv);
+ if (TAINTING_get)
+ TAINT_set(SvTAINTED(keysv));
keysv = sv_2mortal(newSVsv(keysv));
mg_copy(MUTABLE_SV(hv), val, (char*)keysv, HEf_SVKEY);
} else {
}
}
- if (is_utf8 & !(flags & HVhek_KEYCANONICAL)) {
+ if (is_utf8 && !(flags & HVhek_KEYCANONICAL)) {
char * const keysave = (char *)key;
key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
if (is_utf8)
}
}
- if (HvREHASH(hv) || (!hash && !(keysv && (SvIsCOW_shared_hash(keysv)))))
- PERL_HASH_INTERNAL_(hash, key, klen, HvREHASH(hv));
- else if (!hash)
- hash = SvSHARED_HASH(keysv);
-
- /* We don't have a pointer to the hv, so we have to replicate the
- flag into every HEK, so that hv_iterkeysv can see it.
- And yes, you do need this even though you are not "storing" because
- you can flip the flags below if doing an lval lookup. (And that
- was put in to give the semantics Andreas was expecting.) */
- if (HvREHASH(hv))
- flags |= HVhek_REHASH;
+ if (!hash) {
+ if (keysv && (SvIsCOW_shared_hash(keysv)))
+ hash = SvSHARED_HASH(keysv);
+ else
+ PERL_HASH(hash, key, klen);
+ }
masked_flags = (flags & HVhek_MASK);
if (masked_flags & HVhek_ENABLEHVKFLAGS)
HvHASKFLAGS_on(hv);
- {
- const HE *counter = HeNEXT(entry);
-
- xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */
- if (!counter) { /* initial entry? */
- } else if (xhv->xhv_keys > xhv->xhv_max) {
- /* Use only the old HvUSEDKEYS(hv) > HvMAX(hv) condition to limit
- bucket splits on a rehashed hash, as we're not going to
- split it again, and if someone is lucky (evil) enough to
- get all the keys in one list they could exhaust our memory
- as we repeatedly double the number of buckets on every
- entry. Linear search feels a less worse thing to do. */
- hsplit(hv);
- } else if(!HvREHASH(hv)) {
- U32 n_links = 1;
-
- while ((counter = HeNEXT(counter)))
- n_links++;
-
- if (n_links > HV_MAX_LENGTH_BEFORE_SPLIT) {
- hsplit(hv);
- }
- }
+ xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */
+ if ( DO_HSPLIT(xhv) ) {
+ hsplit(hv);
}
if (return_svp) {
int k_flags, I32 d_flags, U32 hash)
{
dVAR;
- register XPVHV* xhv;
- register HE *entry;
- register HE **oentry;
+ XPVHV* xhv;
+ HE *entry;
+ HE **oentry;
bool is_utf8 = (k_flags & HVhek_UTF8) ? TRUE : FALSE;
int masked_flags;
if (!HvARRAY(hv))
return NULL;
- if (is_utf8) {
+ if (is_utf8 && !(k_flags & HVhek_KEYCANONICAL)) {
const char * const keysave = key;
key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
HvHASKFLAGS_on(MUTABLE_SV(hv));
}
- if (HvREHASH(hv) || (!hash && !(keysv && (SvIsCOW_shared_hash(keysv)))))
- PERL_HASH_INTERNAL_(hash, key, klen, HvREHASH(hv));
- else if (!hash)
- hash = SvSHARED_HASH(keysv);
+ if (!hash) {
+ if (keysv && (SvIsCOW_shared_hash(keysv)))
+ hash = SvSHARED_HASH(keysv);
+ else
+ PERL_HASH(hash, key, klen);
+ }
masked_flags = (k_flags & HVhek_MASK);
mro_changes = 1;
}
- if (d_flags & G_DISCARD) {
- sv = HeVAL(entry);
- HeVAL(entry) = &PL_sv_placeholder;
- if (sv) {
- /* deletion of method from stash */
- if (isGV(sv) && isGV_with_GP(sv) && GvCVu(sv)
- && HvENAME_get(hv))
- mro_method_changed_in(hv);
- SvREFCNT_dec(sv);
- sv = NULL;
- }
- }
- else {
- sv = sv_2mortal(HeVAL(entry));
- HeVAL(entry) = &PL_sv_placeholder;
+ sv = d_flags & G_DISCARD ? HeVAL(entry) : sv_2mortal(HeVAL(entry));
+ HeVAL(entry) = &PL_sv_placeholder;
+ if (sv) {
+ /* deletion of method from stash */
+ if (isGV(sv) && isGV_with_GP(sv) && GvCVu(sv)
+ && HvENAME_get(hv))
+ mro_method_changed_in(hv);
}
/*
HvHASKFLAGS_off(hv);
}
+ if (d_flags & G_DISCARD) {
+ SvREFCNT_dec(sv);
+ sv = NULL;
+ }
+
if (mro_changes == 1) mro_isa_changed_in(hv);
else if (mro_changes == 2)
mro_package_moved(NULL, stash, gv, 1);
S_hsplit(pTHX_ HV *hv)
{
dVAR;
- register XPVHV* const xhv = (XPVHV*)SvANY(hv);
+ 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;
+ I32 newsize = oldsize * 2;
+ I32 i;
char *a = (char*) HvARRAY(hv);
- register HE **aep;
- int longest_chain = 0;
- int was_shared;
+ HE **aep;
PERL_ARGS_ASSERT_HSPLIT;
aep = (HE**)a;
for (i=0; i<oldsize; i++,aep++) {
- int left_length = 0;
- int right_length = 0;
HE **oentry = aep;
HE *entry = *aep;
- register HE **bep;
+ HE **bep;
if (!entry) /* non-existent */
continue;
*oentry = HeNEXT(entry);
HeNEXT(entry) = *bep;
*bep = entry;
- right_length++;
}
else {
oentry = &HeNEXT(entry);
- left_length++;
}
entry = *oentry;
} while (entry);
/* I think we don't actually need to keep track of the longest length,
merely flag if anything is too long. But for the moment while
developing this code I'll track it. */
- if (left_length > longest_chain)
- longest_chain = left_length;
- if (right_length > longest_chain)
- longest_chain = right_length;
- }
-
-
- /* Pick your policy for "hashing isn't working" here: */
- if (longest_chain <= HV_MAX_LENGTH_BEFORE_SPLIT /* split worked? */
- || HvREHASH(hv)) {
- return;
- }
-
- if (hv == PL_strtab) {
- /* Urg. Someone is doing something nasty to the string table.
- Can't win. */
- return;
- }
-
- /* Awooga. Awooga. Pathological data. */
- /*PerlIO_printf(PerlIO_stderr(), "%p %d of %d with %d/%d buckets\n", (void*)hv,
- longest_chain, HvTOTALKEYS(hv), HvFILL(hv), 1+HvMAX(hv));*/
-
- ++newsize;
- Newxz(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
- + (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0), char);
- if (SvOOK(hv)) {
- Copy(HvAUX(hv), &a[newsize * sizeof(HE*)], 1, struct xpvhv_aux);
- }
-
- was_shared = HvSHAREKEYS(hv);
-
- HvSHAREKEYS_off(hv);
- HvREHASH_on(hv);
-
- aep = HvARRAY(hv);
-
- for (i=0; i<newsize; i++,aep++) {
- register HE *entry = *aep;
- while (entry) {
- /* We're going to trash this HE's next pointer when we chain it
- into the new hash below, so store where we go next. */
- HE * const next = HeNEXT(entry);
- UV hash;
- HE **bep;
-
- /* Rehash it */
- PERL_HASH_INTERNAL(hash, HeKEY(entry), HeKLEN(entry));
-
- if (was_shared) {
- /* Unshare it. */
- HEK * const new_hek
- = save_hek_flags(HeKEY(entry), HeKLEN(entry),
- hash, HeKFLAGS(entry));
- unshare_hek (HeKEY_hek(entry));
- HeKEY_hek(entry) = new_hek;
- } else {
- /* Not shared, so simply write the new hash in. */
- HeHASH(entry) = hash;
- }
- /*PerlIO_printf(PerlIO_stderr(), "%d ", HeKFLAGS(entry));*/
- HEK_REHASH_on(HeKEY_hek(entry));
- /*PerlIO_printf(PerlIO_stderr(), "%d\n", HeKFLAGS(entry));*/
-
- /* Copy oentry to the correct new chain. */
- bep = ((HE**)a) + (hash & (I32) xhv->xhv_max);
- HeNEXT(entry) = *bep;
- *bep = entry;
-
- entry = next;
- }
}
- Safefree (HvARRAY(hv));
- HvARRAY(hv) = (HE **)a;
}
void
Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
{
dVAR;
- register XPVHV* xhv = (XPVHV*)SvANY(hv);
+ XPVHV* xhv = (XPVHV*)SvANY(hv);
const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
- register I32 newsize;
- register I32 i;
- register char *a;
- register HE **aep;
+ I32 newsize;
+ I32 i;
+ char *a;
+ HE **aep;
PERL_ARGS_ASSERT_HV_KSPLIT;
if (!entry) /* non-existent */
continue;
do {
- register I32 j = (HeHASH(entry) & newsize);
+ I32 j = (HeHASH(entry) & newsize);
if (j != i) {
j -= i;
HV * const hv = newHV();
STRLEN hv_max;
- if (!ohv || !HvTOTALKEYS(ohv))
+ if (!ohv || (!HvTOTALKEYS(ohv) && !SvMAGICAL((const SV *)ohv)))
return hv;
hv_max = HvMAX(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),
- SvIMMORTAL(val) ? val : newSVsv(val),
+ SV *val = hv_iterval(ohv,entry);
+ SV * const keysv = HeSVKEY(entry);
+ val = SvIMMORTAL(val) ? val : newSVsv(val);
+ if (keysv)
+ (void)hv_store_ent(hv, keysv, val, 0);
+ else
+ (void)hv_store_flags(hv, HeKEY(entry), HeKLEN(entry), val,
HeHASH(entry), HeKFLAGS(entry));
}
HvRITER_set(ohv, riter);
{
HV * const hv = newHV();
- if (ohv && HvTOTALKEYS(ohv)) {
+ if (ohv) {
STRLEN hv_max = HvMAX(ohv);
STRLEN hv_fill = HvFILL(ohv);
HE *entry;
const I32 riter = HvRITER_get(ohv);
HE * const eiter = HvEITER_get(ohv);
+ ENTER;
+ SAVEFREESV(hv);
+
while (hv_max && hv_max + 1 >= hv_fill * 2)
hv_max = hv_max / 2;
HvMAX(hv) = hv_max;
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,
+ SV *const sv = newSVsv(hv_iterval(ohv,entry));
+ SV *heksv = HeSVKEY(entry);
+ if (!heksv && sv) heksv = newSVhek(HeKEY_hek(entry));
+ if (sv) sv_magic(sv, NULL, PERL_MAGIC_hintselem,
(char *)heksv, HEf_SVKEY);
- SvREFCNT_dec(heksv);
- (void)hv_store_flags(hv, HeKEY(entry), HeKLEN(entry),
- sv, HeHASH(entry), HeKFLAGS(entry));
+ if (heksv == HeSVKEY(entry))
+ (void)hv_store_ent(hv, heksv, sv, 0);
+ else {
+ (void)hv_common(hv, heksv, HeKEY(entry), HeKLEN(entry),
+ HeKFLAGS(entry), HV_FETCH_ISSTORE|HV_FETCH_JUST_SV, sv, HeHASH(entry));
+ SvREFCNT_dec(heksv);
+ }
}
HvRITER_set(ohv, riter);
HvEITER_set(ohv, eiter);
+
+ SvREFCNT_inc_simple_void_NN(hv);
+ LEAVE;
}
hv_magic(hv, NULL, PERL_MAGIC_hints);
return hv;
/* like hv_free_ent, but returns the SV rather than freeing it */
STATIC SV*
-S_hv_free_ent_ret(pTHX_ HV *hv, register HE *entry)
+S_hv_free_ent_ret(pTHX_ HV *hv, HE *entry)
{
dVAR;
SV *val;
if (!entry)
return NULL;
val = HeVAL(entry);
- if (val && isGV(val) && isGV_with_GP(val) && GvCVu(val) && HvENAME(hv))
- mro_method_changed_in(hv); /* deletion of method from stash */
if (HeKLEN(entry) == HEf_SVKEY) {
SvREFCNT_dec(HeKEY_sv(entry));
Safefree(HeKEY_hek(entry));
void
-Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
+Perl_hv_free_ent(pTHX_ HV *hv, HE *entry)
{
dVAR;
SV *val;
void
-Perl_hv_delayfree_ent(pTHX_ HV *hv, register HE *entry)
+Perl_hv_delayfree_ent(pTHX_ HV *hv, HE *entry)
{
dVAR;
=for apidoc hv_clear
Frees the all the elements of a hash, leaving it empty.
-The XS equivalent of %hash = (). See also L</hv_undef>.
+The XS equivalent of C<%hash = ()>. See also L</hv_undef>.
+
+If any destructors are triggered as a result, the hv itself may
+be freed.
=cut
*/
Perl_hv_clear(pTHX_ HV *hv)
{
dVAR;
- register XPVHV* xhv;
+ XPVHV* xhv;
if (!hv)
return;
xhv = (XPVHV*)SvANY(hv);
+ ENTER;
+ SAVEFREESV(SvREFCNT_inc_simple_NN(hv));
if (SvREADONLY(hv) && HvARRAY(hv) != NULL) {
/* restricted hash: convert all keys to placeholders */
STRLEN i;
mg_clear(MUTABLE_SV(hv));
HvHASKFLAGS_off(hv);
- HvREHASH_off(hv);
}
if (SvOOK(hv)) {
if(HvENAME_get(hv))
mro_isa_changed_in(hv);
HvEITER_set(hv, NULL);
}
+ LEAVE;
}
/*
/*
=for apidoc hv_undef
-Undefines the hash. The XS equivalent of undef(%hash).
+Undefines the hash. The XS equivalent of C<undef(%hash)>.
As well as freeing all the elements of the hash (like hv_clear()), this
also frees any auxiliary data and storage associated with the hash.
+
+If any destructors are triggered as a result, the hv itself may
+be freed.
+
See also L</hv_clear>.
=cut
Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
{
dVAR;
- register XPVHV* xhv;
+ XPVHV* xhv;
const char *name;
+ const bool save = !!SvREFCNT(hv);
if (!hv)
return;
/* note that the code following prior to hfreeentries is duplicated
* in sv_clear(), and changes here should be done there too */
if (PL_phase != PERL_PHASE_DESTRUCT && (name = HvNAME(hv))) {
- if (PL_stashcache)
+ if (PL_stashcache) {
+ DEBUG_o(Perl_deb(aTHX_ "hv_undef_flags clearing PL_stashcache for '%"
+ HEKf"'\n", HvNAME_HEK(hv)));
(void)hv_delete(PL_stashcache, name,
HEK_UTF8(HvNAME_HEK(hv)) ? -HvNAMELEN_get(hv) : HvNAMELEN_get(hv),
G_DISCARD
);
+ }
hv_name_set(hv, NULL, 0, 0);
}
+ if (save) {
+ ENTER;
+ SAVEFREESV(SvREFCNT_inc_simple_NN(hv));
+ }
hfreeentries(hv);
if (SvOOK(hv)) {
struct xpvhv_aux * const aux = HvAUX(hv);
if ((name = HvENAME_get(hv))) {
if (PL_phase != PERL_PHASE_DESTRUCT)
mro_isa_changed_in(hv);
- if (PL_stashcache)
+ if (PL_stashcache) {
+ DEBUG_o(Perl_deb(aTHX_ "hv_undef_flags clearing PL_stashcache for effective name '%"
+ HEKf"'\n", HvENAME_HEK(hv)));
(void)hv_delete(
PL_stashcache, name,
HEK_UTF8(HvENAME_HEK(hv)) ? -HvENAMELEN_get(hv) : HvENAMELEN_get(hv),
G_DISCARD
);
+ }
}
/* If this call originated from sv_clear, then we must check for
* effective names that need freeing, as well as the usual name. */
name = HvNAME(hv);
if (flags & HV_NAME_SETALL ? !!aux->xhv_name_u.xhvnameu_name : !!name) {
- if (name && PL_stashcache)
+ if (name && PL_stashcache) {
+ DEBUG_o(Perl_deb(aTHX_ "hv_undef_flags clearing PL_stashcache for name '%"
+ HEKf"'\n", HvNAME_HEK(hv)));
(void)hv_delete(PL_stashcache, name, (HEK_UTF8(HvNAME_HEK(hv)) ? -HvNAMELEN_get(hv) : HvNAMELEN_get(hv)), G_DISCARD);
+ }
hv_name_set(hv, NULL, 0, flags);
}
if((meta = aux->xhv_mro_meta)) {
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) {
+ SvREFCNT_dec_NN(meta->mro_linear_all);
+ /* mro_linear_current is just acting as a shortcut pointer,
+ hence the else. */
+ }
+ else
/* Only the current MRO is stored, so this owns the data.
*/
SvREFCNT_dec(meta->mro_linear_current);
- meta->mro_linear_current = NULL;
- }
SvREFCNT_dec(meta->mro_nextmethod);
SvREFCNT_dec(meta->isa);
Safefree(meta);
aux->xhv_mro_meta = NULL;
}
+ SvREFCNT_dec(aux->xhv_super);
if (!aux->xhv_name_u.xhvnameu_name && ! aux->xhv_backreferences)
SvFLAGS(hv) &= ~SVf_OOK;
}
xhv->xhv_max = 7; /* HvMAX(hv) = 7 (it's a normal hash) */
HvARRAY(hv) = 0;
}
- HvPLACEHOLDERS_set(hv, 0);
+ /* if we're freeing the HV, the SvMAGIC field has been reused for
+ * other purposes, and so there can't be any placeholder magic */
+ if (SvREFCNT(hv))
+ HvPLACEHOLDERS_set(hv, 0);
if (SvRMAGICAL(hv))
mg_clear(MUTABLE_SV(hv));
+ if (save) LEAVE;
}
/*
+ sizeof(struct xpvhv_aux), char);
}
HvARRAY(hv) = (HE**) array;
- /* SvOOK_on(hv) attacks the IV flags. */
- SvFLAGS(hv) |= SVf_OOK;
+ SvOOK_on(hv);
iter = HvAUX(hv);
iter->xhv_riter = -1; /* HvRITER(hv) = -1 */
iter->xhv_name_count = 0;
iter->xhv_backreferences = 0;
iter->xhv_mro_meta = NULL;
+ iter->xhv_super = NULL;
return iter;
}
/*
=for apidoc hv_ename_add
-Adds a name to a stash's internal list of effective names. See
+Adds a name to a stash's internal list of effective names. See
C<hv_ename_delete>.
This is called when a stash is assigned to a new location in the symbol
/*
=for apidoc hv_ename_delete
-Removes a name from a stash's internal list of effective names. If this is
+Removes a name from a stash's internal list of effective names. If this is
the name returned by C<HvENAME>, then another name in the list will take
its place (C<HvENAME> will use it).
HvAUX(hv)->xhv_backreferences = 0;
Perl_sv_kill_backrefs(aTHX_ MUTABLE_SV(hv), av);
if (SvTYPE(av) == SVt_PVAV)
- SvREFCNT_dec(av);
+ SvREFCNT_dec_NN(av);
}
}
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
-C<&Perl_sv_placeholder>. Note that the implementation of placeholders and
+C<&PL_sv_placeholder>. Note that the implementation of placeholders and
restricted hashes may change, and the implementation currently is
insufficiently abstracted for any change to be tidy.
Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
{
dVAR;
- register XPVHV* xhv;
- register HE *entry;
+ XPVHV* xhv;
+ HE *entry;
HE *oldentry;
MAGIC* mg;
struct xpvhv_aux *iter;
if (!SvOOK(hv)) {
/* Too many things (well, pp_each at least) merrily assume that you can
- call iv_iternext without calling hv_iterinit, so we'll have to deal
+ call hv_iternext without calling hv_iterinit, so we'll have to deal
with it. */
hv_iterinit(hv);
}
if (entry) {
sv_setsv(key, HeSVKEY_force(entry));
SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */
+ HeSVKEY_set(entry, NULL);
}
else {
char *k;
/* one HE per MAGICAL hash */
iter->xhv_eiter = entry = new_HE(); /* HvEITER(hv) = new_HE() */
+ HvLAZYDEL_on(hv); /* make sure entry gets freed */
Zero(entry, 1, HE);
Newxz(k, HEK_BASESIZE + sizeof(const SV *), char);
hek = (HEK*)k;
Safefree(HeKEY_hek(entry));
del_HE(entry);
iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */
+ HvLAZYDEL_off(hv);
return NULL;
}
}
hv_free_ent(hv, oldentry);
}
- /*if (HvREHASH(hv) && entry && !HeKREHASH(entry))
- PerlIO_printf(PerlIO_stderr(), "Awooga %p %p\n", (void*)hv, (void*)entry);*/
-
iter->xhv_eiter = entry; /* HvEITER(hv) = entry */
return entry;
}
*/
char *
-Perl_hv_iterkey(pTHX_ register HE *entry, I32 *retlen)
+Perl_hv_iterkey(pTHX_ HE *entry, I32 *retlen)
{
PERL_ARGS_ASSERT_HV_ITERKEY;
*/
SV *
-Perl_hv_iterkeysv(pTHX_ register HE *entry)
+Perl_hv_iterkeysv(pTHX_ HE *entry)
{
PERL_ARGS_ASSERT_HV_ITERKEYSV;
*/
SV *
-Perl_hv_iterval(pTHX_ HV *hv, register HE *entry)
+Perl_hv_iterval(pTHX_ HV *hv, HE *entry)
{
PERL_ARGS_ASSERT_HV_ITERVAL;
S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
{
dVAR;
- register XPVHV* xhv;
+ XPVHV* xhv;
HE *entry;
- register HE **oentry;
+ HE **oentry;
bool is_utf8 = FALSE;
int k_flags = 0;
const char * const save = str;
if (!entry)
Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
- "Attempt to free non-existent shared string '%s'%s"
+ "Attempt to free nonexistent shared string '%s'%s"
pTHX__FORMAT,
hek ? HEK_KEY(hek) : str,
((k_flags & HVhek_UTF8) ? " (utf8)" : "") pTHX__VALUE);
* len and hash must both be valid for str.
*/
HEK *
-Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash)
+Perl_share_hek(pTHX_ const char *str, I32 len, U32 hash)
{
bool is_utf8 = FALSE;
int flags = 0;
we should flag that it needs upgrading on keys or each. Also flag
that we need share_hek_flags to free the string. */
if (str != save) {
+ dVAR;
PERL_HASH(hash, str, len);
flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
}
}
STATIC HEK *
-S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
+S_share_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags)
{
dVAR;
- register HE *entry;
+ HE *entry;
const int flags_masked = flags & HVhek_MASK;
const U32 hindex = hash & (I32) HvMAX(PL_strtab);
- register XPVHV * const xhv = (XPVHV*)SvANY(PL_strtab);
+ XPVHV * const xhv = (XPVHV*)SvANY(PL_strtab);
PERL_ARGS_ASSERT_SHARE_HEK_FLAGS;
/* 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.
+ HE directly from the HEK.
*/
Newx(k, STRUCT_OFFSET(struct shared_he,
xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */
if (!next) { /* initial entry? */
- } else if (xhv->xhv_keys > xhv->xhv_max /* HvUSEDKEYS(hv) > HvMAX(hv) */) {
- hsplit(PL_strtab);
+ } else if ( DO_HSPLIT(xhv) ) {
+ hsplit(PL_strtab);
}
}
U8 utf8_flag;
PERL_ARGS_ASSERT_REFCOUNTED_HE_FETCH_PVN;
- if (flags & ~REFCOUNTED_HE_KEY_UTF8)
+ if (flags & ~(REFCOUNTED_HE_KEY_UTF8|REFCOUNTED_HE_EXISTS))
Perl_croak(aTHX_ "panic: refcounted_he_fetch_pvn bad flags %"UVxf,
(UV)flags);
if (!chain)
memEQ(HEK_KEY(chain->refcounted_he_hek), keypv, keylen) &&
utf8_flag == (HEK_FLAGS(chain->refcounted_he_hek) & HVhek_UTF8)
#endif
- )
+ ) {
+ if (flags & REFCOUNTED_HE_EXISTS)
+ return (chain->refcounted_he_data[0] & HVrhek_typemask)
+ == HVrhek_delete
+ ? NULL : &PL_sv_yes;
return sv_2mortal(refcounted_he_value(chain));
+ }
}
- return &PL_sv_placeholder;
+ return flags & REFCOUNTED_HE_EXISTS ? NULL : &PL_sv_placeholder;
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
- * indent-tabs-mode: t
+ * indent-tabs-mode: nil
* End:
*
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
*/
https://perl5.git.perl.org / perl5.git / blobdiff