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