/* 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);
STATIC HE*
S_new_he(pTHX)
{
+ dVAR;
HE* he;
void ** const root = &PL_body_roots[HE_SVSLOT];
void
Perl_free_tied_hv_pool(pTHX)
{
+ dVAR;
HE *he = PL_hv_fetch_ent_mh;
while (he) {
HE * const ohe = he;
int masked_flags;
if (!hv)
- return 0;
+ return NULL;
if (keysv) {
if (flags & HVhek_FREEKEY)
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;
- AV *new_backrefs = NULL;
+ /* 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);
+
+ name = iter->xhv_name;
+ iter->xhv_name = NULL;
+ } else {
+ name = NULL;
+ }
- /* If there are weak references to this HV, we need to avoid freeing them
- up here.
- */
- if (iter) {
- 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. */
+ 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. */
+
+ 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);
+ } else {
+ sv_magic((SV*)hv, (SV*)iter->xhv_backreferences,
+ PERL_MAGIC_backref, NULL, 0);
+ }
+ iter->xhv_backreferences = NULL;
}
- iter->xhv_backreferences = 0;
- }
- }
- 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;
+ 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*) */
- HvFILL(hv) = 0;
- ((XPVHV*) SvANY(hv))->xhv_keys = 0;
+ /* There are now no allocated pointers in the aux structure. */
- entry = array[0];
- for (;;) {
- if (entry) {
- register HE * const oentry = entry;
- entry = HeNEXT(entry);
- hv_free_ent(hv, oentry);
+ SvFLAGS(hv) &= ~SVf_OOK; /* Goodbye, aux structure. */
+ /* What aux structure? */
}
- if (!entry) {
- if (++riter > max)
- break;
- entry = array[riter];
- }
- }
- if (SvOOK(hv)) {
- /* Someone attempted to iterate or set the hash name while we had
- the array set to 0. */
- assert(HvARRAY(hv));
-
- if(HvAUX(hv)->xhv_backreferences) {
- if (iter) {
- /* Erk. They caused the backreference AV to be put back
- into the hash aux structure */
- assert (!iter->xhv_backreferences);
- iter->xhv_backreferences = HvAUX(hv)->xhv_backreferences;
- } else {
- /* Erk. They created a backreference array when there was none
- before. */
- new_backrefs = HvAUX(hv)->xhv_backreferences;
+ /* 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 (HvAUX(hv)->xhv_name) {
- unshare_hek_or_pvn(HvAUX(hv)->xhv_name, 0, 0, 0);
+
+ if (!HvARRAY(hv)) {
+ /* Good. No-one added anything this time round. */
+ break;
}
- /* SvOOK_off calls sv_backoff, which isn't correct. */
- Safefree(HvARRAY(hv));
- HvARRAY(hv) = 0;
- SvFLAGS(hv) &= ~SVf_OOK;
- }
+ 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));
- /* 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 (HvAUX(hv)->xhv_name) {
+ unshare_hek_or_pvn(HvAUX(hv)->xhv_name, 0, 0, 0);
+ }
}
- iter->xhv_riter = -1; /* HvRITER(hv) = -1 */
- iter->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
- SvFLAGS(hv) |= SVf_OOK;
- }
- HvARRAY(hv) = array;
-
- if (new_backrefs) {
- /* Don't lose the backreferences array */
- *Perl_hv_backreferences_p(aTHX_ hv) = new_backrefs;
+ if (--attempts == 0) {
+ Perl_die(aTHX_ "panic: hfreeentries failed to free hash - something is repeatedly re-creating entries");
+ }
+ };
+
+ 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;
}
}
void
Perl_hv_undef(pTHX_ HV *hv)
{
+ dVAR;
register XPVHV* xhv;
const char *name;
void
Perl_hv_name_set(pTHX_ HV *hv, const char *name, I32 len, int flags)
{
+ dVAR;
struct xpvhv_aux *iter;
U32 hash;
STATIC void
S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
{
+ dVAR;
register XPVHV* xhv;
HE *entry;
register HE **oentry;
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;
const int flags_masked = flags & HVhek_MASK;
const U32 hindex = hash & (I32) HvMAX(PL_strtab);
projects / p5sagit/p5-mst-13.2.git / blobdiff