hv.c

   1 /*    hv.c
   2  *
   3  *    Copyright (c) 1991-2001, Larry Wall
   4  *
   5  *    You may distribute under the terms of either the GNU General Public
   6  *    License or the Artistic License, as specified in the README file.
   7  *
   8  */
   9
  10 /*
  11  * "I sit beside the fire and think of all that I have seen."  --Bilbo
  12  */
  13
  14 #include "EXTERN.h"
  15 #define PERL_IN_HV_C
  16 #include "perl.h"
  17
  18 STATIC HE*
  19 S_new_he(pTHX)
  20 {
  21     HE* he;
  22     LOCK_SV_MUTEX;
  23     if (!PL_he_root)
  24         more_he();
  25     he = PL_he_root;
  26     PL_he_root = HeNEXT(he);
  27     UNLOCK_SV_MUTEX;
  28     return he;
  29 }
  30
  31 STATIC void
  32 S_del_he(pTHX_ HE *p)
  33 {
  34     LOCK_SV_MUTEX;
  35     HeNEXT(p) = (HE*)PL_he_root;
  36     PL_he_root = p;
  37     UNLOCK_SV_MUTEX;
  38 }
  39
  40 STATIC void
  41 S_more_he(pTHX)
  42 {
  43     register HE* he;
  44     register HE* heend;
  45     XPV *ptr;
  46     New(54, ptr, 1008/sizeof(XPV), XPV);
  47     ptr->xpv_pv = (char*)PL_he_arenaroot;
  48     PL_he_arenaroot = ptr;
  49
  50     he = (HE*)ptr;
  51     heend = &he[1008 / sizeof(HE) - 1];
  52     PL_he_root = ++he;
  53     while (he < heend) {
  54         HeNEXT(he) = (HE*)(he + 1);
  55         he++;
  56     }
  57     HeNEXT(he) = 0;
  58 }
  59
  60 #ifdef PURIFY
  61
  62 #define new_HE() (HE*)safemalloc(sizeof(HE))
  63 #define del_HE(p) safefree((char*)p)
  64
  65 #else
  66
  67 #define new_HE() new_he()
  68 #define del_HE(p) del_he(p)
  69
  70 #endif
  71
  72 STATIC HEK *
  73 S_save_hek(pTHX_ const char *str, I32 len, U32 hash)
  74 {
  75     char *k;
  76     register HEK *hek;
  77     bool is_utf8 = FALSE;
  78
  79     if (len < 0) {
  80       len = -len;
  81       is_utf8 = TRUE;
  82     }
  83
  84     New(54, k, HEK_BASESIZE + len + 1, char);
  85     hek = (HEK*)k;
  86     Copy(str, HEK_KEY(hek), len, char);
  87     HEK_LEN(hek) = len;
  88     HEK_HASH(hek) = hash;
  89     HEK_UTF8(hek) = (char)is_utf8;
  90     return hek;
  91 }
  92
  93 void
  94 Perl_unshare_hek(pTHX_ HEK *hek)
  95 {
  96     unsharepvn(HEK_KEY(hek),HEK_UTF8(hek)?-HEK_LEN(hek):HEK_LEN(hek),
  97                 HEK_HASH(hek));
  98 }
  99
 100 #if defined(USE_ITHREADS)
 101 HE *
 102 Perl_he_dup(pTHX_ HE *e, bool shared, CLONE_PARAMS* param)
 103 {
 104     HE *ret;
 105
 106     if (!e)
 107         return Nullhe;
 108     /* look for it in the table first */
 109     ret = (HE*)ptr_table_fetch(PL_ptr_table, e);
 110     if (ret)
 111         return ret;
 112
 113     /* create anew and remember what it is */
 114     ret = new_HE();
 115     ptr_table_store(PL_ptr_table, e, ret);
 116
 117     HeNEXT(ret) = he_dup(HeNEXT(e),shared, param);
 118     if (HeKLEN(e) == HEf_SVKEY)
 119         HeKEY_sv(ret) = SvREFCNT_inc(sv_dup(HeKEY_sv(e), param));
 120     else if (shared)
 121         HeKEY_hek(ret) = share_hek(HeKEY(e), HeKLEN_UTF8(e), HeHASH(e));
 122     else
 123         HeKEY_hek(ret) = save_hek(HeKEY(e), HeKLEN_UTF8(e), HeHASH(e));
 124     HeVAL(ret) = SvREFCNT_inc(sv_dup(HeVAL(e), param));
 125     return ret;
 126 }
 127 #endif  /* USE_ITHREADS */
 128
 129 static void
 130 Perl_hv_notallowed(pTHX_ bool is_utf8, const char *key, I32 klen,
 131                    const char *keysave)
 132 {
 133     SV *sv = sv_newmortal();
 134     if (key == keysave) {
 135         sv_setpvn(sv, key, klen);
 136     }
 137     else {
 138         /* Need to free saved eventually assign to mortal SV */
 139         SV *sv = sv_newmortal();
 140         sv_usepvn(sv, (char *) key, klen);
 141     }
 142     if (is_utf8) {
 143         SvUTF8_on(sv);
 144     }
 145     Perl_croak(aTHX_ "Attempt to access to key '%_' in fixed hash",sv);
 146 }
 147
 148 /* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot
 149  * contains an SV* */
 150
 151 /*
 152 =for apidoc hv_fetch
 153
 154 Returns the SV which corresponds to the specified key in the hash.  The
 155 C<klen> is the length of the key.  If C<lval> is set then the fetch will be
 156 part of a store.  Check that the return value is non-null before
 157 dereferencing it to an C<SV*>.
 158
 159 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
 160 information on how to use this function on tied hashes.
 161
 162 =cut
 163 */
 164
 165 SV**
 166 Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen, I32 lval)
 167 {
 168     register XPVHV* xhv;
 169     register U32 hash;
 170     register HE *entry;
 171     SV *sv;
 172     bool is_utf8 = FALSE;
 173     const char *keysave = key;
 174
 175     if (!hv)
 176         return 0;
 177
 178     if (klen < 0) {
 179       klen = -klen;
 180       is_utf8 = TRUE;
 181     }
 182
 183     if (SvRMAGICAL(hv)) {
 184         if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
 185             sv = sv_newmortal();
 186             mg_copy((SV*)hv, sv, key, klen);
 187             PL_hv_fetch_sv = sv;
 188             return &PL_hv_fetch_sv;
 189         }
 190 #ifdef ENV_IS_CASELESS
 191         else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
 192             U32 i;
 193             for (i = 0; i < klen; ++i)
 194                 if (isLOWER(key[i])) {
 195                     char *nkey = strupr(SvPVX(sv_2mortal(newSVpvn(key,klen))));
 196                     SV **ret = hv_fetch(hv, nkey, klen, 0);
 197                     if (!ret && lval)
 198                         ret = hv_store(hv, key, klen, NEWSV(61,0), 0);
 199                     return ret;
 200                 }
 201         }
 202 #endif
 203     }
 204
 205     /* We use xhv->xhv_foo fields directly instead of HvFOO(hv) to
 206        avoid unnecessary pointer dereferencing. */
 207     xhv = (XPVHV*)SvANY(hv);
 208     if (!xhv->xhv_array /* !HvARRAY(hv) */) {
 209         if (lval
 210 #ifdef DYNAMIC_ENV_FETCH  /* if it's an %ENV lookup, we may get it on the fly */
 211                  || (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env))
 212 #endif
 213                                                                   )
 214             Newz(503, xhv->xhv_array /* HvARRAY(hv) */,
 215                  PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
 216                  char);
 217         else
 218             return 0;
 219     }
 220
 221     if (is_utf8) {
 222         STRLEN tmplen = klen;
 223         /* Just casting the &klen to (STRLEN) won't work well
 224          * if STRLEN and I32 are of different widths. --jhi */
 225         key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
 226         klen = tmplen;
 227     }
 228
 229     PERL_HASH(hash, key, klen);
 230
 231     /* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
 232     entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 233     for (; entry; entry = HeNEXT(entry)) {
 234         if (HeHASH(entry) != hash)              /* strings can't be equal */
 235             continue;
 236         if (HeKLEN(entry) != klen)
 237             continue;
 238         if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
 239             continue;
 240         if (HeKUTF8(entry) != (char)is_utf8)
 241             continue;
 242         if (key != keysave)
 243             Safefree(key);
 244         /* if we find a placeholder, we pretend we haven't found anything */
 245         if (HeVAL(entry) == &PL_sv_undef)
 246             break;
 247         return &HeVAL(entry);
 248
 249     }
 250 #ifdef DYNAMIC_ENV_FETCH  /* %ENV lookup?  If so, try to fetch the value now */
 251     if (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
 252         unsigned long len;
 253         char *env = PerlEnv_ENVgetenv_len(key,&len);
 254         if (env) {
 255             sv = newSVpvn(env,len);
 256             SvTAINTED_on(sv);
 257             if (key != keysave)
 258                 Safefree(key);
 259             return hv_store(hv,key,klen,sv,hash);
 260         }
 261     }
 262 #endif
 263     if (!entry && SvREADONLY(hv)) {
 264         Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
 265     }
 266     if (lval) {         /* gonna assign to this, so it better be there */
 267         sv = NEWSV(61,0);
 268         if (key != keysave) { /* must be is_utf8 == 0 */
 269             SV **ret = hv_store(hv,key,klen,sv,hash);
 270             Safefree(key);
 271             return ret;
 272         }
 273         else
 274             return hv_store(hv,key,is_utf8?-klen:klen,sv,hash);
 275     }
 276     if (key != keysave)
 277         Safefree(key);
 278     return 0;
 279 }
 280
 281 /* returns an HE * structure with the all fields set */
 282 /* note that hent_val will be a mortal sv for MAGICAL hashes */
 283 /*
 284 =for apidoc hv_fetch_ent
 285
 286 Returns the hash entry which corresponds to the specified key in the hash.
 287 C<hash> must be a valid precomputed hash number for the given C<key>, or 0
 288 if you want the function to compute it.  IF C<lval> is set then the fetch
 289 will be part of a store.  Make sure the return value is non-null before
 290 accessing it.  The return value when C<tb> is a tied hash is a pointer to a
 291 static location, so be sure to make a copy of the structure if you need to
 292 store it somewhere.
 293
 294 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
 295 information on how to use this function on tied hashes.
 296
 297 =cut
 298 */
 299
 300 HE *
 301 Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
 302 {
 303     register XPVHV* xhv;
 304     register char *key;
 305     STRLEN klen;
 306     register HE *entry;
 307     SV *sv;
 308     bool is_utf8;
 309     char *keysave;
 310
 311     if (!hv)
 312         return 0;
 313
 314     if (SvRMAGICAL(hv)) {
 315         if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
 316             sv = sv_newmortal();
 317             keysv = sv_2mortal(newSVsv(keysv));
 318             mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
 319             if (!HeKEY_hek(&PL_hv_fetch_ent_mh)) {
 320                 char *k;
 321                 New(54, k, HEK_BASESIZE + sizeof(SV*), char);
 322                 HeKEY_hek(&PL_hv_fetch_ent_mh) = (HEK*)k;
 323             }
 324             HeSVKEY_set(&PL_hv_fetch_ent_mh, keysv);
 325             HeVAL(&PL_hv_fetch_ent_mh) = sv;
 326             return &PL_hv_fetch_ent_mh;
 327         }
 328 #ifdef ENV_IS_CASELESS
 329         else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
 330             U32 i;
 331             key = SvPV(keysv, klen);
 332             for (i = 0; i < klen; ++i)
 333                 if (isLOWER(key[i])) {
 334                     SV *nkeysv = sv_2mortal(newSVpvn(key,klen));
 335                     (void)strupr(SvPVX(nkeysv));
 336                     entry = hv_fetch_ent(hv, nkeysv, 0, 0);
 337                     if (!entry && lval)
 338                         entry = hv_store_ent(hv, keysv, NEWSV(61,0), hash);
 339                     return entry;
 340                 }
 341         }
 342 #endif
 343     }
 344
 345     xhv = (XPVHV*)SvANY(hv);
 346     if (!xhv->xhv_array /* !HvARRAY(hv) */) {
 347         if (lval
 348 #ifdef DYNAMIC_ENV_FETCH  /* if it's an %ENV lookup, we may get it on the fly */
 349                  || (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env))
 350 #endif
 351                                                                   )
 352             Newz(503, xhv->xhv_array /* HvARRAY(hv) */,
 353                  PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
 354                  char);
 355         else
 356             return 0;
 357     }
 358
 359     keysave = key = SvPV(keysv, klen);
 360     is_utf8 = (SvUTF8(keysv)!=0);
 361
 362     if (is_utf8)
 363         key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
 364
 365     if (!hash)
 366         PERL_HASH(hash, key, klen);
 367
 368     /* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
 369     entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 370     for (; entry; entry = HeNEXT(entry)) {
 371         if (HeHASH(entry) != hash)              /* strings can't be equal */
 372             continue;
 373         if (HeKLEN(entry) != klen)
 374             continue;
 375         if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
 376             continue;
 377         if (HeKUTF8(entry) != (char)is_utf8)
 378             continue;
 379         if (key != keysave)
 380             Safefree(key);
 381         /* if we find a placeholder, we pretend we haven't found anything */
 382         if (HeVAL(entry) == &PL_sv_undef)
 383             break;
 384         return entry;
 385     }
 386 #ifdef DYNAMIC_ENV_FETCH  /* %ENV lookup?  If so, try to fetch the value now */
 387     if (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
 388         unsigned long len;
 389         char *env = PerlEnv_ENVgetenv_len(key,&len);
 390         if (env) {
 391             sv = newSVpvn(env,len);
 392             SvTAINTED_on(sv);
 393             return hv_store_ent(hv,keysv,sv,hash);
 394         }
 395     }
 396 #endif
 397     if (!entry && SvREADONLY(hv)) {
 398         Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
 399     }
 400     if (key != keysave)
 401         Safefree(key);
 402     if (lval) {         /* gonna assign to this, so it better be there */
 403         sv = NEWSV(61,0);
 404         return hv_store_ent(hv,keysv,sv,hash);
 405     }
 406     return 0;
 407 }
 408
 409 STATIC void
 410 S_hv_magic_check(pTHX_ HV *hv, bool *needs_copy, bool *needs_store)
 411 {
 412     MAGIC *mg = SvMAGIC(hv);
 413     *needs_copy = FALSE;
 414     *needs_store = TRUE;
 415     while (mg) {
 416         if (isUPPER(mg->mg_type)) {
 417             *needs_copy = TRUE;
 418             switch (mg->mg_type) {
 419             case PERL_MAGIC_tied:
 420             case PERL_MAGIC_sig:
 421                 *needs_store = FALSE;
 422             }
 423         }
 424         mg = mg->mg_moremagic;
 425     }
 426 }
 427
 428 /*
 429 =for apidoc hv_store
 430
 431 Stores an SV in a hash.  The hash key is specified as C<key> and C<klen> is
 432 the length of the key.  The C<hash> parameter is the precomputed hash
 433 value; if it is zero then Perl will compute it.  The return value will be
 434 NULL if the operation failed or if the value did not need to be actually
 435 stored within the hash (as in the case of tied hashes).  Otherwise it can
 436 be dereferenced to get the original C<SV*>.  Note that the caller is
 437 responsible for suitably incrementing the reference count of C<val> before
 438 the call, and decrementing it if the function returned NULL.
 439
 440 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
 441 information on how to use this function on tied hashes.
 442
 443 =cut
 444 */
 445
 446 SV**
 447 Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen, SV *val, register U32 hash)
 448 {
 449     register XPVHV* xhv;
 450     register I32 i;
 451     register HE *entry;
 452     register HE **oentry;
 453     bool is_utf8 = FALSE;
 454     const char *keysave = key;
 455
 456     if (!hv)
 457         return 0;
 458
 459     if (klen < 0) {
 460       klen = -klen;
 461       is_utf8 = TRUE;
 462     }
 463
 464     xhv = (XPVHV*)SvANY(hv);
 465     if (SvMAGICAL(hv)) {
 466         bool needs_copy;
 467         bool needs_store;
 468         hv_magic_check (hv, &needs_copy, &needs_store);
 469         if (needs_copy) {
 470             mg_copy((SV*)hv, val, key, klen);
 471             if (!xhv->xhv_array /* !HvARRAY */ && !needs_store)
 472                 return 0;
 473 #ifdef ENV_IS_CASELESS
 474             else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
 475                 key = savepvn(key,klen);
 476                 key = (const char*)strupr((char*)key);
 477                 hash = 0;
 478             }
 479 #endif
 480         }
 481     }
 482     if (is_utf8) {
 483         STRLEN tmplen = klen;
 484         /* See the note in hv_fetch(). --jhi */
 485         key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
 486         klen = tmplen;
 487     }
 488
 489     if (!hash)
 490         PERL_HASH(hash, key, klen);
 491
 492     if (!xhv->xhv_array /* !HvARRAY(hv) */)
 493         Newz(505, xhv->xhv_array /* HvARRAY(hv) */,
 494              PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
 495              char);
 496
 497     /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
 498     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 499     i = 1;
 500
 501     for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
 502         if (HeHASH(entry) != hash)              /* strings can't be equal */
 503             continue;
 504         if (HeKLEN(entry) != klen)
 505             continue;
 506         if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
 507             continue;
 508         if (HeKUTF8(entry) != (char)is_utf8)
 509             continue;
 510         if (HeVAL(entry) == &PL_sv_undef)
 511             xhv->xhv_placeholders--; /* yes, can store into placeholder slot */
 512         else
 513             SvREFCNT_dec(HeVAL(entry));
 514         HeVAL(entry) = val;
 515         if (key != keysave)
 516             Safefree(key);
 517         return &HeVAL(entry);
 518     }
 519
 520     if (SvREADONLY(hv)) {
 521         Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
 522     }
 523
 524     entry = new_HE();
 525     if (HvSHAREKEYS(hv))
 526         HeKEY_hek(entry) = share_hek(key, is_utf8?-klen:klen, hash);
 527     else                                       /* gotta do the real thing */
 528         HeKEY_hek(entry) = save_hek(key, is_utf8?-klen:klen, hash);
 529     if (key != keysave)
 530         Safefree(key);
 531     HeVAL(entry) = val;
 532     HeNEXT(entry) = *oentry;
 533     *oentry = entry;
 534
 535     xhv->xhv_keys++; /* HvKEYS(hv)++ */
 536     if (i) {                            /* initial entry? */
 537         xhv->xhv_fill++; /* HvFILL(hv)++ */
 538         if (xhv->xhv_keys > xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */)
 539             hsplit(hv);
 540     }
 541
 542     return &HeVAL(entry);
 543 }
 544
 545 /*
 546 =for apidoc hv_store_ent
 547
 548 Stores C<val> in a hash.  The hash key is specified as C<key>.  The C<hash>
 549 parameter is the precomputed hash value; if it is zero then Perl will
 550 compute it.  The return value is the new hash entry so created.  It will be
 551 NULL if the operation failed or if the value did not need to be actually
 552 stored within the hash (as in the case of tied hashes).  Otherwise the
 553 contents of the return value can be accessed using the C<He?> macros
 554 described here.  Note that the caller is responsible for suitably
 555 incrementing the reference count of C<val> before the call, and
 556 decrementing it if the function returned NULL.
 557
 558 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
 559 information on how to use this function on tied hashes.
 560
 561 =cut
 562 */
 563
 564 HE *
 565 Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, register U32 hash)
 566 {
 567     register XPVHV* xhv;
 568     register char *key;
 569     STRLEN klen;
 570     register I32 i;
 571     register HE *entry;
 572     register HE **oentry;
 573     bool is_utf8;
 574     char *keysave;
 575
 576     if (!hv)
 577         return 0;
 578
 579     xhv = (XPVHV*)SvANY(hv);
 580     if (SvMAGICAL(hv)) {
 581         bool needs_copy;
 582         bool needs_store;
 583         hv_magic_check (hv, &needs_copy, &needs_store);
 584         if (needs_copy) {
 585             bool save_taint = PL_tainted;
 586             if (PL_tainting)
 587                 PL_tainted = SvTAINTED(keysv);
 588             keysv = sv_2mortal(newSVsv(keysv));
 589             mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
 590             TAINT_IF(save_taint);
 591             if (!xhv->xhv_array /* !HvARRAY(hv) */ && !needs_store)
 592                 return Nullhe;
 593 #ifdef ENV_IS_CASELESS
 594             else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
 595                 key = SvPV(keysv, klen);
 596                 keysv = sv_2mortal(newSVpvn(key,klen));
 597                 (void)strupr(SvPVX(keysv));
 598                 hash = 0;
 599             }
 600 #endif
 601         }
 602     }
 603
 604     keysave = key = SvPV(keysv, klen);
 605     is_utf8 = (SvUTF8(keysv) != 0);
 606
 607     if (is_utf8)
 608         key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
 609
 610     if (!hash)
 611         PERL_HASH(hash, key, klen);
 612
 613     if (!xhv->xhv_array /* !HvARRAY(hv) */)
 614         Newz(505, xhv->xhv_array /* HvARRAY(hv) */,
 615              PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
 616              char);
 617
 618     /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
 619     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 620     i = 1;
 621
 622     for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
 623         if (HeHASH(entry) != hash)              /* strings can't be equal */
 624             continue;
 625         if (HeKLEN(entry) != klen)
 626             continue;
 627         if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
 628             continue;
 629         if (HeKUTF8(entry) != (char)is_utf8)
 630             continue;
 631         if (HeVAL(entry) == &PL_sv_undef)
 632             xhv->xhv_placeholders--; /* yes, can store into placeholder slot */
 633         else
 634             SvREFCNT_dec(HeVAL(entry));
 635         HeVAL(entry) = val;
 636         if (key != keysave)
 637             Safefree(key);
 638         return entry;
 639     }
 640
 641     if (SvREADONLY(hv)) {
 642         Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
 643     }
 644
 645     entry = new_HE();
 646     if (HvSHAREKEYS(hv))
 647         HeKEY_hek(entry) = share_hek(key, is_utf8?-(I32)klen:klen, hash);
 648     else                                       /* gotta do the real thing */
 649         HeKEY_hek(entry) = save_hek(key, is_utf8?-(I32)klen:klen, hash);
 650     if (key != keysave)
 651         Safefree(key);
 652     HeVAL(entry) = val;
 653     HeNEXT(entry) = *oentry;
 654     *oentry = entry;
 655
 656     xhv->xhv_keys++; /* HvKEYS(hv)++ */
 657     if (i) {                            /* initial entry? */
 658         xhv->xhv_fill++; /* HvFILL(hv)++ */
 659         if (xhv->xhv_keys > xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */)
 660             hsplit(hv);
 661     }
 662
 663     return entry;
 664 }
 665
 666 /*
 667 =for apidoc hv_delete
 668
 669 Deletes a key/value pair in the hash.  The value SV is removed from the
 670 hash and returned to the caller.  The C<klen> is the length of the key.
 671 The C<flags> value will normally be zero; if set to G_DISCARD then NULL
 672 will be returned.
 673
 674 =cut
 675 */
 676
 677 SV *
 678 Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags)
 679 {
 680     register XPVHV* xhv;
 681     register I32 i;
 682     register U32 hash;
 683     register HE *entry;
 684     register HE **oentry;
 685     SV **svp;
 686     SV *sv;
 687     bool is_utf8 = FALSE;
 688     const char *keysave = key;
 689
 690     if (!hv)
 691         return Nullsv;
 692     if (klen < 0) {
 693       klen = -klen;
 694       is_utf8 = TRUE;
 695     }
 696     if (SvRMAGICAL(hv)) {
 697         bool needs_copy;
 698         bool needs_store;
 699         hv_magic_check (hv, &needs_copy, &needs_store);
 700
 701         if (needs_copy && (svp = hv_fetch(hv, key, klen, TRUE))) {
 702             sv = *svp;
 703             mg_clear(sv);
 704             if (!needs_store) {
 705                 if (mg_find(sv, PERL_MAGIC_tiedelem)) {
 706                     /* No longer an element */
 707                     sv_unmagic(sv, PERL_MAGIC_tiedelem);
 708                     return sv;
 709                 }
 710                 return Nullsv;          /* element cannot be deleted */
 711             }
 712 #ifdef ENV_IS_CASELESS
 713             else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
 714                 sv = sv_2mortal(newSVpvn(key,klen));
 715                 key = strupr(SvPVX(sv));
 716             }
 717 #endif
 718         }
 719     }
 720     xhv = (XPVHV*)SvANY(hv);
 721     if (!xhv->xhv_array /* !HvARRAY(hv) */)
 722         return Nullsv;
 723
 724     if (is_utf8) {
 725         STRLEN tmplen = klen;
 726         /* See the note in hv_fetch(). --jhi */
 727         key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
 728         klen = tmplen;
 729     }
 730
 731     PERL_HASH(hash, key, klen);
 732
 733     /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
 734     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 735     entry = *oentry;
 736     i = 1;
 737     for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
 738         if (HeHASH(entry) != hash)              /* strings can't be equal */
 739             continue;
 740         if (HeKLEN(entry) != klen)
 741             continue;
 742         if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
 743             continue;
 744         if (HeKUTF8(entry) != (char)is_utf8)
 745             continue;
 746         if (key != keysave)
 747             Safefree(key);
 748         /* if placeholder is here, it's already been deleted.... */
 749         if (HeVAL(entry) == &PL_sv_undef)
 750         {
 751             if (SvREADONLY(hv))
 752                 return Nullsv;  /* if still SvREADONLY, leave it deleted. */
 753             else {
 754                 /* okay, really delete the placeholder... */
 755                 *oentry = HeNEXT(entry);
 756                 if (i && !*oentry)
 757                     xhv->xhv_fill--; /* HvFILL(hv)-- */
 758                 if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
 759                     HvLAZYDEL_on(hv);
 760                 else
 761                     hv_free_ent(hv, entry);
 762                 xhv->xhv_keys--; /* HvKEYS(hv)-- */
 763                 xhv->xhv_placeholders--;
 764                 return Nullsv;
 765             }
 766         }
 767         else if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
 768             Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
 769         }
 770
 771         if (flags & G_DISCARD)
 772             sv = Nullsv;
 773         else {
 774             sv = sv_2mortal(HeVAL(entry));
 775             HeVAL(entry) = &PL_sv_undef;
 776         }
 777
 778         /*
 779          * If a restricted hash, rather than really deleting the entry, put
 780          * a placeholder there. This marks the key as being "approved", so
 781          * we can still access via not-really-existing key without raising
 782          * an error.
 783          */
 784         if (SvREADONLY(hv)) {
 785             HeVAL(entry) = &PL_sv_undef;
 786             /* We'll be saving this slot, so the number of allocated keys
 787              * doesn't go down, but the number placeholders goes up */
 788             xhv->xhv_placeholders++; /* HvPLACEHOLDERS(hv)++ */
 789         } else {
 790             *oentry = HeNEXT(entry);
 791             if (i && !*oentry)
 792                 xhv->xhv_fill--; /* HvFILL(hv)-- */
 793             if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
 794                 HvLAZYDEL_on(hv);
 795             else
 796                 hv_free_ent(hv, entry);
 797             xhv->xhv_keys--; /* HvKEYS(hv)-- */
 798         }
 799         return sv;
 800     }
 801     if (SvREADONLY(hv)) {
 802         Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
 803     }
 804
 805     if (key != keysave)
 806         Safefree(key);
 807     return Nullsv;
 808 }
 809
 810 /*
 811 =for apidoc hv_delete_ent
 812
 813 Deletes a key/value pair in the hash.  The value SV is removed from the
 814 hash and returned to the caller.  The C<flags> value will normally be zero;
 815 if set to G_DISCARD then NULL will be returned.  C<hash> can be a valid
 816 precomputed hash value, or 0 to ask for it to be computed.
 817
 818 =cut
 819 */
 820
 821 SV *
 822 Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
 823 {
 824     register XPVHV* xhv;
 825     register I32 i;
 826     register char *key;
 827     STRLEN klen;
 828     register HE *entry;
 829     register HE **oentry;
 830     SV *sv;
 831     bool is_utf8;
 832     char *keysave;
 833
 834     if (!hv)
 835         return Nullsv;
 836     if (SvRMAGICAL(hv)) {
 837         bool needs_copy;
 838         bool needs_store;
 839         hv_magic_check (hv, &needs_copy, &needs_store);
 840
 841         if (needs_copy && (entry = hv_fetch_ent(hv, keysv, TRUE, hash))) {
 842             sv = HeVAL(entry);
 843             mg_clear(sv);
 844             if (!needs_store) {
 845                 if (mg_find(sv, PERL_MAGIC_tiedelem)) {
 846                     /* No longer an element */
 847                     sv_unmagic(sv, PERL_MAGIC_tiedelem);
 848                     return sv;
 849                 }
 850                 return Nullsv;          /* element cannot be deleted */
 851             }
 852 #ifdef ENV_IS_CASELESS
 853             else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
 854                 key = SvPV(keysv, klen);
 855                 keysv = sv_2mortal(newSVpvn(key,klen));
 856                 (void)strupr(SvPVX(keysv));
 857                 hash = 0;
 858             }
 859 #endif
 860         }
 861     }
 862     xhv = (XPVHV*)SvANY(hv);
 863     if (!xhv->xhv_array /* !HvARRAY(hv) */)
 864         return Nullsv;
 865
 866     keysave = key = SvPV(keysv, klen);
 867     is_utf8 = (SvUTF8(keysv) != 0);
 868
 869     if (is_utf8)
 870         key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
 871
 872     if (!hash)
 873         PERL_HASH(hash, key, klen);
 874
 875     /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
 876     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 877     entry = *oentry;
 878     i = 1;
 879     for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
 880         if (HeHASH(entry) != hash)              /* strings can't be equal */
 881             continue;
 882         if (HeKLEN(entry) != klen)
 883             continue;
 884         if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
 885             continue;
 886         if (HeKUTF8(entry) != (char)is_utf8)
 887             continue;
 888         if (key != keysave)
 889             Safefree(key);
 890
 891         /* if placeholder is here, it's already been deleted.... */
 892         if (HeVAL(entry) == &PL_sv_undef)
 893         {
 894             if (SvREADONLY(hv))
 895                 return Nullsv; /* if still SvREADONLY, leave it deleted. */
 896             else {
 897                 // okay, really delete the placeholder.
 898                 *oentry = HeNEXT(entry);
 899                 if (i && !*oentry)
 900                     xhv->xhv_fill--; /* HvFILL(hv)-- */
 901                 if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
 902                     HvLAZYDEL_on(hv);
 903                 else
 904                     hv_free_ent(hv, entry);
 905                 xhv->xhv_keys--; /* HvKEYS(hv)-- */
 906                 xhv->xhv_placeholders--;
 907                 return Nullsv;
 908             }
 909         }
 910         else if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
 911             Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
 912         }
 913
 914         if (flags & G_DISCARD)
 915             sv = Nullsv;
 916         else {
 917             sv = sv_2mortal(HeVAL(entry));
 918             HeVAL(entry) = &PL_sv_undef;
 919         }
 920
 921         /*
 922          * If a restricted hash, rather than really deleting the entry, put
 923          * a placeholder there. This marks the key as being "approved", so
 924          * we can still access via not-really-existing key without raising
 925          * an error.
 926          */
 927         if (SvREADONLY(hv)) {
 928             HeVAL(entry) = &PL_sv_undef;
 929             /* We'll be saving this slot, so the number of allocated keys
 930              * doesn't go down, but the number placeholders goes up */
 931             xhv->xhv_placeholders++; /* HvPLACEHOLDERS(hv)++ */
 932         } else {
 933             *oentry = HeNEXT(entry);
 934             if (i && !*oentry)
 935                 xhv->xhv_fill--; /* HvFILL(hv)-- */
 936             if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
 937                 HvLAZYDEL_on(hv);
 938             else
 939                 hv_free_ent(hv, entry);
 940             xhv->xhv_keys--; /* HvKEYS(hv)-- */
 941         }
 942         return sv;
 943     }
 944     if (SvREADONLY(hv)) {
 945         Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
 946     }
 947
 948     if (key != keysave)
 949         Safefree(key);
 950     return Nullsv;
 951 }
 952
 953 /*
 954 =for apidoc hv_exists
 955
 956 Returns a boolean indicating whether the specified hash key exists.  The
 957 C<klen> is the length of the key.
 958
 959 =cut
 960 */
 961
 962 bool
 963 Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen)
 964 {
 965     register XPVHV* xhv;
 966     register U32 hash;
 967     register HE *entry;
 968     SV *sv;
 969     bool is_utf8 = FALSE;
 970     const char *keysave = key;
 971
 972     if (!hv)
 973         return 0;
 974
 975     if (klen < 0) {
 976       klen = -klen;
 977       is_utf8 = TRUE;
 978     }
 979
 980     if (SvRMAGICAL(hv)) {
 981         if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
 982             sv = sv_newmortal();
 983             mg_copy((SV*)hv, sv, key, klen);
 984             magic_existspack(sv, mg_find(sv, PERL_MAGIC_tiedelem));
 985             return SvTRUE(sv);
 986         }
 987 #ifdef ENV_IS_CASELESS
 988         else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
 989             sv = sv_2mortal(newSVpvn(key,klen));
 990             key = strupr(SvPVX(sv));
 991         }
 992 #endif
 993     }
 994
 995     xhv = (XPVHV*)SvANY(hv);
 996 #ifndef DYNAMIC_ENV_FETCH
 997     if (!xhv->xhv_array /* !HvARRAY(hv) */)
 998         return 0;
 999 #endif
