new md5sum for modified MD5.xs file
[p5sagit/p5-mst-13.2.git] / hv.c
diff --git a/hv.c b/hv.c
index 51c8d0a..7058116 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1,6 +1,6 @@
 /*    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.
@@ -75,20 +75,27 @@ S_save_hek(pTHX_ const char *str, I32 len, U32 hash)
 {
     char *k;
     register HEK *hek;
+    bool is_utf8 = FALSE;
+
+    if (len < 0) {
+      len = -len;
+      is_utf8 = TRUE;
+    }
 
     New(54, k, HEK_BASESIZE + len + 1, char);
     hek = (HEK*)k;
     Copy(str, HEK_KEY(hek), len, char);
-    *(HEK_KEY(hek) + len) = '\0';
     HEK_LEN(hek) = len;
     HEK_HASH(hek) = hash;
+    HEK_UTF8(hek) = (char)is_utf8;
     return hek;
 }
 
 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)
@@ -112,9 +119,9 @@ Perl_he_dup(pTHX_ HE *e, bool shared)
     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(e), HeHASH(e));
+       HeKEY_hek(ret) = share_hek(HeKEY(e), HeKLEN_UTF8(e), HeHASH(e));
     else
-       HeKEY_hek(ret) = save_hek(HeKEY(e), HeKLEN(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;
 }
@@ -138,26 +145,32 @@ information on how to use this function on tied hashes.
 */
 
 SV**
-Perl_hv_fetch(pTHX_ HV *hv, const char *key, U32 klen, I32 lval)
+Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen, I32 lval)
 {
     register XPVHV* xhv;
     register U32 hash;
     register HE *entry;
     SV *sv;
+    bool is_utf8 = FALSE;
+    const char *keysave = key;
 
     if (!hv)
        return 0;
 
+    if (klen < 0) {
+      klen = -klen;
+      is_utf8 = TRUE;
+    }
+
     if (SvRMAGICAL(hv)) {
-       if (mg_find((SV*)hv,'P')) {
-           dTHR;
+       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])) {
@@ -184,6 +197,14 @@ Perl_hv_fetch(pTHX_ HV *hv, const char *key, U32 klen, I32 lval)
            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];
@@ -194,6 +215,10 @@ Perl_hv_fetch(pTHX_ HV *hv, const char *key, U32 klen, I32 lval)
            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 &HeVAL(entry);
     }
 #ifdef DYNAMIC_ENV_FETCH  /* %ENV lookup?  If so, try to fetch the value now */
@@ -203,14 +228,24 @@ Perl_hv_fetch(pTHX_ HV *hv, const char *key, U32 klen, I32 lval)
        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,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;
 }
 
@@ -241,16 +276,14 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
     STRLEN klen;
     register HE *entry;
     SV *sv;
+    bool is_utf8;
+    char *keysave;
 
     if (!hv)
        return 0;
 
-    if (SvUTF8((SV*)hv) && !SvUTF8(keysv))
-        sv_utf8_upgrade(keysv);
-
     if (SvRMAGICAL(hv)) {
-       if (mg_find((SV*)hv,'P')) {
-           dTHR;
+       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);
@@ -264,7 +297,7 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
            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)
@@ -293,7 +326,11 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
            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);
@@ -306,6 +343,10 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
            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 entry;
     }
 #ifdef DYNAMIC_ENV_FETCH  /* %ENV lookup?  If so, try to fetch the value now */
@@ -319,6 +360,8 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
        }
     }
 #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);
@@ -336,8 +379,8 @@ S_hv_magic_check(pTHX_ HV *hv, bool *needs_copy, bool *needs_store)
        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;
            }
        }
@@ -364,16 +407,23 @@ information on how to use this function on tied hashes.
 */
 
 SV**
-Perl_hv_store(pTHX_ HV *hv, const char *key, U32 klen, SV *val, register U32 hash)
+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;
+    bool is_utf8 = FALSE;
+    const char *keysave = key;
 
     if (!hv)
        return 0;
 
