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