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
 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         else if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
 910             Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
 911         }
 912
 913         if (flags & G_DISCARD)
 914             sv = Nullsv;
 915         else {
 916             sv = sv_2mortal(HeVAL(entry));
 917             HeVAL(entry) = &PL_sv_undef;
 918         }
 919
 920         /*
 921          * If a restricted hash, rather than really deleting the entry, put
 922          * a placeholder there. This marks the key as being "approved", so
 923          * we can still access via not-really-existing key without raising
 924          * an error.
 925          */
 926         if (SvREADONLY(hv)) {
 927             HeVAL(entry) = &PL_sv_undef;
 928             /* We'll be saving this slot, so the number of allocated keys
 929              * doesn't go down, but the number placeholders goes up */
 930             xhv->xhv_placeholders++; /* HvPLACEHOLDERS(hv)++ */
 931         } else {
 932             *oentry = HeNEXT(entry);
 933             if (i && !*oentry)
 934                 xhv->xhv_fill--; /* HvFILL(hv)-- */
 935             if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
 936                 HvLAZYDEL_on(hv);
 937             else
 938                 hv_free_ent(hv, entry);
 939             xhv->xhv_keys--; /* HvKEYS(hv)-- */
 940         }
 941         return sv;
 942     }
 943     if (SvREADONLY(hv)) {
 944         Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
 945     }
 946
 947     if (key != keysave)
 948         Safefree(key);
 949     return Nullsv;
 950 }
 951
 952 /*
 953 =for apidoc hv_exists
 954
 955 Returns a boolean indicating whether the specified hash key exists.  The
 956 C<klen> is the length of the key.
 957
 958 =cut
 959 */
 960
 961 bool
 962 Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen)
 963 {
 964     register XPVHV* xhv;
 965     register U32 hash;
 966     register HE *entry;
 967     SV *sv;
 968     bool is_utf8 = FALSE;
 969     const char *keysave = key;
 970
 971     if (!hv)
 972         return 0;
 973
 974     if (klen < 0) {
 975       klen = -klen;
 976       is_utf8 = TRUE;
 977     }
 978
 979     if (SvRMAGICAL(hv)) {
 980         if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
 981             sv = sv_newmortal();
 982             mg_copy((SV*)hv, sv, key, klen);
 983             magic_existspack(sv, mg_find(sv, PERL_MAGIC_tiedelem));
 984             return SvTRUE(sv);
 985         }
 986 #ifdef ENV_IS_CASELESS
 987         else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
 988             sv = sv_2mortal(newSVpvn(key,klen));
 989             key = strupr(SvPVX(sv));
 990         }
 991 #endif
 992     }
 993
 994     xhv = (XPVHV*)SvANY(hv);
 995 #ifndef DYNAMIC_ENV_FETCH
 996     if (!xhv->xhv_array /* !HvARRAY(hv) */)
 997         return 0;
 998 #endif
 999
