{
const int flags_masked = flags & HVhek_MASK;
char *k;
- register HEK *hek;
+ HEK *hek;
PERL_ARGS_ASSERT_SAVE_HEK_FLAGS;
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);
}
}
- 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)
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);
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;
+ HE **aep;
int longest_chain = 0;
int was_shared;
int right_length = 0;
HE **oentry = aep;
HE *entry = *aep;
- register HE **bep;
+ HE **bep;
if (!entry) /* non-existent */
continue;
aep = HvARRAY(hv);
for (i=0; i<newsize; i++,aep++) {
- register HE *entry = *aep;
+ 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. */
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;
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;
}
HvRITER_set(ohv, riter);
HvEITER_set(ohv, eiter);
+
+ SvREFCNT_inc_simple_void_NN(hv);
+ LEAVE;
}
hv_magic(hv, NULL, PERL_MAGIC_hints);
return hv;
Perl_hv_clear(pTHX_ HV *hv)
{
dVAR;
- register XPVHV* xhv;
+ XPVHV* xhv;
if (!hv)
return;
Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
{
dVAR;
- register XPVHV* xhv;
+ XPVHV* xhv;
const char *name;
const bool save = !!SvREFCNT(hv);
/* 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) {
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)) {
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;
}
iter->xhv_name_count = 0;
iter->xhv_backreferences = 0;
iter->xhv_mro_meta = NULL;
+ iter->xhv_super = NULL;
return iter;
}
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;
}
}
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;
S_share_hek_flags(pTHX_ const char *str, I32 len, register 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;
https://perl5.git.perl.org / perl5.git / blobdiff