HEK *
Perl_hek_dup(pTHX_ HEK *source, CLONE_PARAMS* param)
{
- HEK *shared = (HEK*)ptr_table_fetch(PL_ptr_table, source);
+ HEK *shared;
PERL_ARGS_ASSERT_HEK_DUP;
PERL_UNUSED_ARG(param);
+ if (!source)
+ return NULL;
+
+ shared = (HEK*)ptr_table_fetch(PL_ptr_table, source);
if (shared) {
/* We already shared this hash key. */
(void)share_hek_hek(shared);
char *k;
Newx(k, HEK_BASESIZE + sizeof(const SV *), char);
HeKEY_hek(ret) = (HEK*)k;
- HeKEY_sv(ret) = SvREFCNT_inc(sv_dup(HeKEY_sv(e), param));
+ HeKEY_sv(ret) = sv_dup_inc(HeKEY_sv(e), param);
}
else if (shared) {
/* This is hek_dup inlined, which seems to be important for speed
else
HeKEY_hek(ret) = save_hek_flags(HeKEY(e), HeKLEN(e), HeHASH(e),
HeKFLAGS(e));
- HeVAL(ret) = SvREFCNT_inc(sv_dup(HeVAL(e), param));
+ HeVAL(ret) = sv_dup_inc(HeVAL(e), param);
return ret;
}
#endif /* USE_ITHREADS */
if (flags & HVhek_FREEKEY)
Safefree(key);
key = SvPV_const(keysv, klen);
- flags = 0;
is_utf8 = (SvUTF8(keysv) != 0);
+ if (SvIsCOW_shared_hash(keysv)) {
+ flags = HVhek_KEYCANONICAL | (is_utf8 ? HVhek_UTF8 : 0);
+ } else {
+ flags = 0;
+ }
} else {
is_utf8 = ((flags & HVhek_UTF8) ? TRUE : FALSE);
}
}
}
- if (is_utf8) {
+ 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 (flags & HVhek_FREEKEY)
Safefree(keysave);
flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
+ /* If the caller calculated a hash, it was on the sequence of
+ octets that are the UTF-8 form. We've now changed the sequence
+ of octets stored to that of the equivalent byte representation,
+ so the hash we need is different. */
+ hash = 0;
}
}
xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */
if (!counter) { /* initial entry? */
- xhv->xhv_fill++; /* HvFILL(hv)++ */
- } else if (xhv->xhv_keys > (IV)xhv->xhv_max) {
+ } else if (xhv->xhv_keys > xhv->xhv_max) {
hsplit(hv);
} else if(!HvREHASH(hv)) {
U32 n_links = 1;
}
sv = sv_newmortal();
- if (HvFILL((const HV *)hv))
+ if (HvTOTALKEYS((const HV *)hv))
Perl_sv_setpvf(aTHX_ sv, "%ld/%ld",
(long)HvFILL(hv), (long)HvMAX(hv) + 1);
else
HvPLACEHOLDERS(hv)++;
} else {
*oentry = HeNEXT(entry);
- if(!*first_entry) {
- xhv->xhv_fill--; /* HvFILL(hv)-- */
- }
if (SvOOK(hv) && entry == HvAUX(hv)->xhv_eiter /* HvEITER(hv) */)
HvLAZYDEL_on(hv);
else
if ((HeHASH(entry) & newsize) != (U32)i) {
*oentry = HeNEXT(entry);
HeNEXT(entry) = *bep;
- if (!*bep)
- xhv->xhv_fill++; /* HvFILL(hv)++ */
*bep = entry;
right_length++;
continue;
left_length++;
}
}
- if (!*aep) /* everything moved */
- xhv->xhv_fill--; /* HvFILL(hv)-- */
/* 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. */
was_shared = HvSHAREKEYS(hv);
- xhv->xhv_fill = 0;
HvSHAREKEYS_off(hv);
HvREHASH_on(hv);
/* Copy oentry to the correct new chain. */
bep = ((HE**)a) + (hash & (I32) xhv->xhv_max);
- if (!*bep)
- xhv->xhv_fill++; /* HvFILL(hv)++ */
HeNEXT(entry) = *bep;
*bep = entry;
}
xhv->xhv_max = --newsize; /* HvMAX(hv) = --newsize */
HvARRAY(hv) = (HE **) a;
- if (!xhv->xhv_fill /* !HvFILL(hv) */) /* skip rest if no entries */
+ if (!xhv->xhv_keys /* !HvTOTALKEYS(hv) */) /* skip rest if no entries */
return;
aep = (HE**)a;
if (j != i) {
j -= i;
*oentry = HeNEXT(entry);
- if (!(HeNEXT(entry) = aep[j]))
- xhv->xhv_fill++; /* HvFILL(hv)++ */
+ HeNEXT(entry) = aep[j];
aep[j] = entry;
continue;
}
else
oentry = &HeNEXT(entry);
}
- if (!*aep) /* everything moved */
- xhv->xhv_fill--; /* HvFILL(hv)-- */
}
}
HV *
Perl_newHVhv(pTHX_ HV *ohv)
{
+ dVAR;
HV * const hv = newHV();
- STRLEN hv_max, hv_fill;
+ STRLEN hv_max;
- if (!ohv || (hv_fill = HvFILL(ohv)) == 0)
+ if (!ohv || !HvTOTALKEYS(ohv))
return hv;
hv_max = HvMAX(ohv);
const STRLEN len = HeKLEN(oent);
const int flags = HeKFLAGS(oent);
HE * const ent = new_HE();
+ SV *const val = HeVAL(oent);
- HeVAL(ent) = newSVsv(HeVAL(oent));
+ HeVAL(ent) = SvIMMORTAL(val) ? val : newSVsv(val);
HeKEY_hek(ent)
= shared ? share_hek_flags(key, len, hash, flags)
: save_hek_flags(key, len, hash, flags);
}
HvMAX(hv) = hv_max;
- HvFILL(hv) = hv_fill;
HvTOTALKEYS(hv) = HvTOTALKEYS(ohv);
HvARRAY(hv) = ents;
} /* not magical */
HE *entry;
const I32 riter = HvRITER_get(ohv);
HE * const eiter = HvEITER_get(ohv);
+ STRLEN hv_fill = HvFILL(ohv);
/* Can we use fewer buckets? (hv_max is always 2^n-1) */
while (hv_max && hv_max + 1 >= hv_fill * 2)
hv_iterinit(ohv);
while ((entry = hv_iternext_flags(ohv, 0))) {
+ SV *const val = HeVAL(entry);
(void)hv_store_flags(hv, HeKEY(entry), HeKLEN(entry),
- newSVsv(HeVAL(entry)), HeHASH(entry),
- HeKFLAGS(entry));
+ SvIMMORTAL(val) ? val : newSVsv(val),
+ HeHASH(entry), HeKFLAGS(entry));
}
HvRITER_set(ohv, riter);
HvEITER_set(ohv, eiter);
Perl_hv_copy_hints_hv(pTHX_ HV *const ohv)
{
HV * const hv = newHV();
- STRLEN hv_fill;
- if (ohv && (hv_fill = HvFILL(ohv))) {
+ if (ohv && HvTOTALKEYS(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);
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,
- (char *)newSVhek (HeKEY_hek(entry)), HEf_SVKEY);
+ (char *)heksv, HEf_SVKEY);
+ SvREFCNT_dec(heksv);
(void)hv_store_flags(hv, HeKEY(entry), HeKLEN(entry),
sv, HeHASH(entry), HeKFLAGS(entry));
}
if (!entry)
return;
val = HeVAL(entry);
- if (val && isGV(val) && isGV_with_GP(val) && GvCVu(val) && HvNAME_get(hv))
- mro_method_changed_in(hv); /* deletion of method from stash */
+ if (HvNAME(hv) && anonymise_cv(HvNAME_HEK(hv), val) && GvCVu(val))
+ mro_method_changed_in(hv);
SvREFCNT_dec(val);
if (HeKLEN(entry) == HEf_SVKEY) {
SvREFCNT_dec(HeKEY_sv(entry));
del_HE(entry);
}
+static I32
+S_anonymise_cv(pTHX_ HEK *stash, SV *val)
+{
+ CV *cv;
+
+ PERL_ARGS_ASSERT_ANONYMISE_CV;
+
+ if (val && isGV(val) && isGV_with_GP(val) && (cv = GvCV(val))) {
+ if ((SV *)CvGV(cv) == val) {
+ GV *anongv;
+
+ if (stash) {
+ SV *gvname = newSVhek(stash);
+ sv_catpvs(gvname, "::__ANON__");
+ anongv = gv_fetchsv(gvname, GV_ADDMULTI, SVt_PVCV);
+ SvREFCNT_dec(gvname);
+ } else {
+ anongv = gv_fetchpvs("__ANON__::__ANON__", GV_ADDMULTI,
+ SVt_PVCV);
+ }
+ CvGV(cv) = anongv;
+ CvANON_on(cv);
+ return 1;
+ }
+ }
+ return 0;
+}
+
void
Perl_hv_delayfree_ent(pTHX_ HV *hv, register HE *entry)
{
while ((entry = *oentry)) {
if (HeVAL(entry) == &PL_sv_placeholder) {
*oentry = HeNEXT(entry);
- if (first && !*oentry)
- HvFILL(hv)--; /* This linked list is now empty. */
if (entry == HvEITER_get(hv))
HvLAZYDEL_on(hv);
else
if (!orig_array)
return;
+ if (HvNAME(hv) && orig_array != NULL) {
+ /* symbol table: make all the contained subs ANON */
+ STRLEN i;
+ XPVHV *xhv = (XPVHV*)SvANY(hv);
+
+ for (i = 0; i <= xhv->xhv_max; i++) {
+ HE *entry = (HvARRAY(hv))[i];
+ for (; entry; entry = HeNEXT(entry)) {
+ SV *val = HeVAL(entry);
+ /* we need to put the subs in the __ANON__ symtable, as
+ * this one is being cleared. */
+ anonymise_cv(NULL, val);
+ }
+ }
+ }
+
if (SvOOK(hv)) {
/* If the hash is actually a symbol table with a name, look after the
name. */
iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */
if((meta = iter->xhv_mro_meta)) {
- if(meta->mro_linear_dfs) SvREFCNT_dec(meta->mro_linear_dfs);
- if(meta->mro_linear_c3) SvREFCNT_dec(meta->mro_linear_c3);
+ 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) {
+ /* Only the current MRO is stored, so this owns the data.
+ */
+ SvREFCNT_dec(meta->mro_linear_current);
+ meta->mro_linear_current = NULL;
+ }
if(meta->mro_nextmethod) SvREFCNT_dec(meta->mro_nextmethod);
SvREFCNT_dec(meta->isa);
Safefree(meta);
/* make everyone else think the array is empty, so that the destructors
* called for freed entries can't recusively mess with us */
HvARRAY(hv) = NULL;
- HvFILL(hv) = 0;
((XPVHV*) SvANY(hv))->xhv_keys = 0;
mg_clear(MUTABLE_SV(hv));
}
+/*
+=for apidoc hv_fill
+
+Returns the number of hash buckets that happen to be in use. This function is
+wrapped by the macro C<HvFILL>.
+
+Previously this value was stored in the HV structure, rather than being
+calculated on demand.
+
+=cut
+*/
+
+STRLEN
+Perl_hv_fill(pTHX_ HV const *const hv)
+{
+ STRLEN count = 0;
+ HE **ents = HvARRAY(hv);
+
+ PERL_ARGS_ASSERT_HV_FILL;
+
+ if (ents) {
+ HE *const *const last = ents + HvMAX(hv);
+ count = last + 1 - ents;
+
+ do {
+ if (!*ents)
+ --count;
+ } while (++ents <= last);
+ }
+ return count;
+}
+
static struct xpvhv_aux*
S_hv_auxinit(HV *hv) {
struct xpvhv_aux *iter;
HeSVKEY_set(entry, SvREFCNT_inc_simple_NN(key));
return entry; /* beware, hent_val is not set */
}
- if (HeVAL(entry))
- SvREFCNT_dec(HeVAL(entry));
+ SvREFCNT_dec(HeVAL(entry));
Safefree(HeKEY_hek(entry));
del_HE(entry);
iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */
}
}
}
- while (!entry) {
- /* OK. Come to the end of the current list. Grab the next one. */
- iter->xhv_riter++; /* HvRITER(hv)++ */
- if (iter->xhv_riter > (I32)xhv->xhv_max /* HvRITER(hv) > HvMAX(hv) */) {
- /* There is no next one. End of the hash. */
- iter->xhv_riter = -1; /* HvRITER(hv) = -1 */
- break;
- }
- entry = (HvARRAY(hv))[iter->xhv_riter];
+ /* Skip the entire loop if the hash is empty. */
+ if ((flags & HV_ITERNEXT_WANTPLACEHOLDERS)
+ ? HvTOTALKEYS(hv) : HvUSEDKEYS(hv)) {
+ while (!entry) {
+ /* OK. Come to the end of the current list. Grab the next one. */
- if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) {
- /* If we have an entry, but it's a placeholder, don't count it.
- Try the next. */
- while (entry && HeVAL(entry) == &PL_sv_placeholder)
- entry = HeNEXT(entry);
+ iter->xhv_riter++; /* HvRITER(hv)++ */
+ if (iter->xhv_riter > (I32)xhv->xhv_max /* HvRITER(hv) > HvMAX(hv) */) {
+ /* There is no next one. End of the hash. */
+ iter->xhv_riter = -1; /* HvRITER(hv) = -1 */
+ break;
+ }
+ entry = (HvARRAY(hv))[iter->xhv_riter];
+
+ if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) {
+ /* If we have an entry, but it's a placeholder, don't count it.
+ Try the next. */
+ while (entry && HeVAL(entry) == &PL_sv_placeholder)
+ entry = HeNEXT(entry);
+ }
+ /* Will loop again if this linked list starts NULL
+ (for HV_ITERNEXT_WANTPLACEHOLDERS)
+ or if we run through it and find only placeholders. */
}
- /* Will loop again if this linked list starts NULL
- (for HV_ITERNEXT_WANTPLACEHOLDERS)
- or if we run through it and find only placeholders. */
}
if (oldentry && HvLAZYDEL(hv)) { /* was deleted earlier? */
shared hek */
assert (he->shared_he_he.hent_hek == hek);
- LOCK_STRTAB_MUTEX;
if (he->shared_he_he.he_valu.hent_refcount - 1) {
--he->shared_he_he.he_valu.hent_refcount;
- UNLOCK_STRTAB_MUTEX;
return;
}
- UNLOCK_STRTAB_MUTEX;
hash = HEK_HASH(hek);
} else if (len < 0) {
} */
xhv = (XPVHV*)SvANY(PL_strtab);
/* assert(xhv_array != 0) */
- LOCK_STRTAB_MUTEX;
first = oentry = &(HvARRAY(PL_strtab))[hash & (I32) HvMAX(PL_strtab)];
if (he) {
const HE *const he_he = &(he->shared_he_he);
if (entry) {
if (--entry->he_valu.hent_refcount == 0) {
*oentry = HeNEXT(entry);
- if (!*first) {
- /* There are now no entries in our slot. */
- xhv->xhv_fill--; /* HvFILL(hv)-- */
- }
Safefree(entry);
xhv->xhv_keys--; /* HvTOTALKEYS(hv)-- */
}
}
- UNLOCK_STRTAB_MUTEX;
- if (!entry && ckWARN_d(WARN_INTERNAL))
- Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
- "Attempt to free non-existent shared string '%s'%s"
- pTHX__FORMAT,
- hek ? HEK_KEY(hek) : str,
- ((k_flags & HVhek_UTF8) ? " (utf8)" : "") pTHX__VALUE);
+ if (!entry)
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
+ "Attempt to free non-existent shared string '%s'%s"
+ pTHX__FORMAT,
+ hek ? HEK_KEY(hek) : str,
+ ((k_flags & HVhek_UTF8) ? " (utf8)" : "") pTHX__VALUE);
if (k_flags & HVhek_FREEKEY)
Safefree(str);
}
*/
/* assert(xhv_array != 0) */
- LOCK_STRTAB_MUTEX;
entry = (HvARRAY(PL_strtab))[hindex];
for (;entry; entry = HeNEXT(entry)) {
if (HeHASH(entry) != hash) /* strings can't be equal */
xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */
if (!next) { /* initial entry? */
- xhv->xhv_fill++; /* HvFILL(hv)++ */
- } else if (xhv->xhv_keys > (IV)xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */) {
+ } else if (xhv->xhv_keys > xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */) {
hsplit(PL_strtab);
}
}
++entry->he_valu.hent_refcount;
- UNLOCK_STRTAB_MUTEX;
if (flags & HVhek_FREEKEY)
Safefree(str);
/* Link it into the chain. */
HeNEXT(entry) = *oentry;
- if (!HeNEXT(entry)) {
- /* initial entry. */
- HvFILL(hv)++;
- }
*oentry = entry;
HvTOTALKEYS(hv)++;
}
}
+/* 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_ struct refcounted_he *const chain, STRLEN *len,
U32 *flags) {