+    if (klen < 0) {
+      klen = -klen;
+      is_utf8 = TRUE;
+    }
+
     xhv = (XPVHV*)SvANY(hv);
     if (SvMAGICAL(hv)) {
        bool needs_copy;
@@ -384,14 +434,21 @@ Perl_hv_store(pTHX_ HV *hv, const char *key, U32 klen, SV *val, register U32 has
            if (!xhv->xhv_array && !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 = 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);
 
@@ -409,16 +466,22 @@ Perl_hv_store(pTHX_ HV *hv, const char *key, U32 klen, SV *val, register U32 has
            continue;
        if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
            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, 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, 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;
@@ -461,27 +524,14 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, register U32 hash)
     register I32 i;
     register HE *entry;
     register HE **oentry;
+    bool is_utf8;
+    char *keysave;
 
     if (!hv)
        return 0;
 
     xhv = (XPVHV*)SvANY(hv);
-
-    if (SvUTF8((SV*)hv) && !SvUTF8(keysv))
-       sv_utf8_upgrade(keysv);
-    else if (SvUTF8(keysv) && !SvUTF8((SV*)hv)) { /* Upgrade hash */
-       SvUTF8_on((SV*)hv);
-       /* XXX Need to save iterator to prevent weird things during "each" */
-       (void)hv_iterinit(hv);
-       while (entry = hv_iternext(hv)) {
-           if (HeKLEN(entry) != HEf_SVKEY) /* Upgrade to SV key */
-               HeSVKEY_set(entry, newSVpvn(HeKEY(entry), HeKLEN(entry)));
-           sv_utf8_upgrade(HeKEY_sv(entry));
-       }
-    }
-
     if (SvMAGICAL(hv)) {
-       dTHR;
        bool needs_copy;
        bool needs_store;
        hv_magic_check (hv, &needs_copy, &needs_store);
@@ -495,7 +545,7 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, register U32 hash)
            if (!xhv->xhv_array && !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));
@@ -505,7 +555,11 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, register U32 hash)
        }
     }
 
-    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);
@@ -524,16 +578,22 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, register U32 hash)
            continue;
        if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
            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, 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, 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;
@@ -560,7 +620,7 @@ will be returned.
 */
 
 SV *
-Perl_hv_delete(pTHX_ HV *hv, const char *key, U32 klen, I32 flags)
+Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags)
 {
     register XPVHV* xhv;
     register I32 i;
@@ -569,9 +629,15 @@ Perl_hv_delete(pTHX_ HV *hv, const char *key, U32 klen, I32 flags)
     register HE **oentry;
     SV **svp;
     SV *sv;
+    bool is_utf8 = FALSE;
+    const char *keysave = key;
 
     if (!hv)
        return Nullsv;
+    if (klen < 0) {
+      klen = -klen;
+      is_utf8 = TRUE;
+    }
     if (SvRMAGICAL(hv)) {
        bool needs_copy;
        bool needs_store;
@@ -581,14 +647,15 @@ Perl_hv_delete(pTHX_ HV *hv, const char *key, U32 klen, I32 flags)
            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));
            }
@@ -599,6 +666,13 @@ Perl_hv_delete(pTHX_ HV *hv, const char *key, U32 klen, I32 flags)
     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];
@@ -611,6 +685,10 @@ Perl_hv_delete(pTHX_ HV *hv, const char *key, U32 klen, I32 flags)
            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);
        *oentry = HeNEXT(entry);
        if (i && !*oentry)
            xhv->xhv_fill--;
@@ -627,6 +705,8 @@ Perl_hv_delete(pTHX_ HV *hv, const char *key, U32 klen, I32 flags)
        --xhv->xhv_keys;
        return sv;
     }
+    if (key != keysave)
+       Safefree(key);
     return Nullsv;
 }
 
@@ -651,6 +731,8 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
     register HE *entry;
     register HE **oentry;
     SV *sv;
+    bool is_utf8;
+    char *keysave;
 
     if (!hv)
        return Nullsv;
@@ -663,14 +745,15 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
            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));
@@ -683,7 +766,11 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
     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);
@@ -698,6 +785,10 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
            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);
        *oentry = HeNEXT(entry);
        if (i && !*oentry)
            xhv->xhv_fill--;
@@ -714,6 +805,8 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
        --xhv->xhv_keys;
        return sv;
     }
+    if (key != keysave)
+       Safefree(key);
     return Nullsv;
 }
 
@@ -727,26 +820,32 @@ C<klen> is the length of the key.
 */
 
 bool
