#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 */
SV**
Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen, I32 lval)
{
+ register XPVHV* xhv;
register U32 hash;
register HE *entry;
SV *sv;
#endif
}
- if (!HvARRAY(hv)) {
+ /* We use xhv->xhv_foo fields directly instead of HvFOO(hv) to
+ avoid unnecessary pointer dereferencing. */
+ xhv = (XPVHV*)SvANY(hv);
+ 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, HvARRAY(hv),
- PERL_HV_ARRAY_ALLOC_BYTES(HvMAX(hv) + 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 = (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 */
continue;
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) {
HE *
Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
{
+ register XPVHV* xhv;
register char *key;
STRLEN klen;
register HE *entry;
#endif
}
- if (!HvARRAY(hv)) {
+ xhv = (XPVHV*)SvANY(hv);
+ 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, HvARRAY(hv),
- PERL_HV_ARRAY_ALLOC_BYTES(HvMAX(hv) + 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 = (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 */
continue;
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) {
SV**
Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen, SV *val, register U32 hash)
{
+ register XPVHV* xhv;
register I32 i;
register HE *entry;
register HE **oentry;
is_utf8 = TRUE;
}
+ xhv = (XPVHV*)SvANY(hv);
if (SvMAGICAL(hv)) {
bool needs_copy;
bool needs_store;
hv_magic_check (hv, &needs_copy, &needs_store);
if (needs_copy) {
mg_copy((SV*)hv, val, key, klen);
- if (!HvARRAY(hv) && !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 (!HvARRAY(hv))
- Newz(505, HvARRAY(hv),
- PERL_HV_ARRAY_ALLOC_BYTES(HvMAX(hv) + 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 = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
+ oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
i = 1;
for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
HeNEXT(entry) = *oentry;
*oentry = entry;
- HvKEYS(hv)++;
+ xhv->xhv_keys++; /* HvKEYS(hv)++ */
if (i) { /* initial entry? */
- HvFILL(hv)++;
- if (HvKEYS(hv) > HvMAX(hv))
+ xhv->xhv_fill++; /* HvFILL(hv)++ */
+ if (xhv->xhv_keys > xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */)
hsplit(hv);
}
HE *
Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, register U32 hash)
{
+ register XPVHV* xhv;
register char *key;
STRLEN klen;
register I32 i;
if (!hv)
return 0;
+ xhv = (XPVHV*)SvANY(hv);
if (SvMAGICAL(hv)) {
bool needs_copy;
bool needs_store;
keysv = sv_2mortal(newSVsv(keysv));
mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
TAINT_IF(save_taint);
- if (!HvARRAY(hv) && !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 (!HvARRAY(hv))
- Newz(505, HvARRAY(hv),
- PERL_HV_ARRAY_ALLOC_BYTES(HvMAX(hv) + 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 = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
+ oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
i = 1;
for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
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;
- HvKEYS(hv)++;
+ xhv->xhv_keys++; /* HvKEYS(hv)++ */
if (i) { /* initial entry? */
- HvFILL(hv)++;
- if (HvKEYS(hv) > HvMAX(hv))
+ xhv->xhv_fill++; /* HvFILL(hv)++ */
+ if (xhv->xhv_keys > xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */)
hsplit(hv);
}
SV *
Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags)
{
+ register XPVHV* xhv;
register I32 i;
register U32 hash;
register HE *entry;
#endif
}
}
- if (!HvARRAY(hv))
+ xhv = (XPVHV*)SvANY(hv);
+ 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);
PERL_HASH(hash, key, klen);
- oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)];
+ /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
+ oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
entry = *oentry;
i = 1;
for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
Safefree(key);
*oentry = HeNEXT(entry);
if (i && !*oentry)
- HvFILL(hv)--;
+ xhv->xhv_fill--; /* HvFILL(hv)-- */
if (flags & G_DISCARD)
sv = Nullsv;
else {
sv = sv_2mortal(HeVAL(entry));
HeVAL(entry) = &PL_sv_undef;
}
- if (entry == HvEITER(hv))
+ if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
HvLAZYDEL_on(hv);
else
hv_free_ent(hv, entry);
- HvKEYS(hv)--;
+ xhv->xhv_keys--; /* HvKEYS(hv)-- */
return sv;
}
if (key != keysave)
SV *
Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
{
+ register XPVHV* xhv;
register I32 i;
register char *key;
STRLEN klen;
#endif
}
}
- if (!HvARRAY(hv))
+ xhv = (XPVHV*)SvANY(hv);
+ 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 (!hash)
PERL_HASH(hash, key, klen);
- oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)];
+ /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
+ oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
entry = *oentry;
i = 1;
for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
Safefree(key);
*oentry = HeNEXT(entry);
if (i && !*oentry)
- HvFILL(hv)--;
+ xhv->xhv_fill--; /* HvFILL(hv)-- */
if (flags & G_DISCARD)
sv = Nullsv;
else {
sv = sv_2mortal(HeVAL(entry));
HeVAL(entry) = &PL_sv_undef;
}
- if (entry == HvEITER(hv))
+ if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
HvLAZYDEL_on(hv);
else
hv_free_ent(hv, entry);
- HvKEYS(hv)--;
+ xhv->xhv_keys--; /* HvKEYS(hv)-- */
return sv;
}
if (key != keysave)
bool
Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen)
{
+ register XPVHV* xhv;
register U32 hash;
register HE *entry;
SV *sv;
#endif
}
+ xhv = (XPVHV*)SvANY(hv);
#ifndef DYNAMIC_ENV_FETCH
- if (!HvARRAY(hv))
+ 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 (!HvARRAY(hv)) entry = Null(HE*);
+ if (!xhv->xhv_array /* !HvARRAY(hv) */) entry = Null(HE*);
else
#endif
- entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)];
+ /* 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 */
continue;
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) {
bool
Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
{
+ register XPVHV* xhv;
register char *key;
STRLEN klen;
register HE *entry;
#endif
}
+ xhv = (XPVHV*)SvANY(hv);
#ifndef DYNAMIC_ENV_FETCH
- if (!HvARRAY(hv))
+ 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 (!HvARRAY(hv)) entry = Null(HE*);
+ if (!xhv->xhv_array /* !HvARRAY(hv) */) entry = Null(HE*);
else
#endif
- entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)];
+ /* 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 */
continue;
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) {
STATIC void
S_hsplit(pTHX_ HV *hv)
{
- I32 oldsize = (I32) HvMAX(hv) + 1; /* sic(k) */
+ register XPVHV* xhv = (XPVHV*)SvANY(hv);
+ I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
register I32 newsize = oldsize * 2;
register I32 i;
- register char *a = (char *)HvARRAY(hv);
+ register char *a = xhv->xhv_array; /* HvARRAY(hv) */
register HE **aep;
register HE **bep;
register HE *entry;
PL_nomemok = FALSE;
return;
}
- Copy(HvARRAY(hv), a, oldsize * sizeof(HE*), char);
+ Copy(xhv->xhv_array /* HvARRAY(hv) */, a, oldsize * sizeof(HE*), char);
if (oldsize >= 64) {
- offer_nice_chunk(HvARRAY(hv), PERL_HV_ARRAY_ALLOC_BYTES(oldsize));
+ offer_nice_chunk(xhv->xhv_array /* HvARRAY(hv) */,
+ PERL_HV_ARRAY_ALLOC_BYTES(oldsize));
}
else
- Safefree(HvARRAY(hv));
+ Safefree(xhv->xhv_array /* HvARRAY(hv) */);
#endif
PL_nomemok = FALSE;
Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/
- HvMAX(hv) = --newsize;
- HvARRAY(hv) = 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)
- HvFILL(hv)++;
+ xhv->xhv_fill++; /* HvFILL(hv)++ */
*bep = entry;
continue;
}
oentry = &HeNEXT(entry);
}
if (!*aep) /* everything moved */
- HvFILL(hv)--;
+ xhv->xhv_fill--; /* HvFILL(hv)-- */
}
}
void
Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
{
- I32 oldsize = (I32) HvMAX(hv) + 1; /* sic(k) */
+ register XPVHV* xhv = (XPVHV*)SvANY(hv);
+ 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 = (char *)HvARRAY(hv);
+ a = xhv->xhv_array; /* HvARRAY(hv) */
if (a) {
PL_nomemok = TRUE;
#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
PL_nomemok = FALSE;
return;
}
- Copy(HvARRAY(hv), a, oldsize * sizeof(HE*), char);
+ Copy(xhv->xhv_array /* HvARRAY(hv) */, a, oldsize * sizeof(HE*), char);
if (oldsize >= 64) {
- offer_nice_chunk(HvARRAY(hv), PERL_HV_ARRAY_ALLOC_BYTES(oldsize));
+ offer_nice_chunk(xhv->xhv_array /* HvARRAY(hv) */,
+ PERL_HV_ARRAY_ALLOC_BYTES(oldsize));
}
else
- Safefree(HvARRAY(hv));
+ 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);
}
- HvMAX(hv) = --newsize;
- HvARRAY(hv) = a;
- if (!HvFILL(hv)) /* 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]))
- HvFILL(hv)++;
+ xhv->xhv_fill++; /* HvFILL(hv)++ */
aep[j] = entry;
continue;
}
oentry = &HeNEXT(entry);
}
if (!*aep) /* everything moved */
- HvFILL(hv)--;
+ xhv->xhv_fill--; /* HvFILL(hv)-- */
}
}
Perl_newHV(pTHX)
{
register HV *hv;
+ register XPVHV* xhv;
hv = (HV*)NEWSV(502,0);
sv_upgrade((SV *)hv, SVt_PVHV);
+ xhv = (XPVHV*)SvANY(hv);
SvPOK_off(hv);
SvNOK_off(hv);
#ifndef NODEFAULT_SHAREKEYS
HvSHAREKEYS_on(hv); /* key-sharing on by default */
#endif
- HvMAX(hv) = 7; /* start with 8 buckets */
- HvFILL(hv) = 0;
- HvPMROOT(hv) = 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;
+ }
+
+ /* 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;
+ }
+ }
-#if 0
- if (! SvTIED_mg((SV*)ohv, PERL_MAGIC_tied)) {
- /* Quick way ???*/
+ 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;
void
Perl_hv_clear(pTHX_ HV *hv)
{
+ register XPVHV* xhv;
if (!hv)
return;
+ xhv = (XPVHV*)SvANY(hv);
hfreeentries(hv);
- HvFILL(hv) = 0;
- HvKEYS(hv) = 0;
- if (HvARRAY(hv))
- (void)memzero(HvARRAY(hv), (HvMAX(hv) + 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);
void
Perl_hv_undef(pTHX_ HV *hv)
{
+ register XPVHV* xhv;
if (!hv)
return;
+ xhv = (XPVHV*)SvANY(hv);
hfreeentries(hv);
- Safefree(HvARRAY(hv));
+ Safefree(xhv->xhv_array /* HvARRAY(hv) */);
if (HvNAME(hv)) {
Safefree(HvNAME(hv));
HvNAME(hv) = 0;
}
- HvARRAY(hv) = 0;
- HvMAX(hv) = 7; /* it's a normal hash */
- HvFILL(hv) = 0;
- HvKEYS(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 */
if (SvRMAGICAL(hv))
mg_clear((SV*)hv);
I32
Perl_hv_iterinit(pTHX_ HV *hv)
{
+ register XPVHV* xhv;
HE *entry;
if (!hv)
Perl_croak(aTHX_ "Bad hash");
- entry = HvEITER(hv);
+ xhv = (XPVHV*)SvANY(hv);
+ entry = xhv->xhv_eiter; /* HvEITER(hv) */
if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */
HvLAZYDEL_off(hv);
hv_free_ent(hv, entry);
}
- HvRITER(hv) = -1;
- HvEITER(hv) = Null(HE*);
- return HvKEYS(hv); /* 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) */
}
/*
HE *
Perl_hv_iternext(pTHX_ HV *hv)
{
+ register XPVHV* xhv;
register HE *entry;
HE *oldentry;
MAGIC* mg;
if (!hv)
Perl_croak(aTHX_ "Bad hash");
- oldentry = entry = HvEITER(hv);
+ xhv = (XPVHV*)SvANY(hv);
+ oldentry = entry = xhv->xhv_eiter; /* HvEITER(hv) */
if ((mg = SvTIED_mg((SV*)hv, PERL_MAGIC_tied))) {
SV *key = sv_newmortal();
char *k;
HEK *hek;
- HvEITER(hv) = 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);
- HvEITER(hv) = 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 (!HvARRAY(hv))
- Newz(506, HvARRAY(hv),
- PERL_HV_ARRAY_ALLOC_BYTES(HvMAX(hv) + 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) {
- HvRITER(hv)++;
- if (HvRITER(hv) > HvMAX(hv)) {
- HvRITER(hv) = -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 = (HvARRAY(hv))[HvRITER(hv)]; */
+ entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
}
if (oldentry && HvLAZYDEL(hv)) { /* was deleted earlier? */
hv_free_ent(hv, oldentry);
}
- HvEITER(hv) = entry;
+ xhv->xhv_eiter = entry; /* HvEITER(hv) = entry */
return entry;
}
void
Perl_unsharepvn(pTHX_ const char *str, I32 len, U32 hash)
{
- HV *hv;
+ register XPVHV* xhv;
register HE *entry;
register HE **oentry;
register I32 i = 1;
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:
if (--*Svp == Nullsv)
hv_delete(PL_strtab, str, len, G_DISCARD, hash);
} */
+ xhv = (XPVHV*)SvANY(PL_strtab);
/* assert(xhv_array != 0) */
- hv = PL_strtab;
LOCK_STRTAB_MUTEX;
- oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)];
+ /* 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 */
continue;
if (--HeVAL(entry) == Nullsv) {
*oentry = HeNEXT(entry);
if (i && !*oentry)
- HvFILL(hv)--;
+ xhv->xhv_fill--; /* HvFILL(hv)-- */
Safefree(HeKEY_hek(entry));
del_HE(entry);
- HvKEYS(hv)--;
+ xhv->xhv_keys--; /* HvKEYS(hv)-- */
}
break;
}
HEK *
Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash)
{
- HV *hv;
+ register XPVHV* xhv;
register HE *entry;
register HE **oentry;
register I32 i = 1;
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:
if (!(Svp = hv_fetch(PL_strtab, str, len, FALSE)))
hv_store(PL_strtab, str, len, Nullsv, hash);
*/
+ xhv = (XPVHV*)SvANY(PL_strtab);
/* assert(xhv_array != 0) */
- hv = PL_strtab;
LOCK_STRTAB_MUTEX;
- oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)];
+ /* 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 */
continue;
HeVAL(entry) = Nullsv;
HeNEXT(entry) = *oentry;
*oentry = entry;
- HvKEYS(hv)++;
+ xhv->xhv_keys++; /* HvKEYS(hv)++ */
if (i) { /* initial entry? */
- HvFILL(hv)++;
- if (HvKEYS(hv) > HvMAX(hv))
- hsplit(hv);
+ xhv->xhv_fill++; /* HvFILL(hv)++ */
+ if (xhv->xhv_keys > xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */)
+ hsplit(PL_strtab);
}
}
https://perl5.git.perl.org / perl5.git / blobdiff