#define PERL_IN_HV_C
#include "perl.h"
-
STATIC HE*
S_new_he(pTHX)
{
#if defined(USE_ITHREADS)
HE *
-Perl_he_dup(pTHX_ HE *e, bool shared)
+Perl_he_dup(pTHX_ HE *e, bool shared, CLONE_PARAMS* param)
{
HE *ret;
ret = new_HE();
ptr_table_store(PL_ptr_table, e, ret);
- HeNEXT(ret) = he_dup(HeNEXT(e),shared);
+ HeNEXT(ret) = he_dup(HeNEXT(e),shared, param);
if (HeKLEN(e) == HEf_SVKEY)
- HeKEY_sv(ret) = SvREFCNT_inc(sv_dup(HeKEY_sv(e)));
+ HeKEY_sv(ret) = SvREFCNT_inc(sv_dup(HeKEY_sv(e), param));
else if (shared)
HeKEY_hek(ret) = share_hek(HeKEY(e), HeKLEN_UTF8(e), HeHASH(e));
else
HeKEY_hek(ret) = save_hek(HeKEY(e), HeKLEN_UTF8(e), HeHASH(e));
- HeVAL(ret) = SvREFCNT_inc(sv_dup(HeVAL(e)));
+ HeVAL(ret) = SvREFCNT_inc(sv_dup(HeVAL(e), param));
return ret;
}
#endif /* USE_ITHREADS */
+static void
+Perl_hv_notallowed(pTHX_ bool is_utf8, const char *key, I32 klen,
+ const char *keysave)
+{
+ SV *sv = sv_newmortal();
+ if (key == keysave) {
+ sv_setpvn(sv, key, klen);
+ }
+ else {
+ /* Need to free saved eventually assign to mortal SV */
+ SV *sv = sv_newmortal();
+ sv_usepvn(sv, (char *) key, klen);
+ }
+ if (is_utf8) {
+ SvUTF8_on(sv);
+ }
+ Perl_croak(aTHX_ "Attempt to access to key '%_' in fixed hash",sv);
+}
+
/* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot
* contains an SV* */
Returns the SV which corresponds to the specified key in the hash. The
C<klen> is the length of the key. If C<lval> is set then the fetch will be
part of a store. Check that the return value is non-null before
-dereferencing it to a C<SV*>.
+dereferencing it to an C<SV*>.
See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
information on how to use this function on tied hashes.
#endif
}
+ /* We use xhv->xhv_foo fields directly instead of HvFOO(hv) to
+ avoid unnecessary pointer dereferencing. */
xhv = (XPVHV*)SvANY(hv);
- if (!xhv->xhv_array) {
+ if (!xhv->xhv_array /* !HvARRAY(hv) */) {
if (lval
#ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */
- || mg_find((SV*)hv, PERL_MAGIC_env)
+ || (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env))
#endif
)
- Newz(503, xhv->xhv_array,
- PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
+ Newz(503, xhv->xhv_array /* HvARRAY(hv) */,
+ PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
+ char);
else
return 0;
}
- if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT)) {
+ if (is_utf8) {
STRLEN tmplen = klen;
/* Just casting the &klen to (STRLEN) won't work well
* if STRLEN and I32 are of different widths. --jhi */
PERL_HASH(hash, key, klen);
+ /* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
for (; entry; entry = HeNEXT(entry)) {
if (HeHASH(entry) != hash) /* strings can't be equal */
return &HeVAL(entry);
}
#ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */
- if (mg_find((SV*)hv, PERL_MAGIC_env)) {
+ if (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
unsigned long len;
char *env = PerlEnv_ENVgetenv_len(key,&len);
if (env) {
}
}
#endif
+ if (SvREADONLY(hv)) {
+ Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
+ }
if (lval) { /* gonna assign to this, so it better be there */
sv = NEWSV(61,0);
if (key != keysave) { /* must be is_utf8 == 0 */
return 0;
}
-/* returns a HE * structure with the all fields set */
+/* returns an HE * structure with the all fields set */
/* note that hent_val will be a mortal sv for MAGICAL hashes */
/*
=for apidoc hv_fetch_ent
}
xhv = (XPVHV*)SvANY(hv);
- if (!xhv->xhv_array) {
+ if (!xhv->xhv_array /* !HvARRAY(hv) */) {
if (lval
#ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */
- || mg_find((SV*)hv, PERL_MAGIC_env)
+ || (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env))
#endif
)
- Newz(503, xhv->xhv_array,
- PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
+ Newz(503, xhv->xhv_array /* HvARRAY(hv) */,
+ PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
+ char);
else
return 0;
}
keysave = key = SvPV(keysv, klen);
is_utf8 = (SvUTF8(keysv)!=0);
- if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT))
+ if (is_utf8)
key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
if (!hash)
PERL_HASH(hash, key, klen);
+ /* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
for (; entry; entry = HeNEXT(entry)) {
if (HeHASH(entry) != hash) /* strings can't be equal */
return entry;
}
#ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */
- if (mg_find((SV*)hv, PERL_MAGIC_env)) {
+ if (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
unsigned long len;
char *env = PerlEnv_ENVgetenv_len(key,&len);
if (env) {
}
}
#endif
+ if (SvREADONLY(hv)) {
+ Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
+ }
if (key != keysave)
Safefree(key);
if (lval) { /* gonna assign to this, so it better be there */
hv_magic_check (hv, &needs_copy, &needs_store);
if (needs_copy) {
mg_copy((SV*)hv, val, key, klen);
- if (!xhv->xhv_array && !needs_store)
+ if (!xhv->xhv_array /* !HvARRAY */ && !needs_store)
return 0;
#ifdef ENV_IS_CASELESS
else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
key = savepvn(key,klen);
- key = strupr(key);
+ key = (const char*)strupr((char*)key);
hash = 0;
}
#endif
}
}
- if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT)) {
+ if (is_utf8) {
STRLEN tmplen = klen;
/* See the note in hv_fetch(). --jhi */
key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
if (!hash)
PERL_HASH(hash, key, klen);
- if (!xhv->xhv_array)
- Newz(505, xhv->xhv_array,
- PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
+ if (!xhv->xhv_array /* !HvARRAY(hv) */)
+ Newz(505, xhv->xhv_array /* HvARRAY(hv) */,
+ PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
+ char);
+ /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
i = 1;
return &HeVAL(entry);
}
+ if (SvREADONLY(hv)) {
+ Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
+ }
+
entry = new_HE();
if (HvSHAREKEYS(hv))
HeKEY_hek(entry) = share_hek(key, is_utf8?-klen:klen, hash);
HeNEXT(entry) = *oentry;
*oentry = entry;
- xhv->xhv_keys++;
+ xhv->xhv_keys++; /* HvKEYS(hv)++ */
if (i) { /* initial entry? */
- ++xhv->xhv_fill;
- if (xhv->xhv_keys > xhv->xhv_max)
+ xhv->xhv_fill++; /* HvFILL(hv)++ */
+ if (xhv->xhv_keys > xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */)
hsplit(hv);
}
keysv = sv_2mortal(newSVsv(keysv));
mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
TAINT_IF(save_taint);
- if (!xhv->xhv_array && !needs_store)
+ if (!xhv->xhv_array /* !HvARRAY(hv) */ && !needs_store)
return Nullhe;
#ifdef ENV_IS_CASELESS
else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
keysave = key = SvPV(keysv, klen);
is_utf8 = (SvUTF8(keysv) != 0);
- if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT))
+ if (is_utf8)
key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
if (!hash)
PERL_HASH(hash, key, klen);
- if (!xhv->xhv_array)
- Newz(505, xhv->xhv_array,
- PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
+ if (!xhv->xhv_array /* !HvARRAY(hv) */)
+ Newz(505, xhv->xhv_array /* HvARRAY(hv) */,
+ PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
+ char);
+ /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
i = 1;
return entry;
}
+ if (SvREADONLY(hv)) {
+ Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
+ }
+
entry = new_HE();
if (HvSHAREKEYS(hv))
- HeKEY_hek(entry) = share_hek(key, is_utf8?-klen:klen, hash);
+ HeKEY_hek(entry) = share_hek(key, is_utf8?-(I32)klen:klen, hash);
else /* gotta do the real thing */
- HeKEY_hek(entry) = save_hek(key, is_utf8?-klen:klen, hash);
+ HeKEY_hek(entry) = save_hek(key, is_utf8?-(I32)klen:klen, hash);
if (key != keysave)
Safefree(key);
HeVAL(entry) = val;
HeNEXT(entry) = *oentry;
*oentry = entry;
- xhv->xhv_keys++;
+ xhv->xhv_keys++; /* HvKEYS(hv)++ */
if (i) { /* initial entry? */
- ++xhv->xhv_fill;
- if (xhv->xhv_keys > xhv->xhv_max)
+ xhv->xhv_fill++; /* HvFILL(hv)++ */
+ if (xhv->xhv_keys > xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */)
hsplit(hv);
}
}
}
xhv = (XPVHV*)SvANY(hv);
- if (!xhv->xhv_array)
+ if (!xhv->xhv_array /* !HvARRAY(hv) */)
return Nullsv;
- if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT)) {
+ if (is_utf8) {
STRLEN tmplen = klen;
/* See the note in hv_fetch(). --jhi */
key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
klen = tmplen;
}
+ if (SvREADONLY(hv)) {
+ Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
+ }
+
PERL_HASH(hash, key, klen);
+ /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
entry = *oentry;
i = 1;
Safefree(key);
*oentry = HeNEXT(entry);
if (i && !*oentry)
- xhv->xhv_fill--;
+ xhv->xhv_fill--; /* HvFILL(hv)-- */
if (flags & G_DISCARD)
sv = Nullsv;
else {
sv = sv_2mortal(HeVAL(entry));
HeVAL(entry) = &PL_sv_undef;
}
- if (entry == xhv->xhv_eiter)
+ if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
HvLAZYDEL_on(hv);
else
hv_free_ent(hv, entry);
- --xhv->xhv_keys;
+ xhv->xhv_keys--; /* HvKEYS(hv)-- */
return sv;
}
if (key != keysave)
}
}
xhv = (XPVHV*)SvANY(hv);
- if (!xhv->xhv_array)
+ if (!xhv->xhv_array /* !HvARRAY(hv) */)
return Nullsv;
keysave = key = SvPV(keysv, klen);
is_utf8 = (SvUTF8(keysv) != 0);
- if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT))
+ if (is_utf8)
key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
+ if (SvREADONLY(hv)) {
+ Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
+ }
+
if (!hash)
PERL_HASH(hash, key, klen);
+ /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
entry = *oentry;
i = 1;
Safefree(key);
*oentry = HeNEXT(entry);
if (i && !*oentry)
- xhv->xhv_fill--;
+ xhv->xhv_fill--; /* HvFILL(hv)-- */
if (flags & G_DISCARD)
sv = Nullsv;
else {
sv = sv_2mortal(HeVAL(entry));
HeVAL(entry) = &PL_sv_undef;
}
- if (entry == xhv->xhv_eiter)
+ if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
HvLAZYDEL_on(hv);
else
hv_free_ent(hv, entry);
- --xhv->xhv_keys;
+ xhv->xhv_keys--; /* HvKEYS(hv)-- */
return sv;
}
if (key != keysave)
xhv = (XPVHV*)SvANY(hv);
#ifndef DYNAMIC_ENV_FETCH
- if (!xhv->xhv_array)
+ if (!xhv->xhv_array /* !HvARRAY(hv) */)
return 0;
#endif
- if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT)) {
+ if (is_utf8) {
STRLEN tmplen = klen;
/* See the note in hv_fetch(). --jhi */
key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
PERL_HASH(hash, key, klen);
#ifdef DYNAMIC_ENV_FETCH
- if (!xhv->xhv_array) entry = Null(HE*);
+ if (!xhv->xhv_array /* !HvARRAY(hv) */) entry = Null(HE*);
else
#endif
+ /* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
for (; entry; entry = HeNEXT(entry)) {
if (HeHASH(entry) != hash) /* strings can't be equal */
return TRUE;
}
#ifdef DYNAMIC_ENV_FETCH /* is it out there? */
- if (mg_find((SV*)hv, PERL_MAGIC_env)) {
+ if (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
unsigned long len;
char *env = PerlEnv_ENVgetenv_len(key,&len);
if (env) {
xhv = (XPVHV*)SvANY(hv);
#ifndef DYNAMIC_ENV_FETCH
- if (!xhv->xhv_array)
+ if (!xhv->xhv_array /* !HvARRAY(hv) */)
return 0;
#endif
keysave = key = SvPV(keysv, klen);
is_utf8 = (SvUTF8(keysv) != 0);
- if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT))
+ if (is_utf8)
key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
if (!hash)
PERL_HASH(hash, key, klen);
#ifdef DYNAMIC_ENV_FETCH
- if (!xhv->xhv_array) entry = Null(HE*);
+ if (!xhv->xhv_array /* !HvARRAY(hv) */) entry = Null(HE*);
else
#endif
+ /* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
for (; entry; entry = HeNEXT(entry)) {
if (HeHASH(entry) != hash) /* strings can't be equal */
return TRUE;
}
#ifdef DYNAMIC_ENV_FETCH /* is it out there? */
- if (mg_find((SV*)hv, PERL_MAGIC_env)) {
+ if (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
unsigned long len;
char *env = PerlEnv_ENVgetenv_len(key,&len);
if (env) {
S_hsplit(pTHX_ HV *hv)
{
register XPVHV* xhv = (XPVHV*)SvANY(hv);
- I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
+ I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
register I32 newsize = oldsize * 2;
register I32 i;
- register char *a = xhv->xhv_array;
+ register char *a = xhv->xhv_array; /* HvARRAY(hv) */
register HE **aep;
register HE **bep;
register HE *entry;
PL_nomemok = FALSE;
return;
}
- Copy(xhv->xhv_array, a, oldsize * sizeof(HE*), char);
+ Copy(xhv->xhv_array /* HvARRAY(hv) */, a, oldsize * sizeof(HE*), char);
if (oldsize >= 64) {
- offer_nice_chunk(xhv->xhv_array, PERL_HV_ARRAY_ALLOC_BYTES(oldsize));
+ offer_nice_chunk(xhv->xhv_array /* HvARRAY(hv) */,
+ PERL_HV_ARRAY_ALLOC_BYTES(oldsize));
}
else
- Safefree(xhv->xhv_array);
+ Safefree(xhv->xhv_array /* HvARRAY(hv) */);
#endif
PL_nomemok = FALSE;
Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/
- xhv->xhv_max = --newsize;
- xhv->xhv_array = a;
+ xhv->xhv_max = --newsize; /* HvMAX(hv) = --newsize */
+ xhv->xhv_array = a; /* HvARRAY(hv) = a */
aep = (HE**)a;
for (i=0; i<oldsize; i++,aep++) {
*oentry = HeNEXT(entry);
HeNEXT(entry) = *bep;
if (!*bep)
- xhv->xhv_fill++;
+ xhv->xhv_fill++; /* HvFILL(hv)++ */
*bep = entry;
continue;
}
oentry = &HeNEXT(entry);
}
if (!*aep) /* everything moved */
- xhv->xhv_fill--;
+ xhv->xhv_fill--; /* HvFILL(hv)-- */
}
}
Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
{
register XPVHV* xhv = (XPVHV*)SvANY(hv);
- I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
+ I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
register I32 newsize;
register I32 i;
register I32 j;
if (newsize < newmax)
return; /* overflow detection */
- a = xhv->xhv_array;
+ a = xhv->xhv_array; /* HvARRAY(hv) */
if (a) {
PL_nomemok = TRUE;
#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
PL_nomemok = FALSE;
return;
}
- Copy(xhv->xhv_array, a, oldsize * sizeof(HE*), char);
+ Copy(xhv->xhv_array /* HvARRAY(hv) */, a, oldsize * sizeof(HE*), char);
if (oldsize >= 64) {
- offer_nice_chunk(xhv->xhv_array, PERL_HV_ARRAY_ALLOC_BYTES(oldsize));
+ offer_nice_chunk(xhv->xhv_array /* HvARRAY(hv) */,
+ PERL_HV_ARRAY_ALLOC_BYTES(oldsize));
}
else
- Safefree(xhv->xhv_array);
+ Safefree(xhv->xhv_array /* HvARRAY(hv) */);
#endif
PL_nomemok = FALSE;
Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/
else {
Newz(0, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
}
- xhv->xhv_max = --newsize;
- xhv->xhv_array = a;
- if (!xhv->xhv_fill) /* skip rest if no entries */
+ xhv->xhv_max = --newsize; /* HvMAX(hv) = --newsize */
+ xhv->xhv_array = a; /* HvARRAY(hv) = a */
+ if (!xhv->xhv_fill /* !HvFILL(hv) */) /* skip rest if no entries */
return;
aep = (HE**)a;
j -= i;
*oentry = HeNEXT(entry);
if (!(HeNEXT(entry) = aep[j]))
- xhv->xhv_fill++;
+ xhv->xhv_fill++; /* HvFILL(hv)++ */
aep[j] = entry;
continue;
}
oentry = &HeNEXT(entry);
}
if (!*aep) /* everything moved */
- xhv->xhv_fill--;
+ xhv->xhv_fill--; /* HvFILL(hv)-- */
}
}
#ifndef NODEFAULT_SHAREKEYS
HvSHAREKEYS_on(hv); /* key-sharing on by default */
#endif
- xhv->xhv_max = 7; /* start with 8 buckets */
- xhv->xhv_fill = 0;
- xhv->xhv_pmroot = 0;
+ xhv->xhv_max = 7; /* HvMAX(hv) = 7 (start with 8 buckets) */
+ xhv->xhv_fill = 0; /* HvFILL(hv) = 0 */
+ xhv->xhv_pmroot = 0; /* HvPMROOT(hv) = 0 */
(void)hv_iterinit(hv); /* so each() will start off right */
return hv;
}
HV *
Perl_newHVhv(pTHX_ HV *ohv)
{
- register HV *hv;
- STRLEN hv_max = ohv ? HvMAX(ohv) : 0;
- STRLEN hv_fill = ohv ? HvFILL(ohv) : 0;
-
- hv = newHV();
- while (hv_max && hv_max + 1 >= hv_fill * 2)
- hv_max = hv_max / 2; /* Is always 2^n-1 */
- HvMAX(hv) = hv_max;
- if (!hv_fill)
+ HV *hv = newHV();
+ STRLEN hv_max, hv_fill;
+
+ if (!ohv || (hv_fill = HvFILL(ohv)) == 0)
return hv;
+ hv_max = HvMAX(ohv);
+
+ if (!SvMAGICAL((SV *)ohv)) {
+ /* It's an ordinary hash, so copy it fast. AMS 20010804 */
+ int i, shared = !!HvSHAREKEYS(ohv);
+ HE **ents, **oents = (HE **)HvARRAY(ohv);
+ char *a;
+ New(0, a, PERL_HV_ARRAY_ALLOC_BYTES(hv_max+1), char);
+ ents = (HE**)a;
+
+ /* In each bucket... */
+ for (i = 0; i <= hv_max; i++) {
+ HE *prev = NULL, *ent = NULL, *oent = oents[i];
+
+ if (!oent) {
+ ents[i] = NULL;
+ continue;
+ }
-#if 0
- if (! SvTIED_mg((SV*)ohv, PERL_MAGIC_tied)) {
- /* Quick way ???*/
+ /* Copy the linked list of entries. */
+ for (oent = oents[i]; oent; oent = HeNEXT(oent)) {
+ U32 hash = HeHASH(oent);
+ char *key = HeKEY(oent);
+ STRLEN len = HeKLEN_UTF8(oent);
+
+ ent = new_HE();
+ HeVAL(ent) = newSVsv(HeVAL(oent));
+ HeKEY_hek(ent) = shared ? share_hek(key, len, hash)
+ : save_hek(key, len, hash);
+ if (prev)
+ HeNEXT(prev) = ent;
+ else
+ ents[i] = ent;
+ prev = ent;
+ HeNEXT(ent) = NULL;
+ }
+ }
+
+ HvMAX(hv) = hv_max;
+ HvFILL(hv) = hv_fill;
+ HvKEYS(hv) = HvKEYS(ohv);
+ HvARRAY(hv) = ents;
}
- else
-#endif
- {
+ else {
+ /* Iterate over ohv, copying keys and values one at a time. */
HE *entry;
- I32 hv_riter = HvRITER(ohv); /* current root of iterator */
- HE *hv_eiter = HvEITER(ohv); /* current entry of iterator */
-
- /* Slow way */
+ I32 riter = HvRITER(ohv);
+ HE *eiter = HvEITER(ohv);
+
+ /* Can we use fewer buckets? (hv_max is always 2^n-1) */
+ while (hv_max && hv_max + 1 >= hv_fill * 2)
+ hv_max = hv_max / 2;
+ HvMAX(hv) = hv_max;
+
hv_iterinit(ohv);
while ((entry = hv_iternext(ohv))) {
hv_store(hv, HeKEY(entry), HeKLEN_UTF8(entry),
newSVsv(HeVAL(entry)), HeHASH(entry));
}
- HvRITER(ohv) = hv_riter;
- HvEITER(ohv) = hv_eiter;
+ HvRITER(ohv) = riter;
+ HvEITER(ohv) = eiter;
}
return hv;
return;
xhv = (XPVHV*)SvANY(hv);
hfreeentries(hv);
- xhv->xhv_fill = 0;
- xhv->xhv_keys = 0;
- if (xhv->xhv_array)
- (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*));
+ xhv->xhv_fill = 0; /* HvFILL(hv) = 0 */
+ xhv->xhv_keys = 0; /* HvKEYS(hv) = 0 */
+ if (xhv->xhv_array /* HvARRAY(hv) */)
+ (void)memzero(xhv->xhv_array /* HvARRAY(hv) */,
+ (xhv->xhv_max+1 /* HvMAX(hv)+1 */) * sizeof(HE*));
if (SvRMAGICAL(hv))
mg_clear((SV*)hv);
return;
xhv = (XPVHV*)SvANY(hv);
hfreeentries(hv);
- Safefree(xhv->xhv_array);
+ Safefree(xhv->xhv_array /* HvARRAY(hv) */);
if (HvNAME(hv)) {
Safefree(HvNAME(hv));
HvNAME(hv) = 0;
}
- xhv->xhv_array = 0;
- xhv->xhv_max = 7; /* it's a normal hash */
- xhv->xhv_fill = 0;
- xhv->xhv_keys = 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 */
if (SvRMAGICAL(hv))
mg_clear((SV*)hv);
if (!hv)
Perl_croak(aTHX_ "Bad hash");
xhv = (XPVHV*)SvANY(hv);
- entry = xhv->xhv_eiter;
+ entry = xhv->xhv_eiter; /* HvEITER(hv) */
if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */
HvLAZYDEL_off(hv);
hv_free_ent(hv, entry);
}
- xhv->xhv_riter = -1;
- xhv->xhv_eiter = Null(HE*);
- return xhv->xhv_keys; /* used to be xhv->xhv_fill before 5.004_65 */
+ xhv->xhv_riter = -1; /* HvRITER(hv) = -1 */
+ xhv->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
+ /* used to be xhv->xhv_fill before 5.004_65 */
+ return xhv->xhv_keys; /* HvKEYS(hv) */
}
/*
if (!hv)
Perl_croak(aTHX_ "Bad hash");
xhv = (XPVHV*)SvANY(hv);
- oldentry = entry = xhv->xhv_eiter;
+ oldentry = entry = xhv->xhv_eiter; /* HvEITER(hv) */
if ((mg = SvTIED_mg((SV*)hv, PERL_MAGIC_tied))) {
SV *key = sv_newmortal();
char *k;
HEK *hek;
- xhv->xhv_eiter = entry = new_HE(); /* one HE per MAGICAL hash */
+ /* one HE per MAGICAL hash */
+ xhv->xhv_eiter = entry = new_HE(); /* HvEITER(hv) = new_HE() */
Zero(entry, 1, HE);
Newz(54, k, HEK_BASESIZE + sizeof(SV*), char);
hek = (HEK*)k;
SvREFCNT_dec(HeVAL(entry));
Safefree(HeKEY_hek(entry));
del_HE(entry);
- xhv->xhv_eiter = Null(HE*);
+ xhv->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
return Null(HE*);
}
#ifdef DYNAMIC_ENV_FETCH /* set up %ENV for iteration */
- if (!entry && mg_find((SV*)hv, PERL_MAGIC_env))
+ if (!entry && SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env))
prime_env_iter();
#endif
- if (!xhv->xhv_array)
- Newz(506, xhv->xhv_array,
- PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
+ if (!xhv->xhv_array /* !HvARRAY(hv) */)
+ Newz(506, xhv->xhv_array /* HvARRAY(hv) */,
+ PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
+ char);
if (entry)
entry = HeNEXT(entry);
while (!entry) {
- ++xhv->xhv_riter;
- if (xhv->xhv_riter > xhv->xhv_max) {
- xhv->xhv_riter = -1;
+ xhv->xhv_riter++; /* HvRITER(hv)++ */
+ if (xhv->xhv_riter > xhv->xhv_max /* HvRITER(hv) > HvMAX(hv) */) {
+ xhv->xhv_riter = -1; /* HvRITER(hv) = -1 */
break;
}
+ /* entry = (HvARRAY(hv))[HvRITER(hv)]; */
entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
}
hv_free_ent(hv, oldentry);
}
- xhv->xhv_eiter = entry;
+ xhv->xhv_eiter = entry; /* HvEITER(hv) = entry */
return entry;
}
const char *save = str;
if (len < 0) {
- len = -len;
+ STRLEN tmplen = -len;
is_utf8 = TRUE;
- if (!(PL_hints & HINT_UTF8_DISTINCT)) {
- STRLEN tmplen = len;
- /* See the note in hv_fetch(). --jhi */
- str = (char*)bytes_from_utf8((U8*)str, &tmplen, &is_utf8);
- len = tmplen;
- }
+ /* See the note in hv_fetch(). --jhi */
+ str = (char*)bytes_from_utf8((U8*)str, &tmplen, &is_utf8);
+ len = tmplen;
}
/* what follows is the moral equivalent of:
xhv = (XPVHV*)SvANY(PL_strtab);
/* assert(xhv_array != 0) */
LOCK_STRTAB_MUTEX;
+ /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
if (HeHASH(entry) != hash) /* strings can't be equal */
if (--HeVAL(entry) == Nullsv) {
*oentry = HeNEXT(entry);
if (i && !*oentry)
- xhv->xhv_fill--;
+ xhv->xhv_fill--; /* HvFILL(hv)-- */
Safefree(HeKEY_hek(entry));
del_HE(entry);
- --xhv->xhv_keys;
+ xhv->xhv_keys--; /* HvKEYS(hv)-- */
}
break;
}
const char *save = str;
if (len < 0) {
- len = -len;
+ STRLEN tmplen = -len;
is_utf8 = TRUE;
- if (!(PL_hints & HINT_UTF8_DISTINCT)) {
- STRLEN tmplen = len;
- /* See the note in hv_fetch(). --jhi */
- str = (char*)bytes_from_utf8((U8*)str, &tmplen, &is_utf8);
- len = tmplen;
- }
+ /* See the note in hv_fetch(). --jhi */
+ str = (char*)bytes_from_utf8((U8*)str, &tmplen, &is_utf8);
+ len = tmplen;
}
/* what follows is the moral equivalent of:
xhv = (XPVHV*)SvANY(PL_strtab);
/* assert(xhv_array != 0) */
LOCK_STRTAB_MUTEX;
+ /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
if (HeHASH(entry) != hash) /* strings can't be equal */
HeVAL(entry) = Nullsv;
HeNEXT(entry) = *oentry;
*oentry = entry;
- xhv->xhv_keys++;
+ xhv->xhv_keys++; /* HvKEYS(hv)++ */
if (i) { /* initial entry? */
- ++xhv->xhv_fill;
- if (xhv->xhv_keys > xhv->xhv_max)
+ xhv->xhv_fill++; /* HvFILL(hv)++ */
+ if (xhv->xhv_keys > xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */)
hsplit(PL_strtab);
}
}