hv.c

   1 /*    hv.c
   2  *
   3  *    Copyright (c) 1991-1997, Larry Wall
   4  *
   5  *    You may distribute under the terms of either the GNU General Public
   6  *    License or the Artistic License, as specified in the README file.
   7  *
   8  */
   9
  10 /*
  11  * "I sit beside the fire and think of all that I have seen."  --Bilbo
  12  */
  13
  14 #include "EXTERN.h"
  15 #include "perl.h"
  16
  17 static void hsplit _((HV *hv));
  18 static void hfreeentries _((HV *hv));
  19
  20 static HE* more_he(void);
  21
  22 static HE*
  23 new_he(void)
  24 {
  25     HE* he;
  26     if (he_root) {
  27         he = he_root;
  28         he_root = HeNEXT(he);
  29         return he;
  30     }
  31     return more_he();
  32 }
  33
  34 static void
  35 del_he(HE *p)
  36 {
  37     HeNEXT(p) = (HE*)he_root;
  38     he_root = p;
  39 }
  40
  41 static HE*
  42 more_he(void)
  43 {
  44     register HE* he;
  45     register HE* heend;
  46     he_root = (HE*)safemalloc(1008);
  47     he = he_root;
  48     heend = &he[1008 / sizeof(HE) - 1];
  49     while (he < heend) {
  50         HeNEXT(he) = (HE*)(he + 1);
  51         he++;
  52     }
  53     HeNEXT(he) = 0;
  54     return new_he();
  55 }
  56
  57 static HEK *
  58 save_hek(char *str, I32 len, U32 hash)
  59 {
  60     char *k;
  61     register HEK *hek;
  62
  63     New(54, k, HEK_BASESIZE + len + 1, char);
  64     hek = (HEK*)k;
  65     Copy(str, HEK_KEY(hek), len, char);
  66     *(HEK_KEY(hek) + len) = '\0';
  67     HEK_LEN(hek) = len;
  68     HEK_HASH(hek) = hash;
  69     return hek;
  70 }
  71
  72 void
  73 unshare_hek(HEK *hek)
  74 {
  75     unsharepvn(HEK_KEY(hek),HEK_LEN(hek),HEK_HASH(hek));
  76 }
  77
  78 /* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot
  79  * contains an SV* */
  80
  81 SV**
  82 hv_fetch(HV *hv, char *key, U32 klen, I32 lval)
  83 {
  84     register XPVHV* xhv;
  85     register U32 hash;
  86     register HE *entry;
  87     SV *sv;
  88
  89     if (!hv)
  90         return 0;
  91
  92     if (SvRMAGICAL(hv)) {
  93         if (mg_find((SV*)hv,'P')) {
  94             dTHR;
  95             sv = sv_newmortal();
  96             mg_copy((SV*)hv, sv, key, klen);
  97             Sv = sv;
  98             return &Sv;
  99         }
 100     }
 101
 102     xhv = (XPVHV*)SvANY(hv);
 103     if (!xhv->xhv_array) {
 104         if (lval
 105 #ifdef DYNAMIC_ENV_FETCH  /* if it's an %ENV lookup, we may get it on the fly */
 106                  || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
 107 #endif
 108                                                                   )
 109             Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
 110         else
 111             return 0;
 112     }
 113
 114     PERL_HASH(hash, key, klen);
 115
 116     entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 117     for (; entry; entry = HeNEXT(entry)) {
 118         if (HeHASH(entry) != hash)              /* strings can't be equal */
 119             continue;
 120         if (HeKLEN(entry) != klen)
 121             continue;
 122         if (memNE(HeKEY(entry),key,klen))       /* is this it? */
 123             continue;
 124         return &HeVAL(entry);
 125     }
 126 #ifdef DYNAMIC_ENV_FETCH  /* %ENV lookup?  If so, try to fetch the value now */
 127     if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
 128       char *gotenv;
 129
 130       if ((gotenv = ENV_getenv(key)) != Nullch) {
 131         sv = newSVpv(gotenv,strlen(gotenv));
 132         SvTAINTED_on(sv);
 133         return hv_store(hv,key,klen,sv,hash);
 134       }
 135     }
 136 #endif
 137     if (lval) {         /* gonna assign to this, so it better be there */
 138         sv = NEWSV(61,0);
 139         return hv_store(hv,key,klen,sv,hash);
 140     }
 141     return 0;
 142 }
 143
 144 /* returns a HE * structure with the all fields set */
 145 /* note that hent_val will be a mortal sv for MAGICAL hashes */
 146 HE *
 147 hv_fetch_ent(HV *hv, SV *keysv, I32 lval, register U32 hash)
 148 {
 149     register XPVHV* xhv;
 150     register char *key;
 151     STRLEN klen;
 152     register HE *entry;
 153     SV *sv;
 154
 155     if (!hv)
 156         return 0;
 157
 158     if (SvRMAGICAL(hv) && mg_find((SV*)hv,'P')) {
 159         static HE mh;
 160
 161         sv = sv_newmortal();
 162         keysv = sv_2mortal(newSVsv(keysv));
 163         mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
 164         if (!HeKEY_hek(&mh)) {
 165             char *k;
 166             New(54, k, HEK_BASESIZE + sizeof(SV*), char);
 167             HeKEY_hek(&mh) = (HEK*)k;
 168         }
 169         HeSVKEY_set(&mh, keysv);
 170         HeVAL(&mh) = sv;
 171         return &mh;
 172     }
 173
 174     xhv = (XPVHV*)SvANY(hv);
 175     if (!xhv->xhv_array) {
 176         if (lval
 177 #ifdef DYNAMIC_ENV_FETCH  /* if it's an %ENV lookup, we may get it on the fly */
 178                  || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
 179 #endif
 180                                                                   )
 181             Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
 182         else
 183             return 0;
 184     }
 185
 186     key = SvPV(keysv, klen);
 187
 188     if (!hash)
 189         PERL_HASH(hash, key, klen);
 190
 191     entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 192     for (; entry; entry = HeNEXT(entry)) {
 193         if (HeHASH(entry) != hash)              /* strings can't be equal */
 194             continue;
 195         if (HeKLEN(entry) != klen)
 196             continue;
 197         if (memNE(HeKEY(entry),key,klen))       /* is this it? */
 198             continue;
 199         return entry;
 200     }
 201 #ifdef DYNAMIC_ENV_FETCH  /* %ENV lookup?  If so, try to fetch the value now */
 202     if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
 203       char *gotenv;
 204
 205       if ((gotenv = ENV_getenv(key)) != Nullch) {
 206         sv = newSVpv(gotenv,strlen(gotenv));
 207         SvTAINTED_on(sv);
 208         return hv_store_ent(hv,keysv,sv,hash);
 209       }
 210     }
 211 #endif
 212     if (lval) {         /* gonna assign to this, so it better be there */
 213         sv = NEWSV(61,0);
 214         return hv_store_ent(hv,keysv,sv,hash);
 215     }
 216     return 0;
 217 }
 218
 219 static void
 220 hv_magic_check (hv, needs_copy, needs_store)
 221 HV *hv;
 222 bool *needs_copy;
 223 bool *needs_store;
 224 {
 225     MAGIC *mg = SvMAGIC(hv);
 226     *needs_copy = FALSE;
 227     *needs_store = TRUE;
 228     while (mg) {
 229         if (isUPPER(mg->mg_type)) {
 230             *needs_copy = TRUE;
 231             switch (mg->mg_type) {
 232             case 'P':
 233             case 'I':
 234             case 'S':
 235                 *needs_store = FALSE;
 236             default:
 237             }
 238         }
 239         mg = mg->mg_moremagic;
 240     }
 241 }
 242
 243 SV**
 244 hv_store(HV *hv, char *key, U32 klen, SV *val, register U32 hash)
 245 {
 246     register XPVHV* xhv;
 247     register I32 i;
 248     register HE *entry;
 249     register HE **oentry;
 250
 251     if (!hv)
 252         return 0;
 253
 254     xhv = (XPVHV*)SvANY(hv);
 255     if (SvMAGICAL(hv)) {
 256         bool needs_copy;
 257         bool needs_store;
 258         hv_magic_check (hv, &needs_copy, &needs_store);
 259         if (needs_copy) {
 260             mg_copy((SV*)hv, val, key, klen);
 261             if (!xhv->xhv_array && !needs_store)
 262                 return 0;
 263         }
 264     }
 265     if (!hash)
 266         PERL_HASH(hash, key, klen);
 267
 268     if (!xhv->xhv_array)
 269         Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char);
 270
 271     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 272     i = 1;
 273
 274     for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
 275         if (HeHASH(entry) != hash)              /* strings can't be equal */
 276             continue;
 277         if (HeKLEN(entry) != klen)
 278             continue;
 279         if (memNE(HeKEY(entry),key,klen))       /* is this it? */
 280             continue;
 281         SvREFCNT_dec(HeVAL(entry));
 282         HeVAL(entry) = val;
 283         return &HeVAL(entry);
 284     }
 285
 286     entry = new_he();
 287     if (HvSHAREKEYS(hv))
 288         HeKEY_hek(entry) = share_hek(key, klen, hash);
 289     else                                       /* gotta do the real thing */
 290         HeKEY_hek(entry) = save_hek(key, klen, hash);
 291     HeVAL(entry) = val;
 292     HeNEXT(entry) = *oentry;
 293     *oentry = entry;
 294
 295     xhv->xhv_keys++;
 296     if (i) {                            /* initial entry? */
 297         ++xhv->xhv_fill;
 298         if (xhv->xhv_keys > xhv->xhv_max)
 299             hsplit(hv);
 300     }
 301
 302     return &HeVAL(entry);
 303 }
 304
 305 HE *
 306 hv_store_ent(HV *hv, SV *keysv, SV *val, register U32 hash)
 307 {
 308     register XPVHV* xhv;
 309     register char *key;
 310     STRLEN klen;
 311     register I32 i;
 312     register HE *entry;
 313     register HE **oentry;
 314
 315     if (!hv)
 316         return 0;
 317
 318     xhv = (XPVHV*)SvANY(hv);
 319     if (SvMAGICAL(hv)) {
 320         dTHR;
 321         bool needs_copy;
 322         bool needs_store;
 323         hv_magic_check (hv, &needs_copy, &needs_store);
 324         if (needs_copy) {
 325             bool save_taint = tainted;
 326             if (tainting)
 327                 tainted = SvTAINTED(keysv);
 328             keysv = sv_2mortal(newSVsv(keysv));
 329             mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
 330             TAINT_IF(save_taint);
 331             if (!xhv->xhv_array && !needs_store)
 332                 return Nullhe;
 333         }
 334     }
 335
 336     key = SvPV(keysv, klen);
 337
 338     if (!hash)
 339         PERL_HASH(hash, key, klen);
 340
 341     if (!xhv->xhv_array)
 342         Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char);
 343
 344     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 345     i = 1;
 346
 347     for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
 348         if (HeHASH(entry) != hash)              /* strings can't be equal */
 349             continue;
 350         if (HeKLEN(entry) != klen)
 351             continue;
 352         if (memNE(HeKEY(entry),key,klen))       /* is this it? */
 353             continue;
 354         SvREFCNT_dec(HeVAL(entry));
 355         HeVAL(entry) = val;
 356         return entry;
 357     }
 358
 359     entry = new_he();
 360     if (HvSHAREKEYS(hv))
 361         HeKEY_hek(entry) = share_hek(key, klen, hash);
 362     else                                       /* gotta do the real thing */
 363         HeKEY_hek(entry) = save_hek(key, klen, hash);
 364     HeVAL(entry) = val;
 365     HeNEXT(entry) = *oentry;
 366     *oentry = entry;
 367
 368     xhv->xhv_keys++;
 369     if (i) {                            /* initial entry? */
 370         ++xhv->xhv_fill;
 371         if (xhv->xhv_keys > xhv->xhv_max)
 372             hsplit(hv);
 373     }
 374
 375     return entry;
 376 }
 377
 378 SV *
 379 hv_delete(HV *hv, char *key, U32 klen, I32 flags)
 380 {
 381     register XPVHV* xhv;
 382     register I32 i;
 383     register U32 hash;
 384     register HE *entry;
 385     register HE **oentry;
 386     SV *sv;
 387
 388     if (!hv)
 389         return Nullsv;
 390     if (SvRMAGICAL(hv)) {
 391         sv = *hv_fetch(hv, key, klen, TRUE);
 392         mg_clear(sv);
 393         if (mg_find(sv, 's')) {
 394             return Nullsv;              /* %SIG elements cannot be deleted */
 395         }
 396         if (mg_find(sv, 'p')) {
 397             sv_unmagic(sv, 'p');        /* No longer an element */
 398             return sv;
 399         }
 400     }
 401     xhv = (XPVHV*)SvANY(hv);
 402     if (!xhv->xhv_array)
 403         return Nullsv;
 404
 405     PERL_HASH(hash, key, klen);
 406
 407     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 408     entry = *oentry;
 409     i = 1;
 410     for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
 411         if (HeHASH(entry) != hash)              /* strings can't be equal */
 412             continue;
 413         if (HeKLEN(entry) != klen)
 414             continue;
 415         if (memNE(HeKEY(entry),key,klen))       /* is this it? */
 416             continue;
 417         *oentry = HeNEXT(entry);
 418         if (i && !*oentry)
 419             xhv->xhv_fill--;
 420         if (flags & G_DISCARD)
 421             sv = Nullsv;
 422         else
 423             sv = sv_mortalcopy(HeVAL(entry));
 424         if (entry == xhv->xhv_eiter)
 425             HvLAZYDEL_on(hv);
 426         else
 427             hv_free_ent(hv, entry);
 428         --xhv->xhv_keys;
 429         return sv;
 430     }
 431     return Nullsv;
 432 }
 433
 434 SV *
 435 hv_delete_ent(HV *hv, SV *keysv, I32 flags, U32 hash)
 436 {
 437     register XPVHV* xhv;
 438     register I32 i;
 439     register char *key;
 440     STRLEN klen;
 441     register HE *entry;
 442     register HE **oentry;
 443     SV *sv;
 444
 445     if (!hv)
 446         return Nullsv;
 447     if (SvRMAGICAL(hv)) {
 448         entry = hv_fetch_ent(hv, keysv, TRUE, hash);
 449         sv = HeVAL(entry);
 450         mg_clear(sv);
 451         if (mg_find(sv, 'p')) {
 452             sv_unmagic(sv, 'p');        /* No longer an element */
 453             return sv;
 454         }
 455     }
 456     xhv = (XPVHV*)SvANY(hv);
 457     if (!xhv->xhv_array)
 458         return Nullsv;
 459
 460     key = SvPV(keysv, klen);
 461
 462     if (!hash)
 463         PERL_HASH(hash, key, klen);
 464
 465     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 466     entry = *oentry;
 467     i = 1;
 468     for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
 469         if (HeHASH(entry) != hash)              /* strings can't be equal */
 470             continue;
 471         if (HeKLEN(entry) != klen)
 472             continue;
 473         if (memNE(HeKEY(entry),key,klen))       /* is this it? */
 474             continue;
 475         *oentry = HeNEXT(entry);
 476         if (i && !*oentry)
 477             xhv->xhv_fill--;
 478         if (flags & G_DISCARD)
 479             sv = Nullsv;
 480         else
 481             sv = sv_mortalcopy(HeVAL(entry));
 482         if (entry == xhv->xhv_eiter)
 483             HvLAZYDEL_on(hv);
 484         else
 485             hv_free_ent(hv, entry);
 486         --xhv->xhv_keys;
 487         return sv;
 488     }
 489     return Nullsv;
 490 }
 491
 492 bool
 493 hv_exists(HV *hv, char *key, U32 klen)
 494 {
 495     register XPVHV* xhv;
 496     register U32 hash;
 497     register HE *entry;
 498     SV *sv;
 499
 500     if (!hv)
 501         return 0;
 502
 503     if (SvRMAGICAL(hv)) {
 504         if (mg_find((SV*)hv,'P')) {
 505             dTHR;
 506             sv = sv_newmortal();
 507             mg_copy((SV*)hv, sv, key, klen);
 508             magic_existspack(sv, mg_find(sv, 'p'));
 509             return SvTRUE(sv);
 510         }
 511     }
 512
 513     xhv = (XPVHV*)SvANY(hv);
 514     if (!xhv->xhv_array)
 515         return 0;
 516
 517     PERL_HASH(hash, key, klen);
 518
 519     entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 520     for (; entry; entry = HeNEXT(entry)) {
 521         if (HeHASH(entry) != hash)              /* strings can't be equal */
 522             continue;
 523         if (HeKLEN(entry) != klen)
 524             continue;
 525         if (memNE(HeKEY(entry),key,klen))       /* is this it? */
 526             continue;
 527         return TRUE;
 528     }
 529     return FALSE;
 530 }
 531
 532
 533 bool
 534 hv_exists_ent(HV *hv, SV *keysv, U32 hash)
 535 {
 536     register XPVHV* xhv;
 537     register char *key;
 538     STRLEN klen;
 539     register HE *entry;
 540     SV *sv;
 541
 542     if (!hv)
 543         return 0;
 544
 545     if (SvRMAGICAL(hv)) {
 546         if (mg_find((SV*)hv,'P')) {
 547             dTHR;               /* just for SvTRUE */
 548             sv = sv_newmortal();
 549             keysv = sv_2mortal(newSVsv(keysv));
 550             mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
 551             magic_existspack(sv, mg_find(sv, 'p'));
 552             return SvTRUE(sv);
 553         }
 554     }
 555
 556     xhv = (XPVHV*)SvANY(hv);
 557     if (!xhv->xhv_array)
 558         return 0;
 559
 560     key = SvPV(keysv, klen);
 561     if (!hash)
 562         PERL_HASH(hash, key, klen);
 563
 564     entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 565     for (; entry; entry = HeNEXT(entry)) {
 566         if (HeHASH(entry) != hash)              /* strings can't be equal */
 567             continue;
 568         if (HeKLEN(entry) != klen)
 569             continue;
 570         if (memNE(HeKEY(entry),key,klen))       /* is this it? */
 571             continue;
 572         return TRUE;
 573     }
 574     return FALSE;
 575 }
 576
 577 static void
 578 hsplit(HV *hv)
 579 {
 580     register XPVHV* xhv = (XPVHV*)SvANY(hv);
 581     I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
 582     register I32 newsize = oldsize * 2;
 583     register I32 i;
 584     register HE **a;
 585     register HE **b;
 586     register HE *entry;
 587     register HE **oentry;
 588 #ifndef STRANGE_MALLOC
 589     I32 tmp;
 590 #endif
 591
 592     a = (HE**)xhv->xhv_array;
 593     nomemok = TRUE;
 594 #ifdef STRANGE_MALLOC
 595     Renew(a, newsize, HE*);
 596 #else
 597     i = newsize * sizeof(HE*);
 598 #define MALLOC_OVERHEAD 16
 599     tmp = MALLOC_OVERHEAD;
 600     while (tmp - MALLOC_OVERHEAD < i)
 601         tmp += tmp;
 602     tmp -= MALLOC_OVERHEAD;
 603     tmp /= sizeof(HE*);
 604     assert(tmp >= newsize);
 605     New(2,a, tmp, HE*);
 606     Copy(xhv->xhv_array, a, oldsize, HE*);
 607     if (oldsize >= 64) {
 608         offer_nice_chunk(xhv->xhv_array,
 609                          oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD);
 610     }
 611     else
 612         Safefree(xhv->xhv_array);
 613 #endif
 614
 615     nomemok = FALSE;
 616     Zero(&a[oldsize], oldsize, HE*);            /* zero 2nd half*/
 617     xhv->xhv_max = --newsize;
 618     xhv->xhv_array = (char*)a;
 619
 620     for (i=0; i<oldsize; i++,a++) {
 621         if (!*a)                                /* non-existent */
 622             continue;
 623         b = a+oldsize;
 624         for (oentry = a, entry = *a; entry; entry = *oentry) {
 625             if ((HeHASH(entry) & newsize) != i) {
 626                 *oentry = HeNEXT(entry);
 627                 HeNEXT(entry) = *b;
 628                 if (!*b)
 629                     xhv->xhv_fill++;
 630                 *b = entry;
 631                 continue;
 632             }
 633             else
 634                 oentry = &HeNEXT(entry);
 635         }
 636         if (!*a)                                /* everything moved */
 637             xhv->xhv_fill--;
 638     }
 639 }
 640
 641 void
 642 hv_ksplit(HV *hv, IV newmax)
 643 {
 644     register XPVHV* xhv = (XPVHV*)SvANY(hv);
 645     I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
 646     register I32 newsize;
 647     register I32 i;
 648     register I32 j;
 649     register HE **a;
 650     register HE *entry;
 651     register HE **oentry;
 652
 653     newsize = (I32) newmax;                     /* possible truncation here */
 654     if (newsize != newmax || newmax <= oldsize)
 655         return;
 656     while ((newsize & (1 + ~newsize)) != newsize) {
 657         newsize &= ~(newsize & (1 + ~newsize)); /* get proper power of 2 */
 658     }
 659     if (newsize < newmax)
 660         newsize *= 2;
 661     if (newsize < newmax)
 662         return;                                 /* overflow detection */
 663
 664     a = (HE**)xhv->xhv_array;
 665     if (a) {
 666         nomemok = TRUE;
 667 #ifdef STRANGE_MALLOC
 668         Renew(a, newsize, HE*);
 669 #else
 670         i = newsize * sizeof(HE*);
 671         j = MALLOC_OVERHEAD;
 672         while (j - MALLOC_OVERHEAD < i)
 673             j += j;
 674         j -= MALLOC_OVERHEAD;
 675         j /= sizeof(HE*);
 676         assert(j >= newsize);
 677         New(2, a, j, HE*);
 678         Copy(xhv->xhv_array, a, oldsize, HE*);
 679         if (oldsize >= 64) {
 680             offer_nice_chunk(xhv->xhv_array,
 681                              oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD);
 682         }
 683         else
 684             Safefree(xhv->xhv_array);
 685 #endif
 686         nomemok = FALSE;
 687         Zero(&a[oldsize], newsize-oldsize, HE*); /* zero 2nd half*/
 688     }
 689     else {
 690         Newz(0, a, newsize, HE*);
 691     }
 692     xhv->xhv_max = --newsize;
 693     xhv->xhv_array = (char*)a;
 694     if (!xhv->xhv_fill)                         /* skip rest if no entries */
 695         return;
 696
 697     for (i=0; i<oldsize; i++,a++) {
 698         if (!*a)                                /* non-existent */
 699             continue;
 700         for (oentry = a, entry = *a; entry; entry = *oentry) {
 701             if ((j = (HeHASH(entry) & newsize)) != i) {
 702                 j -= i;
 703                 *oentry = HeNEXT(entry);
 704                 if (!(HeNEXT(entry) = a[j]))
 705                     xhv->xhv_fill++;
 706                 a[j] = entry;
 707                 continue;
 708             }
 709             else
 710                 oentry = &HeNEXT(entry);
 711         }
 712         if (!*a)                                /* everything moved */
 713             xhv->xhv_fill--;
 714     }
 715 }
 716
 717 HV *
 718 newHV(void)
 719 {
 720     register HV *hv;
 721     register XPVHV* xhv;
 722
 723     hv = (HV*)NEWSV(502,0);
 724     sv_upgrade((SV *)hv, SVt_PVHV);
 725     xhv = (XPVHV*)SvANY(hv);
 726     SvPOK_off(hv);
 727     SvNOK_off(hv);
 728 #ifndef NODEFAULT_SHAREKEYS
 729     HvSHAREKEYS_on(hv);         /* key-sharing on by default */
 730 #endif
 731     xhv->xhv_max = 7;           /* start with 8 buckets */
 732     xhv->xhv_fill = 0;
 733     xhv->xhv_pmroot = 0;
 734     (void)hv_iterinit(hv);      /* so each() will start off right */
 735     return hv;
 736 }
 737
 738 void
 739 hv_free_ent(HV *hv, register HE *entry)
 740 {
 741     if (!entry)
 742         return;
 743     if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv))
 744         sub_generation++;       /* may be deletion of method from stash */
 745     SvREFCNT_dec(HeVAL(entry));
 746     if (HeKLEN(entry) == HEf_SVKEY) {
 747         SvREFCNT_dec(HeKEY_sv(entry));
 748         Safefree(HeKEY_hek(entry));
 749     }
 750     else if (HvSHAREKEYS(hv))
 751         unshare_hek(HeKEY_hek(entry));
 752     else
 753         Safefree(HeKEY_hek(entry));
 754     del_he(entry);
 755 }
 756
 757 void
 758 hv_delayfree_ent(HV *hv, register HE *entry)
 759 {
 760     if (!entry)
 761         return;
 762     if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv))
 763         sub_generation++;       /* may be deletion of method from stash */
 764     sv_2mortal(HeVAL(entry));   /* free between statements */
 765     if (HeKLEN(entry) == HEf_SVKEY) {
 766         sv_2mortal(HeKEY_sv(entry));
 767         Safefree(HeKEY_hek(entry));
 768     }
 769     else if (HvSHAREKEYS(hv))
 770         unshare_hek(HeKEY_hek(entry));
 771     else
 772         Safefree(HeKEY_hek(entry));
 773     del_he(entry);
 774 }
 775
 776 void
 777 hv_clear(HV *hv)
 778 {
 779     register XPVHV* xhv;
 780     if (!hv)
 781         return;
 782     xhv = (XPVHV*)SvANY(hv);
 783     hfreeentries(hv);
 784     xhv->xhv_fill = 0;
 785     xhv->xhv_keys = 0;
 786     if (xhv->xhv_array)
 787         (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*));
 788
 789     if (SvRMAGICAL(hv))
 790         mg_clear((SV*)hv);
 791 }
 792
 793 static void
 794 hfreeentries(HV *hv)
 795 {
 796     register HE **array;
 797     register HE *entry;
 798     register HE *oentry = Null(HE*);
 799     I32 riter;
 800     I32 max;
 801
 802     if (!hv)
 803         return;
 804     if (!HvARRAY(hv))
 805         return;
 806
 807     riter = 0;
 808     max = HvMAX(hv);
 809     array = HvARRAY(hv);
 810     entry = array[0];
 811     for (;;) {
 812         if (entry) {
 813             oentry = entry;
 814             entry = HeNEXT(entry);
 815             hv_free_ent(hv, oentry);
 816         }
 817         if (!entry) {
 818             if (++riter > max)
 819                 break;
 820             entry = array[riter];
 821         }
 822     }
 823     (void)hv_iterinit(hv);
 824 }
 825
 826 void
 827 hv_undef(HV *hv)
 828 {
 829     register XPVHV* xhv;
 830     if (!hv)
 831         return;
 832     xhv = (XPVHV*)SvANY(hv);
 833     hfreeentries(hv);
 834     Safefree(xhv->xhv_array);
 835     if (HvNAME(hv)) {
 836         Safefree(HvNAME(hv));
 837         HvNAME(hv) = 0;
 838     }
 839     xhv->xhv_array = 0;
 840     xhv->xhv_max = 7;           /* it's a normal hash */
 841     xhv->xhv_fill = 0;
 842     xhv->xhv_keys = 0;
 843
 844     if (SvRMAGICAL(hv))
 845         mg_clear((SV*)hv);
 846 }
 847
 848 I32
 849 hv_iterinit(HV *hv)
 850 {
 851     register XPVHV* xhv;
 852     HE *entry;
 853
 854     if (!hv)
 855         croak("Bad hash");
 856     xhv = (XPVHV*)SvANY(hv);
 857     entry = xhv->xhv_eiter;
 858 #ifdef DYNAMIC_ENV_FETCH  /* set up %ENV for iteration */
 859     if (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME))
 860         prime_env_iter();
 861 #endif
 862     if (entry && HvLAZYDEL(hv)) {       /* was deleted earlier? */
 863         HvLAZYDEL_off(hv);
 864         hv_free_ent(hv, entry);
 865     }
 866     xhv->xhv_riter = -1;
 867     xhv->xhv_eiter = Null(HE*);
 868     return xhv->xhv_fill;       /* should be xhv->xhv_keys? May change later */
 869 }
 870
 871 HE *
 872 hv_iternext(HV *hv)
 873 {
 874     register XPVHV* xhv;
 875     register HE *entry;
 876     HE *oldentry;
 877     MAGIC* mg;
 878
 879     if (!hv)
 880         croak("Bad hash");
 881     xhv = (XPVHV*)SvANY(hv);
 882     oldentry = entry = xhv->xhv_eiter;
 883
 884     if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) {
 885         SV *key = sv_newmortal();
 886         if (entry) {
 887             sv_setsv(key, HeSVKEY_force(entry));
 888             SvREFCNT_dec(HeSVKEY(entry));       /* get rid of previous key */
 889         }
 890         else {
 891             char *k;
 892             HEK *hek;
 893
 894             xhv->xhv_eiter = entry = new_he();  /* one HE per MAGICAL hash */
 895             Zero(entry, 1, HE);
 896             Newz(54, k, HEK_BASESIZE + sizeof(SV*), char);
 897             hek = (HEK*)k;
 898             HeKEY_hek(entry) = hek;
 899             HeKLEN(entry) = HEf_SVKEY;
 900         }
 901         magic_nextpack((SV*) hv,mg,key);
 902         if (SvOK(key)) {
 903             /* force key to stay around until next time */
 904             HeSVKEY_set(entry, SvREFCNT_inc(key));
 905             return entry;               /* beware, hent_val is not set */
 906         }
 907         if (HeVAL(entry))
 908             SvREFCNT_dec(HeVAL(entry));
 909         Safefree(HeKEY_hek(entry));
 910         del_he(entry);
 911         xhv->xhv_eiter = Null(HE*);
 912         return Null(HE*);
 913     }
 914
 915     if (!xhv->xhv_array)
 916         Newz(506,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
 917     if (entry)
 918         entry = HeNEXT(entry);
 919     while (!entry) {
 920         ++xhv->xhv_riter;
 921         if (xhv->xhv_riter > xhv->xhv_max) {
 922             xhv->xhv_riter = -1;
 923             break;
 924         }
 925         entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
 926     }
 927
 928     if (oldentry && HvLAZYDEL(hv)) {            /* was deleted earlier? */
 929         HvLAZYDEL_off(hv);
 930         hv_free_ent(hv, oldentry);
 931     }
 932
 933     xhv->xhv_eiter = entry;
 934     return entry;
 935 }
 936
 937 char *
 938 hv_iterkey(register HE *entry, I32 *retlen)
 939 {
 940     if (HeKLEN(entry) == HEf_SVKEY) {
 941         STRLEN len;
 942         char *p = SvPV(HeKEY_sv(entry), len);
 943         *retlen = len;
 944         return p;
 945     }
 946     else {
 947         *retlen = HeKLEN(entry);
 948         return HeKEY(entry);
 949     }
 950 }
 951
 952 /* unlike hv_iterval(), this always returns a mortal copy of the key */
 953 SV *
 954 hv_iterkeysv(register HE *entry)
 955 {
 956     if (HeKLEN(entry) == HEf_SVKEY)
 957         return sv_mortalcopy(HeKEY_sv(entry));
 958     else
 959         return sv_2mortal(newSVpv((HeKLEN(entry) ? HeKEY(entry) : ""),
 960                                   HeKLEN(entry)));
 961 }
 962
 963 SV *
 964 hv_iterval(HV *hv, register HE *entry)
 965 {
 966     if (SvRMAGICAL(hv)) {
 967         if (mg_find((SV*)hv,'P')) {
 968             SV* sv = sv_newmortal();
 969             if (HeKLEN(entry) == HEf_SVKEY)
 970                 mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY);
 971             else mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry));
 972             return sv;
 973         }
 974     }
 975     return HeVAL(entry);
 976 }
 977
 978 SV *
 979 hv_iternextsv(HV *hv, char **key, I32 *retlen)
 980 {
 981     HE *he;
 982     if ( (he = hv_iternext(hv)) == NULL)
 983         return NULL;
 984     *key = hv_iterkey(he, retlen);
 985     return hv_iterval(hv, he);
 986 }
 987
 988 void
 989 hv_magic(HV *hv, GV *gv, int how)
 990 {
 991     sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
 992 }
 993
 994 char*
 995 sharepvn(char *sv, I32 len, U32 hash)
 996 {
 997     return HEK_KEY(share_hek(sv, len, hash));
 998 }
 999
