/* hv.c
*
- * Copyright (c) 1991-2003, Larry Wall
+ * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ * 2000, 2001, 2002, 2003, 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.
return hek;
}
+/* free the pool of temporary HE/HEK pairs retunrned by hv_fetch_ent
+ * for tied hashes */
+
+void
+Perl_free_tied_hv_pool(pTHX)
+{
+ HE *ohe;
+ HE *he = PL_hv_fetch_ent_mh;
+ while (he) {
+ Safefree(HeKEY_hek(he));
+ ohe = he;
+ he = HeNEXT(he);
+ del_HE(ohe);
+ }
+}
+
#if defined(USE_ITHREADS)
HE *
Perl_he_dup(pTHX_ HE *e, bool shared, CLONE_PARAMS* param)
ptr_table_store(PL_ptr_table, e, ret);
HeNEXT(ret) = he_dup(HeNEXT(e),shared, param);
- if (HeKLEN(e) == HEf_SVKEY)
+ if (HeKLEN(e) == HEf_SVKEY) {
+ char *k;
+ New(54, k, HEK_BASESIZE + sizeof(SV*), char);
+ HeKEY_hek(ret) = (HEK*)k;
HeKEY_sv(ret) = SvREFCNT_inc(sv_dup(HeKEY_sv(e), param));
+ }
else if (shared)
HeKEY_hek(ret) = share_hek_flags(HeKEY(e), HeKLEN(e), HeHASH(e),
HeKFLAGS(e));
}
else {
/* Need to free saved eventually assign to mortal SV */
- SV *sv = sv_newmortal();
+ /* XXX is this line an error ???: SV *sv = sv_newmortal(); */
sv_usepvn(sv, (char *) key, klen);
}
if (flags & HVhek_UTF8) {
*/
if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
sv = sv_newmortal();
+ sv_upgrade(sv, SVt_PVLV);
mg_copy((SV*)hv, sv, key, klen);
if (flags & HVhek_FREEKEY)
Safefree(key);
- PL_hv_fetch_sv = sv;
- return &PL_hv_fetch_sv;
+ LvTYPE(sv) = 't';
+ LvTARG(sv) = sv; /* fake (SV**) */
+ return &(LvTARG(sv));
}
#ifdef ENV_IS_CASELESS
else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
/* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
for (; entry; entry = HeNEXT(entry)) {
+ if (!HeKEY_hek(entry))
+ continue;
if (HeHASH(entry) != hash) /* strings can't be equal */
continue;
if (HeKLEN(entry) != (I32)klen)
}
else
HeKFLAGS(entry) = flags;
+ if (flags)
+ HvHASKFLAGS_on(hv);
}
if (flags & HVhek_FREEKEY)
Safefree(key);
/* if we find a placeholder, we pretend we haven't found anything */
- if (HeVAL(entry) == &PL_sv_undef)
+ if (HeVAL(entry) == &PL_sv_placeholder)
break;
return &HeVAL(entry);
if (SvRMAGICAL(hv)) {
if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
sv = sv_newmortal();
- keysv = sv_2mortal(newSVsv(keysv));
+ keysv = newSVsv(keysv);
mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
- if (!HeKEY_hek(&PL_hv_fetch_ent_mh)) {
+ /* grab a fake HE/HEK pair from the pool or make a new one */
+ entry = PL_hv_fetch_ent_mh;
+ if (entry)
+ PL_hv_fetch_ent_mh = HeNEXT(entry);
+ else {
char *k;
+ entry = new_HE();
New(54, k, HEK_BASESIZE + sizeof(SV*), char);
- HeKEY_hek(&PL_hv_fetch_ent_mh) = (HEK*)k;
+ HeKEY_hek(entry) = (HEK*)k;
}
- HeSVKEY_set(&PL_hv_fetch_ent_mh, keysv);
- HeVAL(&PL_hv_fetch_ent_mh) = sv;
- return &PL_hv_fetch_ent_mh;
- }
+ HeNEXT(entry) = Nullhe;
+ HeSVKEY_set(entry, keysv);
+ HeVAL(entry) = sv;
+ sv_upgrade(sv, SVt_PVLV);
+ LvTYPE(sv) = 'T';
+ LvTARG(sv) = (SV*)entry; /* so we can free entry when freeing sv */
+ return entry;
+ }
#ifdef ENV_IS_CASELESS
else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
U32 i;
#endif
}
+ keysave = key = SvPV(keysv, klen);
xhv = (XPVHV*)SvANY(hv);
if (!xhv->xhv_array /* !HvARRAY(hv) */) {
if (lval
return 0;
}
- keysave = key = SvPV(keysv, klen);
is_utf8 = (SvUTF8(keysv)!=0);
if (is_utf8) {
}
else
HeKFLAGS(entry) = flags;
+ if (flags)
+ HvHASKFLAGS_on(hv);
}
if (key != keysave)
Safefree(key);
/* if we find a placeholder, we pretend we haven't found anything */
- if (HeVAL(entry) == &PL_sv_undef)
+ if (HeVAL(entry) == &PL_sv_placeholder)
break;
return entry;
}
continue;
if ((HeKFLAGS(entry) ^ flags) & HVhek_UTF8)
continue;
- if (HeVAL(entry) == &PL_sv_undef)
+ if (HeVAL(entry) == &PL_sv_placeholder)
xhv->xhv_placeholders--; /* yes, can store into placeholder slot */
else
SvREFCNT_dec(HeVAL(entry));
/* We have been requested to insert a placeholder. Currently
only Storable is allowed to do this. */
xhv->xhv_placeholders++;
- HeVAL(entry) = &PL_sv_undef;
+ HeVAL(entry) = &PL_sv_placeholder;
} else
HeVAL(entry) = val;
/* We have been requested to insert a placeholder. Currently
only Storable is allowed to do this. */
xhv->xhv_placeholders++;
- HeVAL(entry) = &PL_sv_undef;
+ HeVAL(entry) = &PL_sv_placeholder;
} else
HeVAL(entry) = val;
HeNEXT(entry) = *oentry;
xhv->xhv_keys++; /* HvKEYS(hv)++ */
if (i) { /* initial entry? */
xhv->xhv_fill++; /* HvFILL(hv)++ */
- if (xhv->xhv_keys > (IV)xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */)
- hsplit(hv);
+ } else if (xhv->xhv_keys > (IV)xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */) {
+ hsplit(hv);
}
return &HeVAL(entry);
continue;
if ((HeKFLAGS(entry) ^ flags) & HVhek_UTF8)
continue;
- if (HeVAL(entry) == &PL_sv_undef)
+ if (HeVAL(entry) == &PL_sv_placeholder)
xhv->xhv_placeholders--; /* yes, can store into placeholder slot */
else
SvREFCNT_dec(HeVAL(entry));
if (k_flags & HVhek_FREEKEY)
Safefree(key);
/* if placeholder is here, it's already been deleted.... */
- if (HeVAL(entry) == &PL_sv_undef)
+ if (HeVAL(entry) == &PL_sv_placeholder)
{
if (SvREADONLY(hv))
return Nullsv; /* if still SvREADONLY, leave it deleted. */
sv = Nullsv;
else {
sv = sv_2mortal(HeVAL(entry));
- HeVAL(entry) = &PL_sv_undef;
+ HeVAL(entry) = &PL_sv_placeholder;
}
/*
* an error.
*/
if (SvREADONLY(hv)) {
- HeVAL(entry) = &PL_sv_undef;
+ HeVAL(entry) = &PL_sv_placeholder;
/* We'll be saving this slot, so the number of allocated keys
* doesn't go down, but the number placeholders goes up */
xhv->xhv_placeholders++; /* HvPLACEHOLDERS(hv)++ */
Safefree(key);
/* if placeholder is here, it's already been deleted.... */
- if (HeVAL(entry) == &PL_sv_undef)
+ if (HeVAL(entry) == &PL_sv_placeholder)
{
if (SvREADONLY(hv))
return Nullsv; /* if still SvREADONLY, leave it deleted. */
sv = Nullsv;
else {
sv = sv_2mortal(HeVAL(entry));
- HeVAL(entry) = &PL_sv_undef;
+ HeVAL(entry) = &PL_sv_placeholder;
}
/*
* an error.
*/
if (SvREADONLY(hv)) {
- HeVAL(entry) = &PL_sv_undef;
+ HeVAL(entry) = &PL_sv_placeholder;
/* We'll be saving this slot, so the number of allocated keys
* doesn't go down, but the number placeholders goes up */
xhv->xhv_placeholders++; /* HvPLACEHOLDERS(hv)++ */
if (k_flags & HVhek_FREEKEY)
Safefree(key);
/* If we find the key, but the value is a placeholder, return false. */
- if (HeVAL(entry) == &PL_sv_undef)
+ if (HeVAL(entry) == &PL_sv_placeholder)
return FALSE;
return TRUE;
if (k_flags & HVhek_FREEKEY)
Safefree(key);
/* If we find the key, but the value is a placeholder, return false. */
- if (HeVAL(entry) == &PL_sv_undef)
+ if (HeVAL(entry) == &PL_sv_placeholder)
return FALSE;
return TRUE;
}
if (!hv)
return;
- if(SvREADONLY(hv)) {
- Perl_croak(aTHX_ "Attempt to clear a restricted hash");
+ xhv = (XPVHV*)SvANY(hv);
+
+ if (SvREADONLY(hv)) {
+ /* restricted hash: convert all keys to placeholders */
+ I32 i;
+ HE* entry;
+ for (i = 0; i <= (I32) xhv->xhv_max; i++) {
+ entry = ((HE**)xhv->xhv_array)[i];
+ for (; entry; entry = HeNEXT(entry)) {
+ /* not already placeholder */
+ if (HeVAL(entry) != &PL_sv_placeholder) {
+ if (HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
+ SV* keysv = hv_iterkeysv(entry);
+ Perl_croak(aTHX_
+ "Attempt to delete readonly key '%"SVf"' from a restricted hash",
+ keysv);
+ }
+ SvREFCNT_dec(HeVAL(entry));
+ HeVAL(entry) = &PL_sv_placeholder;
+ xhv->xhv_placeholders++; /* HvPLACEHOLDERS(hv)++ */
+ }
+ }
+ }
+ return;
}
- xhv = (XPVHV*)SvANY(hv);
hfreeentries(hv);
- xhv->xhv_fill = 0; /* HvFILL(hv) = 0 */
- xhv->xhv_keys = 0; /* HvKEYS(hv) = 0 */
xhv->xhv_placeholders = 0; /* HvPLACEHOLDERS(hv) = 0 */
if (xhv->xhv_array /* HvARRAY(hv) */)
(void)memzero(xhv->xhv_array /* HvARRAY(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**);
+ HvFILL(hv) = 0;
+ ((XPVHV*) SvANY(hv))->xhv_keys = 0;
+
entry = array[0];
for (;;) {
if (entry) {
entry = array[riter];
}
}
+ HvARRAY(hv) = array;
(void)hv_iterinit(hv);
}
hfreeentries(hv);
Safefree(xhv->xhv_array /* HvARRAY(hv) */);
if (HvNAME(hv)) {
- if(PL_stashcache)
- hv_delete_ent(PL_stashcache, sv_2mortal(newSVpv(HvNAME(hv),0)), G_DISCARD, 0);
+ if(PL_stashcache)
+ hv_delete(PL_stashcache, HvNAME(hv), strlen(HvNAME(hv)), G_DISCARD);
Safefree(HvNAME(hv));
HvNAME(hv) = 0;
}
xhv->xhv_max = 7; /* HvMAX(hv) = 7 (it's a normal hash) */
xhv->xhv_array = 0; /* HvARRAY(hv) = 0 */
- xhv->xhv_fill = 0; /* HvFILL(hv) = 0 */
- xhv->xhv_keys = 0; /* HvKEYS(hv) = 0 */
xhv->xhv_placeholders = 0; /* HvPLACEHOLDERS(hv) = 0 */
if (SvRMAGICAL(hv))
The C<flags> value will normally be zero; if HV_ITERNEXT_WANTPLACEHOLDERS is
set the placeholders keys (for restricted hashes) will be returned in addition
to normal keys. By default placeholders are automatically skipped over.
-Currently a placeholder is implemented with a value that is literally
-<&Perl_sv_undef> (a regular C<undef> value is a normal read-write SV for which
-C<!SvOK> is false). Note that the implementation of placeholders and
+Currently a placeholder is implemented with a value that is
+C<&Perl_sv_placeholder>. Note that the implementation of placeholders and
restricted hashes may change, and the implementation currently is
insufficiently abstracted for any change to be tidy.
* Skip past any placeholders -- don't want to include them in
* any iteration.
*/
- while (entry && HeVAL(entry) == &PL_sv_undef) {
+ while (entry && HeVAL(entry) == &PL_sv_placeholder) {
entry = HeNEXT(entry);
}
}
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_undef)
+ while (entry && HeVAL(entry) == &PL_sv_placeholder)
entry = HeNEXT(entry);
}
/* Will loop again if this linked list starts NULL
https://perl5.git.perl.org / perl5.git / blobdiff