#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.
}
if (SvRMAGICAL(hv)) {
- if (mg_find((SV*)hv,'P')) {
+ if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
sv = sv_newmortal();
mg_copy((SV*)hv, sv, key, klen);
PL_hv_fetch_sv = sv;
return &PL_hv_fetch_sv;
}
#ifdef ENV_IS_CASELESS
- else if (mg_find((SV*)hv,'E')) {
+ else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
U32 i;
for (i = 0; i < klen; ++i)
if (isLOWER(key[i])) {
#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 */
- || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
+ || (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))
- key = (char*)bytes_from_utf8((U8*)key, (STRLEN*)&klen, &is_utf8);
+ 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 */
+ key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
+ klen = tmplen;
+ }
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 (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
+ 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
return 0;
if (SvRMAGICAL(hv)) {
- if (mg_find((SV*)hv,'P')) {
+ if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
sv = sv_newmortal();
keysv = sv_2mortal(newSVsv(keysv));
mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
return &PL_hv_fetch_ent_mh;
}
#ifdef ENV_IS_CASELESS
- else if (mg_find((SV*)hv,'E')) {
+ else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
U32 i;
key = SvPV(keysv, klen);
for (i = 0; i < klen; ++i)
}
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 */
- || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
+ || (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 (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
+ 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 */
if (isUPPER(mg->mg_type)) {
*needs_copy = TRUE;
switch (mg->mg_type) {
- case 'P':
- case 'S':
+ case PERL_MAGIC_tied:
+ case PERL_MAGIC_sig:
*needs_store = FALSE;
}
}
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,'E')) {
- SV *sv = sv_2mortal(newSVpvn(key,klen));
- key = strupr(SvPVX(sv));
+ else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
+ key = savepvn(key,klen);
+ key = (const char*)strupr((char*)key);
hash = 0;
}
#endif
}
}
- if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT))
- key = (char*)bytes_from_utf8((U8*)key, (STRLEN*)&klen, &is_utf8);
+ 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 (!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);
}
compute it. The return value is the new hash entry so created. It will be
NULL if the operation failed or if the value did not need to be actually
stored within the hash (as in the case of tied hashes). Otherwise the
-contents of the return value can be accessed using the C<He???> macros
+contents of the return value can be accessed using the C<He?> macros
described here. Note that the caller is responsible for suitably
incrementing the reference count of C<val> before the call, and
decrementing it if the function returned NULL.
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,'E')) {
+ else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
key = SvPV(keysv, klen);
keysv = sv_2mortal(newSVpvn(key,klen));
(void)strupr(SvPVX(keysv));
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);
}
sv = *svp;
mg_clear(sv);
if (!needs_store) {
- if (mg_find(sv, 'p')) {
- sv_unmagic(sv, 'p'); /* No longer an element */
+ if (mg_find(sv, PERL_MAGIC_tiedelem)) {
+ /* No longer an element */
+ sv_unmagic(sv, PERL_MAGIC_tiedelem);
return sv;
}
return Nullsv; /* element cannot be deleted */
}
#ifdef ENV_IS_CASELESS
- else if (mg_find((SV*)hv,'E')) {
+ else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
sv = sv_2mortal(newSVpvn(key,klen));
key = strupr(SvPVX(sv));
}
}
}
xhv = (XPVHV*)SvANY(hv);
- if (!xhv->xhv_array)
+ if (!xhv->xhv_array /* !HvARRAY(hv) */)
return Nullsv;
- if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT))
- key = (char*)bytes_from_utf8((U8*)key, (STRLEN*)&klen, &is_utf8);
+ 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)
sv = HeVAL(entry);
mg_clear(sv);
if (!needs_store) {
- if (mg_find(sv, 'p')) {
- sv_unmagic(sv, 'p'); /* No longer an element */
+ if (mg_find(sv, PERL_MAGIC_tiedelem)) {
+ /* No longer an element */
+ sv_unmagic(sv, PERL_MAGIC_tiedelem);
return sv;
}
return Nullsv; /* element cannot be deleted */
}
#ifdef ENV_IS_CASELESS
- else if (mg_find((SV*)hv,'E')) {
+ else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
key = SvPV(keysv, klen);
keysv = sv_2mortal(newSVpvn(key,klen));
(void)strupr(SvPVX(keysv));
}
}
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)
}
if (SvRMAGICAL(hv)) {
- if (mg_find((SV*)hv,'P')) {
+ if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
sv = sv_newmortal();
mg_copy((SV*)hv, sv, key, klen);
- magic_existspack(sv, mg_find(sv, 'p'));
+ magic_existspack(sv, mg_find(sv, PERL_MAGIC_tiedelem));
return SvTRUE(sv);
}
#ifdef ENV_IS_CASELESS
- else if (mg_find((SV*)hv,'E')) {
+ else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
sv = sv_2mortal(newSVpvn(key,klen));
key = strupr(SvPVX(sv));
}
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))
- key = (char*)bytes_from_utf8((U8*)key, (STRLEN*)&klen, &is_utf8);
+ 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;
+ }
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 (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME)) {
+ if (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
unsigned long len;
char *env = PerlEnv_ENVgetenv_len(key,&len);
if (env) {
return 0;
if (SvRMAGICAL(hv)) {
- if (mg_find((SV*)hv,'P')) {
+ if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
+ SV* svret = sv_newmortal();
sv = sv_newmortal();
keysv = sv_2mortal(newSVsv(keysv));
mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
- magic_existspack(sv, mg_find(sv, 'p'));
- return SvTRUE(sv);
+ magic_existspack(svret, mg_find(sv, PERL_MAGIC_tiedelem));
+ return SvTRUE(svret);
}
#ifdef ENV_IS_CASELESS
- else if (mg_find((SV*)hv,'E')) {
+ else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
key = SvPV(keysv, klen);
keysv = sv_2mortal(newSVpvn(key,klen));
(void)strupr(SvPVX(keysv));
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 (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME)) {
+ 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;
return;
}
#else
-#define MALLOC_OVERHEAD 16
New(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
if (!a) {
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, 'P')) {
- /* 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, 'P'))) {
+ if ((mg = SvTIED_mg((SV*)hv, PERL_MAGIC_tied))) {
SV *key = sv_newmortal();
if (entry) {
sv_setsv(key, HeSVKEY_force(entry));
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 && HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME))
+ 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;
}
Perl_hv_iterval(pTHX_ HV *hv, register HE *entry)
{
if (SvRMAGICAL(hv)) {
- if (mg_find((SV*)hv,'P')) {
+ if (mg_find((SV*)hv, PERL_MAGIC_tied)) {
SV* sv = sv_newmortal();
if (HeKLEN(entry) == HEf_SVKEY)
mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY);
const char *save = str;
if (len < 0) {
- len = -len;
+ STRLEN tmplen = -len;
is_utf8 = TRUE;
- if (!(PL_hints & HINT_UTF8_DISTINCT))
- str = (char*)bytes_from_utf8((U8*)str, (STRLEN*)&len, &is_utf8);
+ /* 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))
- str = (char*)bytes_from_utf8((U8*)str, (STRLEN*)&len, &is_utf8);
+ /* 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);
}
}