hv.c

   1 /*    hv.c
   2  *
   3  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
   4  *    2000, 2001, 2002, 2003, by Larry Wall and others
   5  *
   6  *    You may distribute under the terms of either the GNU General Public
   7  *    License or the Artistic License, as specified in the README file.
   8  *
   9  */
  10
  11 /*
  12  * "I sit beside the fire and think of all that I have seen."  --Bilbo
  13  */
  14
  15 /*
  16 =head1 Hash Manipulation Functions
  17 */
  18
  19 #include "EXTERN.h"
  20 #define PERL_IN_HV_C
  21 #define PERL_HASH_INTERNAL_ACCESS
  22 #include "perl.h"
  23
  24 #define HV_MAX_LENGTH_BEFORE_SPLIT 14
  25
  26 STATIC HE*
  27 S_new_he(pTHX)
  28 {
  29     HE* he;
  30     LOCK_SV_MUTEX;
  31     if (!PL_he_root)
  32         more_he();
  33     he = PL_he_root;
  34     PL_he_root = HeNEXT(he);
  35     UNLOCK_SV_MUTEX;
  36     return he;
  37 }
  38
  39 STATIC void
  40 S_del_he(pTHX_ HE *p)
  41 {
  42     LOCK_SV_MUTEX;
  43     HeNEXT(p) = (HE*)PL_he_root;
  44     PL_he_root = p;
  45     UNLOCK_SV_MUTEX;
  46 }
  47
  48 STATIC void
  49 S_more_he(pTHX)
  50 {
  51     register HE* he;
  52     register HE* heend;
  53     XPV *ptr;
  54     New(54, ptr, 1008/sizeof(XPV), XPV);
  55     ptr->xpv_pv = (char*)PL_he_arenaroot;
  56     PL_he_arenaroot = ptr;
  57
  58     he = (HE*)ptr;
  59     heend = &he[1008 / sizeof(HE) - 1];
  60     PL_he_root = ++he;
  61     while (he < heend) {
  62         HeNEXT(he) = (HE*)(he + 1);
  63         he++;
  64     }
  65     HeNEXT(he) = 0;
  66 }
  67
  68 #ifdef PURIFY
  69
  70 #define new_HE() (HE*)safemalloc(sizeof(HE))
  71 #define del_HE(p) safefree((char*)p)
  72
  73 #else
  74
  75 #define new_HE() new_he()
  76 #define del_HE(p) del_he(p)
  77
  78 #endif
  79
  80 STATIC HEK *
  81 S_save_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags)
  82 {
  83     char *k;
  84     register HEK *hek;
  85
  86     New(54, k, HEK_BASESIZE + len + 2, char);
  87     hek = (HEK*)k;
  88     Copy(str, HEK_KEY(hek), len, char);
  89     HEK_KEY(hek)[len] = 0;
  90     HEK_LEN(hek) = len;
  91     HEK_HASH(hek) = hash;
  92     HEK_FLAGS(hek) = (unsigned char)flags;
  93     return hek;
  94 }
  95
  96 /* free the pool of temporary HE/HEK pairs retunrned by hv_fetch_ent
  97  * for tied hashes */
  98
  99 void
 100 Perl_free_tied_hv_pool(pTHX)
 101 {
 102     HE *ohe;
 103     HE *he = PL_hv_fetch_ent_mh;
 104     while (he) {
 105         Safefree(HeKEY_hek(he));
 106         ohe = he;
 107         he = HeNEXT(he);
 108         del_HE(ohe);
 109     }
 110     PL_hv_fetch_ent_mh = Nullhe;
 111 }
 112
 113 #if defined(USE_ITHREADS)
 114 HE *
 115 Perl_he_dup(pTHX_ HE *e, bool shared, CLONE_PARAMS* param)
 116 {
 117     HE *ret;
 118
 119     if (!e)
 120         return Nullhe;
 121     /* look for it in the table first */
 122     ret = (HE*)ptr_table_fetch(PL_ptr_table, e);
 123     if (ret)
 124         return ret;
 125
 126     /* create anew and remember what it is */
 127     ret = new_HE();
 128     ptr_table_store(PL_ptr_table, e, ret);
 129
 130     HeNEXT(ret) = he_dup(HeNEXT(e),shared, param);
 131     if (HeKLEN(e) == HEf_SVKEY) {
 132         char *k;
 133         New(54, k, HEK_BASESIZE + sizeof(SV*), char);
 134         HeKEY_hek(ret) = (HEK*)k;
 135         HeKEY_sv(ret) = SvREFCNT_inc(sv_dup(HeKEY_sv(e), param));
 136     }
 137     else if (shared)
 138         HeKEY_hek(ret) = share_hek_flags(HeKEY(e), HeKLEN(e), HeHASH(e),
 139                                          HeKFLAGS(e));
 140     else
 141         HeKEY_hek(ret) = save_hek_flags(HeKEY(e), HeKLEN(e), HeHASH(e),
 142                                         HeKFLAGS(e));
 143     HeVAL(ret) = SvREFCNT_inc(sv_dup(HeVAL(e), param));
 144     return ret;
 145 }
 146 #endif  /* USE_ITHREADS */
 147
 148 static void
 149 S_hv_notallowed(pTHX_ int flags, const char *key, I32 klen,
 150                 const char *msg)
 151 {
 152     SV *sv = sv_newmortal(), *esv = sv_newmortal();
 153     if (!(flags & HVhek_FREEKEY)) {
 154         sv_setpvn(sv, key, klen);
 155     }
 156     else {
 157         /* Need to free saved eventually assign to mortal SV */
 158         /* XXX is this line an error ???:  SV *sv = sv_newmortal(); */
 159         sv_usepvn(sv, (char *) key, klen);
 160     }
 161     if (flags & HVhek_UTF8) {
 162         SvUTF8_on(sv);
 163     }
 164     Perl_sv_setpvf(aTHX_ esv, "Attempt to %s a restricted hash", msg);
 165     Perl_croak(aTHX_ SvPVX(esv), sv);
 166 }
 167
 168 /* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot
 169  * contains an SV* */
 170
 171 /*
 172 =for apidoc hv_fetch
 173
 174 Returns the SV which corresponds to the specified key in the hash.  The
 175 C<klen> is the length of the key.  If C<lval> is set then the fetch will be
 176 part of a store.  Check that the return value is non-null before
 177 dereferencing it to an C<SV*>.
 178
 179 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
 180 information on how to use this function on tied hashes.
 181
 182 =cut
 183 */
 184
 185
 186 SV**
 187 Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen, I32 lval)
 188 {
 189     bool is_utf8 = FALSE;
 190     const char *keysave = key;
 191     int flags = 0;
 192
 193     if (klen < 0) {
 194       klen = -klen;
 195       is_utf8 = TRUE;
 196     }
 197
 198     if (is_utf8) {
 199         STRLEN tmplen = klen;
 200         /* Just casting the &klen to (STRLEN) won't work well
 201          * if STRLEN and I32 are of different widths. --jhi */
 202         key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
 203         klen = tmplen;
 204         /* If we were able to downgrade here, then than means that we were
 205            passed in a key which only had chars 0-255, but was utf8 encoded.  */
 206         if (is_utf8)
 207             flags = HVhek_UTF8;
 208         /* If we found we were able to downgrade the string to bytes, then
 209            we should flag that it needs upgrading on keys or each.  */
 210         if (key != keysave)
 211             flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
 212     }
 213
 214     return hv_fetch_flags (hv, key, klen, lval, flags);
 215 }
 216
 217 STATIC SV**
 218 S_hv_fetch_flags(pTHX_ HV *hv, const char *key, I32 klen, I32 lval, int flags)
 219 {
 220     register XPVHV* xhv;
 221     register U32 hash;
 222     register HE *entry;
 223     SV *sv;
 224
 225     if (!hv)
 226         return 0;
 227
 228     if (SvRMAGICAL(hv)) {
 229         /* All this clause seems to be utf8 unaware.
 230            By moving the utf8 stuff out to hv_fetch_flags I need to ensure
 231            key doesn't leak. I've not tried solving the utf8-ness.
 232            NWC.
 233         */
 234         if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
 235             sv = sv_newmortal();
 236             sv_upgrade(sv, SVt_PVLV);
 237             mg_copy((SV*)hv, sv, key, klen);
 238             if (flags & HVhek_FREEKEY)
 239                 Safefree(key);
 240             LvTYPE(sv) = 't';
 241             LvTARG(sv) = sv; /* fake (SV**) */
 242             return &(LvTARG(sv));
 243         }
 244 #ifdef ENV_IS_CASELESS
 245         else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
 246             I32 i;
 247             for (i = 0; i < klen; ++i)
 248                 if (isLOWER(key[i])) {
 249                     char *nkey = strupr(SvPVX(sv_2mortal(newSVpvn(key,klen))));
 250                     SV **ret = hv_fetch(hv, nkey, klen, 0);
 251                     if (!ret && lval) {
 252                         ret = hv_store_flags(hv, key, klen, NEWSV(61,0), 0,
 253                                              flags);
 254                     } else if (flags & HVhek_FREEKEY)
 255                         Safefree(key);
 256                     return ret;
 257                 }
 258         }
 259 #endif
 260     }
 261
 262     /* We use xhv->xhv_foo fields directly instead of HvFOO(hv) to
 263        avoid unnecessary pointer dereferencing. */
 264     xhv = (XPVHV*)SvANY(hv);
 265     if (!xhv->xhv_array /* !HvARRAY(hv) */) {
 266         if (lval
 267 #ifdef DYNAMIC_ENV_FETCH  /* if it's an %ENV lookup, we may get it on the fly */
 268                  || (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env))
 269 #endif
 270                                                                   )
 271             Newz(503, xhv->xhv_array /* HvARRAY(hv) */,
 272                  PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
 273                  char);
 274         else {
 275             if (flags & HVhek_FREEKEY)
 276                 Safefree(key);
 277             return 0;
 278         }
 279     }
 280
 281     if (HvREHASH(hv)) {
 282         PERL_HASH_INTERNAL(hash, key, klen);
 283         /* Yes, you do need this even though you are not "storing" because
 284            you can flip the flags below if doing an lval lookup.  (And that
 285            was put in to give the semantics Andreas was expecting.)  */
 286         flags |= HVhek_REHASH;
 287     } else {
 288         PERL_HASH(hash, key, klen);
 289     }
 290
 291     /* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
 292     entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 293     for (; entry; entry = HeNEXT(entry)) {
 294         if (!HeKEY_hek(entry))
 295             continue;
 296         if (HeHASH(entry) != hash)              /* strings can't be equal */
 297             continue;
 298         if (HeKLEN(entry) != (I32)klen)
 299             continue;
 300         if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
 301             continue;
 302         /* flags is 0 if not utf8. need HeKFLAGS(entry) also 0.
 303            flags is 1 if utf8. need HeKFLAGS(entry) also 1.
 304            xor is true if bits differ, in which case this isn't a match.  */
 305         if ((HeKFLAGS(entry) ^ flags) & HVhek_UTF8)
 306             continue;
 307         if (lval && HeKFLAGS(entry) != flags) {
 308             /* We match if HVhek_UTF8 bit in our flags and hash key's match.
 309                But if entry was set previously with HVhek_WASUTF8 and key now
 310                doesn't (or vice versa) then we should change the key's flag,
 311                as this is assignment.  */
 312             if (HvSHAREKEYS(hv)) {
 313                 /* Need to swap the key we have for a key with the flags we
 314                    need. As keys are shared we can't just write to the flag,
 315                    so we share the new one, unshare the old one.  */
 316                 int flags_nofree = flags & ~HVhek_FREEKEY;
 317                 HEK *new_hek = share_hek_flags(key, klen, hash, flags_nofree);
 318                 unshare_hek (HeKEY_hek(entry));
 319                 HeKEY_hek(entry) = new_hek;
 320             }
 321             else
 322                 HeKFLAGS(entry) = flags;
 323             if (flags & HVhek_ENABLEHVKFLAGS)
 324                 HvHASKFLAGS_on(hv);
 325         }
 326         if (flags & HVhek_FREEKEY)
 327             Safefree(key);
 328         /* if we find a placeholder, we pretend we haven't found anything */
 329         if (HeVAL(entry) == &PL_sv_placeholder)
 330             break;
 331         return &HeVAL(entry);
 332
 333     }
 334 #ifdef DYNAMIC_ENV_FETCH  /* %ENV lookup?  If so, try to fetch the value now */
 335     if (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
 336         unsigned long len;
 337         char *env = PerlEnv_ENVgetenv_len(key,&len);
 338         if (env) {
 339             sv = newSVpvn(env,len);
 340             SvTAINTED_on(sv);
 341             if (flags & HVhek_FREEKEY)
 342                 Safefree(key);
 343             return hv_store(hv,key,klen,sv,hash);
 344         }
 345     }
 346 #endif
 347     if (!entry && SvREADONLY(hv)) {
 348         S_hv_notallowed(aTHX_ flags, key, klen,
 349                         "access disallowed key '%"SVf"' in"
 350                         );
 351     }
 352     if (lval) {         /* gonna assign to this, so it better be there */
 353         sv = NEWSV(61,0);
 354         return hv_store_flags(hv,key,klen,sv,hash,flags);
 355     }
 356     if (flags & HVhek_FREEKEY)
 357         Safefree(key);
 358     return 0;
 359 }
 360
 361 /* returns an HE * structure with the all fields set */
 362 /* note that hent_val will be a mortal sv for MAGICAL hashes */
 363 /*
 364 =for apidoc hv_fetch_ent
 365
 366 Returns the hash entry which corresponds to the specified key in the hash.
 367 C<hash> must be a valid precomputed hash number for the given C<key>, or 0
 368 if you want the function to compute it.  IF C<lval> is set then the fetch
 369 will be part of a store.  Make sure the return value is non-null before
 370 accessing it.  The return value when C<tb> is a tied hash is a pointer to a
 371 static location, so be sure to make a copy of the structure if you need to
 372 store it somewhere.
 373
 374 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
 375 information on how to use this function on tied hashes.
 376
 377 =cut
 378 */
 379
 380 HE *
 381 Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
 382 {
 383     register XPVHV* xhv;
 384     register char *key;
 385     STRLEN klen;
 386     register HE *entry;
 387     SV *sv;
 388     bool is_utf8;
 389     int flags = 0;
 390     char *keysave;
 391
 392     if (!hv)
 393         return 0;
 394
 395     if (SvRMAGICAL(hv)) {
 396         if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
 397             sv = sv_newmortal();
 398             keysv = newSVsv(keysv);
 399             mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
 400             /* grab a fake HE/HEK pair from the pool or make a new one */
 401             entry = PL_hv_fetch_ent_mh;
 402             if (entry)
 403                 PL_hv_fetch_ent_mh = HeNEXT(entry);
 404             else {
 405                 char *k;
 406                 entry = new_HE();
 407                 New(54, k, HEK_BASESIZE + sizeof(SV*), char);
 408                 HeKEY_hek(entry) = (HEK*)k;
 409             }
 410             HeNEXT(entry) = Nullhe;
 411             HeSVKEY_set(entry, keysv);
 412             HeVAL(entry) = sv;
 413             sv_upgrade(sv, SVt_PVLV);
 414             LvTYPE(sv) = 'T';
 415             LvTARG(sv) = (SV*)entry; /* so we can free entry when freeing sv */
 416             return entry;
 417         }
 418 #ifdef ENV_IS_CASELESS
 419         else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
 420             U32 i;
 421             key = SvPV(keysv, klen);
 422             for (i = 0; i < klen; ++i)
 423                 if (isLOWER(key[i])) {
 424                     SV *nkeysv = sv_2mortal(newSVpvn(key,klen));
 425                     (void)strupr(SvPVX(nkeysv));
 426                     entry = hv_fetch_ent(hv, nkeysv, 0, 0);
 427                     if (!entry && lval)
 428                         entry = hv_store_ent(hv, keysv, NEWSV(61,0), hash);
 429                     return entry;
 430                 }
 431         }
 432 #endif
 433     }
 434
 435     keysave = key = SvPV(keysv, klen);
 436     xhv = (XPVHV*)SvANY(hv);
 437     if (!xhv->xhv_array /* !HvARRAY(hv) */) {
 438         if (lval
 439 #ifdef DYNAMIC_ENV_FETCH  /* if it's an %ENV lookup, we may get it on the fly */
 440                  || (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env))
 441 #endif
 442                                                                   )
 443             Newz(503, xhv->xhv_array /* HvARRAY(hv) */,
 444                  PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
 445                  char);
 446         else
 447             return 0;
 448     }
 449
 450     is_utf8 = (SvUTF8(keysv)!=0);
 451
 452     if (is_utf8) {
 453         key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
 454         if (is_utf8)
 455             flags = HVhek_UTF8;
 456         if (key != keysave)
 457             flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
 458     }
 459
 460     if (HvREHASH(hv)) {
 461         PERL_HASH_INTERNAL(hash, key, klen);
 462         /* Yes, you do need this even though you are not "storing" because
 463            you can flip the flags below if doing an lval lookup.  (And that
 464            was put in to give the semantics Andreas was expecting.)  */
 465         flags |= HVhek_REHASH;
 466     } else if (!hash) {
 467         if SvIsCOW_shared_hash(keysv) {
 468             hash = SvUVX(keysv);
 469         } else {
 470             PERL_HASH(hash, key, klen);
 471         }
 472     }
 473
 474     /* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
 475     entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 476     for (; entry; entry = HeNEXT(entry)) {
 477         if (HeHASH(entry) != hash)              /* strings can't be equal */
 478             continue;
 479         if (HeKLEN(entry) != (I32)klen)
 480             continue;
 481         if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
 482             continue;
 483         if ((HeKFLAGS(entry) ^ flags) & HVhek_UTF8)
 484             continue;
 485         if (lval && HeKFLAGS(entry) != flags) {
 486             /* We match if HVhek_UTF8 bit in our flags and hash key's match.
 487                But if entry was set previously with HVhek_WASUTF8 and key now
 488                doesn't (or vice versa) then we should change the key's flag,
 489                as this is assignment.  */
 490             if (HvSHAREKEYS(hv)) {
 491                 /* Need to swap the key we have for a key with the flags we
 492                    need. As keys are shared we can't just write to the flag,
 493                    so we share the new one, unshare the old one.  */
 494                 int flags_nofree = flags & ~HVhek_FREEKEY;
 495                 HEK *new_hek = share_hek_flags(key, klen, hash, flags_nofree);
 496                 unshare_hek (HeKEY_hek(entry));
 497                 HeKEY_hek(entry) = new_hek;
 498             }
 499             else
 500                 HeKFLAGS(entry) = flags;
 501             if (flags & HVhek_ENABLEHVKFLAGS)
 502                 HvHASKFLAGS_on(hv);
 503         }
 504         if (key != keysave)
 505             Safefree(key);
 506         /* if we find a placeholder, we pretend we haven't found anything */
 507         if (HeVAL(entry) == &PL_sv_placeholder)
 508             break;
 509         return entry;
 510     }
 511 #ifdef DYNAMIC_ENV_FETCH  /* %ENV lookup?  If so, try to fetch the value now */
 512     if (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
 513         unsigned long len;
 514         char *env = PerlEnv_ENVgetenv_len(key,&len);
 515         if (env) {
 516             sv = newSVpvn(env,len);
 517             SvTAINTED_on(sv);
 518             return hv_store_ent(hv,keysv,sv,hash);
 519         }
 520     }
 521 #endif
 522     if (!entry && SvREADONLY(hv)) {
 523         S_hv_notallowed(aTHX_ flags, key, klen,
 524                         "access disallowed key '%"SVf"' in"
 525                         );
 526     }
 527     if (flags & HVhek_FREEKEY)
 528         Safefree(key);
 529     if (lval) {         /* gonna assign to this, so it better be there */
 530         sv = NEWSV(61,0);
 531         return hv_store_ent(hv,keysv,sv,hash);
 532     }
 533     return 0;
 534 }
 535
 536 STATIC void
 537 S_hv_magic_check(pTHX_ HV *hv, bool *needs_copy, bool *needs_store)
 538 {
 539     MAGIC *mg = SvMAGIC(hv);
 540     *needs_copy = FALSE;
 541     *needs_store = TRUE;
 542     while (mg) {
 543         if (isUPPER(mg->mg_type)) {
 544             *needs_copy = TRUE;
 545             switch (mg->mg_type) {
 546             case PERL_MAGIC_tied:
 547             case PERL_MAGIC_sig:
 548                 *needs_store = FALSE;
 549             }
 550         }
 551         mg = mg->mg_moremagic;
 552     }
 553 }
 554
 555 /*
 556 =for apidoc hv_store
 557
 558 Stores an SV in a hash.  The hash key is specified as C<key> and C<klen> is
 559 the length of the key.  The C<hash> parameter is the precomputed hash
 560 value; if it is zero then Perl will compute it.  The return value will be
 561 NULL if the operation failed or if the value did not need to be actually
 562 stored within the hash (as in the case of tied hashes).  Otherwise it can
 563 be dereferenced to get the original C<SV*>.  Note that the caller is
 564 responsible for suitably incrementing the reference count of C<val> before
 565 the call, and decrementing it if the function returned NULL.  Effectively
 566 a successful hv_store takes ownership of one reference to C<val>.  This is
 567 usually what you want; a newly created SV has a reference count of one, so
 568 if all your code does is create SVs then store them in a hash, hv_store
 569 will own the only reference to the new SV, and your code doesn't need to do
 570 anything further to tidy up.  hv_store is not implemented as a call to
 571 hv_store_ent, and does not create a temporary SV for the key, so if your
 572 key data is not already in SV form then use hv_store in preference to
 573 hv_store_ent.
 574
 575 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
 576 information on how to use this function on tied hashes.
 577
 578 =cut
 579 */
 580
 581 SV**
 582 Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen, SV *val, U32 hash)
 583 {
 584     bool is_utf8 = FALSE;
 585     const char *keysave = key;
 586     int flags = 0;
 587
 588     if (klen < 0) {
 589       klen = -klen;
 590       is_utf8 = TRUE;
 591     }
 592
 593     if (is_utf8) {
 594         STRLEN tmplen = klen;
 595         /* Just casting the &klen to (STRLEN) won't work well
 596          * if STRLEN and I32 are of different widths. --jhi */
 597         key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
 598         klen = tmplen;
 599         /* If we were able to downgrade here, then than means that we were
 600            passed in a key which only had chars 0-255, but was utf8 encoded.  */
 601         if (is_utf8)
 602             flags = HVhek_UTF8;
 603         /* If we found we were able to downgrade the string to bytes, then
 604            we should flag that it needs upgrading on keys or each.  */
 605         if (key != keysave)
 606             flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
 607     }
 608
 609     return hv_store_flags (hv, key, klen, val, hash, flags);
 610 }
 611
 612 SV**
 613 Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val,
 614                  register U32 hash, int flags)
 615 {
 616     register XPVHV* xhv;
 617     register U32 n_links;
 618     register HE *entry;
 619     register HE **oentry;
 620
 621     if (!hv)
 622         return 0;
 623
 624     xhv = (XPVHV*)SvANY(hv);
 625     if (SvMAGICAL(hv)) {
 626         bool needs_copy;
 627         bool needs_store;
 628         hv_magic_check (hv, &needs_copy, &needs_store);
 629         if (needs_copy) {
 630             mg_copy((SV*)hv, val, key, klen);
 631             if (!xhv->xhv_array /* !HvARRAY */ && !needs_store) {
 632                 if (flags & HVhek_FREEKEY)
 633                     Safefree(key);
 634                 return 0;
 635             }
 636 #ifdef ENV_IS_CASELESS
 637             else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
 638                 key = savepvn(key,klen);
 639                 key = (const char*)strupr((char*)key);
 640                 hash = 0;
 641             }
 642 #endif
 643         }
 644     }
 645
 646     if (flags)
 647         HvHASKFLAGS_on((SV*)hv);
 648
 649     if (HvREHASH(hv)) {
 650         /* We don't have a pointer to the hv, so we have to replicate the
 651            flag into every HEK, so that hv_iterkeysv can see it.  */
 652         flags |= HVhek_REHASH;
 653         PERL_HASH_INTERNAL(hash, key, klen);
 654     } else if (!hash)
 655         PERL_HASH(hash, key, klen);
 656
 657     if (!xhv->xhv_array /* !HvARRAY(hv) */)
 658         Newz(505, xhv->xhv_array /* HvARRAY(hv) */,
 659              PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
 660              char);
 661
 662     /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
 663     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 664
 665     n_links = 0;
 666
 667     for (entry = *oentry; entry; ++n_links, entry = HeNEXT(entry)) {
 668         if (HeHASH(entry) != hash)              /* strings can't be equal */
 669             continue;
 670         if (HeKLEN(entry) != (I32)klen)
 671             continue;
 672         if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
 673             continue;
 674         if ((HeKFLAGS(entry) ^ flags) & HVhek_UTF8)
 675             continue;
 676         if (HeVAL(entry) == &PL_sv_placeholder)
 677             xhv->xhv_placeholders--; /* yes, can store into placeholder slot */
 678         else
 679             SvREFCNT_dec(HeVAL(entry));
 680         if (flags & HVhek_PLACEHOLD) {
 681             /* We have been requested to insert a placeholder. Currently
 682                only Storable is allowed to do this.  */
 683             xhv->xhv_placeholders++;
 684             HeVAL(entry) = &PL_sv_placeholder;
 685         } else
 686             HeVAL(entry) = val;
 687
 688         if (HeKFLAGS(entry) != flags) {
 689             /* We match if HVhek_UTF8 bit in our flags and hash key's match.
 690                But if entry was set previously with HVhek_WASUTF8 and key now
 691                doesn't (or vice versa) then we should change the key's flag,
 692                as this is assignment.  */
 693             if (HvSHAREKEYS(hv)) {
 694                 /* Need to swap the key we have for a key with the flags we
 695                    need. As keys are shared we can't just write to the flag,
 696                    so we share the new one, unshare the old one.  */
 697                 int flags_nofree = flags & ~HVhek_FREEKEY;
 698                 HEK *new_hek = share_hek_flags(key, klen, hash, flags_nofree);
 699                 unshare_hek (HeKEY_hek(entry));
 700                 HeKEY_hek(entry) = new_hek;
 701             }
 702             else
 703                 HeKFLAGS(entry) = flags;
 704         }
 705         if (flags & HVhek_FREEKEY)
 706             Safefree(key);
 707         return &HeVAL(entry);
 708     }
 709
 710     if (SvREADONLY(hv)) {
 711         S_hv_notallowed(aTHX_ flags, key, klen,
 712                         "access disallowed key '%"SVf"' to"
 713                         );
 714     }
 715
 716     entry = new_HE();
 717     /* share_hek_flags will do the free for us.  This might be considered
 718        bad API design.  */
 719     if (HvSHAREKEYS(hv))
 720         HeKEY_hek(entry) = share_hek_flags(key, klen, hash, flags);
 721     else                                       /* gotta do the real thing */
 722         HeKEY_hek(entry) = save_hek_flags(key, klen, hash, flags);
 723     if (flags & HVhek_PLACEHOLD) {
 724         /* We have been requested to insert a placeholder. Currently
 725            only Storable is allowed to do this.  */
 726         xhv->xhv_placeholders++;
 727         HeVAL(entry) = &PL_sv_placeholder;
 728     } else
 729         HeVAL(entry) = val;
 730     HeNEXT(entry) = *oentry;
 731     *oentry = entry;
 732
 733     xhv->xhv_keys++; /* HvKEYS(hv)++ */
 734     if (!n_links) {                             /* initial entry? */
 735         xhv->xhv_fill++; /* HvFILL(hv)++ */
 736     } else if ((xhv->xhv_keys > (IV)xhv->xhv_max)
 737                || ((n_links > HV_MAX_LENGTH_BEFORE_SPLIT) && !HvREHASH(hv))) {
 738         /* Use the old HvKEYS(hv) > HvMAX(hv) condition to limit bucket
 739            splits on a rehashed hash, as we're not going to split it again,
 740            and if someone is lucky (evil) enough to get all the keys in one
 741            list they could exhaust our memory as we repeatedly double the
 742            number of buckets on every entry. Linear search feels a less worse
 743            thing to do.  */
 744         hsplit(hv);
 745     }
 746
 747     return &HeVAL(entry);
 748 }
 749
 750 /*
 751 =for apidoc hv_store_ent
 752
 753 Stores C<val> in a hash.  The hash key is specified as C<key>.  The C<hash>
 754 parameter is the precomputed hash value; if it is zero then Perl will
 755 compute it.  The return value is the new hash entry so created.  It will be
 756 NULL if the operation failed or if the value did not need to be actually
 757 stored within the hash (as in the case of tied hashes).  Otherwise the
 758 contents of the return value can be accessed using the C<He?> macros
 759 described here.  Note that the caller is responsible for suitably
 760 incrementing the reference count of C<val> before the call, and
 761 decrementing it if the function returned NULL.  Effectively a successful
 762 hv_store_ent takes ownership of one reference to C<val>.  This is
 763 usually what you want; a newly created SV has a reference count of one, so
 764 if all your code does is create SVs then store them in a hash, hv_store
 765 will own the only reference to the new SV, and your code doesn't need to do
 766 anything further to tidy up.  Note that hv_store_ent only reads the C<key>;
 767 unlike C<val> it does not take ownership of it, so maintaining the correct
 768 reference count on C<key> is entirely the caller's responsibility.  hv_store
 769 is not implemented as a call to hv_store_ent, and does not create a temporary
 770 SV for the key, so if your key data is not already in SV form then use
 771 hv_store in preference to hv_store_ent.
 772
 773 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
 774 information on how to use this function on tied hashes.
 775
 776 =cut
 777 */
 778
 779 HE *
 780 Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash)
 781 {
 782     XPVHV* xhv;
 783     char *key;
 784     STRLEN klen;
 785     U32 n_links;
 786     HE *entry;
 787     HE **oentry;
 788     bool is_utf8;
 789     int flags = 0;
 790     char *keysave;
 791
 792     if (!hv)
 793         return 0;
 794
 795     xhv = (XPVHV*)SvANY(hv);
 796     if (SvMAGICAL(hv)) {
 797         bool needs_copy;
 798         bool needs_store;
 799         hv_magic_check (hv, &needs_copy, &needs_store);
 800         if (needs_copy) {
 801             bool save_taint = PL_tainted;
 802             if (PL_tainting)
 803                 PL_tainted = SvTAINTED(keysv);
 804             keysv = sv_2mortal(newSVsv(keysv));
 805             mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
 806             TAINT_IF(save_taint);
 807             if (!xhv->xhv_array /* !HvARRAY(hv) */ && !needs_store)
 808                 return Nullhe;
 809 #ifdef ENV_IS_CASELESS
 810             else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
 811                 key = SvPV(keysv, klen);
 812                 keysv = sv_2mortal(newSVpvn(key,klen));
 813                 (void)strupr(SvPVX(keysv));
 814                 hash = 0;
 815             }
 816 #endif
 817         }
 818     }
 819
 820     keysave = key = SvPV(keysv, klen);
 821     is_utf8 = (SvUTF8(keysv) != 0);
 822
 823     if (is_utf8) {
 824         key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
 825         if (is_utf8)
 826             flags = HVhek_UTF8;
 827         if (key != keysave)
 828             flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
 829         HvHASKFLAGS_on((SV*)hv);
 830     }
 831
 832     if (HvREHASH(hv)) {
 833         /* We don't have a pointer to the hv, so we have to replicate the
 834            flag into every HEK, so that hv_iterkeysv can see it.  */
 835         flags |= HVhek_REHASH;
 836         PERL_HASH_INTERNAL(hash, key, klen);
 837     } else if (!hash) {
 838         if SvIsCOW_shared_hash(keysv) {
 839             hash = SvUVX(keysv);
 840         } else {
 841             PERL_HASH(hash, key, klen);
 842         }
 843     }
 844
 845     if (!xhv->xhv_array /* !HvARRAY(hv) */)
 846         Newz(505, xhv->xhv_array /* HvARRAY(hv) */,
 847              PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
 848              char);
 849
 850     /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
 851     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 852     n_links = 0;
 853     entry = *oentry;
 854     for (; entry; ++n_links, entry = HeNEXT(entry)) {
 855         if (HeHASH(entry) != hash)              /* strings can't be equal */
 856             continue;
 857         if (HeKLEN(entry) != (I32)klen)
 858             continue;
 859         if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
 860             continue;
 861         if ((HeKFLAGS(entry) ^ flags) & HVhek_UTF8)
 862             continue;
 863         if (HeVAL(entry) == &PL_sv_placeholder)
 864             xhv->xhv_placeholders--; /* yes, can store into placeholder slot */
 865         else
 866             SvREFCNT_dec(HeVAL(entry));
 867         HeVAL(entry) = val;
 868         if (HeKFLAGS(entry) != flags) {
 869             /* We match if HVhek_UTF8 bit in our flags and hash key's match.
 870                But if entry was set previously with HVhek_WASUTF8 and key now
 871                doesn't (or vice versa) then we should change the key's flag,
 872                as this is assignment.  */
 873             if (HvSHAREKEYS(hv)) {
 874                 /* Need to swap the key we have for a key with the flags we
 875                    need. As keys are shared we can't just write to the flag,
 876                    so we share the new one, unshare the old one.  */
 877                 int flags_nofree = flags & ~HVhek_FREEKEY;
 878                 HEK *new_hek = share_hek_flags(key, klen, hash, flags_nofree);
 879                 unshare_hek (HeKEY_hek(entry));
 880                 HeKEY_hek(entry) = new_hek;
 881             }
 882             else
 883                 HeKFLAGS(entry) = flags;
 884         }
 885         if (flags & HVhek_FREEKEY)
 886             Safefree(key);
 887         return entry;
 888     }
 889
 890     if (SvREADONLY(hv)) {
 891         S_hv_notallowed(aTHX_ flags, key, klen,
 892                         "access disallowed key '%"SVf"' to"
 893                         );
 894     }
 895
 896     entry = new_HE();
 897     /* share_hek_flags will do the free for us.  This might be considered
 898        bad API design.  */
 899     if (HvSHAREKEYS(hv))
 900         HeKEY_hek(entry) = share_hek_flags(key, klen, hash, flags);
 901     else                                       /* gotta do the real thing */
 902         HeKEY_hek(entry) = save_hek_flags(key, klen, hash, flags);
 903     HeVAL(entry) = val;
 904     HeNEXT(entry) = *oentry;
 905     *oentry = entry;
 906
 907     xhv->xhv_keys++; /* HvKEYS(hv)++ */
 908     if (!n_links) {                             /* initial entry? */
 909         xhv->xhv_fill++; /* HvFILL(hv)++ */
 910     } else if ((xhv->xhv_keys > (IV)xhv->xhv_max)
 911                || ((n_links > HV_MAX_LENGTH_BEFORE_SPLIT) && !HvREHASH(hv))) {
 912         /* Use only the old HvKEYS(hv) > HvMAX(hv) condition to limit bucket
 913            splits on a rehashed hash, as we're not going to split it again,
 914            and if someone is lucky (evil) enough to get all the keys in one
 915            list they could exhaust our memory as we repeatedly double the
 916            number of buckets on every entry. Linear search feels a less worse
 917            thing to do.  */
 918         hsplit(hv);
 919     }
 920
 921     return entry;
 922 }
 923
 924 /*
 925 =for apidoc hv_delete
 926
 927 Deletes a key/value pair in the hash.  The value SV is removed from the
 928 hash and returned to the caller.  The C<klen> is the length of the key.
 929 The C<flags> value will normally be zero; if set to G_DISCARD then NULL
 930 will be returned.
 931
 932 =cut
 933 */
 934
 935 SV *
 936 Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags)
 937 {
 938     register XPVHV* xhv;
 939     register I32 i;
 940     register U32 hash;
 941     register HE *entry;
 942     register HE **oentry;
 943     SV **svp;
 944     SV *sv;
 945     bool is_utf8 = FALSE;
 946     int k_flags = 0;
 947     const char *keysave = key;
 948
 949     if (!hv)
 950         return Nullsv;
 951     if (klen < 0) {
 952         klen = -klen;
 953         is_utf8 = TRUE;
 954     }
 955     if (SvRMAGICAL(hv)) {
 956         bool needs_copy;
 957         bool needs_store;
 958         hv_magic_check (hv, &needs_copy, &needs_store);
 959
 960         if (needs_copy && (svp = hv_fetch(hv, key, klen, TRUE))) {
 961             sv = *svp;
 962             if (SvMAGICAL(sv)) {
 963                 mg_clear(sv);
 964             }
 965             if (!needs_store) {
 966                 if (mg_find(sv, PERL_MAGIC_tiedelem)) {
 967                     /* No longer an element */
 968                     sv_unmagic(sv, PERL_MAGIC_tiedelem);
 969                     return sv;
 970                 }
 971                 return Nullsv;          /* element cannot be deleted */
 972             }
 973 #ifdef ENV_IS_CASELESS
 974             else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
 975                 sv = sv_2mortal(newSVpvn(key,klen));
 976                 key = strupr(SvPVX(sv));
 977             }
 978 #endif
 979         }
 980     }
 981     xhv = (XPVHV*)SvANY(hv);
 982     if (!xhv->xhv_array /* !HvARRAY(hv) */)
 983         return Nullsv;
 984
 985     if (is_utf8) {
 986         STRLEN tmplen = klen;
 987         /* See the note in hv_fetch(). --jhi */
 988         key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
 989         klen = tmplen;
 990         if (is_utf8)
 991             k_flags = HVhek_UTF8;
 992         if (key != keysave)
 993             k_flags |= HVhek_FREEKEY;
 994     }
 995
 996     if (HvREHASH(hv)) {
 997         PERL_HASH_INTERNAL(hash, key, klen);
 998     } else {
 999         PERL_HASH(hash, key, klen);
1000     }
1001
1002     /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
1003     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1004     entry = *oentry;
1005     i = 1;
1006     for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
1007         if (HeHASH(entry) != hash)              /* strings can't be equal */
1008             continue;
1009         if (HeKLEN(entry) != (I32)klen)
1010             continue;
1011         if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
1012             continue;
1013         if ((HeKFLAGS(entry) ^ k_flags) & HVhek_UTF8)
1014             continue;
1015         if (k_flags & HVhek_FREEKEY)
1016             Safefree(key);
1017         /* if placeholder is here, it's already been deleted.... */
1018         if (HeVAL(entry) == &PL_sv_placeholder)
1019         {
1020             if (SvREADONLY(hv))
1021                 return Nullsv;  /* if still SvREADONLY, leave it deleted. */
1022             else {
1023                 /* okay, really delete the placeholder... */
1024                 *oentry = HeNEXT(entry);
1025                 if (i && !*oentry)
1026                     xhv->xhv_fill--; /* HvFILL(hv)-- */
1027                 if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
1028                     HvLAZYDEL_on(hv);
1029                 else
1030                     hv_free_ent(hv, entry);
1031                 xhv->xhv_keys--; /* HvKEYS(hv)-- */
1032                 if (xhv->xhv_keys == 0)
1033                     HvHASKFLAGS_off(hv);
1034                 xhv->xhv_placeholders--;
1035                 return Nullsv;
1036             }
1037         }
1038         else if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
1039             S_hv_notallowed(aTHX_ k_flags, key, klen,
1040                             "delete readonly key '%"SVf"' from"
1041                             );
1042         }
1043
1044         if (flags & G_DISCARD)
1045             sv = Nullsv;
1046         else {
1047             sv = sv_2mortal(HeVAL(entry));
1048             HeVAL(entry) = &PL_sv_placeholder;
1049         }
1050
1051         /*
1052          * If a restricted hash, rather than really deleting the entry, put
1053          * a placeholder there. This marks the key as being "approved", so
1054          * we can still access via not-really-existing key without raising
1055          * an error.
1056          */
1057         if (SvREADONLY(hv)) {
1058             HeVAL(entry) = &PL_sv_placeholder;
1059             /* We'll be saving this slot, so the number of allocated keys
1060              * doesn't go down, but the number placeholders goes up */
1061             xhv->xhv_placeholders++; /* HvPLACEHOLDERS(hv)++ */
1062         } else {
1063             *oentry = HeNEXT(entry);
1064             if (i && !*oentry)
1065                 xhv->xhv_fill--; /* HvFILL(hv)-- */
1066             if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
1067                 HvLAZYDEL_on(hv);
1068             else
1069                 hv_free_ent(hv, entry);
1070             xhv->xhv_keys--; /* HvKEYS(hv)-- */
1071             if (xhv->xhv_keys == 0)
1072                 HvHASKFLAGS_off(hv);
1073         }
1074         return sv;
1075     }
1076     if (SvREADONLY(hv)) {
1077         S_hv_notallowed(aTHX_ k_flags, key, klen,
1078                         "access disallowed key '%"SVf"' from"
1079                         );
1080     }
1081
1082     if (k_flags & HVhek_FREEKEY)
1083         Safefree(key);
1084     return Nullsv;
1085 }
1086
1087 /*
1088 =for apidoc hv_delete_ent
1089
1090 Deletes a key/value pair in the hash.  The value SV is removed from the
1091 hash and returned to the caller.  The C<flags> value will normally be zero;
1092 if set to G_DISCARD then NULL will be returned.  C<hash> can be a valid
1093 precomputed hash value, or 0 to ask for it to be computed.
1094
1095 =cut
1096 */
1097
1098 SV *
1099 Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
1100 {
1101     register XPVHV* xhv;
1102     register I32 i;
1103     register char *key;
1104     STRLEN klen;
1105     register HE *entry;
1106     register HE **oentry;
1107     SV *sv;
1108     bool is_utf8;
1109     int k_flags = 0;
1110     char *keysave;
1111
1112     if (!hv)
1113         return Nullsv;
1114     if (SvRMAGICAL(hv)) {
1115         bool needs_copy;
1116         bool needs_store;
1117         hv_magic_check (hv, &needs_copy, &needs_store);
1118
1119         if (needs_copy && (entry = hv_fetch_ent(hv, keysv, TRUE, hash))) {
1120             sv = HeVAL(entry);
1121             if (SvMAGICAL(sv)) {
1122                 mg_clear(sv);
1123             }
1124             if (!needs_store) {
1125                 if (mg_find(sv, PERL_MAGIC_tiedelem)) {
1126                     /* No longer an element */
1127                     sv_unmagic(sv, PERL_MAGIC_tiedelem);
1128                     return sv;
1129                 }
1130                 return Nullsv;          /* element cannot be deleted */
1131             }
1132 #ifdef ENV_IS_CASELESS
1133             else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
1134                 key = SvPV(keysv, klen);
1135                 keysv = sv_2mortal(newSVpvn(key,klen));
1136                 (void)strupr(SvPVX(keysv));
1137                 hash = 0;
1138             }
1139 #endif
1140         }
1141     }
1142     xhv = (XPVHV*)SvANY(hv);
1143     if (!xhv->xhv_array /* !HvARRAY(hv) */)
1144         return Nullsv;
1145
1146     keysave = key = SvPV(keysv, klen);
1147     is_utf8 = (SvUTF8(keysv) != 0);
1148
1149     if (is_utf8) {
1150         key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
1151         if (is_utf8)
1152             k_flags = HVhek_UTF8;
1153         if (key != keysave)
1154             k_flags |= HVhek_FREEKEY;
1155     }
1156
1157     if (HvREHASH(hv)) {
1158         PERL_HASH_INTERNAL(hash, key, klen);
1159     } else if (!hash) {
1160         PERL_HASH(hash, key, klen);
1161     }
1162
1163     /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
1164     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1165     entry = *oentry;
1166     i = 1;
1167     for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
1168         if (HeHASH(entry) != hash)              /* strings can't be equal */
1169             continue;
1170         if (HeKLEN(entry) != (I32)klen)
1171             continue;
1172         if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
1173             continue;
1174         if ((HeKFLAGS(entry) ^ k_flags) & HVhek_UTF8)
1175             continue;
1176         if (k_flags & HVhek_FREEKEY)
1177             Safefree(key);
1178
1179         /* if placeholder is here, it's already been deleted.... */
1180         if (HeVAL(entry) == &PL_sv_placeholder)
1181         {
1182             if (SvREADONLY(hv))
1183                 return Nullsv; /* if still SvREADONLY, leave it deleted. */
1184
1185            /* okay, really delete the placeholder. */
1186            *oentry = HeNEXT(entry);
1187            if (i && !*oentry)
1188                xhv->xhv_fill--; /* HvFILL(hv)-- */
1189            if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
1190                HvLAZYDEL_on(hv);
1191            else
1192                hv_free_ent(hv, entry);
1193            xhv->xhv_keys--; /* HvKEYS(hv)-- */
1194            if (xhv->xhv_keys == 0)
1195                HvHASKFLAGS_off(hv);
1196            xhv->xhv_placeholders--;
1197            return Nullsv;
1198         }
1199         else if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
1200             S_hv_notallowed(aTHX_ k_flags, key, klen,
1201                             "delete readonly key '%"SVf"' from"
1202                             );
1203         }
1204
1205         if (flags & G_DISCARD)
1206             sv = Nullsv;
1207         else {
1208             sv = sv_2mortal(HeVAL(entry));
1209             HeVAL(entry) = &PL_sv_placeholder;
1210         }
1211
1212         /*
1213          * If a restricted hash, rather than really deleting the entry, put
1214          * a placeholder there. This marks the key as being "approved", so
1215          * we can still access via not-really-existing key without raising
1216          * an error.
1217          */
1218         if (SvREADONLY(hv)) {
1219             HeVAL(entry) = &PL_sv_placeholder;
1220             /* We'll be saving this slot, so the number of allocated keys
1221              * doesn't go down, but the number placeholders goes up */
1222             xhv->xhv_placeholders++; /* HvPLACEHOLDERS(hv)++ */
1223         } else {
1224             *oentry = HeNEXT(entry);
1225             if (i && !*oentry)
1226                 xhv->xhv_fill--; /* HvFILL(hv)-- */
1227             if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
1228                 HvLAZYDEL_on(hv);
1229             else
1230                 hv_free_ent(hv, entry);
1231             xhv->xhv_keys--; /* HvKEYS(hv)-- */
1232             if (xhv->xhv_keys == 0)
1233                 HvHASKFLAGS_off(hv);
1234         }
1235         return sv;
1236     }
1237     if (SvREADONLY(hv)) {
1238         S_hv_notallowed(aTHX_ k_flags, key, klen,
1239                         "delete disallowed key '%"SVf"' from"
1240                         );
1241     }
1242
1243     if (k_flags & HVhek_FREEKEY)
1244         Safefree(key);
1245     return Nullsv;
1246 }
1247
1248 /*
1249 =for apidoc hv_exists
1250
1251 Returns a boolean indicating whether the specified hash key exists.  The
1252 C<klen> is the length of the key.
1253
1254 =cut
1255 */
1256
1257 bool
1258 Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen)
1259 {
1260     register XPVHV* xhv;
1261     register U32 hash;
1262     register HE *entry;
1263     SV *sv;
1264     bool is_utf8 = FALSE;
1265     const char *keysave = key;
1266     int k_flags = 0;
1267
1268     if (!hv)
1269         return 0;
1270
1271     if (klen < 0) {
1272       klen = -klen;
1273       is_utf8 = TRUE;
1274     }
1275
1276     if (SvRMAGICAL(hv)) {
1277         if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
1278             sv = sv_newmortal();
1279             mg_copy((SV*)hv, sv, key, klen);
1280             magic_existspack(sv, mg_find(sv, PERL_MAGIC_tiedelem));
1281             return (bool)SvTRUE(sv);
1282         }
1283 #ifdef ENV_IS_CASELESS
1284         else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
1285             sv = sv_2mortal(newSVpvn(key,klen));
1286             key = strupr(SvPVX(sv));
1287         }
1288 #endif
1289     }
1290
1291     xhv = (XPVHV*)SvANY(hv);
1292 #ifndef DYNAMIC_ENV_FETCH
1293     if (!xhv->xhv_array /* !HvARRAY(hv) */)
1294         return 0;
1295 #endif
1296
1297     if (is_utf8) {
1298         STRLEN tmplen = klen;
1299         /* See the note in hv_fetch(). --jhi */
1300         key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
1301         klen = tmplen;
1302         if (is_utf8)
1303             k_flags = HVhek_UTF8;
1304         if (key != keysave)
1305             k_flags |= HVhek_FREEKEY;
1306     }
1307
1308     if (HvREHASH(hv)) {
1309         PERL_HASH_INTERNAL(hash, key, klen);
1310     } else {
1311         PERL_HASH(hash, key, klen);
1312     }
1313
1314 #ifdef DYNAMIC_ENV_FETCH
1315     if (!xhv->xhv_array /* !HvARRAY(hv) */) entry = Null(HE*);
1316     else
1317 #endif
1318     /* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
1319     entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1320     for (; entry; entry = HeNEXT(entry)) {
1321         if (HeHASH(entry) != hash)              /* strings can't be equal */
1322             continue;
1323         if (HeKLEN(entry) != klen)
1324             continue;
1325         if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
1326             continue;
1327         if ((HeKFLAGS(entry) ^ k_flags) & HVhek_UTF8)
1328             continue;
1329         if (k_flags & HVhek_FREEKEY)
1330             Safefree(key);
1331         /* If we find the key, but the value is a placeholder, return false. */
1332         if (HeVAL(entry) == &PL_sv_placeholder)
1333             return FALSE;
1334
1335         return TRUE;
1336     }
1337 #ifdef DYNAMIC_ENV_FETCH  /* is it out there? */
1338     if (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
1339         unsigned long len;
1340         char *env = PerlEnv_ENVgetenv_len(key,&len);
1341         if (env) {
1342             sv = newSVpvn(env,len);
1343             SvTAINTED_on(sv);
1344             (void)hv_store(hv,key,klen,sv,hash);
1345             if (k_flags & HVhek_FREEKEY)
1346                 Safefree(key);
1347             return TRUE;
1348         }
1349     }
1350 #endif
1351     if (k_flags & HVhek_FREEKEY)
1352         Safefree(key);
1353     return FALSE;
1354 }
1355
1356
1357 /*
1358 =for apidoc hv_exists_ent
1359
1360 Returns a boolean indicating whether the specified hash key exists. C<hash>
1361 can be a valid precomputed hash value, or 0 to ask for it to be
1362 computed.
1363
1364 =cut
1365 */
1366
1367 bool
1368 Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
1369 {
1370     register XPVHV* xhv;
1371     register char *key;
1372     STRLEN klen;
1373     register HE *entry;
1374     SV *sv;
1375     bool is_utf8;
1376     char *keysave;
1377     int k_flags = 0;
1378
1379     if (!hv)
1380         return 0;
1381
1382     if (SvRMAGICAL(hv)) {
1383         if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
1384            SV* svret = sv_newmortal();
1385             sv = sv_newmortal();
1386             keysv = sv_2mortal(newSVsv(keysv));
1387             mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
1388            magic_existspack(svret, mg_find(sv, PERL_MAGIC_tiedelem));
1389            return (bool)SvTRUE(svret);
1390         }
1391 #ifdef ENV_IS_CASELESS
1392         else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
1393             key = SvPV(keysv, klen);
1394             keysv = sv_2mortal(newSVpvn(key,klen));
1395             (void)strupr(SvPVX(keysv));
1396             hash = 0;
1397         }
1398 #endif
1399     }
1400
1401     xhv = (XPVHV*)SvANY(hv);
1402 #ifndef DYNAMIC_ENV_FETCH
1403     if (!xhv->xhv_array /* !HvARRAY(hv) */)
1404         return 0;
1405 #endif
1406
1407     keysave = key = SvPV(keysv, klen);
1408     is_utf8 = (SvUTF8(keysv) != 0);
1409     if (is_utf8) {
1410         key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
1411         if (is_utf8)
1412             k_flags = HVhek_UTF8;
1413         if (key != keysave)
1414             k_flags |= HVhek_FREEKEY;
1415     }
1416     if (HvREHASH(hv)) {
1417         PERL_HASH_INTERNAL(hash, key, klen);
1418     } else if (!hash)
1419         PERL_HASH(hash, key, klen);
1420
1421 #ifdef DYNAMIC_ENV_FETCH
1422     if (!xhv->xhv_array /* !HvARRAY(hv) */) entry = Null(HE*);
1423     else
1424 #endif
1425     /* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
1426     entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1427     for (; entry; entry = HeNEXT(entry)) {
1428         if (HeHASH(entry) != hash)              /* strings can't be equal */
1429             continue;
1430         if (HeKLEN(entry) != (I32)klen)
1431             continue;
1432         if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
1433             continue;
1434         if ((HeKFLAGS(entry) ^ k_flags) & HVhek_UTF8)
1435             continue;
1436         if (k_flags & HVhek_FREEKEY)
1437             Safefree(key);
1438         /* If we find the key, but the value is a placeholder, return false. */
1439         if (HeVAL(entry) == &PL_sv_placeholder)
1440             return FALSE;
1441         return TRUE;
1442     }
1443 #ifdef DYNAMIC_ENV_FETCH  /* is it out there? */
1444     if (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
1445         unsigned long len;
1446         char *env = PerlEnv_ENVgetenv_len(key,&len);
1447         if (env) {
1448             sv = newSVpvn(env,len);
1449             SvTAINTED_on(sv);
1450             (void)hv_store_ent(hv,keysv,sv,hash);
1451             if (k_flags & HVhek_FREEKEY)
1452                 Safefree(key);
1453             return TRUE;
1454         }
1455     }
1456 #endif
1457     if (k_flags & HVhek_FREEKEY)
1458         Safefree(key);
1459     return FALSE;
1460 }
1461
1462 STATIC void
1463 S_hsplit(pTHX_ HV *hv)
1464 {
1465     register XPVHV* xhv = (XPVHV*)SvANY(hv);
1466     I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
1467     register I32 newsize = oldsize * 2;
1468     register I32 i;
1469     register char *a = xhv->xhv_array; /* HvARRAY(hv) */
1470     register HE **aep;
1471     register HE **bep;
1472     register HE *entry;
1473     register HE **oentry;
1474     int longest_chain = 0;
1475     int was_shared;
1476
1477     PL_nomemok = TRUE;
1478 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
1479     Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
1480     if (!a) {
1481       PL_nomemok = FALSE;
1482       return;
1483     }
1484 #else
1485     New(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
1486     if (!a) {
1487       PL_nomemok = FALSE;
1488       return;
1489     }
1490     Copy(xhv->xhv_array /* HvARRAY(hv) */, a, oldsize * sizeof(HE*), char);
1491     if (oldsize >= 64) {
1492         offer_nice_chunk(xhv->xhv_array /* HvARRAY(hv) */,
1493                         PERL_HV_ARRAY_ALLOC_BYTES(oldsize));
1494     }
1495     else
1496         Safefree(xhv->xhv_array /* HvARRAY(hv) */);
1497 #endif
1498
1499     PL_nomemok = FALSE;
1500     Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char);     /* zero 2nd half*/
1501     xhv->xhv_max = --newsize;   /* HvMAX(hv) = --newsize */
1502     xhv->xhv_array = a;         /* HvARRAY(hv) = a */
1503     aep = (HE**)a;
1504
1505     for (i=0; i<oldsize; i++,aep++) {
1506         int left_length = 0;
1507         int right_length = 0;
1508
1509         if (!*aep)                              /* non-existent */
1510             continue;
1511         bep = aep+oldsize;
1512         for (oentry = aep, entry = *aep; entry; entry = *oentry) {
1513             if ((HeHASH(entry) & newsize) != (U32)i) {
1514                 *oentry = HeNEXT(entry);
1515                 HeNEXT(entry) = *bep;
1516                 if (!*bep)
1517                     xhv->xhv_fill++; /* HvFILL(hv)++ */
1518                 *bep = entry;
1519                 right_length++;
1520                 continue;
1521             }
1522             else {
1523                 oentry = &HeNEXT(entry);
1524                 left_length++;
1525             }
1526         }
1527         if (!*aep)                              /* everything moved */
1528             xhv->xhv_fill--; /* HvFILL(hv)-- */
1529         /* I think we don't actually need to keep track of the longest length,
1530            merely flag if anything is too long. But for the moment while
1531            developing this code I'll track it.  */
1532         if (left_length > longest_chain)
1533             longest_chain = left_length;
1534         if (right_length > longest_chain)
1535             longest_chain = right_length;
1536     }
1537
1538
1539     /* Pick your policy for "hashing isn't working" here:  */
1540     if (longest_chain <= HV_MAX_LENGTH_BEFORE_SPLIT /* split worked?  */
1541         || HvREHASH(hv)) {
1542         return;
1543     }
1544
1545     if (hv == PL_strtab) {
1546         /* Urg. Someone is doing something nasty to the string table.
1547            Can't win.  */
1548         return;
1549     }
1550
1551     /* Awooga. Awooga. Pathological data.  */
1552     /*PerlIO_printf(PerlIO_stderr(), "%p %d of %d with %d/%d buckets\n", hv,
1553       longest_chain, HvTOTALKEYS(hv), HvFILL(hv),  1+HvMAX(hv));*/
1554
1555     ++newsize;
1556     Newz(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
1557     was_shared = HvSHAREKEYS(hv);
1558
1559     xhv->xhv_fill = 0;
1560     HvSHAREKEYS_off(hv);
1561     HvREHASH_on(hv);
1562
1563     aep = (HE **) xhv->xhv_array;
1564
1565     for (i=0; i<newsize; i++,aep++) {
1566         entry = *aep;
1567         while (entry) {
1568             /* We're going to trash this HE's next pointer when we chain it
1569                into the new hash below, so store where we go next.  */
1570             HE *next = HeNEXT(entry);
1571             UV hash;
1572
1573             /* Rehash it */
1574             PERL_HASH_INTERNAL(hash, HeKEY(entry), HeKLEN(entry));
1575
1576             if (was_shared) {
1577                 /* Unshare it.  */
1578                 HEK *new_hek
1579                     = save_hek_flags(HeKEY(entry), HeKLEN(entry),
1580                                      hash, HeKFLAGS(entry));
1581                 unshare_hek (HeKEY_hek(entry));
1582                 HeKEY_hek(entry) = new_hek;
1583             } else {
1584                 /* Not shared, so simply write the new hash in. */
1585                 HeHASH(entry) = hash;
1586             }
1587             /*PerlIO_printf(PerlIO_stderr(), "%d ", HeKFLAGS(entry));*/
1588             HEK_REHASH_on(HeKEY_hek(entry));
1589             /*PerlIO_printf(PerlIO_stderr(), "%d\n", HeKFLAGS(entry));*/
1590
1591             /* Copy oentry to the correct new chain.  */
1592             bep = ((HE**)a) + (hash & (I32) xhv->xhv_max);
1593             if (!*bep)
1594                     xhv->xhv_fill++; /* HvFILL(hv)++ */
1595             HeNEXT(entry) = *bep;
1596             *bep = entry;
1597
1598             entry = next;
1599         }
1600     }
1601     Safefree (xhv->xhv_array);
1602     xhv->xhv_array = a;         /* HvARRAY(hv) = a */
1603 }
1604
1605 void
1606 Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
1607 {
1608     register XPVHV* xhv = (XPVHV*)SvANY(hv);
1609     I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
1610     register I32 newsize;
1611     register I32 i;
1612     register I32 j;
1613     register char *a;
1614     register HE **aep;
1615     register HE *entry;
1616     register HE **oentry;
1617
1618     newsize = (I32) newmax;                     /* possible truncation here */
1619     if (newsize != newmax || newmax <= oldsize)
1620         return;
1621     while ((newsize & (1 + ~newsize)) != newsize) {
1622         newsize &= ~(newsize & (1 + ~newsize)); /* get proper power of 2 */
1623     }
1624     if (newsize < newmax)
1625         newsize *= 2;
1626     if (newsize < newmax)
1627         return;                                 /* overflow detection */
1628
1629     a = xhv->xhv_array; /* HvARRAY(hv) */
1630     if (a) {
1631         PL_nomemok = TRUE;
1632 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
1633         Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
1634         if (!a) {
1635           PL_nomemok = FALSE;
1636           return;
1637         }
1638 #else
1639         New(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
1640         if (!a) {
1641           PL_nomemok = FALSE;
1642           return;
1643         }
1644         Copy(xhv->xhv_array /* HvARRAY(hv) */, a, oldsize * sizeof(HE*), char);
1645         if (oldsize >= 64) {
1646             offer_nice_chunk(xhv->xhv_array /* HvARRAY(hv) */,
1647                             PERL_HV_ARRAY_ALLOC_BYTES(oldsize));
1648         }
1649         else
1650             Safefree(xhv->xhv_array /* HvARRAY(hv) */);
1651 #endif
1652         PL_nomemok = FALSE;
1653         Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/
1654     }
1655     else {
1656         Newz(0, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
1657     }
1658     xhv->xhv_max = --newsize;   /* HvMAX(hv) = --newsize */
1659     xhv->xhv_array = a;         /* HvARRAY(hv) = a */
1660     if (!xhv->xhv_fill /* !HvFILL(hv) */)       /* skip rest if no entries */
1661         return;
1662
1663     aep = (HE**)a;
1664     for (i=0; i<oldsize; i++,aep++) {
1665         if (!*aep)                              /* non-existent */
1666             continue;
1667         for (oentry = aep, entry = *aep; entry; entry = *oentry) {
1668             if ((j = (HeHASH(entry) & newsize)) != i) {
1669                 j -= i;
1670                 *oentry = HeNEXT(entry);
1671                 if (!(HeNEXT(entry) = aep[j]))
1672                     xhv->xhv_fill++; /* HvFILL(hv)++ */
1673                 aep[j] = entry;
1674                 continue;
1675             }
1676             else
1677                 oentry = &HeNEXT(entry);
1678         }
1679         if (!*aep)                              /* everything moved */
1680             xhv->xhv_fill--; /* HvFILL(hv)-- */
1681     }
1682 }
1683
1684 /*
1685 =for apidoc newHV
1686
1687 Creates a new HV.  The reference count is set to 1.
1688
1689 =cut
1690 */
1691
1692 HV *
1693 Perl_newHV(pTHX)
1694 {
1695     register HV *hv;
1696     register XPVHV* xhv;
1697
1698     hv = (HV*)NEWSV(502,0);
1699     sv_upgrade((SV *)hv, SVt_PVHV);
1700     xhv = (XPVHV*)SvANY(hv);
1701     SvPOK_off(hv);
1702     SvNOK_off(hv);
1703 #ifndef NODEFAULT_SHAREKEYS
1704     HvSHAREKEYS_on(hv);         /* key-sharing on by default */
1705 #endif
1706
1707     xhv->xhv_max    = 7;        /* HvMAX(hv) = 7 (start with 8 buckets) */
1708     xhv->xhv_fill   = 0;        /* HvFILL(hv) = 0 */
1709     xhv->xhv_pmroot = 0;        /* HvPMROOT(hv) = 0 */
1710     (void)hv_iterinit(hv);      /* so each() will start off right */
1711     return hv;
1712 }
1713
1714 HV *
1715 Perl_newHVhv(pTHX_ HV *ohv)
1716 {
1717     HV *hv = newHV();
1718     STRLEN hv_max, hv_fill;
1719
1720     if (!ohv || (hv_fill = HvFILL(ohv)) == 0)
1721         return hv;
1722     hv_max = HvMAX(ohv);
1723
1724     if (!SvMAGICAL((SV *)ohv)) {
1725         /* It's an ordinary hash, so copy it fast. AMS 20010804 */
1726         STRLEN i;
1727         bool shared = !!HvSHAREKEYS(ohv);
1728         HE **ents, **oents = (HE **)HvARRAY(ohv);
1729         char *a;
1730         New(0, a, PERL_HV_ARRAY_ALLOC_BYTES(hv_max+1), char);
1731         ents = (HE**)a;
1732
1733         /* In each bucket... */
1734         for (i = 0; i <= hv_max; i++) {
1735             HE *prev = NULL, *ent = NULL, *oent = oents[i];
1736
1737             if (!oent) {
1738                 ents[i] = NULL;
1739                 continue;
1740             }
1741
1742             /* Copy the linked list of entries. */
1743             for (oent = oents[i]; oent; oent = HeNEXT(oent)) {
1744                 U32 hash   = HeHASH(oent);
1745                 char *key  = HeKEY(oent);
1746                 STRLEN len = HeKLEN(oent);
1747                 int flags  = HeKFLAGS(oent);
1748
1749                 ent = new_HE();
1750                 HeVAL(ent)     = newSVsv(HeVAL(oent));
1751                 HeKEY_hek(ent)
1752                     = shared ? share_hek_flags(key, len, hash, flags)
1753                              :  save_hek_flags(key, len, hash, flags);
1754                 if (prev)
1755                     HeNEXT(prev) = ent;
1756                 else
1757                     ents[i] = ent;
1758                 prev = ent;
1759                 HeNEXT(ent) = NULL;
1760             }
1761         }
1762
1763         HvMAX(hv)   = hv_max;
1764         HvFILL(hv)  = hv_fill;
1765         HvTOTALKEYS(hv)  = HvTOTALKEYS(ohv);
1766         HvARRAY(hv) = ents;
1767     }
1768     else {
1769         /* Iterate over ohv, copying keys and values one at a time. */
1770         HE *entry;
1771         I32 riter = HvRITER(ohv);
1772         HE *eiter = HvEITER(ohv);
1773
1774         /* Can we use fewer buckets? (hv_max is always 2^n-1) */
1775         while (hv_max && hv_max + 1 >= hv_fill * 2)
1776             hv_max = hv_max / 2;
1777         HvMAX(hv) = hv_max;
1778
1779         hv_iterinit(ohv);
1780         while ((entry = hv_iternext_flags(ohv, 0))) {
1781             hv_store_flags(hv, HeKEY(entry), HeKLEN(entry),
1782                            newSVsv(HeVAL(entry)), HeHASH(entry),
1783                            HeKFLAGS(entry));
1784         }
1785         HvRITER(ohv) = riter;
1786         HvEITER(ohv) = eiter;
1787     }
1788
1789     return hv;
1790 }
1791
1792 void
1793 Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
1794 {
1795     SV *val;
1796
1797     if (!entry)
1798         return;
1799     val = HeVAL(entry);
1800     if (val && isGV(val) && GvCVu(val) && HvNAME(hv))
1801         PL_sub_generation++;    /* may be deletion of method from stash */
1802     SvREFCNT_dec(val);
1803     if (HeKLEN(entry) == HEf_SVKEY) {
1804         SvREFCNT_dec(HeKEY_sv(entry));
1805         Safefree(HeKEY_hek(entry));
1806     }
1807     else if (HvSHAREKEYS(hv))
1808         unshare_hek(HeKEY_hek(entry));
1809     else
1810         Safefree(HeKEY_hek(entry));
1811     del_HE(entry);
1812 }
1813
1814 void
1815 Perl_hv_delayfree_ent(pTHX_ HV *hv, register HE *entry)
1816 {
1817     if (!entry)
1818         return;
1819     if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv))
1820         PL_sub_generation++;    /* may be deletion of method from stash */
1821     sv_2mortal(HeVAL(entry));   /* free between statements */
1822     if (HeKLEN(entry) == HEf_SVKEY) {
1823         sv_2mortal(HeKEY_sv(entry));
1824         Safefree(HeKEY_hek(entry));
1825     }
1826     else if (HvSHAREKEYS(hv))
1827         unshare_hek(HeKEY_hek(entry));
1828     else
1829         Safefree(HeKEY_hek(entry));
1830     del_HE(entry);
1831 }
1832
1833 /*
1834 =for apidoc hv_clear
1835
1836 Clears a hash, making it empty.
1837
1838 =cut
1839 */
1840
1841 void
1842 Perl_hv_clear(pTHX_ HV *hv)
1843 {
1844     register XPVHV* xhv;
1845     if (!hv)
1846         return;
1847
1848     xhv = (XPVHV*)SvANY(hv);
1849
1850     if (SvREADONLY(hv)) {
1851         /* restricted hash: convert all keys to placeholders */
1852         I32 i;
1853         HE* entry;
1854         for (i = 0; i <= (I32) xhv->xhv_max; i++) {
1855             entry = ((HE**)xhv->xhv_array)[i];
1856             for (; entry; entry = HeNEXT(entry)) {
1857                 /* not already placeholder */
1858                 if (HeVAL(entry) != &PL_sv_placeholder) {
1859                     if (HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
1860                         SV* keysv = hv_iterkeysv(entry);
1861                         Perl_croak(aTHX_
1862         "Attempt to delete readonly key '%"SVf"' from a restricted hash",
1863                                    keysv);
1864                     }
1865                     SvREFCNT_dec(HeVAL(entry));
1866                     HeVAL(entry) = &PL_sv_placeholder;
1867                     xhv->xhv_placeholders++; /* HvPLACEHOLDERS(hv)++ */
1868                 }
1869             }
1870         }
1871         return;
1872     }
1873
1874     hfreeentries(hv);
1875     xhv->xhv_placeholders = 0; /* HvPLACEHOLDERS(hv) = 0 */
1876     if (xhv->xhv_array /* HvARRAY(hv) */)
1877         (void)memzero(xhv->xhv_array /* HvARRAY(hv) */,
1878                       (xhv->xhv_max+1 /* HvMAX(hv)+1 */) * sizeof(HE*));
1879
1880     if (SvRMAGICAL(hv))
1881         mg_clear((SV*)hv);
1882
1883     HvHASKFLAGS_off(hv);
1884     HvREHASH_off(hv);
1885 }
1886
1887 STATIC void
1888 S_hfreeentries(pTHX_ HV *hv)
1889 {
1890     register HE **array;
1891     register HE *entry;
1892     register HE *oentry = Null(HE*);
1893     I32 riter;
1894     I32 max;
1895
1896     if (!hv)
1897         return;
1898     if (!HvARRAY(hv))
1899         return;
1900
1901     riter = 0;
1902     max = HvMAX(hv);
1903     array = HvARRAY(hv);
1904     /* make everyone else think the array is empty, so that the destructors
1905      * called for freed entries can't recusively mess with us */
1906     HvARRAY(hv) = Null(HE**);
1907     HvFILL(hv) = 0;
1908     ((XPVHV*) SvANY(hv))->xhv_keys = 0;
1909
1910     entry = array[0];
1911     for (;;) {
1912         if (entry) {
1913             oentry = entry;
1914             entry = HeNEXT(entry);
1915             hv_free_ent(hv, oentry);
1916         }
1917         if (!entry) {
1918             if (++riter > max)
1919                 break;
1920             entry = array[riter];
1921         }
1922     }
1923     HvARRAY(hv) = array;
1924     (void)hv_iterinit(hv);
1925 }
1926
1927 /*
1928 =for apidoc hv_undef
1929
1930 Undefines the hash.
1931
1932 =cut
1933 */
1934
1935 void
1936 Perl_hv_undef(pTHX_ HV *hv)
1937 {
1938     register XPVHV* xhv;
1939     if (!hv)
1940         return;
1941     xhv = (XPVHV*)SvANY(hv);
1942     hfreeentries(hv);
1943     Safefree(xhv->xhv_array /* HvARRAY(hv) */);
1944     if (HvNAME(hv)) {
1945         if(PL_stashcache)
1946             hv_delete(PL_stashcache, HvNAME(hv), strlen(HvNAME(hv)), G_DISCARD);
1947         Safefree(HvNAME(hv));
1948         HvNAME(hv) = 0;
1949     }
1950     xhv->xhv_max   = 7; /* HvMAX(hv) = 7 (it's a normal hash) */
1951     xhv->xhv_array = 0; /* HvARRAY(hv) = 0 */
1952     xhv->xhv_placeholders = 0; /* HvPLACEHOLDERS(hv) = 0 */
1953
1954     if (SvRMAGICAL(hv))
1955         mg_clear((SV*)hv);
1956 }
1957
1958 /*
1959 =for apidoc hv_iterinit
1960
1961 Prepares a starting point to traverse a hash table.  Returns the number of
1962 keys in the hash (i.e. the same as C<HvKEYS(tb)>).  The return value is
1963 currently only meaningful for hashes without tie magic.
1964
1965 NOTE: Before version 5.004_65, C<hv_iterinit> used to return the number of
1966 hash buckets that happen to be in use.  If you still need that esoteric
1967 value, you can get it through the macro C<HvFILL(tb)>.
1968
1969
1970 =cut
1971 */
1972
1973 I32
1974 Perl_hv_iterinit(pTHX_ HV *hv)
1975 {
1976     register XPVHV* xhv;
1977     HE *entry;
1978
1979     if (!hv)
1980         Perl_croak(aTHX_ "Bad hash");
1981     xhv = (XPVHV*)SvANY(hv);
1982     entry = xhv->xhv_eiter; /* HvEITER(hv) */
1983     if (entry && HvLAZYDEL(hv)) {       /* was deleted earlier? */
1984         HvLAZYDEL_off(hv);
1985         hv_free_ent(hv, entry);
1986     }
1987     xhv->xhv_riter = -1;        /* HvRITER(hv) = -1 */
1988     xhv->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
1989     /* used to be xhv->xhv_fill before 5.004_65 */
1990     return XHvTOTALKEYS(xhv);
1991 }
1992 /*
1993 =for apidoc hv_iternext
1994
1995 Returns entries from a hash iterator.  See C<hv_iterinit>.
1996
1997 You may call C<hv_delete> or C<hv_delete_ent> on the hash entry that the
1998 iterator currently points to, without losing your place or invalidating your
1999 iterator.  Note that in this case the current entry is deleted from the hash
2000 with your iterator holding the last reference to it.  Your iterator is flagged
2001 to free the entry on the next call to C<hv_iternext>, so you must not discard
2002 your iterator immediately else the entry will leak - call C<hv_iternext> to
2003 trigger the resource deallocation.
2004
2005 =cut
2006 */
2007
2008 HE *
2009 Perl_hv_iternext(pTHX_ HV *hv)
2010 {
2011     return hv_iternext_flags(hv, 0);
2012 }
2013
2014 /*
2015 =for apidoc hv_iternext_flags
2016
2017 Returns entries from a hash iterator.  See C<hv_iterinit> and C<hv_iternext>.
2018 The C<flags> value will normally be zero; if HV_ITERNEXT_WANTPLACEHOLDERS is
2019 set the placeholders keys (for restricted hashes) will be returned in addition
2020 to normal keys. By default placeholders are automatically skipped over.
2021 Currently a placeholder is implemented with a value that is
2022 C<&Perl_sv_placeholder>. Note that the implementation of placeholders and
2023 restricted hashes may change, and the implementation currently is
2024 insufficiently abstracted for any change to be tidy.
2025
2026 =cut
2027 */
2028
2029 HE *
2030 Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
2031 {
2032     register XPVHV* xhv;
2033     register HE *entry;
2034     HE *oldentry;
2035     MAGIC* mg;
2036
2037     if (!hv)
2038         Perl_croak(aTHX_ "Bad hash");
2039     xhv = (XPVHV*)SvANY(hv);
2040     oldentry = entry = xhv->xhv_eiter; /* HvEITER(hv) */
2041
2042     if ((mg = SvTIED_mg((SV*)hv, PERL_MAGIC_tied))) {
2043         SV *key = sv_newmortal();
2044         if (entry) {
2045             sv_setsv(key, HeSVKEY_force(entry));
2046             SvREFCNT_dec(HeSVKEY(entry));       /* get rid of previous key */
2047         }
2048         else {
2049             char *k;
2050             HEK *hek;
2051
2052             /* one HE per MAGICAL hash */
2053             xhv->xhv_eiter = entry = new_HE(); /* HvEITER(hv) = new_HE() */
2054             Zero(entry, 1, HE);
2055             Newz(54, k, HEK_BASESIZE + sizeof(SV*), char);
2056             hek = (HEK*)k;
2057             HeKEY_hek(entry) = hek;
2058             HeKLEN(entry) = HEf_SVKEY;
2059         }
2060         magic_nextpack((SV*) hv,mg,key);
2061         if (SvOK(key)) {
2062             /* force key to stay around until next time */
2063             HeSVKEY_set(entry, SvREFCNT_inc(key));
2064             return entry;               /* beware, hent_val is not set */
2065         }
2066         if (HeVAL(entry))
2067             SvREFCNT_dec(HeVAL(entry));
2068         Safefree(HeKEY_hek(entry));
2069         del_HE(entry);
2070         xhv->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
2071         return Null(HE*);
2072     }
2073 #ifdef DYNAMIC_ENV_FETCH  /* set up %ENV for iteration */
2074     if (!entry && SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env))
2075         prime_env_iter();
2076 #endif
2077
2078     if (!xhv->xhv_array /* !HvARRAY(hv) */)
2079         Newz(506, xhv->xhv_array /* HvARRAY(hv) */,
2080              PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
2081              char);
2082     /* At start of hash, entry is NULL.  */
2083     if (entry)
2084     {
2085         entry = HeNEXT(entry);
2086         if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) {
2087             /*
2088              * Skip past any placeholders -- don't want to include them in
2089              * any iteration.
2090              */
2091             while (entry && HeVAL(entry) == &PL_sv_placeholder) {
2092                 entry = HeNEXT(entry);
2093             }
2094         }
2095     }
2096     while (!entry) {
2097         /* OK. Come to the end of the current list.  Grab the next one.  */
2098
2099         xhv->xhv_riter++; /* HvRITER(hv)++ */
2100         if (xhv->xhv_riter > (I32)xhv->xhv_max /* HvRITER(hv) > HvMAX(hv) */) {
2101             /* There is no next one.  End of the hash.  */
2102             xhv->xhv_riter = -1; /* HvRITER(hv) = -1 */
2103             break;
2104         }
2105         /* entry = (HvARRAY(hv))[HvRITER(hv)]; */
2106         entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
2107
2108         if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) {
2109             /* If we have an entry, but it's a placeholder, don't count it.
2110                Try the next.  */
2111             while (entry && HeVAL(entry) == &PL_sv_placeholder)
2112                 entry = HeNEXT(entry);
2113         }
2114         /* Will loop again if this linked list starts NULL
2115            (for HV_ITERNEXT_WANTPLACEHOLDERS)
2116            or if we run through it and find only placeholders.  */
2117     }
2118
2119     if (oldentry && HvLAZYDEL(hv)) {            /* was deleted earlier? */
2120         HvLAZYDEL_off(hv);
2121         hv_free_ent(hv, oldentry);
2122     }
2123
2124     /*if (HvREHASH(hv) && entry && !HeKREHASH(entry))
2125       PerlIO_printf(PerlIO_stderr(), "Awooga %p %p\n", hv, entry);*/
2126
2127     xhv->xhv_eiter = entry; /* HvEITER(hv) = entry */
2128     return entry;
2129 }
2130
2131 /*
2132 =for apidoc hv_iterkey
2133
2134 Returns the key from the current position of the hash iterator.  See
2135 C<hv_iterinit>.
2136
2137 =cut
2138 */
2139
2140 char *
2141 Perl_hv_iterkey(pTHX_ register HE *entry, I32 *retlen)
2142 {
2143     if (HeKLEN(entry) == HEf_SVKEY) {
2144         STRLEN len;
2145         char *p = SvPV(HeKEY_sv(entry), len);
2146         *retlen = len;
2147         return p;
2148     }
2149     else {
2150         *retlen = HeKLEN(entry);
2151         return HeKEY(entry);
2152     }
2153 }
2154
2155 /* unlike hv_iterval(), this always returns a mortal copy of the key */
2156 /*
2157 =for apidoc hv_iterkeysv
2158
2159 Returns the key as an C<SV*> from the current position of the hash
2160 iterator.  The return value will always be a mortal copy of the key.  Also
2161 see C<hv_iterinit>.
2162
2163 =cut
2164 */
2165
2166 SV *
2167 Perl_hv_iterkeysv(pTHX_ register HE *entry)
2168 {
2169     if (HeKLEN(entry) != HEf_SVKEY) {
2170         HEK *hek = HeKEY_hek(entry);
2171         int flags = HEK_FLAGS(hek);
2172         SV *sv;
2173
2174         if (flags & HVhek_WASUTF8) {
2175             /* Trouble :-)
2176                Andreas would like keys he put in as utf8 to come back as utf8
2177             */
2178             STRLEN utf8_len = HEK_LEN(hek);
2179             U8 *as_utf8 = bytes_to_utf8 ((U8*)HEK_KEY(hek), &utf8_len);
2180
2181             sv = newSVpvn ((char*)as_utf8, utf8_len);
2182             SvUTF8_on (sv);
2183             Safefree (as_utf8); /* bytes_to_utf8() allocates a new string */
2184         } else if (flags & HVhek_REHASH) {
2185             /* We don't have a pointer to the hv, so we have to replicate the
2186                flag into every HEK. This hv is using custom a hasing
2187                algorithm. Hence we can't return a shared string scalar, as
2188                that would contain the (wrong) hash value, and might get passed
2189                into an hv routine with a regular hash  */
2190
2191             sv = newSVpvn (HEK_KEY(hek), HEK_LEN(hek));
2192             if (HEK_UTF8(hek))
2193                 SvUTF8_on (sv);
2194         } else {
2195             sv = newSVpvn_share(HEK_KEY(hek),
2196                                 (HEK_UTF8(hek) ? -HEK_LEN(hek) : HEK_LEN(hek)),
2197                                 HEK_HASH(hek));
2198         }
2199         return sv_2mortal(sv);
2200     }
2201     return sv_mortalcopy(HeKEY_sv(entry));
2202 }
2203
2204 /*
2205 =for apidoc hv_iterval
2206
2207 Returns the value from the current position of the hash iterator.  See
2208 C<hv_iterkey>.
2209
2210 =cut
2211 */
2212
2213 SV *
2214 Perl_hv_iterval(pTHX_ HV *hv, register HE *entry)
2215 {
2216     if (SvRMAGICAL(hv)) {
2217         if (mg_find((SV*)hv, PERL_MAGIC_tied)) {
2218             SV* sv = sv_newmortal();
2219             if (HeKLEN(entry) == HEf_SVKEY)
2220                 mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY);
2221             else mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry));
2222             return sv;
2223         }
2224     }
2225     return HeVAL(entry);
2226 }
2227
2228 /*
2229 =for apidoc hv_iternextsv
2230
2231 Performs an C<hv_iternext>, C<hv_iterkey>, and C<hv_iterval> in one
2232 operation.
2233
2234 =cut
2235 */
2236
2237 SV *
2238 Perl_hv_iternextsv(pTHX_ HV *hv, char **key, I32 *retlen)
2239 {
2240     HE *he;
2241     if ( (he = hv_iternext_flags(hv, 0)) == NULL)
2242         return NULL;
2243     *key = hv_iterkey(he, retlen);
2244     return hv_iterval(hv, he);
2245 }
2246
2247 /*
2248 =for apidoc hv_magic
2249
2250 Adds magic to a hash.  See C<sv_magic>.
2251
2252 =cut
2253 */
2254
2255 void
2256 Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how)
2257 {
2258     sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
2259 }
2260
2261 #if 0 /* use the macro from hv.h instead */
2262
2263 char*
2264 Perl_sharepvn(pTHX_ const char *sv, I32 len, U32 hash)
2265 {
2266     return HEK_KEY(share_hek(sv, len, hash));
2267 }
2268
2269 #endif
2270
2271 /* possibly free a shared string if no one has access to it
2272  * len and hash must both be valid for str.
2273  */
2274 void
2275 Perl_unsharepvn(pTHX_ const char *str, I32 len, U32 hash)
2276 {
2277     unshare_hek_or_pvn (NULL, str, len, hash);
2278 }
2279
2280
2281 void
2282 Perl_unshare_hek(pTHX_ HEK *hek)
2283 {
2284     unshare_hek_or_pvn(hek, NULL, 0, 0);
2285 }
2286
2287 /* possibly free a shared string if no one has access to it
2288    hek if non-NULL takes priority over the other 3, else str, len and hash
2289    are used.  If so, len and hash must both be valid for str.
2290  */
2291 STATIC void
2292 S_unshare_hek_or_pvn(pTHX_ HEK *hek, const char *str, I32 len, U32 hash)
2293 {
2294     register XPVHV* xhv;
2295     register HE *entry;
2296     register HE **oentry;
2297     register I32 i = 1;
2298     I32 found = 0;
2299     bool is_utf8 = FALSE;
2300     int k_flags = 0;
2301     const char *save = str;
2302
2303     if (hek) {
2304         hash = HEK_HASH(hek);
2305     } else if (len < 0) {
2306         STRLEN tmplen = -len;
2307         is_utf8 = TRUE;
2308         /* See the note in hv_fetch(). --jhi */
2309         str = (char*)bytes_from_utf8((U8*)str, &tmplen, &is_utf8);
2310         len = tmplen;
2311         if (is_utf8)
2312             k_flags = HVhek_UTF8;
2313         if (str != save)
2314             k_flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
2315     }
2316
2317     /* what follows is the moral equivalent of:
2318     if ((Svp = hv_fetch(PL_strtab, tmpsv, FALSE, hash))) {
2319         if (--*Svp == Nullsv)
2320             hv_delete(PL_strtab, str, len, G_DISCARD, hash);
2321     } */
2322     xhv = (XPVHV*)SvANY(PL_strtab);
2323     /* assert(xhv_array != 0) */
2324     LOCK_STRTAB_MUTEX;
2325     /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
2326     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
2327     if (hek) {
2328         for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
2329             if (HeKEY_hek(entry) != hek)
2330                 continue;
2331             found = 1;
2332             break;
2333         }
2334     } else {
2335         int flags_masked = k_flags & HVhek_MASK;
2336         for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
2337             if (HeHASH(entry) != hash)          /* strings can't be equal */
2338                 continue;
2339             if (HeKLEN(entry) != len)
2340                 continue;
2341             if (HeKEY(entry) != str && memNE(HeKEY(entry),str,len))     /* is this it? */
2342                 continue;
2343             if (HeKFLAGS(entry) != flags_masked)
2344                 continue;
2345             found = 1;
2346             break;
2347         }
2348     }
2349
2350     if (found) {
2351         if (--HeVAL(entry) == Nullsv) {
2352             *oentry = HeNEXT(entry);
2353             if (i && !*oentry)
2354                 xhv->xhv_fill--; /* HvFILL(hv)-- */
2355             Safefree(HeKEY_hek(entry));
2356             del_HE(entry);
2357             xhv->xhv_keys--; /* HvKEYS(hv)-- */
2358         }
2359     }
2360
2361     UNLOCK_STRTAB_MUTEX;
2362     if (!found && ckWARN_d(WARN_INTERNAL))
2363         Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
2364                     "Attempt to free non-existent shared string '%s'%s",
2365                     hek ? HEK_KEY(hek) : str,
2366                     (k_flags & HVhek_UTF8) ? " (utf8)" : "");
2367     if (k_flags & HVhek_FREEKEY)
2368         Safefree(str);
2369 }
2370
2371 /* get a (constant) string ptr from the global string table
2372  * string will get added if it is not already there.
2373  * len and hash must both be valid for str.
2374  */
2375 HEK *
2376 Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash)
2377 {
2378     bool is_utf8 = FALSE;
2379     int flags = 0;
2380     const char *save = str;
2381
2382     if (len < 0) {
2383       STRLEN tmplen = -len;
2384       is_utf8 = TRUE;
2385       /* See the note in hv_fetch(). --jhi */
2386       str = (char*)bytes_from_utf8((U8*)str, &tmplen, &is_utf8);
2387       len = tmplen;
2388       /* If we were able to downgrade here, then than means that we were passed
2389          in a key which only had chars 0-255, but was utf8 encoded.  */
2390       if (is_utf8)
2391           flags = HVhek_UTF8;
2392       /* If we found we were able to downgrade the string to bytes, then
2393          we should flag that it needs upgrading on keys or each.  Also flag
2394          that we need share_hek_flags to free the string.  */
2395       if (str != save)
2396           flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
2397     }
2398
2399     return share_hek_flags (str, len, hash, flags);
2400 }
2401
2402 STATIC HEK *
2403 S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
2404 {
2405     register XPVHV* xhv;
2406     register HE *entry;
2407     register HE **oentry;
2408     register I32 i = 1;
2409     I32 found = 0;
2410     int flags_masked = flags & HVhek_MASK;
2411
2412     /* what follows is the moral equivalent of:
2413
2414     if (!(Svp = hv_fetch(PL_strtab, str, len, FALSE)))
2415         hv_store(PL_strtab, str, len, Nullsv, hash);
2416
2417         Can't rehash the shared string table, so not sure if it's worth
2418         counting the number of entries in the linked list
2419     */
2420     xhv = (XPVHV*)SvANY(PL_strtab);
2421     /* assert(xhv_array != 0) */
2422     LOCK_STRTAB_MUTEX;
2423     /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
2424     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
2425     for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
2426         if (HeHASH(entry) != hash)              /* strings can't be equal */
2427             continue;
2428         if (HeKLEN(entry) != len)
2429             continue;
2430         if (HeKEY(entry) != str && memNE(HeKEY(entry),str,len)) /* is this it? */
2431             continue;
2432         if (HeKFLAGS(entry) != flags_masked)
2433             continue;
2434         found = 1;
2435         break;
2436     }
2437     if (!found) {
2438         entry = new_HE();
2439         HeKEY_hek(entry) = save_hek_flags(str, len, hash, flags);
2440         HeVAL(entry) = Nullsv;
2441         HeNEXT(entry) = *oentry;
2442         *oentry = entry;
2443         xhv->xhv_keys++; /* HvKEYS(hv)++ */
2444         if (i) {                                /* initial entry? */
2445             xhv->xhv_fill++; /* HvFILL(hv)++ */
2446         } else if (xhv->xhv_keys > (IV)xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */) {
2447                 hsplit(PL_strtab);
2448         }
2449     }
2450
2451     ++HeVAL(entry);                             /* use value slot as REFCNT */
2452     UNLOCK_STRTAB_MUTEX;
2453
2454     if (flags & HVhek_FREEKEY)
2455         Safefree(str);
2456
2457     return HeKEY_hek(entry);
2458 }