1000
1001     if (is_utf8) {
1002         STRLEN tmplen = klen;
1003         /* See the note in hv_fetch(). --jhi */
1004         key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
1005         klen = tmplen;
1006     }
1007
1008     PERL_HASH(hash, key, klen);
1009
1010 #ifdef DYNAMIC_ENV_FETCH
1011     if (!xhv->xhv_array /* !HvARRAY(hv) */) entry = Null(HE*);
1012     else
1013 #endif
1014     /* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
1015     entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1016     for (; entry; entry = HeNEXT(entry)) {
1017         if (HeHASH(entry) != hash)              /* strings can't be equal */
1018             continue;
1019         if (HeKLEN(entry) != klen)
1020             continue;
1021         if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
1022             continue;
1023         if (HeKUTF8(entry) != (char)is_utf8)
1024             continue;
1025         if (key != keysave)
1026             Safefree(key);
1027         /* If we find the key, but the value is a placeholder, return false. */
1028         if (HeVAL(entry) == &PL_sv_undef)
1029             return FALSE;
1030
1031         return TRUE;
1032     }
1033 #ifdef DYNAMIC_ENV_FETCH  /* is it out there? */
1034     if (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
1035         unsigned long len;
1036         char *env = PerlEnv_ENVgetenv_len(key,&len);
1037         if (env) {
1038             sv = newSVpvn(env,len);
1039             SvTAINTED_on(sv);
1040             (void)hv_store(hv,key,klen,sv,hash);
1041             return TRUE;
1042         }
1043     }
1044 #endif
1045     if (key != keysave)
1046         Safefree(key);
1047     return FALSE;
1048 }
1049
1050
1051 /*
1052 =for apidoc hv_exists_ent
1053
1054 Returns a boolean indicating whether the specified hash key exists. C<hash>
1055 can be a valid precomputed hash value, or 0 to ask for it to be
1056 computed.
1057
1058 =cut
1059 */
1060
1061 bool
1062 Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
1063 {
1064     register XPVHV* xhv;
1065     register char *key;
1066     STRLEN klen;
1067     register HE *entry;
1068     SV *sv;
1069     bool is_utf8;
1070     char *keysave;
1071
1072     if (!hv)
1073         return 0;
1074
1075     if (SvRMAGICAL(hv)) {
1076         if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
1077            SV* svret = sv_newmortal();
1078             sv = sv_newmortal();
1079             keysv = sv_2mortal(newSVsv(keysv));
1080             mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
1081            magic_existspack(svret, mg_find(sv, PERL_MAGIC_tiedelem));
1082            return SvTRUE(svret);
1083         }
1084 #ifdef ENV_IS_CASELESS
1085         else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
1086             key = SvPV(keysv, klen);
1087             keysv = sv_2mortal(newSVpvn(key,klen));
1088             (void)strupr(SvPVX(keysv));
1089             hash = 0;
1090         }
1091 #endif
1092     }
1093
1094     xhv = (XPVHV*)SvANY(hv);
1095 #ifndef DYNAMIC_ENV_FETCH
1096     if (!xhv->xhv_array /* !HvARRAY(hv) */)
1097         return 0;
1098 #endif
1099
1100     keysave = key = SvPV(keysv, klen);
1101     is_utf8 = (SvUTF8(keysv) != 0);
1102     if (is_utf8)
1103         key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
1104     if (!hash)
1105         PERL_HASH(hash, key, klen);
1106
1107 #ifdef DYNAMIC_ENV_FETCH
1108     if (!xhv->xhv_array /* !HvARRAY(hv) */) entry = Null(HE*);
1109     else
1110 #endif
1111     /* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
1112     entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1113     for (; entry; entry = HeNEXT(entry)) {
1114         if (HeHASH(entry) != hash)              /* strings can't be equal */
1115             continue;
1116         if (HeKLEN(entry) != klen)
1117             continue;
1118         if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
1119             continue;
1120         if (HeKUTF8(entry) != (char)is_utf8)
1121             continue;
1122         if (key != keysave)
1123             Safefree(key);
1124         /* If we find the key, but the value is a placeholder, return false. */
1125         if (HeVAL(entry) == &PL_sv_undef)
1126             return FALSE;
1127         return TRUE;
1128     }
1129 #ifdef DYNAMIC_ENV_FETCH  /* is it out there? */
1130     if (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
1131         unsigned long len;
1132         char *env = PerlEnv_ENVgetenv_len(key,&len);
1133         if (env) {
1134             sv = newSVpvn(env,len);
1135             SvTAINTED_on(sv);
1136             (void)hv_store_ent(hv,keysv,sv,hash);
1137             return TRUE;
1138         }
1139     }
1140 #endif
1141     if (key != keysave)
1142         Safefree(key);
1143     return FALSE;
1144 }
1145
1146 STATIC void
1147 S_hsplit(pTHX_ HV *hv)
1148 {
1149     register XPVHV* xhv = (XPVHV*)SvANY(hv);
1150     I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
1151     register I32 newsize = oldsize * 2;
1152     register I32 i;
1153     register char *a = xhv->xhv_array; /* HvARRAY(hv) */
1154     register HE **aep;
1155     register HE **bep;
1156     register HE *entry;
1157     register HE **oentry;
1158
1159     PL_nomemok = TRUE;
1160 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
1161     Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
1162     if (!a) {
1163       PL_nomemok = FALSE;
1164       return;
1165     }
1166 #else
1167     New(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
1168     if (!a) {
1169       PL_nomemok = FALSE;
1170       return;
1171     }
1172     Copy(xhv->xhv_array /* HvARRAY(hv) */, a, oldsize * sizeof(HE*), char);
1173     if (oldsize >= 64) {
1174         offer_nice_chunk(xhv->xhv_array /* HvARRAY(hv) */,
1175                         PERL_HV_ARRAY_ALLOC_BYTES(oldsize));
1176     }
1177     else
1178         Safefree(xhv->xhv_array /* HvARRAY(hv) */);
1179 #endif
1180
1181     PL_nomemok = FALSE;
1182     Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char);     /* zero 2nd half*/
1183     xhv->xhv_max = --newsize;   /* HvMAX(hv) = --newsize */
1184     xhv->xhv_array = a;         /* HvARRAY(hv) = a */
1185     aep = (HE**)a;
1186
1187     for (i=0; i<oldsize; i++,aep++) {
1188         if (!*aep)                              /* non-existent */
1189             continue;
1190         bep = aep+oldsize;
1191         for (oentry = aep, entry = *aep; entry; entry = *oentry) {
1192             if ((HeHASH(entry) & newsize) != i) {
1193                 *oentry = HeNEXT(entry);
1194                 HeNEXT(entry) = *bep;
1195                 if (!*bep)
1196                     xhv->xhv_fill++; /* HvFILL(hv)++ */
1197                 *bep = entry;
1198                 continue;
1199             }
1200             else
1201                 oentry = &HeNEXT(entry);
1202         }
1203         if (!*aep)                              /* everything moved */
1204             xhv->xhv_fill--; /* HvFILL(hv)-- */
1205     }
1206 }
1207
1208 void
1209 Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
1210 {
1211     register XPVHV* xhv = (XPVHV*)SvANY(hv);
1212     I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
1213     register I32 newsize;
1214     register I32 i;
1215     register I32 j;
1216     register char *a;
1217     register HE **aep;
1218     register HE *entry;
1219     register HE **oentry;
1220
1221     newsize = (I32) newmax;                     /* possible truncation here */
1222     if (newsize != newmax || newmax <= oldsize)
1223         return;
1224     while ((newsize & (1 + ~newsize)) != newsize) {
1225         newsize &= ~(newsize & (1 + ~newsize)); /* get proper power of 2 */
1226     }
1227     if (newsize < newmax)
1228         newsize *= 2;
1229     if (newsize < newmax)
1230         return;                                 /* overflow detection */
1231
1232     a = xhv->xhv_array; /* HvARRAY(hv) */
1233     if (a) {
1234         PL_nomemok = TRUE;
1235 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
1236         Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
1237         if (!a) {
1238           PL_nomemok = FALSE;
1239           return;
1240         }
1241 #else
1242         New(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
1243         if (!a) {
1244           PL_nomemok = FALSE;
1245           return;
1246         }
1247         Copy(xhv->xhv_array /* HvARRAY(hv) */, a, oldsize * sizeof(HE*), char);
1248         if (oldsize >= 64) {
1249             offer_nice_chunk(xhv->xhv_array /* HvARRAY(hv) */,
1250                             PERL_HV_ARRAY_ALLOC_BYTES(oldsize));
1251         }
1252         else
1253             Safefree(xhv->xhv_array /* HvARRAY(hv) */);
1254 #endif
1255         PL_nomemok = FALSE;
1256         Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/
1257     }
1258     else {
1259         Newz(0, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
1260     }
1261     xhv->xhv_max = --newsize;   /* HvMAX(hv) = --newsize */
1262     xhv->xhv_array = a;         /* HvARRAY(hv) = a */
1263     if (!xhv->xhv_fill /* !HvFILL(hv) */)       /* skip rest if no entries */
1264         return;
1265
1266     aep = (HE**)a;
1267     for (i=0; i<oldsize; i++,aep++) {
1268         if (!*aep)                              /* non-existent */
1269             continue;
1270         for (oentry = aep, entry = *aep; entry; entry = *oentry) {
1271             if ((j = (HeHASH(entry) & newsize)) != i) {
1272                 j -= i;
1273                 *oentry = HeNEXT(entry);
1274                 if (!(HeNEXT(entry) = aep[j]))
1275                     xhv->xhv_fill++; /* HvFILL(hv)++ */
1276                 aep[j] = entry;
1277                 continue;
1278             }
1279             else
1280                 oentry = &HeNEXT(entry);
1281         }
1282         if (!*aep)                              /* everything moved */
1283             xhv->xhv_fill--; /* HvFILL(hv)-- */
1284     }
1285 }
1286
1287 /*
1288 =for apidoc newHV
1289
1290 Creates a new HV.  The reference count is set to 1.
1291
1292 =cut
1293 */
1294
1295 HV *
1296 Perl_newHV(pTHX)
1297 {
1298     register HV *hv;
1299     register XPVHV* xhv;
1300
1301     hv = (HV*)NEWSV(502,0);
1302     sv_upgrade((SV *)hv, SVt_PVHV);
1303     xhv = (XPVHV*)SvANY(hv);
1304     SvPOK_off(hv);
1305     SvNOK_off(hv);
1306 #ifndef NODEFAULT_SHAREKEYS
1307     HvSHAREKEYS_on(hv);         /* key-sharing on by default */
1308 #endif
1309     xhv->xhv_max    = 7;        /* HvMAX(hv) = 7 (start with 8 buckets) */
1310     xhv->xhv_fill   = 0;        /* HvFILL(hv) = 0 */
1311     xhv->xhv_pmroot = 0;        /* HvPMROOT(hv) = 0 */
1312     (void)hv_iterinit(hv);      /* so each() will start off right */
1313     return hv;
1314 }
1315
1316 HV *
1317 Perl_newHVhv(pTHX_ HV *ohv)
1318 {
1319     HV *hv = newHV();
1320     STRLEN hv_max, hv_fill;
1321
1322     if (!ohv || (hv_fill = HvFILL(ohv)) == 0)
1323         return hv;
1324     hv_max = HvMAX(ohv);
1325
1326     if (!SvMAGICAL((SV *)ohv)) {
1327         /* It's an ordinary hash, so copy it fast. AMS 20010804 */
1328         int i, shared = !!HvSHAREKEYS(ohv);
1329         HE **ents, **oents = (HE **)HvARRAY(ohv);
1330         char *a;
1331         New(0, a, PERL_HV_ARRAY_ALLOC_BYTES(hv_max+1), char);
1332         ents = (HE**)a;
1333
1334         /* In each bucket... */
1335         for (i = 0; i <= hv_max; i++) {
1336             HE *prev = NULL, *ent = NULL, *oent = oents[i];
1337
1338             if (!oent) {
1339                 ents[i] = NULL;
1340                 continue;
1341             }
1342
1343             /* Copy the linked list of entries. */
1344             for (oent = oents[i]; oent; oent = HeNEXT(oent)) {
1345                 U32 hash   = HeHASH(oent);
1346                 char *key  = HeKEY(oent);
1347                 STRLEN len = HeKLEN_UTF8(oent);
1348
1349                 ent = new_HE();
1350                 HeVAL(ent)     = newSVsv(HeVAL(oent));
1351                 HeKEY_hek(ent) = shared ? share_hek(key, len, hash)
1352                                         :  save_hek(key, len, hash);
1353                 if (prev)
1354                     HeNEXT(prev) = ent;
1355                 else
1356                     ents[i] = ent;
1357                 prev = ent;
1358                 HeNEXT(ent) = NULL;
1359             }
1360         }
1361
1362         HvMAX(hv)   = hv_max;
1363         HvFILL(hv)  = hv_fill;
1364         HvTOTALKEYS(hv)  = HvTOTALKEYS(ohv);
1365         HvARRAY(hv) = ents;
1366     }
1367     else {
1368         /* Iterate over ohv, copying keys and values one at a time. */
1369         HE *entry;
1370         I32 riter = HvRITER(ohv);
1371         HE *eiter = HvEITER(ohv);
1372
1373         /* Can we use fewer buckets? (hv_max is always 2^n-1) */
1374         while (hv_max && hv_max + 1 >= hv_fill * 2)
1375             hv_max = hv_max / 2;
1376         HvMAX(hv) = hv_max;
1377
1378         hv_iterinit(ohv);
1379         while ((entry = hv_iternext(ohv))) {
1380             hv_store(hv, HeKEY(entry), HeKLEN_UTF8(entry),
1381                      newSVsv(HeVAL(entry)), HeHASH(entry));
1382         }
1383         HvRITER(ohv) = riter;
1384         HvEITER(ohv) = eiter;
1385     }
1386
1387     return hv;
1388 }
1389
1390 void
1391 Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
1392 {
1393     SV *val;
1394
1395     if (!entry)
1396         return;
1397     val = HeVAL(entry);
1398     if (val && isGV(val) && GvCVu(val) && HvNAME(hv))
1399         PL_sub_generation++;    /* may be deletion of method from stash */
1400     SvREFCNT_dec(val);
1401     if (HeKLEN(entry) == HEf_SVKEY) {
1402         SvREFCNT_dec(HeKEY_sv(entry));
1403         Safefree(HeKEY_hek(entry));
1404     }
1405     else if (HvSHAREKEYS(hv))
1406         unshare_hek(HeKEY_hek(entry));
1407     else
1408         Safefree(HeKEY_hek(entry));
1409     del_HE(entry);
1410 }
1411
1412 void
1413 Perl_hv_delayfree_ent(pTHX_ HV *hv, register HE *entry)
1414 {
1415     if (!entry)
1416         return;
1417     if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv))
1418         PL_sub_generation++;    /* may be deletion of method from stash */
1419     sv_2mortal(HeVAL(entry));   /* free between statements */
1420     if (HeKLEN(entry) == HEf_SVKEY) {
1421         sv_2mortal(HeKEY_sv(entry));
1422         Safefree(HeKEY_hek(entry));
1423     }
1424     else if (HvSHAREKEYS(hv))
1425         unshare_hek(HeKEY_hek(entry));
1426     else
1427         Safefree(HeKEY_hek(entry));
1428     del_HE(entry);
1429 }
1430
1431 /*
1432 =for apidoc hv_clear
1433
1434 Clears a hash, making it empty.
1435
1436 =cut
1437 */
1438
1439 void
1440 Perl_hv_clear(pTHX_ HV *hv)
1441 {
1442     register XPVHV* xhv;
1443     if (!hv)
1444         return;
1445     xhv = (XPVHV*)SvANY(hv);
1446     hfreeentries(hv);
1447     xhv->xhv_fill = 0; /* HvFILL(hv) = 0 */
1448     xhv->xhv_keys = 0; /* HvKEYS(hv) = 0 */
1449     xhv->xhv_placeholders = 0; /* HvPLACEHOLDERS(hv) = 0 */
1450     if (xhv->xhv_array /* HvARRAY(hv) */)
1451         (void)memzero(xhv->xhv_array /* HvARRAY(hv) */,
1452                       (xhv->xhv_max+1 /* HvMAX(hv)+1 */) * sizeof(HE*));
1453
1454     if (SvRMAGICAL(hv))
1455         mg_clear((SV*)hv);
1456 }
1457
1458 STATIC void
1459 S_hfreeentries(pTHX_ HV *hv)
1460 {
1461     register HE **array;
1462     register HE *entry;
1463     register HE *oentry = Null(HE*);
1464     I32 riter;
1465     I32 max;
1466
1467     if (!hv)
1468         return;
1469     if (!HvARRAY(hv))
1470         return;
1471
1472     riter = 0;
1473     max = HvMAX(hv);
1474     array = HvARRAY(hv);
1475     entry = array[0];
1476     for (;;) {
1477         if (entry) {
1478             oentry = entry;
1479             entry = HeNEXT(entry);
1480             hv_free_ent(hv, oentry);
1481         }
1482         if (!entry) {
1483             if (++riter > max)
1484                 break;
1485             entry = array[riter];
1486         }
1487     }
1488     (void)hv_iterinit(hv);
1489 }
1490
1491 /*
1492 =for apidoc hv_undef
1493
1494 Undefines the hash.
1495
1496 =cut
1497 */
1498
1499 void
1500 Perl_hv_undef(pTHX_ HV *hv)
1501 {
1502     register XPVHV* xhv;
1503     if (!hv)
1504         return;
1505     xhv = (XPVHV*)SvANY(hv);
1506     hfreeentries(hv);
1507     Safefree(xhv->xhv_array /* HvARRAY(hv) */);
1508     if (HvNAME(hv)) {
1509         Safefree(HvNAME(hv));
1510         HvNAME(hv) = 0;
1511     }
1512     xhv->xhv_max   = 7; /* HvMAX(hv) = 7 (it's a normal hash) */
1513     xhv->xhv_array = 0; /* HvARRAY(hv) = 0 */
1514     xhv->xhv_fill  = 0; /* HvFILL(hv) = 0 */
1515     xhv->xhv_keys  = 0; /* HvKEYS(hv) = 0 */
1516     xhv->xhv_placeholders = 0; /* HvPLACEHOLDERS(hv) = 0 */
1517
1518     if (SvRMAGICAL(hv))
1519         mg_clear((SV*)hv);
1520 }
1521
1522 /*
1523 =for apidoc hv_iterinit
1524
1525 Prepares a starting point to traverse a hash table.  Returns the number of
1526 keys in the hash (i.e. the same as C<HvKEYS(tb)>).  The return value is
1527 currently only meaningful for hashes without tie magic.
1528
1529 NOTE: Before version 5.004_65, C<hv_iterinit> used to return the number of
1530 hash buckets that happen to be in use.  If you still need that esoteric
1531 value, you can get it through the macro C<HvFILL(tb)>.
1532
1533 =cut
1534 */
1535
1536 I32
1537 Perl_hv_iterinit(pTHX_ HV *hv)
1538 {
1539     register XPVHV* xhv;
1540     HE *entry;
1541
1542     if (!hv)
1543         Perl_croak(aTHX_ "Bad hash");
1544     xhv = (XPVHV*)SvANY(hv);
1545     entry = xhv->xhv_eiter; /* HvEITER(hv) */
1546     if (entry && HvLAZYDEL(hv)) {       /* was deleted earlier? */
1547         HvLAZYDEL_off(hv);
1548         hv_free_ent(hv, entry);
1549     }
1550     xhv->xhv_riter = -1;        /* HvRITER(hv) = -1 */
1551     xhv->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
1552     /* used to be xhv->xhv_fill before 5.004_65 */
1553     return XHvTOTALKEYS(xhv);
1554 }
1555
1556 /*
1557 =for apidoc hv_iternext
1558
1559 Returns entries from a hash iterator.  See C<hv_iterinit>.
1560
1561 =cut
1562 */
1563
1564 HE *
1565 Perl_hv_iternext(pTHX_ HV *hv)
1566 {
1567     register XPVHV* xhv;
1568     register HE *entry;
1569     HE *oldentry;
1570     MAGIC* mg;
1571
1572     if (!hv)
1573         Perl_croak(aTHX_ "Bad hash");
1574     xhv = (XPVHV*)SvANY(hv);
1575     oldentry = entry = xhv->xhv_eiter; /* HvEITER(hv) */
1576
1577     if ((mg = SvTIED_mg((SV*)hv, PERL_MAGIC_tied))) {
1578         SV *key = sv_newmortal();
1579         if (entry) {
1580             sv_setsv(key, HeSVKEY_force(entry));
1581             SvREFCNT_dec(HeSVKEY(entry));       /* get rid of previous key */
1582         }
1583         else {
1584             char *k;
1585             HEK *hek;
1586
1587             /* one HE per MAGICAL hash */
1588             xhv->xhv_eiter = entry = new_HE(); /* HvEITER(hv) = new_HE() */
1589             Zero(entry, 1, HE);
1590             Newz(54, k, HEK_BASESIZE + sizeof(SV*), char);
1591             hek = (HEK*)k;
1592             HeKEY_hek(entry) = hek;
1593             HeKLEN(entry) = HEf_SVKEY;
1594         }
1595         magic_nextpack((SV*) hv,mg,key);
1596         if (SvOK(key)) {
1597             /* force key to stay around until next time */
1598             HeSVKEY_set(entry, SvREFCNT_inc(key));
1599             return entry;               /* beware, hent_val is not set */
1600         }
1601         if (HeVAL(entry))
1602             SvREFCNT_dec(HeVAL(entry));
1603         Safefree(HeKEY_hek(entry));
1604         del_HE(entry);
1605         xhv->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
1606         return Null(HE*);
1607     }
1608 #ifdef DYNAMIC_ENV_FETCH  /* set up %ENV for iteration */
1609     if (!entry && SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env))
1610         prime_env_iter();
1611 #endif
1612
1613     if (!xhv->xhv_array /* !HvARRAY(hv) */)
1614         Newz(506, xhv->xhv_array /* HvARRAY(hv) */,
1615              PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
1616              char);
1617     if (entry)
1618     {
1619         entry = HeNEXT(entry);
1620         /*
1621          * Skip past any placeholders -- don't want to include them in
1622          * any iteration.
1623          */
1624         while (entry && HeVAL(entry) == &PL_sv_undef) {
1625             entry = HeNEXT(entry);
1626         }
1627     }
1628     while (!entry) {
1629         xhv->xhv_riter++; /* HvRITER(hv)++ */
1630         if (xhv->xhv_riter > xhv->xhv_max /* HvRITER(hv) > HvMAX(hv) */) {
1631             xhv->xhv_riter = -1; /* HvRITER(hv) = -1 */
1632             break;
1633         }
1634         /* entry = (HvARRAY(hv))[HvRITER(hv)]; */
1635         entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
1636
1637         /* if we have an entry, but it's a placeholder, don't count it */
1638         if (entry && HeVAL(entry) == &PL_sv_undef)
1639             entry = 0;
1640
1641     }
1642
1643     if (oldentry && HvLAZYDEL(hv)) {            /* was deleted earlier? */
1644         HvLAZYDEL_off(hv);
1645         hv_free_ent(hv, oldentry);
1646     }
1647
1648     xhv->xhv_eiter = entry; /* HvEITER(hv) = entry */
1649     return entry;
1650 }
1651
1652 /*
1653 =for apidoc hv_iterkey
1654
1655 Returns the key from the current position of the hash iterator.  See
1656 C<hv_iterinit>.
1657
1658 =cut
1659 */
1660
1661 char *
1662 Perl_hv_iterkey(pTHX_ register HE *entry, I32 *retlen)
1663 {
1664     if (HeKLEN(entry) == HEf_SVKEY) {
1665         STRLEN len;
1666         char *p = SvPV(HeKEY_sv(entry), len);
1667         *retlen = len;
1668         return p;
1669     }
1670     else {
1671         *retlen = HeKLEN(entry);
1672         return HeKEY(entry);
1673     }
1674 }
1675
1676 /* unlike hv_iterval(), this always returns a mortal copy of the key */
1677 /*
1678 =for apidoc hv_iterkeysv
1679
1680 Returns the key as an C<SV*> from the current position of the hash
1681 iterator.  The return value will always be a mortal copy of the key.  Also
1682 see C<hv_iterinit>.
1683
1684 =cut
1685 */
1686
1687 SV *
1688 Perl_hv_iterkeysv(pTHX_ register HE *entry)
1689 {
1690     if (HeKLEN(entry) == HEf_SVKEY)
1691         return sv_mortalcopy(HeKEY_sv(entry));
1692     else
1693         return sv_2mortal(newSVpvn_share((HeKLEN(entry) ? HeKEY(entry) : ""),
1694                                          HeKLEN_UTF8(entry), HeHASH(entry)));
1695 }
1696
1697 /*
1698 =for apidoc hv_iterval
1699
1700 Returns the value from the current position of the hash iterator.  See
1701 C<hv_iterkey>.
1702
1703 =cut
1704 */
1705
1706 SV *
1707 Perl_hv_iterval(pTHX_ HV *hv, register HE *entry)
1708 {
1709     if (SvRMAGICAL(hv)) {
1710         if (mg_find((SV*)hv, PERL_MAGIC_tied)) {
1711             SV* sv = sv_newmortal();
1712             if (HeKLEN(entry) == HEf_SVKEY)
1713                 mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY);
1714             else mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry));
1715             return sv;
1716         }
1717     }
1718     return HeVAL(entry);
1719 }
1720
1721 /*
1722 =for apidoc hv_iternextsv
1723
1724 Performs an C<hv_iternext>, C<hv_iterkey>, and C<hv_iterval> in one
1725 operation.
1726
1727 =cut
1728 */
1729
1730 SV *
1731 Perl_hv_iternextsv(pTHX_ HV *hv, char **key, I32 *retlen)
1732 {
1733     HE *he;
1734     if ( (he = hv_iternext(hv)) == NULL)
1735         return NULL;
1736     *key = hv_iterkey(he, retlen);
1737     return hv_iterval(hv, he);
1738 }
1739
1740 /*
1741 =for apidoc hv_magic
1742
1743 Adds magic to a hash.  See C<sv_magic>.
1744
1745 =cut
1746 */
1747
1748 void
1749 Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how)
1750 {
1751     sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
1752 }
1753
1754 #if 0 /* use the macro from hv.h instead */
1755
1756 char*
1757 Perl_sharepvn(pTHX_ const char *sv, I32 len, U32 hash)
1758 {
1759     return HEK_KEY(share_hek(sv, len, hash));
1760 }
1761
1762 #endif
1763
1764 /* possibly free a shared string if no one has access to it
1765  * len and hash must both be valid for str.
1766  */
1767 void
1768 Perl_unsharepvn(pTHX_ const char *str, I32 len, U32 hash)
1769 {
1770     register XPVHV* xhv;
1771     register HE *entry;
1772     register HE **oentry;
1773     register I32 i = 1;
1774     I32 found = 0;
1775     bool is_utf8 = FALSE;
1776     const char *save = str;
1777
1778     if (len < 0) {
1779       STRLEN tmplen = -len;
1780       is_utf8 = TRUE;
1781       /* See the note in hv_fetch(). --jhi */
1782       str = (char*)bytes_from_utf8((U8*)str, &tmplen, &is_utf8);
1783       len = tmplen;
1784     }
1785
1786     /* what follows is the moral equivalent of:
1787     if ((Svp = hv_fetch(PL_strtab, tmpsv, FALSE, hash))) {
1788         if (--*Svp == Nullsv)
1789             hv_delete(PL_strtab, str, len, G_DISCARD, hash);
1790     } */
1791     xhv = (XPVHV*)SvANY(PL_strtab);
1792     /* assert(xhv_array != 0) */
1793     LOCK_STRTAB_MUTEX;
1794     /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
1795     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1796     for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
1797         if (HeHASH(entry) != hash)              /* strings can't be equal */
1798             continue;
1799         if (HeKLEN(entry) != len)
1800             continue;
1801         if (HeKEY(entry) != str && memNE(HeKEY(entry),str,len)) /* is this it? */
1802             continue;
1803         if (HeKUTF8(entry) != (char)is_utf8)
1804             continue;
1805         found = 1;
1806         if (--HeVAL(entry) == Nullsv) {
1807             *oentry = HeNEXT(entry);
1808             if (i && !*oentry)
1809                 xhv->xhv_fill--; /* HvFILL(hv)-- */
1810             Safefree(HeKEY_hek(entry));
1811             del_HE(entry);
1812             xhv->xhv_keys--; /* HvKEYS(hv)-- */
1813         }
1814         break;
1815     }
1816     UNLOCK_STRTAB_MUTEX;
1817     if (str != save)
1818         Safefree(str);
1819     if (!found && ckWARN_d(WARN_INTERNAL))
1820         Perl_warner(aTHX_ WARN_INTERNAL, "Attempt to free non-existent shared string '%s'",str);
1821 }
1822
1823 /* get a (constant) string ptr from the global string table
1824  * string will get added if it is not already there.
1825  * len and hash must both be valid for str.
1826  */
1827 HEK *
1828 Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash)
1829 {
1830     register XPVHV* xhv;
1831     register HE *entry;
1832     register HE **oentry;
1833     register I32 i = 1;
1834     I32 found = 0;
1835     bool is_utf8 = FALSE;
1836     const char *save = str;
1837
1838     if (len < 0) {
1839       STRLEN tmplen = -len;
1840       is_utf8 = TRUE;
1841       /* See the note in hv_fetch(). --jhi */
1842       str = (char*)bytes_from_utf8((U8*)str, &tmplen, &is_utf8);
1843       len = tmplen;
1844     }
1845
1846     /* what follows is the moral equivalent of:
1847
1848     if (!(Svp = hv_fetch(PL_strtab, str, len, FALSE)))
1849         hv_store(PL_strtab, str, len, Nullsv, hash);
1850     */
1851     xhv = (XPVHV*)SvANY(PL_strtab);
1852     /* assert(xhv_array != 0) */
1853     LOCK_STRTAB_MUTEX;
1854     /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
1855     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1856     for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
1857         if (HeHASH(entry) != hash)              /* strings can't be equal */
1858             continue;
1859         if (HeKLEN(entry) != len)
1860             continue;
1861         if (HeKEY(entry) != str && memNE(HeKEY(entry),str,len)) /* is this it? */
1862             continue;
1863         if (HeKUTF8(entry) != (char)is_utf8)
1864             continue;
1865         found = 1;
1866         break;
1867     }
1868     if (!found) {
1869         entry = new_HE();
1870         HeKEY_hek(entry) = save_hek(str, is_utf8?-len:len, hash);
1871         HeVAL(entry) = Nullsv;
1872         HeNEXT(entry) = *oentry;
1873         *oentry = entry;
1874         xhv->xhv_keys++; /* HvKEYS(hv)++ */
1875         if (i) {                                /* initial entry? */
1876             xhv->xhv_fill++; /* HvFILL(hv)++ */
1877             if (xhv->xhv_keys > xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */)
1878                 hsplit(PL_strtab);
1879         }
1880     }
1881
1882     ++HeVAL(entry);                             /* use value slot as REFCNT */
1883     UNLOCK_STRTAB_MUTEX;
1884     if (str != save)
1885         Safefree(str);
1886     return HeKEY_hek(entry);
1887 }