-Perl_hv_exists(pTHX_ HV *hv, const char *key, U32 klen)
+Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen)
 {
     register XPVHV* xhv;
     register U32 hash;
     register HE *entry;
     SV *sv;
+    bool is_utf8 = FALSE;
+    const char *keysave = key;
 
     if (!hv)
        return 0;
 
+    if (klen < 0) {
+      klen = -klen;
+      is_utf8 = TRUE;
+    }
+
     if (SvRMAGICAL(hv)) {
-       if (mg_find((SV*)hv,'P')) {
-           dTHR;
+       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));
        }
@@ -759,6 +858,13 @@ Perl_hv_exists(pTHX_ HV *hv, const char *key, U32 klen)
        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
@@ -773,6 +879,10 @@ Perl_hv_exists(pTHX_ HV *hv, const char *key, U32 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? */
@@ -787,6 +897,8 @@ Perl_hv_exists(pTHX_ HV *hv, const char *key, U32 klen)
        }
     }
 #endif
+    if (key != keysave)
+       Safefree(key);
     return FALSE;
 }
 
@@ -809,21 +921,23 @@ Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
     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, 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));
@@ -838,7 +952,10 @@ Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
        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);
 
@@ -854,6 +971,10 @@ Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
            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? */
@@ -868,6 +989,8 @@ Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
        }
     }
 #endif
+    if (key != keysave)
+       Safefree(key);
     return FALSE;
 }
 
@@ -892,7 +1015,6 @@ S_hsplit(pTHX_ HV *hv)
       return;
     }
 #else
-#define MALLOC_OVERHEAD 16
     New(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
     if (!a) {
       PL_nomemok = FALSE;
@@ -1055,7 +1177,7 @@ Perl_newHVhv(pTHX_ HV *ohv)
        return hv;
 
 #if 0
-    if (! SvTIED_mg((SV*)ohv, 'P')) {
+    if (! SvTIED_mg((SV*)ohv, PERL_MAGIC_tied)) {
        /* Quick way ???*/
     }
     else
@@ -1068,8 +1190,8 @@ Perl_newHVhv(pTHX_ HV *ohv)
        /* Slow way */
        hv_iterinit(ohv);
        while ((entry = hv_iternext(ohv))) {
-           hv_store(hv, HeKEY(entry), HeKLEN(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;
@@ -1261,7 +1383,7 @@ Perl_hv_iternext(pTHX_ HV *hv)
     xhv = (XPVHV*)SvANY(hv);
     oldentry = entry = xhv->xhv_eiter;
 
-    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));
@@ -1359,10 +1481,9 @@ Perl_hv_iterkeysv(pTHX_ register HE *entry)
 {
     if (HeKLEN(entry) == HEf_SVKEY)
        return sv_mortalcopy(HeKEY_sv(entry));
-    else {
+    else
        return sv_2mortal(newSVpvn_share((HeKLEN(entry) ? HeKEY(entry) : ""),
-                                 HeKLEN(entry), HeHASH(entry)));
-    }
+                                        HeKLEN_UTF8(entry), HeHASH(entry)));
 }
 
 /*
@@ -1378,7 +1499,7 @@ SV *
 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);
@@ -1439,6 +1560,19 @@ Perl_unsharepvn(pTHX_ const char *str, I32 len, U32 hash)
     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))) {
@@ -1456,6 +1590,8 @@ Perl_unsharepvn(pTHX_ const char *str, I32 len, U32 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);
@@ -1468,12 +1604,10 @@ Perl_unsharepvn(pTHX_ const char *str, I32 len, U32 hash)
        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
@@ -1488,6 +1622,19 @@ Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash)
     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:
 
@@ -1505,12 +1652,14 @@ Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash)
            continue;
        if (HeKEY(entry) != str && memNE(HeKEY(entry),str,len)) /* is this it? */
            continue;
+       if (HeKUTF8(entry) != (char)is_utf8)
+           continue;
        found = 1;
        break;
     }
     if (!found) {
        entry = new_HE();
-       HeKEY_hek(entry) = save_hek(str, len, hash);
+       HeKEY_hek(entry) = save_hek(str, is_utf8?-len:len, hash);
        HeVAL(entry) = Nullsv;
        HeNEXT(entry) = *oentry;
        *oentry = entry;
@@ -1524,8 +1673,7 @@ Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash)
 
     ++HeVAL(entry);                            /* use value slot as REFCNT */
     UNLOCK_STRTAB_MUTEX;
+    if (str != save)
+       Safefree(str);
     return HeKEY_hek(entry);
 }
-
-
-