hv.c

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