/* hv.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
+ * 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
STATIC void
S_more_he(pTHX)
{
+ dVAR;
HE* he;
HE* heend;
Newx(he, PERL_ARENA_SIZE/sizeof(HE), HE);
- HeNEXT(he) = PL_he_arenaroot;
- PL_he_arenaroot = he;
+ HeNEXT(he) = (HE*) PL_body_arenaroots[HE_SVSLOT];
+ PL_body_arenaroots[HE_SVSLOT] = he;
heend = &he[PERL_ARENA_SIZE / sizeof(HE) - 1];
- PL_he_root = ++he;
+ PL_body_roots[HE_SVSLOT] = ++he;
while (he < heend) {
HeNEXT(he) = (HE*)(he + 1);
he++;
STATIC HE*
S_new_he(pTHX)
{
+ dVAR;
HE* he;
+ void ** const root = &PL_body_roots[HE_SVSLOT];
+
LOCK_SV_MUTEX;
- if (!PL_he_root)
+ if (!*root)
S_more_he(aTHX);
- he = PL_he_root;
- PL_he_root = HeNEXT(he);
+ he = *root;
+ *root = HeNEXT(he);
UNLOCK_SV_MUTEX;
return he;
}
#define del_HE(p) \
STMT_START { \
LOCK_SV_MUTEX; \
- HeNEXT(p) = (HE*)PL_he_root; \
- PL_he_root = p; \
+ HeNEXT(p) = (HE*)(PL_body_roots[HE_SVSLOT]); \
+ PL_body_roots[HE_SVSLOT] = p; \
UNLOCK_SV_MUTEX; \
} STMT_END
void
Perl_free_tied_hv_pool(pTHX)
{
+ dVAR;
HE *he = PL_hv_fetch_ent_mh;
while (he) {
HE * const ohe = he;
return hek ? &HeVAL(hek) : NULL;
}
+/* XXX This looks like an ideal candidate to inline */
SV**
Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val,
register U32 hash, int flags)
=cut
*/
+/* XXX This looks like an ideal candidate to inline */
HE *
Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash)
{
flags = 0;
}
hek = hv_fetch_common (hv, NULL, key, klen, flags,
- HV_FETCH_JUST_SV | (lval ? HV_FETCH_LVALUE : 0),
+ lval ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE) : HV_FETCH_JUST_SV,
Nullsv, 0);
return hek ? &HeVAL(hek) : NULL;
}
=cut
*/
+/* XXX This looks like an ideal candidate to inline */
bool
Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
{
int masked_flags;
if (!hv)
- return 0;
+ return NULL;
if (keysv) {
if (flags & HVhek_FREEKEY)
if (isLOWER(key[i])) {
/* Would be nice if we had a routine to do the
copy and upercase in a single pass through. */
- const char *nkey = strupr(savepvn(key,klen));
+ const char * const nkey = strupr(savepvn(key,klen));
/* Note that this fetch is for nkey (the uppercased
key) whereas the store is for key (the original) */
entry = hv_fetch_common(hv, Nullsv, nkey, klen,
#endif
if (!entry && SvREADONLY(hv) && !(action & HV_FETCH_ISEXISTS)) {
- S_hv_notallowed(aTHX_ flags, key, klen,
+ hv_notallowed(flags, key, klen,
"Attempt to access disallowed key '%"SVf"' in"
" a restricted hash");
}
=cut
*/
+/* XXX This looks like an ideal candidate to inline */
SV *
Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
{
return Nullsv;
if (is_utf8) {
- const char *keysave = key;
+ const char * const keysave = key;
key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
if (is_utf8)
STATIC void
S_hsplit(pTHX_ HV *hv)
{
+ dVAR;
register XPVHV* xhv = (XPVHV*)SvANY(hv);
const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
register I32 newsize = oldsize * 2;
void
Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
{
+ dVAR;
register XPVHV* xhv = (XPVHV*)SvANY(hv);
const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
register I32 newsize;
void
Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
{
+ dVAR;
SV *val;
if (!entry)
void
Perl_hv_delayfree_ent(pTHX_ HV *hv, register HE *entry)
{
+ dVAR;
if (!entry)
return;
/* SvREFCNT_inc to counter the SvREFCNT_dec in hv_free_ent */
/* Loop down the linked list heads */
bool first = 1;
HE **oentry = &(HvARRAY(hv))[i];
- HE *entry = *oentry;
-
- if (!entry)
- continue;
+ HE *entry;
- for (; entry; entry = *oentry) {
+ while ((entry = *oentry)) {
if (HeVAL(entry) == &PL_sv_placeholder) {
*oentry = HeNEXT(entry);
if (first && !*oentry)
HvFILL(hv)--; /* This linked list is now empty. */
- if (HvEITER_get(hv))
+ if (entry == HvEITER_get(hv))
HvLAZYDEL_on(hv);
else
hv_free_ent(hv, entry);
STATIC void
S_hfreeentries(pTHX_ HV *hv)
{
- register HE **array;
- register HE *entry;
- I32 riter;
- I32 max;
- struct xpvhv_aux *iter;
+ /* This is the array that we're going to restore */
+ HE **orig_array;
+ HEK *name;
+ int attempts = 100;
if (!HvARRAY(hv))
return;
- iter = SvOOK(hv) ? HvAUX(hv) : 0;
+ if (SvOOK(hv)) {
+ /* If the hash is actually a symbol table with a name, look after the
+ name. */
+ struct xpvhv_aux *iter = HvAUX(hv);
- riter = 0;
- max = HvMAX(hv);
- array = HvARRAY(hv);
- /* 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(HE**);
- SvFLAGS(hv) &= ~SVf_OOK;
+ name = iter->xhv_name;
+ iter->xhv_name = NULL;
+ } else {
+ name = NULL;
+ }
- HvFILL(hv) = 0;
- ((XPVHV*) SvANY(hv))->xhv_keys = 0;
+ orig_array = HvARRAY(hv);
+ /* 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. */
- entry = array[0];
- for (;;) {
- if (entry) {
- register HE * const oentry = entry;
- entry = HeNEXT(entry);
- hv_free_ent(hv, oentry);
+ 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 **array = HvARRAY(hv);
+ I32 i = HvMAX(hv);
+
+ /* Because we have taken xhv_name out, the only allocated pointer
+ in the aux structure that might exist is the backreference array.
+ */
+
+ if (SvOOK(hv)) {
+ HE *entry;
+ struct xpvhv_aux *iter = HvAUX(hv);
+ /* If there are weak references to this HV, we need to avoid
+ freeing them up here. In particular we need to keep the AV
+ visible as what we're deleting might well have weak references
+ back to this HV, so the for loop below may well trigger
+ the removal of backreferences from this array. */
+
+ if (iter->xhv_backreferences) {
+ /* So donate them to regular backref magic to keep them safe.
+ 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((SV*)hv, (SV*)iter->xhv_backreferences,
+ PERL_MAGIC_backref, NULL, 0);
+ }
+ 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(HE*); /* HvEITER(hv) = Null(HE*) */
+
+ /* There are now no allocated pointers in the aux structure. */
+
+ SvFLAGS(hv) &= ~SVf_OOK; /* Goodbye, aux structure. */
+ /* What aux structure? */
}
- if (!entry) {
- if (++riter > max)
- break;
- entry = array[riter];
+
+ /* 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;
+
+
+ do {
+ /* Loop down the linked list heads */
+ HE *entry = array[i];
+
+ while (entry) {
+ register HE * const oentry = entry;
+ entry = HeNEXT(entry);
+ hv_free_ent(hv, oentry);
+ }
+ } while (--i >= 0);
+
+ /* 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);
}
- }
- if (SvOOK(hv)) {
- /* Someone attempted to iterate or set the hash name while we had
- the array set to 0. */
- assert(HvARRAY(hv));
+ if (!HvARRAY(hv)) {
+ /* Good. No-one added anything this time round. */
+ break;
+ }
- if (HvAUX(hv)->xhv_name)
- unshare_hek_or_pvn(HvAUX(hv)->xhv_name, 0, 0, 0);
- /* SvOOK_off calls sv_backoff, which isn't correct. */
+ if (SvOOK(hv)) {
+ /* Someone attempted to iterate or set the hash name while we had
+ the array set to 0. We'll catch backferences on the next time
+ round the while loop. */
+ assert(HvARRAY(hv));
- Safefree(HvARRAY(hv));
- HvARRAY(hv) = 0;
- SvFLAGS(hv) &= ~SVf_OOK;
- }
+ if (HvAUX(hv)->xhv_name) {
+ unshare_hek_or_pvn(HvAUX(hv)->xhv_name, 0, 0, 0);
+ }
+ }
- /* FIXME - things will still go horribly wrong (or at least leak) if
- people attempt to add elements to the hash while we're undef()ing it */
- if (iter) {
- entry = iter->xhv_eiter; /* HvEITER(hv) */
- if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */
- HvLAZYDEL_off(hv);
- hv_free_ent(hv, entry);
+ if (--attempts == 0) {
+ Perl_die(aTHX_ "panic: hfreeentries failed to free hash - something is repeatedly re-creating entries");
}
- iter->xhv_riter = -1; /* HvRITER(hv) = -1 */
- iter->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
+ };
+
+ HvARRAY(hv) = orig_array;
+
+ /* If the hash was actually a symbol table, put the name back. */
+ if (name) {
+ /* We have restored the original array. If name is non-NULL, then
+ the original array had an aux structure at the end. So this is
+ valid: */
SvFLAGS(hv) |= SVf_OOK;
+ HvAUX(hv)->xhv_name = name;
}
-
- HvARRAY(hv) = array;
}
/*
void
Perl_hv_undef(pTHX_ HV *hv)
{
+ dVAR;
register XPVHV* xhv;
const char *name;
+
if (!hv)
return;
DEBUG_A(Perl_hv_assert(aTHX_ hv));
iter->xhv_riter = -1; /* HvRITER(hv) = -1 */
iter->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
iter->xhv_name = 0;
-
+ iter->xhv_backreferences = 0;
return iter;
}
I32
Perl_hv_iterinit(pTHX_ HV *hv)
{
- HE *entry;
-
if (!hv)
Perl_croak(aTHX_ "Bad hash");
if (SvOOK(hv)) {
struct xpvhv_aux *iter = HvAUX(hv);
- entry = iter->xhv_eiter; /* HvEITER(hv) */
+ HE * const entry = iter->xhv_eiter; /* HvEITER(hv) */
if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */
HvLAZYDEL_off(hv);
hv_free_ent(hv, entry);
void
Perl_hv_name_set(pTHX_ HV *hv, const char *name, I32 len, int flags)
{
+ dVAR;
struct xpvhv_aux *iter;
U32 hash;
iter->xhv_name = name ? share_hek(name, len, hash) : 0;
}
+AV **
+Perl_hv_backreferences_p(pTHX_ HV *hv) {
+ struct xpvhv_aux *iter;
+
+ iter = SvOOK(hv) ? HvAUX(hv) : S_hv_auxinit(aTHX_ hv);
+ return &(iter->xhv_backreferences);
+}
+
+void
+Perl_hv_kill_backrefs(pTHX_ HV *hv) {
+ AV *av;
+
+ if (!SvOOK(hv))
+ return;
+
+ av = HvAUX(hv)->xhv_backreferences;
+
+ if (av) {
+ HvAUX(hv)->xhv_backreferences = 0;
+ Perl_sv_kill_backrefs(aTHX_ (SV*) hv, av);
+ }
+}
+
/*
hv_iternext is implemented as a macro in hv.h
oldentry = entry = iter->xhv_eiter; /* HvEITER(hv) */
if ((mg = SvTIED_mg((SV*)hv, PERL_MAGIC_tied))) {
- SV *key = sv_newmortal();
+ SV * const key = sv_newmortal();
if (entry) {
sv_setsv(key, HeSVKEY_force(entry));
SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */
{
if (HeKLEN(entry) == HEf_SVKEY) {
STRLEN len;
- char *p = SvPV(HeKEY_sv(entry), len);
+ char * const p = SvPV(HeKEY_sv(entry), len);
*retlen = len;
return p;
}
{
if (SvRMAGICAL(hv)) {
if (mg_find((SV*)hv, PERL_MAGIC_tied)) {
- SV* sv = sv_newmortal();
+ SV* const sv = sv_newmortal();
if (HeKLEN(entry) == HEf_SVKEY)
mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY);
else
SV *
Perl_hv_iternextsv(pTHX_ HV *hv, char **key, I32 *retlen)
{
- HE *he;
- if ( (he = hv_iternext_flags(hv, 0)) == NULL)
+ HE * const he = hv_iternext_flags(hv, 0);
+
+ if (!he)
return NULL;
*key = hv_iterkey(he, retlen);
return hv_iterval(hv, he);
STATIC void
S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
{
+ dVAR;
register XPVHV* xhv;
- register HE *entry;
+ HE *entry;
register HE **oentry;
HE **first;
bool found = 0;
bool is_utf8 = FALSE;
int k_flags = 0;
const char * const save = str;
- struct shared_he *he = 0;
+ struct shared_he *he = NULL;
if (hek) {
/* Find the shared he which is just before us in memory. */
STATIC HEK *
S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
{
+ dVAR;
register HE *entry;
- register HE **oentry;
- I32 found = 0;
const int flags_masked = flags & HVhek_MASK;
+ const U32 hindex = hash & (I32) HvMAX(PL_strtab);
/* what follows is the moral equivalent of:
register XPVHV * const xhv = (XPVHV*)SvANY(PL_strtab);
/* assert(xhv_array != 0) */
LOCK_STRTAB_MUTEX;
- oentry = &(HvARRAY(PL_strtab))[hash & (I32) HvMAX(PL_strtab)];
- for (entry = *oentry; entry; entry = HeNEXT(entry)) {
+ entry = (HvARRAY(PL_strtab))[hindex];
+ for (;entry; entry = HeNEXT(entry)) {
if (HeHASH(entry) != hash) /* strings can't be equal */
continue;
if (HeKLEN(entry) != len)
continue;
if (HeKFLAGS(entry) != flags_masked)
continue;
- found = 1;
break;
}
- if (!found) {
+
+ if (!entry) {
/* What used to be head of the list.
If this is NULL, then we're the first entry for this slot, which
means we need to increate fill. */
- const HE *old_first = *oentry;
struct shared_he *new_entry;
HEK *hek;
char *k;
+ HE **const head = &HvARRAY(PL_strtab)[hindex];
+ HE *const next = *head;
/* 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,
we're up to. */
HeKEY_hek(entry) = hek;
HeVAL(entry) = Nullsv;
- HeNEXT(entry) = *oentry;
- *oentry = entry;
+ HeNEXT(entry) = next;
+ *head = entry;
xhv->xhv_keys++; /* HvKEYS(hv)++ */
- if (!old_first) { /* initial entry? */
+ if (!next) { /* initial entry? */
xhv->xhv_fill++; /* HvFILL(hv)++ */
} else if (xhv->xhv_keys > (IV)xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */) {
hsplit(PL_strtab);
projects / p5sagit/p5-mst-13.2.git / blobdiff