hv.c

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