1000 /* possibly free a shared string if no one has access to it
1001  * len and hash must both be valid for str.
1002  */
1003 void
1004 unsharepvn(char *str, I32 len, U32 hash)
1005 {
1006     register XPVHV* xhv;
1007     register HE *entry;
1008     register HE **oentry;
1009     register I32 i = 1;
1010     I32 found = 0;
1011
1012     /* what follows is the moral equivalent of:
1013     if ((Svp = hv_fetch(strtab, tmpsv, FALSE, hash))) {
1014         if (--*Svp == Nullsv)
1015             hv_delete(strtab, str, len, G_DISCARD, hash);
1016     } */
1017     xhv = (XPVHV*)SvANY(strtab);
1018     /* assert(xhv_array != 0) */
1019     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1020     for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
1021         if (HeHASH(entry) != hash)              /* strings can't be equal */
1022             continue;
1023         if (HeKLEN(entry) != len)
1024             continue;
1025         if (memNE(HeKEY(entry),str,len))        /* is this it? */
1026             continue;
1027         found = 1;
1028         if (--HeVAL(entry) == Nullsv) {
1029             *oentry = HeNEXT(entry);
1030             if (i && !*oentry)
1031                 xhv->xhv_fill--;
1032             Safefree(HeKEY_hek(entry));
1033             del_he(entry);
1034             --xhv->xhv_keys;
1035         }
1036         break;
1037     }
1038
1039     if (!found)
1040         warn("Attempt to free non-existent shared string");
1041 }
1042
1043 /* get a (constant) string ptr from the global string table
1044  * string will get added if it is not already there.
1045  * len and hash must both be valid for str.
1046  */
1047 HEK *
1048 share_hek(char *str, I32 len, register U32 hash)
1049 {
1050     register XPVHV* xhv;
1051     register HE *entry;
1052     register HE **oentry;
1053     register I32 i = 1;
1054     I32 found = 0;
1055
1056     /* what follows is the moral equivalent of:
1057
1058     if (!(Svp = hv_fetch(strtab, str, len, FALSE)))
1059         hv_store(strtab, str, len, Nullsv, hash);
1060     */
1061     xhv = (XPVHV*)SvANY(strtab);
1062     /* assert(xhv_array != 0) */
1063     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1064     for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
1065         if (HeHASH(entry) != hash)              /* strings can't be equal */
1066             continue;
1067         if (HeKLEN(entry) != len)
1068             continue;
1069         if (memNE(HeKEY(entry),str,len))        /* is this it? */
1070             continue;
1071         found = 1;
1072         break;
1073     }
1074     if (!found) {
1075         entry = new_he();
1076         HeKEY_hek(entry) = save_hek(str, len, hash);
1077         HeVAL(entry) = Nullsv;
1078         HeNEXT(entry) = *oentry;
1079         *oentry = entry;
1080         xhv->xhv_keys++;
1081         if (i) {                                /* initial entry? */
1082             ++xhv->xhv_fill;
1083             if (xhv->xhv_keys > xhv->xhv_max)
1084                 hsplit(strtab);
1085         }
1086     }
1087
1088     ++HeVAL(entry);                             /* use value slot as REFCNT */
1089     return HeKEY_hek(entry);
1090 }
1091
1092