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