1000     if (is_utf8) {
1001         STRLEN tmplen = klen;
1002         /* See the note in hv_fetch(). --jhi */
1003         key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
1004         klen = tmplen;
1005     }
1006
1007     PERL_HASH(hash, key, klen);
1008
1009 #ifdef DYNAMIC_ENV_FETCH
1010     if (!xhv->xhv_array /* !HvARRAY(hv) */) entry = Null(HE*);
1011     else
1012 #endif
1013     /* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
1014     entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1015     for (; entry; entry = HeNEXT(entry)) {
1016         if (HeHASH(entry) != hash)              /* strings can't be equal */
1017             continue;
1018         if (HeKLEN(entry) != klen)
1019             continue;
1020         if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
1021             continue;
1022         if (HeKUTF8(entry) != (char)is_utf8)
1023             continue;
1024         if (key != keysave)
1025             Safefree(key);
1026         /* If we find the key, but the value is a placeholder, return false. */
1027         if (HeVAL(entry) == &PL_sv_undef)
1028             return FALSE;
1029
1030         return TRUE;
1031     }
1032 #ifdef DYNAMIC_ENV_FETCH  /* is it out there? */
1033     if (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
1034         unsigned long len;
1035         char *env = PerlEnv_ENVgetenv_len(key,&len);
1036         if (env) {
1037             sv = newSVpvn(env,len);
1038             SvTAINTED_on(sv);
1039             (void)hv_store(hv,key,klen,sv,hash);
1040             return TRUE;
1041         }
1042     }
1043 #endif
1044     if (key != keysave)
1045         Safefree(key);
1046     return FALSE;
1047 }
1048
1049
1050 /*
1051 =for apidoc hv_exists_ent
1052
1053 Returns a boolean indicating whether the specified hash key exists. C<hash>
1054 can be a valid precomputed hash value, or 0 to ask for it to be
1055 computed.
1056
1057 =cut
1058 */
1059
1060 bool
1061 Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
1062 {
1063     register XPVHV* xhv;
1064     register char *key;
1065     STRLEN klen;
1066     register HE *entry;
1067     SV *sv;
1068     bool is_utf8;
1069     char *keysave;
1070
1071     if (!hv)
1072         return 0;
1073
1074     if (SvRMAGICAL(hv)) {
1075         if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
1076            SV* svret = sv_newmortal();
1077             sv = sv_newmortal();
1078             keysv = sv_2mortal(newSVsv(keysv));
1079             mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
1080            magic_existspack(svret, mg_find(sv, PERL_MAGIC_tiedelem));
1081            return SvTRUE(svret);
1082         }
1083 #ifdef ENV_IS_CASELESS
1084         else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
1085             key = SvPV(keysv, klen);
1086             keysv = sv_2mortal(newSVpvn(key,klen));
1087             (void)strupr(SvPVX(keysv));
1088             hash = 0;
1089         }
1090 #endif
1091     }
1092
1093     xhv = (XPVHV*)SvANY(hv);
1094 #ifndef DYNAMIC_ENV_FETCH
1095     if (!xhv->xhv_array /* !HvARRAY(hv) */)
1096         return 0;
1097 #endif
1098
1099     keysave = key = SvPV(keysv, klen);
1100     is_utf8 = (SvUTF8(keysv) != 0);
1101     if (is_utf8)
1102         key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
1103     if (!hash)
1104         PERL_HASH(hash, key, klen);
1105
1106 #ifdef DYNAMIC_ENV_FETCH
1107     if (!xhv->xhv_array /* !HvARRAY(hv) */) entry = Null(HE*);
1108     else
1109 #endif
1110     /* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
1111     entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1112     for (; entry; entry = HeNEXT(entry)) {
1113         if (HeHASH(entry) != hash)              /* strings can't be equal */
1114             continue;
1115         if (HeKLEN(entry) != klen)
1116             continue;
1117         if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
1118             continue;
1119         if (HeKUTF8(entry) != (char)is_utf8)
1120             continue;
1121         if (key != keysave)
1122             Safefree(key);
1123         /* If we find the key, but the value is a placeholder, return false. */
1124         if (HeVAL(entry) == &PL_sv_undef)
1125             return FALSE;
1126         return TRUE;
1127     }
1128 #ifdef DYNAMIC_ENV_FETCH  /* is it out there? */
1129     if (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
1130         unsigned long len;
1131         char *env = PerlEnv_ENVgetenv_len(key,&len);
1132         if (env) {
1133             sv = newSVpvn(env,len);
1134             SvTAINTED_on(sv);
1135             (void)hv_store_ent(hv,keysv,sv,hash);
1136             return TRUE;
1137         }
1138     }
1139 #endif
1140     if (key != keysave)
1141         Safefree(key);
1142     return FALSE;
1143 }
1144
1145 STATIC void
1146 S_hsplit(pTHX_ HV *hv)
1147 {
1148     register XPVHV* xhv = (XPVHV*)SvANY(hv);
1149     I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
1150     register I32 newsize = oldsize * 2;
1151     register I32 i;
1152     register char *a = xhv->xhv_array; /* HvARRAY(hv) */
1153     register HE **aep;
1154     register HE **bep;
1155     register HE *entry;
1156     register HE **oentry;
1157
1158     PL_nomemok = TRUE;
1159 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
1160     Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
1161     if (!a) {
1162       PL_nomemok = FALSE;
1163       return;
1164     }
1165 #else
1166     New(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
1167     if (!a) {
1168       PL_nomemok = FALSE;
1169       return;
1170     }
1171     Copy(xhv->xhv_array /* HvARRAY(hv) */, a, oldsize * sizeof(HE*), char);
1172     if (oldsize >= 64) {
1173         offer_nice_chunk(xhv->xhv_array /* HvARRAY(hv) */,
1174                         PERL_HV_ARRAY_ALLOC_BYTES(oldsize));
1175     }
1176     else
1177         Safefree(xhv->xhv_array /* HvARRAY(hv) */);
1178 #endif
1179
1180     PL_nomemok = FALSE;
1181     Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char);     /* zero 2nd half*/
1182     xhv->xhv_max = --newsize;   /* HvMAX(hv) = --newsize */
1183     xhv->xhv_array = a;         /* HvARRAY(hv) = a */
1184     aep = (HE**)a;
1185
1186     for (i=0; i<oldsize; i++,aep++) {
1187         if (!*aep)                              /* non-existent */
1188             continue;
1189         bep = aep+oldsize;
1190         for (oentry = aep, entry = *aep; entry; entry = *oentry) {
1191             if ((HeHASH(entry) & newsize) != i) {
1192                 *oentry = HeNEXT(entry);
1193                 HeNEXT(entry) = *bep;
1194                 if (!*bep)
1195                     xhv->xhv_fill++; /* HvFILL(hv)++ */
1196                 *bep = entry;
1197                 continue;
1198             }
1199             else
1200                 oentry = &HeNEXT(entry);
1201         }
1202         if (!*aep)                              /* everything moved */
1203             xhv->xhv_fill--; /* HvFILL(hv)-- */
1204     }
1205 }
1206
1207 void
1208 Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
1209 {
1210     register XPVHV* xhv = (XPVHV*)SvANY(hv);
1211     I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
1212     register I32 newsize;
1213     register I32 i;
1214     register I32 j;
1215     register char *a;
1216     register HE **aep;
1217     register HE *entry;
1218     register HE **oentry;
1219
1220     newsize = (I32) newmax;                     /* possible truncation here */
1221     if (newsize != newmax || newmax <= oldsize)
1222         return;
1223     while ((newsize & (1 + ~newsize)) != newsize) {
1224         newsize &= ~(newsize & (1 + ~newsize)); /* get proper power of 2 */
1225     }
1226     if (newsize < newmax)
1227         newsize *= 2;
1228     if (newsize < newmax)
1229         return;                                 /* overflow detection */
1230
1231     a = xhv->xhv_array; /* HvARRAY(hv) */
1232     if (a) {
1233         PL_nomemok = TRUE;
1234 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
1235         Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
1236         if (!a) {
1237           PL_nomemok = FALSE;
1238           return;
1239         }
1240 #else
1241         New(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
1242         if (!a) {
1243           PL_nomemok = FALSE;
1244           return;
1245         }
1246         Copy(xhv->xhv_array /* HvARRAY(hv) */, a, oldsize * sizeof(HE*), char);
1247         if (oldsize >= 64) {
1248             offer_nice_chunk(xhv->xhv_array /* HvARRAY(hv) */,
1249                             PERL_HV_ARRAY_ALLOC_BYTES(oldsize));
1250         }
1251         else
1252             Safefree(xhv->xhv_array /* HvARRAY(hv) */);
1253 #endif
1254         PL_nomemok = FALSE;
1255         Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/
1256     }
1257     else {
1258         Newz(0, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
1259     }
1260     xhv->xhv_max = --newsize;   /* HvMAX(hv) = --newsize */
1261     xhv->xhv_array = a;         /* HvARRAY(hv) = a */
1262     if (!xhv->xhv_fill /* !HvFILL(hv) */)       /* skip rest if no entries */
1263         return;
1264
1265     aep = (HE**)a;
1266     for (i=0; i<oldsize; i++,aep++) {
1267         if (!*aep)                              /* non-existent */
1268             continue;
1269         for (oentry = aep, entry = *aep; entry; entry = *oentry) {
1270             if ((j = (HeHASH(entry) & newsize)) != i) {
1271                 j -= i;
1272                 *oentry = HeNEXT(entry);
1273                 if (!(HeNEXT(entry) = aep[j]))
1274                     xhv->xhv_fill++; /* HvFILL(hv)++ */
1275                 aep[j] = entry;
1276                 continue;
1277             }
1278             else
1279                 oentry = &HeNEXT(entry);
1280         }
1281         if (!*aep)                              /* everything moved */
1282             xhv->xhv_fill--; /* HvFILL(hv)-- */
1283     }
1284 }
1285
1286 /*
1287 =for apidoc newHV
1288
1289 Creates a new HV.  The reference count is set to 1.
1290
1291 =cut
1292 */
1293
1294 HV *
1295 Perl_newHV(pTHX)
1296 {
1297     register HV *hv;
1298     register XPVHV* xhv;
1299
1300     hv = (HV*)NEWSV(502,0);
1301     sv_upgrade((SV *)hv, SVt_PVHV);
1302     xhv = (XPVHV*)SvANY(hv);
1303     SvPOK_off(hv);
1304     SvNOK_off(hv);
1305 #ifndef NODEFAULT_SHAREKEYS
1306     HvSHAREKEYS_on(hv);         /* key-sharing on by default */
1307 #endif
1308     xhv->xhv_max    = 7;        /* HvMAX(hv) = 7 (start with 8 buckets) */
1309     xhv->xhv_fill   = 0;        /* HvFILL(hv) = 0 */
1310     xhv->xhv_pmroot = 0;        /* HvPMROOT(hv) = 0 */
1311     (void)hv_iterinit(hv);      /* so each() will start off right */
1312     return hv;
1313 }
1314
1315 HV *
1316 Perl_newHVhv(pTHX_ HV *ohv)
1317 {
1318     HV *hv = newHV();
1319     STRLEN hv_max, hv_fill;
1320
1321     if (!ohv || (hv_fill = HvFILL(ohv)) == 0)
1322         return hv;
1323     hv_max = HvMAX(ohv);
1324
1325     if (!SvMAGICAL((SV *)ohv)) {
1326         /* It's an ordinary hash, so copy it fast. AMS 20010804 */
1327         int i, shared = !!HvSHAREKEYS(ohv);
1328         HE **ents, **oents = (HE **)HvARRAY(ohv);
1329         char *a;
1330         New(0, a, PERL_HV_ARRAY_ALLOC_BYTES(hv_max+1), char);
1331         ents = (HE**)a;
1332
1333         /* In each bucket... */
1334         for (i = 0; i <= hv_max; i++) {
1335             HE *prev = NULL, *ent = NULL, *oent = oents[i];
1336
1337             if (!oent) {
1338                 ents[i] = NULL;
1339                 continue;
1340             }
1341
1342             /* Copy the linked list of entries. */
1343             for (oent = oents[i]; oent; oent = HeNEXT(oent)) {
1344                 U32 hash   = HeHASH(oent);
1345                 char *key  = HeKEY(oent);
1346                 STRLEN len = HeKLEN_UTF8(oent);
1347
1348                 ent = new_HE();
1349                 HeVAL(ent)     = newSVsv(HeVAL(oent));
1350                 HeKEY_hek(ent) = shared ? share_hek(key, len, hash)
1351                                         :  save_hek(key, len, hash);
1352                 if (prev)
1353                     HeNEXT(prev) = ent;
1354                 else
1355                     ents[i] = ent;
1356                 prev = ent;
1357                 HeNEXT(ent) = NULL;
1358             }
1359         }
1360
1361         HvMAX(hv)   = hv_max;
1362         HvFILL(hv)  = hv_fill;
1363         HvTOTALKEYS(hv)  = HvTOTALKEYS(ohv);
1364         HvARRAY(hv) = ents;
1365     }
1366     else {
1367         /* Iterate over ohv, copying keys and values one at a time. */
1368         HE *entry;
1369         I32 riter = HvRITER(ohv);
1370         HE *eiter = HvEITER(ohv);
1371
1372         /* Can we use fewer buckets? (hv_max is always 2^n-1) */
1373         while (hv_max && hv_max + 1 >= hv_fill * 2)
1374             hv_max = hv_max / 2;
1375         HvMAX(hv) = hv_max;
1376
1377         hv_iterinit(ohv);
1378         while ((entry = hv_iternext(ohv))) {
1379             hv_store(hv, HeKEY(entry), HeKLEN_UTF8(entry),
1380                      newSVsv(HeVAL(entry)), HeHASH(entry));
1381         }
1382         HvRITER(ohv) = riter;
1383         HvEITER(ohv) = eiter;
1384     }
1385
1386     return hv;
1387 }
1388
1389 void
1390 Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
1391 {
1392     SV *val;
1393
1394     if (!entry)
1395         return;
1396     val = HeVAL(entry);
1397     if (val && isGV(val) && GvCVu(val) && HvNAME(hv))
1398         PL_sub_generation++;    /* may be deletion of method from stash */
1399     SvREFCNT_dec(val);
1400     if (HeKLEN(entry) == HEf_SVKEY) {
1401         SvREFCNT_dec(HeKEY_sv(entry));
1402         Safefree(HeKEY_hek(entry));
1403     }
1404     else if (HvSHAREKEYS(hv))
1405         unshare_hek(HeKEY_hek(entry));
1406     else
1407         Safefree(HeKEY_hek(entry));
1408     del_HE(entry);
1409 }
1410
1411 void
1412 Perl_hv_delayfree_ent(pTHX_ HV *hv, register HE *entry)
1413 {
1414     if (!entry)
1415         return;
1416     if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv))
1417         PL_sub_generation++;    /* may be deletion of method from stash */
1418     sv_2mortal(HeVAL(entry));   /* free between statements */
1419     if (HeKLEN(entry) == HEf_SVKEY) {
1420         sv_2mortal(HeKEY_sv(entry));
1421         Safefree(HeKEY_hek(entry));
1422     }
1423     else if (HvSHAREKEYS(hv))
1424         unshare_hek(HeKEY_hek(entry));
1425     else
1426         Safefree(HeKEY_hek(entry));
1427     del_HE(entry);
1428 }
1429
1430 /*
1431 =for apidoc hv_clear
1432
1433 Clears a hash, making it empty.
1434
1435 =cut
1436 */
1437
1438 void
1439 Perl_hv_clear(pTHX_ HV *hv)
1440 {
1441     register XPVHV* xhv;
1442     if (!hv)
1443         return;
1444     xhv = (XPVHV*)SvANY(hv);
1445     hfreeentries(hv);
1446     xhv->xhv_fill = 0; /* HvFILL(hv) = 0 */
1447     xhv->xhv_keys = 0; /* HvKEYS(hv) = 0 */
1448     xhv->xhv_placeholders = 0; /* HvPLACEHOLDERS(hv) = 0 */
1449     if (xhv->xhv_array /* HvARRAY(hv) */)
1450         (void)memzero(xhv->xhv_array /* HvARRAY(hv) */,
1451                       (xhv->xhv_max+1 /* HvMAX(hv)+1 */) * sizeof(HE*));
1452
1453     if (SvRMAGICAL(hv))
1454         mg_clear((SV*)hv);
1455 }
1456
1457 STATIC void
1458 S_hfreeentries(pTHX_ HV *hv)
1459 {
1460     register HE **array;
1461     register HE *entry;
1462     register HE *oentry = Null(HE*);
1463     I32 riter;
1464     I32 max;
1465
1466     if (!hv)
1467         return;
1468     if (!HvARRAY(hv))
1469         return;
1470
1471     riter = 0;
1472     max = HvMAX(hv);
1473     array = HvARRAY(hv);
1474     entry = array[0];
1475     for (;;) {
1476         if (entry) {
1477             oentry = entry;
1478             entry = HeNEXT(entry);
1479             hv_free_ent(hv, oentry);
1480         }
1481         if (!entry) {
1482             if (++riter > max)
1483                 break;
1484             entry = array[riter];
1485         }
1486     }
1487     (void)hv_iterinit(hv);
1488 }
1489
1490 /*
1491 =for apidoc hv_undef
1492
1493 Undefines the hash.
1494
1495 =cut
1496 */
1497
1498 void
1499 Perl_hv_undef(pTHX_ HV *hv)
1500 {
1501     register XPVHV* xhv;
1502     if (!hv)
1503         return;
1504     xhv = (XPVHV*)SvANY(hv);
1505     hfreeentries(hv);
1506     Safefree(xhv->xhv_array /* HvARRAY(hv) */);
1507     if (HvNAME(hv)) {
1508         Safefree(HvNAME(hv));
1509         HvNAME(hv) = 0;
1510     }
1511     xhv->xhv_max   = 7; /* HvMAX(hv) = 7 (it's a normal hash) */
1512     xhv->xhv_array = 0; /* HvARRAY(hv) = 0 */
1513     xhv->xhv_fill  = 0; /* HvFILL(hv) = 0 */
1514     xhv->xhv_keys  = 0; /* HvKEYS(hv) = 0 */
1515     xhv->xhv_placeholders = 0; /* HvPLACEHOLDERS(hv) = 0 */
1516
1517     if (SvRMAGICAL(hv))
1518         mg_clear((SV*)hv);
1519 }
1520
1521 /*
1522 =for apidoc hv_iterinit
1523
1524 Prepares a starting point to traverse a hash table.  Returns the number of
1525 keys in the hash (i.e. the same as C<HvKEYS(tb)>).  The return value is
1526 currently only meaningful for hashes without tie magic.
1527
1528 NOTE: Before version 5.004_65, C<hv_iterinit> used to return the number of
1529 hash buckets that happen to be in use.  If you still need that esoteric
1530 value, you can get it through the macro C<HvFILL(tb)>.
1531
1532 =cut
1533 */
1534
1535 I32
1536 Perl_hv_iterinit(pTHX_ HV *hv)
1537 {
1538     register XPVHV* xhv;
1539     HE *entry;
1540
1541     if (!hv)
1542         Perl_croak(aTHX_ "Bad hash");
1543     xhv = (XPVHV*)SvANY(hv);
1544     entry = xhv->xhv_eiter; /* HvEITER(hv) */
1545     if (entry && HvLAZYDEL(hv)) {       /* was deleted earlier? */
1546         HvLAZYDEL_off(hv);
1547         hv_free_ent(hv, entry);
1548     }
1549     xhv->xhv_riter = -1;        /* HvRITER(hv) = -1 */
1550     xhv->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
1551     /* used to be xhv->xhv_fill before 5.004_65 */
1552     return XHvTOTALKEYS(xhv);
1553 }
1554
1555 /*
1556 =for apidoc hv_iternext
1557
1558 Returns entries from a hash iterator.  See C<hv_iterinit>.
1559
1560 =cut
1561 */
1562
1563 HE *
1564 Perl_hv_iternext(pTHX_ HV *hv)
1565 {
1566     register XPVHV* xhv;
1567     register HE *entry;
1568     HE *oldentry;
1569     MAGIC* mg;
1570
1571     if (!hv)
1572         Perl_croak(aTHX_ "Bad hash");
1573     xhv = (XPVHV*)SvANY(hv);
1574     oldentry = entry = xhv->xhv_eiter; /* HvEITER(hv) */
1575
1576     if ((mg = SvTIED_mg((SV*)hv, PERL_MAGIC_tied))) {
1577         SV *key = sv_newmortal();
1578         if (entry) {
1579             sv_setsv(key, HeSVKEY_force(entry));
1580             SvREFCNT_dec(HeSVKEY(entry));       /* get rid of previous key */
1581         }
1582         else {
1583             char *k;
1584             HEK *hek;
1585
1586             /* one HE per MAGICAL hash */
1587             xhv->xhv_eiter = entry = new_HE(); /* HvEITER(hv) = new_HE() */
1588             Zero(entry, 1, HE);
1589             Newz(54, k, HEK_BASESIZE + sizeof(SV*), char);
1590             hek = (HEK*)k;
1591             HeKEY_hek(entry) = hek;
1592             HeKLEN(entry) = HEf_SVKEY;
1593         }
1594         magic_nextpack((SV*) hv,mg,key);
1595         if (SvOK(key)) {
1596             /* force key to stay around until next time */
1597             HeSVKEY_set(entry, SvREFCNT_inc(key));
1598             return entry;               /* beware, hent_val is not set */
1599         }
1600         if (HeVAL(entry))
1601             SvREFCNT_dec(HeVAL(entry));
1602         Safefree(HeKEY_hek(entry));
1603         del_HE(entry);
1604         xhv->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
1605         return Null(HE*);
1606     }
1607 #ifdef DYNAMIC_ENV_FETCH  /* set up %ENV for iteration */
1608     if (!entry && SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env))
1609         prime_env_iter();
1610 #endif
1611
1612     if (!xhv->xhv_array /* !HvARRAY(hv) */)
1613         Newz(506, xhv->xhv_array /* HvARRAY(hv) */,
1614              PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
1615              char);
1616     if (entry)
1617     {
1618         entry = HeNEXT(entry);
1619         /*
1620          * Skip past any placeholders -- don't want to include them in
1621          * any iteration.
1622          */
1623         while (entry && HeVAL(entry) == &PL_sv_undef) {
1624             entry = HeNEXT(entry);
1625         }
1626     }
1627     while (!entry) {
1628         xhv->xhv_riter++; /* HvRITER(hv)++ */
1629         if (xhv->xhv_riter > xhv->xhv_max /* HvRITER(hv) > HvMAX(hv) */) {
1630             xhv->xhv_riter = -1; /* HvRITER(hv) = -1 */
1631             break;
1632         }
1633         /* entry = (HvARRAY(hv))[HvRITER(hv)]; */
1634         entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
1635
1636         /* if we have an entry, but it's a placeholder, don't count it */
1637         if (entry && HeVAL(entry) == &PL_sv_undef)
1638             entry = 0;
1639
1640     }
1641
1642     if (oldentry && HvLAZYDEL(hv)) {            /* was deleted earlier? */
1643         HvLAZYDEL_off(hv);
1644         hv_free_ent(hv, oldentry);
1645     }
1646
1647     xhv->xhv_eiter = entry; /* HvEITER(hv) = entry */
1648     return entry;
1649 }
1650
1651 /*
1652 =for apidoc hv_iterkey
1653
1654 Returns the key from the current position of the hash iterator.  See
1655 C<hv_iterinit>.
1656
1657 =cut
1658 */
1659
1660 char *
1661 Perl_hv_iterkey(pTHX_ register HE *entry, I32 *retlen)
1662 {
1663     if (HeKLEN(entry) == HEf_SVKEY) {
1664         STRLEN len;
1665         char *p = SvPV(HeKEY_sv(entry), len);
1666         *retlen = len;
1667         return p;
1668     }
1669     else {
1670         *retlen = HeKLEN(entry);
1671         return HeKEY(entry);
1672     }
1673 }
1674
1675 /* unlike hv_iterval(), this always returns a mortal copy of the key */
1676 /*
1677 =for apidoc hv_iterkeysv
1678
1679 Returns the key as an C<SV*> from the current position of the hash
1680 iterator.  The return value will always be a mortal copy of the key.  Also
1681 see C<hv_iterinit>.
1682
1683 =cut
1684 */
1685
1686 SV *
1687 Perl_hv_iterkeysv(pTHX_ register HE *entry)
1688 {
1689     if (HeKLEN(entry) == HEf_SVKEY)
1690         return sv_mortalcopy(HeKEY_sv(entry));
1691     else
1692         return sv_2mortal(newSVpvn_share((HeKLEN(entry) ? HeKEY(entry) : ""),
1693                                          HeKLEN_UTF8(entry), HeHASH(entry)));
1694 }
1695
1696 /*
1697 =for apidoc hv_iterval
1698
1699 Returns the value from the current position of the hash iterator.  See
1700 C<hv_iterkey>.
1701
1702 =cut
1703 */
1704
1705 SV *
1706 Perl_hv_iterval(pTHX_ HV *hv, register HE *entry)
1707 {
1708     if (SvRMAGICAL(hv)) {
1709         if (mg_find((SV*)hv, PERL_MAGIC_tied)) {
1710             SV* sv = sv_newmortal();
1711             if (HeKLEN(entry) == HEf_SVKEY)
1712                 mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY);
1713             else mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry));
1714             return sv;
1715         }
1716     }
1717     return HeVAL(entry);
1718 }
1719
1720 /*
1721 =for apidoc hv_iternextsv
1722
1723 Performs an C<hv_iternext>, C<hv_iterkey>, and C<hv_iterval> in one
1724 operation.
1725
1726 =cut
1727 */
1728
1729 SV *
1730 Perl_hv_iternextsv(pTHX_ HV *hv, char **key, I32 *retlen)
1731 {
1732     HE *he;
1733     if ( (he = hv_iternext(hv)) == NULL)
1734         return NULL;
1735     *key = hv_iterkey(he, retlen);
1736     return hv_iterval(hv, he);
1737 }
1738
1739 /*
1740 =for apidoc hv_magic
1741
1742 Adds magic to a hash.  See C<sv_magic>.
1743
1744 =cut
1745 */
1746
1747 void
1748 Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how)
1749 {
1750     sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
1751 }
1752
1753 #if 0 /* use the macro from hv.h instead */
1754
1755 char*
1756 Perl_sharepvn(pTHX_ const char *sv, I32 len, U32 hash)
1757 {
1758     return HEK_KEY(share_hek(sv, len, hash));
1759 }
1760
1761 #endif
1762
1763 /* possibly free a shared string if no one has access to it
1764  * len and hash must both be valid for str.
1765  */
1766 void
1767 Perl_unsharepvn(pTHX_ const char *str, I32 len, U32 hash)
1768 {
1769     register XPVHV* xhv;
1770     register HE *entry;
1771     register HE **oentry;
1772     register I32 i = 1;
1773     I32 found = 0;
1774     bool is_utf8 = FALSE;
1775     const char *save = str;
1776
1777     if (len < 0) {
1778       STRLEN tmplen = -len;
1779       is_utf8 = TRUE;
1780       /* See the note in hv_fetch(). --jhi */
1781       str = (char*)bytes_from_utf8((U8*)str, &tmplen, &is_utf8);
1782       len = tmplen;
1783     }
1784
1785     /* what follows is the moral equivalent of:
1786     if ((Svp = hv_fetch(PL_strtab, tmpsv, FALSE, hash))) {
1787         if (--*Svp == Nullsv)
1788             hv_delete(PL_strtab, str, len, G_DISCARD, hash);
1789     } */
1790     xhv = (XPVHV*)SvANY(PL_strtab);
1791     /* assert(xhv_array != 0) */
1792     LOCK_STRTAB_MUTEX;
1793     /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
1794     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1795     for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
1796         if (HeHASH(entry) != hash)              /* strings can't be equal */
1797             continue;
1798         if (HeKLEN(entry) != len)
1799             continue;
1800         if (HeKEY(entry) != str && memNE(HeKEY(entry),str,len)) /* is this it? */
1801             continue;
1802         if (HeKUTF8(entry) != (char)is_utf8)
1803             continue;
1804         found = 1;
1805         if (--HeVAL(entry) == Nullsv) {
1806             *oentry = HeNEXT(entry);
1807             if (i && !*oentry)
1808                 xhv->xhv_fill--; /* HvFILL(hv)-- */
1809             Safefree(HeKEY_hek(entry));
1810             del_HE(entry);
1811             xhv->xhv_keys--; /* HvKEYS(hv)-- */
1812         }
1813         break;
1814     }
1815     UNLOCK_STRTAB_MUTEX;
1816     if (str != save)
1817         Safefree(str);
1818     if (!found && ckWARN_d(WARN_INTERNAL))
1819         Perl_warner(aTHX_ WARN_INTERNAL, "Attempt to free non-existent shared string '%s'",str);
1820 }
1821
1822 /* get a (constant) string ptr from the global string table
1823  * string will get added if it is not already there.
1824  * len and hash must both be valid for str.
1825  */
1826 HEK *
1827 Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash)
1828 {
1829     register XPVHV* xhv;
1830     register HE *entry;
1831     register HE **oentry;
1832     register I32 i = 1;
1833     I32 found = 0;
1834     bool is_utf8 = FALSE;
1835     const char *save = str;
1836
1837     if (len < 0) {
1838       STRLEN tmplen = -len;
1839       is_utf8 = TRUE;
1840       /* See the note in hv_fetch(). --jhi */
1841       str = (char*)bytes_from_utf8((U8*)str, &tmplen, &is_utf8);
1842       len = tmplen;
1843     }
1844
1845     /* what follows is the moral equivalent of:
1846
1847     if (!(Svp = hv_fetch(PL_strtab, str, len, FALSE)))
1848         hv_store(PL_strtab, str, len, Nullsv, hash);
1849     */
1850     xhv = (XPVHV*)SvANY(PL_strtab);
1851     /* assert(xhv_array != 0) */
1852     LOCK_STRTAB_MUTEX;
1853     /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
1854     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1855     for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
1856         if (HeHASH(entry) != hash)              /* strings can't be equal */
1857             continue;
1858         if (HeKLEN(entry) != len)
1859             continue;
1860         if (HeKEY(entry) != str && memNE(HeKEY(entry),str,len)) /* is this it? */
1861             continue;
1862         if (HeKUTF8(entry) != (char)is_utf8)
1863             continue;
1864         found = 1;
1865         break;
1866     }
1867     if (!found) {
1868         entry = new_HE();
1869         HeKEY_hek(entry) = save_hek(str, is_utf8?-len:len, hash);
1870         HeVAL(entry) = Nullsv;
1871         HeNEXT(entry) = *oentry;
1872         *oentry = entry;
1873         xhv->xhv_keys++; /* HvKEYS(hv)++ */
1874         if (i) {                                /* initial entry? */
1875             xhv->xhv_fill++; /* HvFILL(hv)++ */
1876             if (xhv->xhv_keys > xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */)
1877                 hsplit(PL_strtab);
1878         }
1879     }
1880
1881     ++HeVAL(entry);                             /* use value slot as REFCNT */
1882     UNLOCK_STRTAB_MUTEX;
1883     if (str != save)
1884         Safefree(str);
1885     return HeKEY_hek(entry);
1886 }