X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=hv.c;h=d5539209bbb0700d04e42e09a8da81cb9861db4d;hb=6e9d10810a2ec27ec94fd014e5dbab341c35afb1;hp=76180f2d8acc5b515d811262c755d965903e37f2;hpb=25716404fbbde2ca91832aab8c9157aafcdcc7e8;p=p5sagit%2Fp5-mst-13.2.git diff --git a/hv.c b/hv.c index 76180f2..d553920 100644 --- a/hv.c +++ b/hv.c @@ -199,7 +199,7 @@ Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen, I32 lval) 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 */ @@ -333,7 +333,7 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash) 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) @@ -447,7 +447,7 @@ Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen, SV *val, register U32 has #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); @@ -565,7 +565,7 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, register U32 hash) 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) @@ -675,7 +675,7 @@ Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags) 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); @@ -779,7 +779,7 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash) 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) @@ -869,7 +869,7 @@ Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen) 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); @@ -966,7 +966,7 @@ Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash) 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); @@ -1180,36 +1180,72 @@ Perl_newHV(pTHX) 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; @@ -1584,14 +1620,11 @@ Perl_unsharepvn(pTHX_ const char *str, I32 len, U32 hash) 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: @@ -1647,14 +1680,11 @@ Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash) 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: