/* hv.c
*
- * Copyright (c) 1991-2000, Larry Wall
+ * Copyright (c) 1991-2001, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
void
Perl_unshare_hek(pTHX_ HEK *hek)
{
- unsharepvn(HEK_KEY(hek),HEK_LEN(hek),HEK_HASH(hek));
+ unsharepvn(HEK_KEY(hek),HEK_UTF8(hek)?-HEK_LEN(hek):HEK_LEN(hek),
+ HEK_HASH(hek));
}
#if defined(USE_ITHREADS)
if (HeKLEN(e) == HEf_SVKEY)
HeKEY_sv(ret) = SvREFCNT_inc(sv_dup(HeKEY_sv(e)));
else if (shared)
- HeKEY_hek(ret) = share_hek(HeKEY(e), HeKLEN_UTF8(e), HeHASH(e));
+ 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));
+ HeKEY_hek(ret) = save_hek(HeKEY(e), HeKLEN_UTF8(e), HeHASH(e));
HeVAL(ret) = SvREFCNT_inc(sv_dup(HeVAL(e)));
return ret;
}
register HE *entry;
SV *sv;
bool is_utf8 = FALSE;
+ const char *keysave = key;
if (!hv)
return 0;
}
if (SvRMAGICAL(hv)) {
- if (mg_find((SV*)hv,'P')) {
- dTHR;
+ if (mg_find((SV*)hv,'P') || SvGMAGICAL((SV*)hv)) {
sv = sv_newmortal();
mg_copy((SV*)hv, sv, key, klen);
PL_hv_fetch_sv = sv;
return 0;
}
+ if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT)) {
+ 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 = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
continue;
if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
continue;
- if (HeKUTF8(entry) != (char)is_utf8)
- continue;
+ if (HeKUTF8(entry) != (char)is_utf8)
+ continue;
+ if (key != keysave)
+ Safefree(key);
return &HeVAL(entry);
}
#ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */
if (env) {
sv = newSVpvn(env,len);
SvTAINTED_on(sv);
+ if (key != keysave)
+ Safefree(key);
return hv_store(hv,key,klen,sv,hash);
}
}
#endif
if (lval) { /* gonna assign to this, so it better be there */
sv = NEWSV(61,0);
- return hv_store(hv,key,is_utf8?-klen:klen,sv,hash);
+ if (key != keysave) { /* must be is_utf8 == 0 */
+ SV **ret = hv_store(hv,key,klen,sv,hash);
+ Safefree(key);
+ return ret;
+ }
+ else
+ return hv_store(hv,key,is_utf8?-klen:klen,sv,hash);
}
+ if (key != keysave)
+ Safefree(key);
return 0;
}
register HE *entry;
SV *sv;
bool is_utf8;
+ char *keysave;
if (!hv)
return 0;
if (SvRMAGICAL(hv)) {
- if (mg_find((SV*)hv,'P')) {
- dTHR;
+ if (mg_find((SV*)hv,'P') || SvGMAGICAL((SV*)hv)) {
sv = sv_newmortal();
keysv = sv_2mortal(newSVsv(keysv));
mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
return 0;
}
- key = SvPV(keysv, klen);
+ keysave = key = SvPV(keysv, klen);
is_utf8 = (SvUTF8(keysv)!=0);
+ if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT))
+ key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
+
if (!hash)
PERL_HASH(hash, key, klen);
continue;
if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
continue;
- if (HeKUTF8(entry) != (char)is_utf8)
- continue;
+ if (HeKUTF8(entry) != (char)is_utf8)
+ continue;
+ if (key != keysave)
+ Safefree(key);
return entry;
}
#ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */
}
}
#endif
+ if (key != keysave)
+ Safefree(key);
if (lval) { /* gonna assign to this, so it better be there */
sv = NEWSV(61,0);
return hv_store_ent(hv,keysv,sv,hash);
register HE *entry;
register HE **oentry;
bool is_utf8 = FALSE;
+ const char *keysave = key;
if (!hv)
return 0;
return 0;
#ifdef ENV_IS_CASELESS
else if (mg_find((SV*)hv,'E')) {
- SV *sv = sv_2mortal(newSVpvn(key,klen));
- key = strupr(SvPVX(sv));
+ key = savepvn(key,klen);
+ key = strupr(key);
hash = 0;
}
#endif
}
}
+ if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT)) {
+ 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);
continue;
if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
continue;
- if (HeKUTF8(entry) != (char)is_utf8)
- continue;
+ if (HeKUTF8(entry) != (char)is_utf8)
+ continue;
SvREFCNT_dec(HeVAL(entry));
HeVAL(entry) = val;
+ if (key != keysave)
+ Safefree(key);
return &HeVAL(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?-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?-klen:klen, hash);
+ if (key != keysave)
+ Safefree(key);
HeVAL(entry) = val;
HeNEXT(entry) = *oentry;
*oentry = entry;
register HE *entry;
register HE **oentry;
bool is_utf8;
+ char *keysave;
if (!hv)
return 0;
xhv = (XPVHV*)SvANY(hv);
if (SvMAGICAL(hv)) {
- dTHR;
bool needs_copy;
bool needs_store;
hv_magic_check (hv, &needs_copy, &needs_store);
}
}
- key = SvPV(keysv, klen);
+ keysave = key = SvPV(keysv, klen);
is_utf8 = (SvUTF8(keysv) != 0);
+ if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT))
+ key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
+
if (!hash)
PERL_HASH(hash, key, klen);
continue;
if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
continue;
- if (HeKUTF8(entry) != (char)is_utf8)
- continue;
+ if (HeKUTF8(entry) != (char)is_utf8)
+ continue;
SvREFCNT_dec(HeVAL(entry));
HeVAL(entry) = val;
+ if (key != keysave)
+ Safefree(key);
return 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?-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?-klen:klen, hash);
+ if (key != keysave)
+ Safefree(key);
HeVAL(entry) = val;
HeNEXT(entry) = *oentry;
*oentry = entry;
SV **svp;
SV *sv;
bool is_utf8 = FALSE;
+ const char *keysave = key;
if (!hv)
return Nullsv;
if (!xhv->xhv_array)
return Nullsv;
+ if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT)) {
+ 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);
oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
continue;
if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
continue;
- if (HeKUTF8(entry) != (char)is_utf8)
- continue;
+ if (HeKUTF8(entry) != (char)is_utf8)
+ continue;
+ if (key != keysave)
+ Safefree(key);
*oentry = HeNEXT(entry);
if (i && !*oentry)
xhv->xhv_fill--;
--xhv->xhv_keys;
return sv;
}
+ if (key != keysave)
+ Safefree(key);
return Nullsv;
}
register HE **oentry;
SV *sv;
bool is_utf8;
+ char *keysave;
if (!hv)
return Nullsv;
if (!xhv->xhv_array)
return Nullsv;
- key = SvPV(keysv, klen);
+ keysave = key = SvPV(keysv, klen);
is_utf8 = (SvUTF8(keysv) != 0);
+ if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT))
+ key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
+
if (!hash)
PERL_HASH(hash, key, klen);
continue;
if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
continue;
- if (HeKUTF8(entry) != (char)is_utf8)
- continue;
+ if (HeKUTF8(entry) != (char)is_utf8)
+ continue;
+ if (key != keysave)
+ Safefree(key);
*oentry = HeNEXT(entry);
if (i && !*oentry)
xhv->xhv_fill--;
--xhv->xhv_keys;
return sv;
}
+ if (key != keysave)
+ Safefree(key);
return Nullsv;
}
register HE *entry;
SV *sv;
bool is_utf8 = FALSE;
+ const char *keysave = key;
if (!hv)
return 0;
}
if (SvRMAGICAL(hv)) {
- if (mg_find((SV*)hv,'P')) {
- dTHR;
+ if (mg_find((SV*)hv,'P') || SvGMAGICAL((SV*)hv)) {
sv = sv_newmortal();
mg_copy((SV*)hv, sv, key, klen);
magic_existspack(sv, mg_find(sv, 'p'));
return 0;
#endif
+ if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT)) {
+ 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
continue;
if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
continue;
- if (HeKUTF8(entry) != (char)is_utf8)
- continue;
+ if (HeKUTF8(entry) != (char)is_utf8)
+ continue;
+ if (key != keysave)
+ Safefree(key);
return TRUE;
}
#ifdef DYNAMIC_ENV_FETCH /* is it out there? */
}
}
#endif
+ if (key != keysave)
+ Safefree(key);
return FALSE;
}
STRLEN klen;
register HE *entry;
SV *sv;
+ bool is_utf8;
+ char *keysave;
if (!hv)
return 0;
if (SvRMAGICAL(hv)) {
- if (mg_find((SV*)hv,'P')) {
- dTHR; /* just for SvTRUE */
+ if (mg_find((SV*)hv,'P') || 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, 'p'));
+ return SvTRUE(svret);
}
#ifdef ENV_IS_CASELESS
else if (mg_find((SV*)hv,'E')) {
return 0;
#endif
- key = SvPV(keysv, klen);
+ keysave = key = SvPV(keysv, klen);
+ is_utf8 = (SvUTF8(keysv) != 0);
+ if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT))
+ key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
if (!hash)
PERL_HASH(hash, key, klen);
continue;
if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
continue;
+ if (HeKUTF8(entry) != (char)is_utf8)
+ continue;
+ if (key != keysave)
+ Safefree(key);
return TRUE;
}
#ifdef DYNAMIC_ENV_FETCH /* is it out there? */
}
}
#endif
+ if (key != keysave)
+ Safefree(key);
return FALSE;
}
return;
}
#else
-#define MALLOC_OVERHEAD 16
New(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
if (!a) {
PL_nomemok = FALSE;
/* Slow way */
hv_iterinit(ohv);
while ((entry = hv_iternext(ohv))) {
- hv_store(hv, HeKEY(entry), HeKLEN_UTF8(entry),
- SvREFCNT_inc(HeVAL(entry)), HeHASH(entry));
+ hv_store(hv, HeKEY(entry), HeKLEN_UTF8(entry),
+ newSVsv(HeVAL(entry)), HeHASH(entry));
}
HvRITER(ohv) = hv_riter;
HvEITER(ohv) = hv_eiter;
{
if (HeKLEN(entry) == HEf_SVKEY)
return sv_mortalcopy(HeKEY_sv(entry));
- else {
- SV *sv = newSVpvn_share((HeKLEN(entry) ? HeKEY(entry) : ""),
- HeKLEN(entry), HeHASH(entry));
- if (HeKUTF8(entry))
- SvUTF8_on(sv);
- return sv_2mortal(sv);
- }
+ else
+ return sv_2mortal(newSVpvn_share((HeKLEN(entry) ? HeKEY(entry) : ""),
+ HeKLEN_UTF8(entry), HeHASH(entry)));
}
/*
register HE **oentry;
register I32 i = 1;
I32 found = 0;
+ bool is_utf8 = FALSE;
+ const char *save = str;
+
+ if (len < 0) {
+ len = -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;
+ }
+ }
/* what follows is the moral equivalent of:
if ((Svp = hv_fetch(PL_strtab, tmpsv, FALSE, hash))) {
continue;
if (HeKEY(entry) != str && memNE(HeKEY(entry),str,len)) /* is this it? */
continue;
+ if (HeKUTF8(entry) != (char)is_utf8)
+ continue;
found = 1;
if (--HeVAL(entry) == Nullsv) {
*oentry = HeNEXT(entry);
break;
}
UNLOCK_STRTAB_MUTEX;
-
- {
- dTHR;
- if (!found && ckWARN_d(WARN_INTERNAL))
- Perl_warner(aTHX_ WARN_INTERNAL, "Attempt to free non-existent shared string '%s'",str);
- }
+ if (str != save)
+ Safefree(str);
+ if (!found && ckWARN_d(WARN_INTERNAL))
+ Perl_warner(aTHX_ WARN_INTERNAL, "Attempt to free non-existent shared string '%s'",str);
}
/* get a (constant) string ptr from the global string table
register I32 i = 1;
I32 found = 0;
bool is_utf8 = FALSE;
+ const char *save = str;
if (len < 0) {
len = -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;
+ }
}
/* what follows is the moral equivalent of:
continue;
if (HeKEY(entry) != str && memNE(HeKEY(entry),str,len)) /* is this it? */
continue;
- if (HeKUTF8(entry) != (char)is_utf8)
- continue;
+ if (HeKUTF8(entry) != (char)is_utf8)
+ continue;
found = 1;
break;
}
if (!found) {
entry = new_HE();
- HeKEY_hek(entry) = save_hek(str, is_utf8?-len:len, hash);
+ HeKEY_hek(entry) = save_hek(str, is_utf8?-len:len, hash);
HeVAL(entry) = Nullsv;
HeNEXT(entry) = *oentry;
*oentry = entry;
++HeVAL(entry); /* use value slot as REFCNT */
UNLOCK_STRTAB_MUTEX;
+ if (str != save)
+ Safefree(str);
return HeKEY_hek(entry);
}
-
-
-