if (!hv)
return NULL;
- if (SvTYPE(hv) == SVTYPEMASK)
+ if (SvTYPE(hv) == (svtype)SVTYPEMASK)
return NULL;
assert(SvTYPE(hv) == SVt_PVHV);
}
}
- if (HvREHASH(hv)) {
- PERL_HASH_INTERNAL(hash, key, klen);
- /* 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) || (!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;
- } else if (!hash) {
- if (keysv && (SvIsCOW_shared_hash(keysv))) {
- hash = SvSHARED_HASH(keysv);
- } else {
- PERL_HASH(hash, key, klen);
- }
- }
masked_flags = (flags & HVhek_MASK);
much back at this point (in hv_store's code). */
break;
}
- /* LVAL fetch which actaully needs a store. */
+ /* LVAL fetch which actually needs a store. */
val = newSV(0);
HvPLACEHOLDERS(hv)--;
} else {
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;
n_links++;
if (n_links > HV_MAX_LENGTH_BEFORE_SPLIT) {
- /* Use only the old HvKEYS(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);
}
}
register XPVHV* xhv;
register HE *entry;
register HE **oentry;
- HE *const *first_entry;
bool is_utf8 = (k_flags & HVhek_UTF8) ? TRUE : FALSE;
int masked_flags;
HvHASKFLAGS_on(MUTABLE_SV(hv));
}
- if (HvREHASH(hv)) {
- PERL_HASH_INTERNAL(hash, key, klen);
- } else if (!hash) {
- if (keysv && (SvIsCOW_shared_hash(keysv))) {
- hash = SvSHARED_HASH(keysv);
- } else {
- PERL_HASH(hash, key, klen);
- }
- }
+ if (HvREHASH(hv) || (!hash && !(keysv && (SvIsCOW_shared_hash(keysv)))))
+ PERL_HASH_INTERNAL_(hash, key, klen, HvREHASH(hv));
+ else if (!hash)
+ hash = SvSHARED_HASH(keysv);
masked_flags = (k_flags & HVhek_MASK);
- first_entry = oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)];
+ oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)];
entry = *oentry;
for (; entry; oentry = &HeNEXT(entry), entry = *oentry) {
SV *sv;
Safefree(key);
return NULL;
}
- if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
+ if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))
+ && !SvIsCOW(HeVAL(entry))) {
hv_notallowed(k_flags, key, klen,
"Attempt to delete readonly key '%"SVf"' from"
" a restricted hash");
if (HeVAL(entry) && HvENAME_get(hv)) {
gv = (GV *)HeVAL(entry);
if (keysv) key = SvPV(keysv, klen);
- if (klen > 1 && key[klen-2] == ':' && key[klen-1] == ':'
+ if ((
+ (klen > 1 && key[klen-2] == ':' && key[klen-1] == ':')
+ ||
+ (klen == 1 && key[0] == ':')
+ )
&& (klen != 6 || hv!=PL_defstash || memNE(key,"main::",6))
&& SvTYPE(gv) == SVt_PVGV && (stash = GvHV((GV *)gv))
&& HvENAME_get(stash)) {
mro_changes = 1;
}
- if (d_flags & G_DISCARD)
- sv = NULL;
+ 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;
* we can still access via not-really-existing key without raising
* an error.
*/
- if (SvREADONLY(hv)) {
- SvREFCNT_dec(HeVAL(entry));
- HeVAL(entry) = &PL_sv_placeholder;
+ if (SvREADONLY(hv))
/* We'll be saving this slot, so the number of allocated keys
* doesn't go down, but the number placeholders goes up */
HvPLACEHOLDERS(hv)++;
- } else {
+ else {
*oentry = HeNEXT(entry);
if (SvOOK(hv) && entry == HvAUX(hv)->xhv_eiter /* HvEITER(hv) */)
HvLAZYDEL_on(hv);
- else
+ else {
+ if (SvOOK(hv) && HvLAZYDEL(hv) &&
+ entry == HeNEXT(HvAUX(hv)->xhv_eiter))
+ HeNEXT(HvAUX(hv)->xhv_eiter) = HeNEXT(entry);
hv_free_ent(hv, entry);
+ }
xhv->xhv_keys--; /* HvTOTALKEYS(hv)-- */
if (xhv->xhv_keys == 0)
HvHASKFLAGS_off(hv);
return hv;
}
-void
-Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
+/* 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)
{
dVAR;
SV *val;
- PERL_ARGS_ASSERT_HV_FREE_ENT;
+ PERL_ARGS_ASSERT_HV_FREE_ENT_RET;
if (!entry)
- return;
+ 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 */
- SvREFCNT_dec(val);
if (HeKLEN(entry) == HEf_SVKEY) {
SvREFCNT_dec(HeKEY_sv(entry));
Safefree(HeKEY_hek(entry));
else
Safefree(HeKEY_hek(entry));
del_HE(entry);
+ return val;
+}
+
+
+void
+Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
+{
+ dVAR;
+ SV *val;
+
+ PERL_ARGS_ASSERT_HV_FREE_ENT;
+
+ if (!entry)
+ return;
+ val = hv_free_ent_ret(hv, entry);
+ SvREFCNT_dec(val);
}
/*
=for apidoc hv_clear
-Clears a hash, making it empty.
+Frees the all the elements of a hash, leaving it empty.
+The XS equivalent of %hash = (). See also L</hv_undef>.
=cut
*/
for (; entry; entry = HeNEXT(entry)) {
/* not already placeholder */
if (HeVAL(entry) != &PL_sv_placeholder) {
- if (HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
+ if (HeVAL(entry) && SvREADONLY(HeVAL(entry))
+ && !SvIsCOW(HeVAL(entry))) {
SV* const keysv = hv_iterkeysv(entry);
Perl_croak(aTHX_
"Attempt to delete readonly key '%"SVf"' from a restricted hash",
}
}
}
- goto reset;
}
+ else {
+ hfreeentries(hv);
+ HvPLACEHOLDERS_set(hv, 0);
- hfreeentries(hv);
- HvPLACEHOLDERS_set(hv, 0);
- if (HvARRAY(hv))
- Zero(HvARRAY(hv), xhv->xhv_max+1 /* HvMAX(hv)+1 */, HE*);
-
- if (SvRMAGICAL(hv))
- mg_clear(MUTABLE_SV(hv));
+ if (SvRMAGICAL(hv))
+ mg_clear(MUTABLE_SV(hv));
- HvHASKFLAGS_off(hv);
- HvREHASH_off(hv);
- reset:
+ HvHASKFLAGS_off(hv);
+ HvREHASH_off(hv);
+ }
if (SvOOK(hv)) {
if(HvENAME_get(hv))
mro_isa_changed_in(hv);
i = HvMAX(hv);
do {
/* Loop down the linked list heads */
- bool first = TRUE;
HE **oentry = &(HvARRAY(hv))[i];
HE *entry;
*oentry = HeNEXT(entry);
if (entry == HvEITER_get(hv))
HvLAZYDEL_on(hv);
- else
+ else {
+ if (SvOOK(hv) && HvLAZYDEL(hv) &&
+ entry == HeNEXT(HvAUX(hv)->xhv_eiter))
+ HeNEXT(HvAUX(hv)->xhv_eiter) = HeNEXT(entry);
hv_free_ent(hv, entry);
+ }
if (--items == 0) {
/* Finished. */
HvTOTALKEYS(hv) -= (IV)HvPLACEHOLDERS_get(hv);
- if (HvKEYS(hv) == 0)
+ if (HvUSEDKEYS(hv) == 0)
HvHASKFLAGS_off(hv);
HvPLACEHOLDERS_set(hv, 0);
return;
}
} else {
oentry = &HeNEXT(entry);
- first = FALSE;
}
}
} while (--i >= 0);
STATIC void
S_hfreeentries(pTHX_ HV *hv)
{
- /* This is the array that we're going to restore */
- HE **const orig_array = HvARRAY(hv);
- HE **tmp_array = NULL;
- const bool has_aux = SvOOK(hv);
- struct xpvhv_aux * current_aux = NULL;
- int attempts = 100;
-
- const bool mpm = PL_phase != PERL_PHASE_DESTRUCT && HvENAME(hv);
+ STRLEN index = 0;
+ XPVHV * const xhv = (XPVHV*)SvANY(hv);
+ SV *sv;
PERL_ARGS_ASSERT_HFREEENTRIES;
- if (!orig_array)
- return;
-
- /* orig_array remains unchanged throughout the loop. If after freeing all
- the entries it turns out that one of the little blighters has triggered
- an action that has caused HvARRAY to be re-allocated, then we set
- array to the new HvARRAY, and try again. */
-
- while (1) {
- /* This is the one we're going to try to empty. First time round
- it's the original array. (Hopefully there will only be 1 time
- round) */
- HE ** const array = HvARRAY(hv);
- I32 i = HvMAX(hv);
-
- struct xpvhv_aux *iter = SvOOK(hv) ? HvAUX(hv) : NULL;
-
- /* make everyone else think the array is empty, so that the destructors
- * called for freed entries can't recursively mess with us */
- HvARRAY(hv) = NULL;
-
- if (SvOOK(hv)) {
- HE *entry;
-
- SvFLAGS(hv) &= ~SVf_OOK; /* Goodbye, aux structure. */
- /* What aux structure? */
- /* (But we still have a pointer to it in iter.) */
-
- /* Copy the name and MRO stuff to a new aux structure
- if present. */
- if (iter->xhv_name || iter->xhv_mro_meta) {
- struct xpvhv_aux * const newaux = hv_auxinit(hv);
- newaux->xhv_name = iter->xhv_name;
- newaux->xhv_name_count = iter->xhv_name_count;
- iter->xhv_name = NULL;
- newaux->xhv_mro_meta = iter->xhv_mro_meta;
- iter->xhv_mro_meta = NULL;
- }
-
- /* Because we have taken xhv_name and
- xhv_mro_meta out, the only allocated
- pointers in the aux structure that might exist are the back-
- reference array and xhv_eiter.
- */
-
- /* weak references: if called from sv_clear(), the backrefs
- * should already have been killed; if there are any left, its
- * because we're doing hv_clear() or hv_undef(), and the HV
- * will continue to live.
- * Because while freeing the entries we fake up a NULL HvARRAY
- * (and hence HvAUX), we need to store the backref array
- * somewhere else; but it still needs to be visible in case
- * any the things we free happen to call sv_del_backref().
- * We do this by storing it in magic instead.
- * If, during the entry freeing, a destructor happens to add
- * a new weak backref, then sv_add_backref will look in both
- * places (magic in HvAUX) for the AV, but will create a new
- * AV in HvAUX if it can't find one (if it finds it in magic,
- * it moves it back into HvAUX. So at the end of the iteration
- * we have to allow for this. */
-
-
- if (iter->xhv_backreferences) {
- if (SvTYPE(iter->xhv_backreferences) == SVt_PVAV) {
- /* The sv_magic will increase the reference count of the AV,
- so we need to drop it first. */
- SvREFCNT_dec(iter->xhv_backreferences);
- if (AvFILLp(iter->xhv_backreferences) == -1) {
- /* Turns out that the array is empty. Just free it. */
- SvREFCNT_dec(iter->xhv_backreferences);
-
- } else {
- sv_magic(MUTABLE_SV(hv),
- MUTABLE_SV(iter->xhv_backreferences),
- PERL_MAGIC_backref, NULL, 0);
- }
- }
- else {
- MAGIC *mg;
- sv_magic(MUTABLE_SV(hv), NULL, PERL_MAGIC_backref, NULL, 0);
- mg = mg_find(MUTABLE_SV(hv), PERL_MAGIC_backref);
- mg->mg_obj = (SV*)iter->xhv_backreferences;
- }
- iter->xhv_backreferences = NULL;
- }
-
- entry = iter->xhv_eiter; /* HvEITER(hv) */
- if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */
- HvLAZYDEL_off(hv);
- hv_free_ent(hv, entry);
- }
- iter->xhv_riter = -1; /* HvRITER(hv) = -1 */
- iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */
-
- /* There are now no allocated pointers in the aux structure. */
- }
-
- /* If there are no keys, there is nothing left to free. */
- if (!((XPVHV*) SvANY(hv))->xhv_keys) break;
-
- /* Since we have removed the HvARRAY (and possibly replaced it by
- calling hv_auxinit), set the number of keys accordingly. */
- ((XPVHV*) SvANY(hv))->xhv_keys = 0;
+ while ((sv = Perl_hfree_next_entry(aTHX_ hv, &index))||xhv->xhv_keys) {
+ SvREFCNT_dec(sv);
+ }
+}
- do {
- /* Loop down the linked list heads */
- HE *entry = array[i];
- while (entry) {
- register HE * const oentry = entry;
- entry = HeNEXT(entry);
- if (
- mpm && HeVAL(oentry) && isGV(HeVAL(oentry)) &&
- GvHV(HeVAL(oentry)) && HvENAME(GvHV(HeVAL(oentry)))
- ) {
- STRLEN klen;
- const char * const key = HePV(oentry,klen);
- if (klen > 1 && key[klen-1]==':' && key[klen-2]==':') {
- mro_package_moved(
- NULL, GvHV(HeVAL(oentry)),
- (GV *)HeVAL(oentry), 0
- );
- }
- }
- hv_free_ent(hv, oentry);
- }
- } while (--i >= 0);
+/* hfree_next_entry()
+ * For use only by S_hfreeentries() and sv_clear().
+ * Delete the next available HE from hv and return the associated SV.
+ * Returns null on empty hash. Nevertheless null is not a reliable
+ * indicator that the hash is empty, as the deleted entry may have a
+ * null value.
+ * indexp is a pointer to the current index into HvARRAY. The index should
+ * initially be set to 0. hfree_next_entry() may update it. */
- /* As there are no allocated pointers in the aux structure, it's now
- safe to free the array we just cleaned up, if it's not the one we're
- going to put back. */
- if (array != orig_array) {
- Safefree(array);
- }
+SV*
+Perl_hfree_next_entry(pTHX_ HV *hv, STRLEN *indexp)
+{
+ struct xpvhv_aux *iter;
+ HE *entry;
+ HE ** array;
+#ifdef DEBUGGING
+ STRLEN orig_index = *indexp;
+#endif
- if (!HvARRAY(hv)) {
- /* Good. No-one added anything this time round. */
- break;
- }
+ PERL_ARGS_ASSERT_HFREE_NEXT_ENTRY;
- if (--attempts == 0) {
- Perl_die(aTHX_ "panic: hfreeentries failed to free hash - something is repeatedly re-creating entries");
+ if (SvOOK(hv) && ((iter = HvAUX(hv)))
+ && ((entry = iter->xhv_eiter)) )
+ {
+ /* the iterator may get resurrected after each
+ * destructor call, so check each time */
+ if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */
+ HvLAZYDEL_off(hv);
+ hv_free_ent(hv, entry);
+ /* warning: at this point HvARRAY may have been
+ * re-allocated, HvMAX changed etc */
}
+ iter->xhv_riter = -1; /* HvRITER(hv) = -1 */
+ iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */
}
-
- /* Set aside the current array for now, in case we still need it. */
- if (SvOOK(hv)) current_aux = HvAUX(hv);
- if (HvARRAY(hv) && HvARRAY(hv) != orig_array)
- tmp_array = HvARRAY(hv);
-
- HvARRAY(hv) = orig_array;
- if (has_aux && current_aux)
- SvFLAGS(hv) |= SVf_OOK;
- else
- SvFLAGS(hv) &=~SVf_OOK;
+ if (!((XPVHV*)SvANY(hv))->xhv_keys)
+ return NULL;
- /* If the hash was actually a symbol table, put the name and MRO
- caches back. */
- if (current_aux) {
- struct xpvhv_aux * const aux
- = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv);
- aux->xhv_name = current_aux->xhv_name;
- aux->xhv_name_count = current_aux->xhv_name_count;
- aux->xhv_mro_meta = current_aux->xhv_mro_meta;
+ array = HvARRAY(hv);
+ assert(array);
+ while ( ! ((entry = array[*indexp])) ) {
+ if ((*indexp)++ >= HvMAX(hv))
+ *indexp = 0;
+ assert(*indexp != orig_index);
}
+ array[*indexp] = HeNEXT(entry);
+ ((XPVHV*) SvANY(hv))->xhv_keys--;
- if (tmp_array) Safefree(tmp_array);
+ if ( PL_phase != PERL_PHASE_DESTRUCT && HvENAME(hv)
+ && HeVAL(entry) && isGV(HeVAL(entry))
+ && GvHV(HeVAL(entry)) && HvENAME(GvHV(HeVAL(entry)))
+ ) {
+ STRLEN klen;
+ const char * const key = HePV(entry,klen);
+ if ((klen > 1 && key[klen-1]==':' && key[klen-2]==':')
+ || (klen == 1 && key[0] == ':')) {
+ mro_package_moved(
+ NULL, GvHV(HeVAL(entry)),
+ (GV *)HeVAL(entry), 0
+ );
+ }
+ }
+ return hv_free_ent_ret(hv, entry);
}
+
/*
=for apidoc hv_undef
-Undefines the hash.
+Undefines the hash. The XS equivalent of 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.
+See also L</hv_clear>.
=cut
*/
allocate an array for storing the effective name. We can skip that
during global destruction, as it does not matter where the CVs point
if they will be freed anyway. */
+ /* 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)
- (void)hv_delete(PL_stashcache, name, HvNAMELEN_get(hv), G_DISCARD);
+ (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);
}
hfreeentries(hv);
if (SvOOK(hv)) {
struct xpvhv_aux * const aux = HvAUX(hv);
struct mro_meta *meta;
- bool zeroed = FALSE;
if ((name = HvENAME_get(hv))) {
- if (PL_phase != PERL_PHASE_DESTRUCT) {
- /* This must come at this point in case
- mro_isa_changed_in dies. */
- Zero(HvARRAY(hv), xhv->xhv_max+1 /* HvMAX(hv)+1 */, HE*);
- zeroed = TRUE;
-
+ if (PL_phase != PERL_PHASE_DESTRUCT)
mro_isa_changed_in(hv);
- }
if (PL_stashcache)
(void)hv_delete(
- PL_stashcache, name, HvENAMELEN_get(hv), G_DISCARD
+ 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 ? (const char *)aux->xhv_name : name) {
+ if (flags & HV_NAME_SETALL ? !!aux->xhv_name_u.xhvnameu_name : !!name) {
if (name && PL_stashcache)
- (void)hv_delete(PL_stashcache, name, HvNAMELEN_get(hv), G_DISCARD);
+ (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)) {
SvREFCNT_dec(meta->mro_linear_current);
meta->mro_linear_current = NULL;
}
- if(meta->mro_nextmethod) SvREFCNT_dec(meta->mro_nextmethod);
+ SvREFCNT_dec(meta->mro_nextmethod);
SvREFCNT_dec(meta->isa);
Safefree(meta);
aux->xhv_mro_meta = NULL;
}
- if (!aux->xhv_name)
+ if (!aux->xhv_name_u.xhvnameu_name && ! aux->xhv_backreferences)
SvFLAGS(hv) &= ~SVf_OOK;
- else if (!zeroed)
- Zero(HvARRAY(hv), xhv->xhv_max+1 /* HvMAX(hv)+1 */, HE*);
}
if (!SvOOK(hv)) {
Safefree(HvARRAY(hv));
iter->xhv_riter = -1; /* HvRITER(hv) = -1 */
iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */
- iter->xhv_name = 0;
+ iter->xhv_name_u.xhvnameu_name = 0;
iter->xhv_name_count = 0;
iter->xhv_backreferences = 0;
iter->xhv_mro_meta = NULL;
=for apidoc hv_iterinit
Prepares a starting point to traverse a hash table. Returns the number of
-keys in the hash (i.e. the same as C<HvKEYS(hv)>). The return value is
+keys in the hash (i.e. the same as C<HvUSEDKEYS(hv)>). The return value is
currently only meaningful for hashes without tie magic.
NOTE: Before version 5.004_65, C<hv_iterinit> used to return the number of
HEK **spot;
PERL_ARGS_ASSERT_HV_NAME_SET;
- PERL_UNUSED_ARG(flags);
if (len > I32_MAX)
Perl_croak(aTHX_ "panic: hv name too long (%"UVuf")", (UV) len);
if (SvOOK(hv)) {
iter = HvAUX(hv);
- if (iter->xhv_name) {
+ if (iter->xhv_name_u.xhvnameu_name) {
if(iter->xhv_name_count) {
if(flags & HV_NAME_SETALL) {
- HEK ** const name = (HEK **)HvAUX(hv)->xhv_name;
+ HEK ** const name = HvAUX(hv)->xhv_name_u.xhvnameu_names;
HEK **hekp = name + (
iter->xhv_name_count < 0
? -iter->xhv_name_count
/* The first elem may be null. */
if(*name) unshare_hek_or_pvn(*name, 0, 0, 0);
Safefree(name);
- spot = &iter->xhv_name;
+ spot = &iter->xhv_name_u.xhvnameu_name;
iter->xhv_name_count = 0;
}
else {
if(iter->xhv_name_count > 0) {
/* shift some things over */
- Renewc(
- iter->xhv_name, iter->xhv_name_count + 1, HEK *, HEK
+ Renew(
+ iter->xhv_name_u.xhvnameu_names, iter->xhv_name_count + 1, HEK *
);
- spot = (HEK **)iter->xhv_name;
+ spot = iter->xhv_name_u.xhvnameu_names;
spot[iter->xhv_name_count] = spot[1];
spot[1] = spot[0];
iter->xhv_name_count = -(iter->xhv_name_count + 1);
}
- else if(*(spot = (HEK **)iter->xhv_name)) {
+ else if(*(spot = iter->xhv_name_u.xhvnameu_names)) {
unshare_hek_or_pvn(*spot, 0, 0, 0);
}
}
}
else if (flags & HV_NAME_SETALL) {
- unshare_hek_or_pvn(iter->xhv_name, 0, 0, 0);
- spot = &iter->xhv_name;
+ unshare_hek_or_pvn(iter->xhv_name_u.xhvnameu_name, 0, 0, 0);
+ spot = &iter->xhv_name_u.xhvnameu_name;
}
else {
- HEK * const existing_name = iter->xhv_name;
- Newxc(iter->xhv_name, 2, HEK *, HEK);
+ HEK * const existing_name = iter->xhv_name_u.xhvnameu_name;
+ Newx(iter->xhv_name_u.xhvnameu_names, 2, HEK *);
iter->xhv_name_count = -2;
- spot = (HEK **)iter->xhv_name;
+ spot = iter->xhv_name_u.xhvnameu_names;
spot[1] = existing_name;
}
}
- else { spot = &iter->xhv_name; iter->xhv_name_count = 0; }
+ else { spot = &iter->xhv_name_u.xhvnameu_name; iter->xhv_name_count = 0; }
} else {
if (name == 0)
return;
iter = hv_auxinit(hv);
- spot = &iter->xhv_name;
+ spot = &iter->xhv_name_u.xhvnameu_name;
}
PERL_HASH(hash, name, len);
- *spot = name ? share_hek(name, len, hash) : NULL;
+ *spot = name ? share_hek(name, flags & SVf_UTF8 ? -(I32)len : (I32)len, hash) : NULL;
+}
+
+/*
+This is basically sv_eq_flags() in sv.c, but we avoid the magic
+and bytes checking.
+*/
+
+STATIC I32
+hek_eq_pvn_flags(pTHX_ const HEK *hek, const char* pv, const I32 pvlen, const U32 flags) {
+ if ( (HEK_UTF8(hek) ? 1 : 0) != (flags & SVf_UTF8 ? 1 : 0) ) {
+ if (flags & SVf_UTF8)
+ return (bytes_cmp_utf8(
+ (const U8*)HEK_KEY(hek), HEK_LEN(hek),
+ (const U8*)pv, pvlen) == 0);
+ else
+ return (bytes_cmp_utf8(
+ (const U8*)pv, pvlen,
+ (const U8*)HEK_KEY(hek), HEK_LEN(hek)) == 0);
+ }
+ else
+ return HEK_LEN(hek) == pvlen && ((HEK_KEY(hek) == pv)
+ || memEQ(HEK_KEY(hek), pv, pvlen));
}
/*
*/
void
-Perl_hv_ename_add(pTHX_ HV *hv, const char *name, U32 len)
+Perl_hv_ename_add(pTHX_ HV *hv, const char *name, U32 len, U32 flags)
{
dVAR;
struct xpvhv_aux *aux = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv);
PERL_HASH(hash, name, len);
if (aux->xhv_name_count) {
- HEK ** const xhv_name = (HEK **)aux->xhv_name;
+ HEK ** const xhv_name = aux->xhv_name_u.xhvnameu_names;
I32 count = aux->xhv_name_count;
HEK **hekp = xhv_name + (count < 0 ? -count : count);
while (hekp-- > xhv_name)
if (
- HEK_LEN(*hekp) == (I32)len && memEQ(HEK_KEY(*hekp), name, len)
- ) {
+ (HEK_UTF8(*hekp) || (flags & SVf_UTF8))
+ ? hek_eq_pvn_flags(aTHX_ *hekp, name, (I32)len, flags)
+ : (HEK_LEN(*hekp) == (I32)len && memEQ(HEK_KEY(*hekp), name, len))
+ ) {
if (hekp == xhv_name && count < 0)
aux->xhv_name_count = -count;
return;
}
if (count < 0) aux->xhv_name_count--, count = -count;
else aux->xhv_name_count++;
- Renewc(aux->xhv_name, count + 1, HEK *, HEK);
- ((HEK **)aux->xhv_name)[count] = share_hek(name, len, hash);
+ Renew(aux->xhv_name_u.xhvnameu_names, count + 1, HEK *);
+ (aux->xhv_name_u.xhvnameu_names)[count] = share_hek(name, (flags & SVf_UTF8 ? -(I32)len : (I32)len), hash);
}
else {
- HEK *existing_name = aux->xhv_name;
+ HEK *existing_name = aux->xhv_name_u.xhvnameu_name;
if (
- existing_name && HEK_LEN(existing_name) == (I32)len
- && memEQ(HEK_KEY(existing_name), name, len)
+ existing_name && (
+ (HEK_UTF8(existing_name) || (flags & SVf_UTF8))
+ ? hek_eq_pvn_flags(aTHX_ existing_name, name, (I32)len, flags)
+ : (HEK_LEN(existing_name) == (I32)len && memEQ(HEK_KEY(existing_name), name, len))
+ )
) return;
- Newxc(aux->xhv_name, 2, HEK *, HEK);
+ Newx(aux->xhv_name_u.xhvnameu_names, 2, HEK *);
aux->xhv_name_count = existing_name ? 2 : -2;
- *(HEK **)aux->xhv_name = existing_name;
- ((HEK **)aux->xhv_name)[1] = share_hek(name, len, hash);
+ *aux->xhv_name_u.xhvnameu_names = existing_name;
+ (aux->xhv_name_u.xhvnameu_names)[1] = share_hek(name, (flags & SVf_UTF8 ? -(I32)len : (I32)len), hash);
}
}
*/
void
-Perl_hv_ename_delete(pTHX_ HV *hv, const char *name, U32 len)
+Perl_hv_ename_delete(pTHX_ HV *hv, const char *name, U32 len, U32 flags)
{
dVAR;
struct xpvhv_aux *aux;
if (!SvOOK(hv)) return;
aux = HvAUX(hv);
- if (!aux->xhv_name) return;
+ if (!aux->xhv_name_u.xhvnameu_name) return;
if (aux->xhv_name_count) {
- HEK ** const namep = (HEK **)aux->xhv_name;
+ HEK ** const namep = aux->xhv_name_u.xhvnameu_names;
I32 const count = aux->xhv_name_count;
HEK **victim = namep + (count < 0 ? -count : count);
while (victim-- > namep + 1)
if (
- HEK_LEN(*victim) == (I32)len
- && memEQ(HEK_KEY(*victim), name, len)
+ (HEK_UTF8(*victim) || (flags & SVf_UTF8))
+ ? hek_eq_pvn_flags(aTHX_ *victim, name, (I32)len, flags)
+ : (HEK_LEN(*victim) == (I32)len && memEQ(HEK_KEY(*victim), name, len))
) {
unshare_hek_or_pvn(*victim, 0, 0, 0);
if (count < 0) ++aux->xhv_name_count;
&& !*namep
) { /* if there are none left */
Safefree(namep);
- aux->xhv_name = NULL;
+ aux->xhv_name_u.xhvnameu_names = NULL;
aux->xhv_name_count = 0;
}
else {
return;
}
if (
- count > 0 && HEK_LEN(*namep) == (I32)len
- && memEQ(HEK_KEY(*namep),name,len)
+ count > 0 && (HEK_UTF8(*namep) || (flags & SVf_UTF8))
+ ? hek_eq_pvn_flags(aTHX_ *namep, name, (I32)len, flags)
+ : (HEK_LEN(*namep) == (I32)len && memEQ(HEK_KEY(*namep), name, len))
) {
aux->xhv_name_count = -count;
}
}
else if(
- HEK_LEN(aux->xhv_name) == (I32)len
- && memEQ(HEK_KEY(aux->xhv_name), name, len)
+ (HEK_UTF8(aux->xhv_name_u.xhvnameu_name) || (flags & SVf_UTF8))
+ ? hek_eq_pvn_flags(aTHX_ aux->xhv_name_u.xhvnameu_name, name, (I32)len, flags)
+ : (HEK_LEN(aux->xhv_name_u.xhvnameu_name) == (I32)len &&
+ memEQ(HEK_KEY(aux->xhv_name_u.xhvnameu_name), name, len))
) {
- const HEK * const namehek = aux->xhv_name;
- Newxc(aux->xhv_name, 1, HEK *, HEK);
- *(const HEK **)aux->xhv_name = namehek;
+ HEK * const namehek = aux->xhv_name_u.xhvnameu_name;
+ Newx(aux->xhv_name_u.xhvnameu_names, 1, HEK *);
+ *aux->xhv_name_u.xhvnameu_names = namehek;
aux->xhv_name_count = -1;
}
}
register XPVHV* xhv;
HE *entry;
register HE **oentry;
- HE **first;
bool is_utf8 = FALSE;
int k_flags = 0;
const char * const save = str;
} */
xhv = (XPVHV*)SvANY(PL_strtab);
/* assert(xhv_array != 0) */
- first = oentry = &(HvARRAY(PL_strtab))[hash & (I32) HvMAX(PL_strtab)];
+ oentry = &(HvARRAY(PL_strtab))[hash & (I32) HvMAX(PL_strtab)];
if (he) {
const HE *const he_he = &(he->shared_he_he);
for (entry = *oentry; entry; oentry = &HeNEXT(entry), entry = *oentry) {
/* If we found we were able to downgrade the string to bytes, then
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)
+ if (str != save) {
+ PERL_HASH(hash, str, len);
flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
+ }
}
return share_hek_flags (str, len, hash, flags);
xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */
if (!next) { /* initial entry? */
- } else if (xhv->xhv_keys > xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */) {
+ } else if (xhv->xhv_keys > xhv->xhv_max /* HvUSEDKEYS(hv) > HvMAX(hv) */) {
hsplit(PL_strtab);
}
}
struct refcounted_he *
Perl_refcounted_he_inc(pTHX_ struct refcounted_he *he)
{
+ dVAR;
if (he) {
HINTS_REFCNT_LOCK;
he->refcounted_he_refcnt++;
return he;
}
+/*
+=for apidoc cop_fetch_label
+
+Returns the label attached to a cop.
+The flags pointer may be set to C<SVf_UTF8> or 0.
+
+=cut
+*/
+
/* pp_entereval is aware that labels are stored with a key ':' at the top of
the linked list. */
const char *
-Perl_fetch_cop_label(pTHX_ COP *const cop, STRLEN *len, U32 *flags) {
+Perl_cop_fetch_label(pTHX_ COP *const cop, STRLEN *len, U32 *flags) {
struct refcounted_he *const chain = cop->cop_hints_hash;
- PERL_ARGS_ASSERT_FETCH_COP_LABEL;
+ PERL_ARGS_ASSERT_COP_FETCH_LABEL;
if (!chain)
return NULL;
return chain->refcounted_he_data + 1;
}
+/*
+=for apidoc cop_store_label
+
+Save a label into a C<cop_hints_hash>. You need to set flags to C<SVf_UTF8>
+for a utf-8 label.
+
+=cut
+*/
+
void
-Perl_store_cop_label(pTHX_ COP *const cop, const char *label, STRLEN len,
+Perl_cop_store_label(pTHX_ COP *const cop, const char *label, STRLEN len,
U32 flags)
{
SV *labelsv;
- PERL_ARGS_ASSERT_STORE_COP_LABEL;
+ PERL_ARGS_ASSERT_COP_STORE_LABEL;
if (flags & ~(SVf_UTF8))
- Perl_croak(aTHX_ "panic: store_cop_label illegal flag bits 0x%" UVxf,
+ Perl_croak(aTHX_ "panic: cop_store_label illegal flag bits 0x%" UVxf,
(UV)flags);
- labelsv = sv_2mortal(newSVpvn(label, len));
+ labelsv = newSVpvn_flags(label, len, SVs_TEMP);
if (flags & SVf_UTF8)
SvUTF8_on(labelsv);
cop->cop_hints_hash
https://perl5.git.perl.org / perl5.git / blobdiff