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 = my_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 = my_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(entry, HvSHAREKEYS(hv));
 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(entry, HvSHAREKEYS(hv));
 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(hent, shared)
 750 register HE *hent;
 751 I32 shared;
 752 {
 753     if (!hent)
 754         return;
 755     if (SvTYPE(HeVAL(hent)) == SVt_PVGV && GvCV(HeVAL(hent)))
 756         sub_generation++;               /* May be deletion of method? */
 757     SvREFCNT_dec(HeVAL(hent));
 758     if (HeKLEN(hent) == HEf_SVKEY) {
 759         SvREFCNT_dec(HeKEY_sv(hent));
 760         Safefree(HeKEY_hek(hent));
 761     } else if (shared)
 762         unshare_hek(HeKEY_hek(hent));
 763     else
 764         Safefree(HeKEY_hek(hent));
 765     del_he(hent);
 766 }
 767
 768 void
 769 he_delayfree(hent, shared)
 770 register HE *hent;
 771 I32 shared;
 772 {
 773     if (!hent)
 774         return;
 775     sv_2mortal(HeVAL(hent));    /* free between statements */
 776     if (HeKLEN(hent) == HEf_SVKEY) {
 777         sv_2mortal(HeKEY_sv(hent));
 778         Safefree(HeKEY_hek(hent));
 779     } else if (shared)
 780         unshare_hek(HeKEY_hek(hent));
 781     else
 782         Safefree(HeKEY_hek(hent));
 783     del_he(hent);
 784 }
 785
 786 void
 787 hv_clear(hv)
 788 HV *hv;
 789 {
 790     register XPVHV* xhv;
 791     if (!hv)
 792         return;
 793     xhv = (XPVHV*)SvANY(hv);
 794     hfreeentries(hv);
 795     xhv->xhv_fill = 0;
 796     xhv->xhv_keys = 0;
 797     if (xhv->xhv_array)
 798         (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*));
 799
 800     if (SvRMAGICAL(hv))
 801         mg_clear((SV*)hv);
 802 }
 803
 804 static void
 805 hfreeentries(hv)
 806 HV *hv;
 807 {
 808     register HE **array;
 809     register HE *hent;
 810     register HE *ohent = Null(HE*);
 811     I32 riter;
 812     I32 max;
 813     I32 shared;
 814
 815     if (!hv)
 816         return;
 817     if (!HvARRAY(hv))
 818         return;
 819
 820     riter = 0;
 821     max = HvMAX(hv);
 822     array = HvARRAY(hv);
 823     hent = array[0];
 824     shared = HvSHAREKEYS(hv);
 825     for (;;) {
 826         if (hent) {
 827             ohent = hent;
 828             hent = HeNEXT(hent);
 829             he_free(ohent, shared);
 830         }
 831         if (!hent) {
 832             if (++riter > max)
 833                 break;
 834             hent = array[riter];
 835         }
 836     }
 837     (void)hv_iterinit(hv);
 838 }
 839
 840 void
 841 hv_undef(hv)
 842 HV *hv;
 843 {
 844     register XPVHV* xhv;
 845     if (!hv)
 846         return;
 847     xhv = (XPVHV*)SvANY(hv);
 848     hfreeentries(hv);
 849     Safefree(xhv->xhv_array);
 850     if (HvNAME(hv)) {
 851         Safefree(HvNAME(hv));
 852         HvNAME(hv) = 0;
 853     }
 854     xhv->xhv_array = 0;
 855     xhv->xhv_max = 7;           /* it's a normal associative array */
 856     xhv->xhv_fill = 0;
 857     xhv->xhv_keys = 0;
 858
 859     if (SvRMAGICAL(hv))
 860         mg_clear((SV*)hv);
 861 }
 862
 863 I32
 864 hv_iterinit(hv)
 865 HV *hv;
 866 {
 867     register XPVHV* xhv = (XPVHV*)SvANY(hv);
 868     HE *entry = xhv->xhv_eiter;
 869 #ifdef DYNAMIC_ENV_FETCH  /* set up %ENV for iteration */
 870     if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) prime_env_iter();
 871 #endif
 872     if (entry && HvLAZYDEL(hv)) {       /* was deleted earlier? */
 873         HvLAZYDEL_off(hv);
 874         he_free(entry, HvSHAREKEYS(hv));
 875     }
 876     xhv->xhv_riter = -1;
 877     xhv->xhv_eiter = Null(HE*);
 878     return xhv->xhv_fill;
 879 }
 880
 881 HE *
 882 hv_iternext(hv)
 883 HV *hv;
 884 {
 885     register XPVHV* xhv;
 886     register HE *entry;
 887     HE *oldentry;
 888     MAGIC* mg;
 889
 890     if (!hv)
 891         croak("Bad associative array");
 892     xhv = (XPVHV*)SvANY(hv);
 893     oldentry = entry = xhv->xhv_eiter;
 894
 895     if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) {
 896         SV *key = sv_newmortal();
 897         if (entry) {
 898             sv_setsv(key, HeSVKEY_force(entry));
 899             SvREFCNT_dec(HeSVKEY(entry));       /* get rid of previous key */
 900         }
 901         else {
 902             char *k;
 903             HEK *hek;
 904
 905             xhv->xhv_eiter = entry = new_he();  /* one HE per MAGICAL hash */
 906             Zero(entry, 1, HE);
 907             Newz(54, k, HEK_BASESIZE + sizeof(SV*), char);
 908             hek = (HEK*)k;
 909             HeKEY_hek(entry) = hek;
 910             HeKLEN(entry) = HEf_SVKEY;
 911         }
 912         magic_nextpack((SV*) hv,mg,key);
 913         if (SvOK(key)) {
 914             /* force key to stay around until next time */
 915             HeSVKEY_set(entry, SvREFCNT_inc(key));
 916             return entry;               /* beware, hent_val is not set */
 917         }
 918         if (HeVAL(entry))
 919             SvREFCNT_dec(HeVAL(entry));
 920         Safefree(HeKEY_hek(entry));
 921         del_he(entry);
 922         xhv->xhv_eiter = Null(HE*);
 923         return Null(HE*);
 924     }
 925
 926     if (!xhv->xhv_array)
 927         Newz(506,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
 928     if (entry)
 929         entry = HeNEXT(entry);
 930     while (!entry) {
 931         ++xhv->xhv_riter;
 932         if (xhv->xhv_riter > xhv->xhv_max) {
 933             xhv->xhv_riter = -1;
 934             break;
 935         }
 936         entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
 937     }
 938
 939     if (oldentry && HvLAZYDEL(hv)) {            /* was deleted earlier? */
 940         HvLAZYDEL_off(hv);
 941         he_free(oldentry, HvSHAREKEYS(hv));
 942     }
 943
 944     xhv->xhv_eiter = entry;
 945     return entry;
 946 }
 947
 948 char *
 949 hv_iterkey(entry,retlen)
 950 register HE *entry;
 951 I32 *retlen;
 952 {
 953     if (HeKLEN(entry) == HEf_SVKEY) {
 954         return SvPV(HeKEY_sv(entry), *(STRLEN*)retlen);
 955     }
 956     else {
 957         *retlen = HeKLEN(entry);
 958         return HeKEY(entry);
 959     }
 960 }
 961
 962 /* unlike hv_iterval(), this always returns a mortal copy of the key */
 963 SV *
 964 hv_iterkeysv(entry)
 965 register HE *entry;
 966 {
 967     if (HeKLEN(entry) == HEf_SVKEY)
 968         return sv_mortalcopy(HeKEY_sv(entry));
 969     else
 970         return sv_2mortal(newSVpv((HeKLEN(entry) ? HeKEY(entry) : ""),
 971                                   HeKLEN(entry)));
 972 }
 973
 974 SV *
 975 hv_iterval(hv,entry)
 976 HV *hv;
 977 register HE *entry;
 978 {
 979     if (SvRMAGICAL(hv)) {
 980         if (mg_find((SV*)hv,'P')) {
 981             SV* sv = sv_newmortal();
 982             if (HeKLEN(entry) == HEf_SVKEY)
 983                 mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY);
 984             else mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry));
 985             return sv;
 986         }
 987     }
 988     return HeVAL(entry);
 989 }
 990
 991 SV *
 992 hv_iternextsv(hv, key, retlen)
 993     HV *hv;
 994     char **key;
 995     I32 *retlen;
 996 {
 997     HE *he;
 998     if ( (he = hv_iternext(hv)) == NULL)
 999         return NULL;
1000     *key = hv_iterkey(he, retlen);
1001     return hv_iterval(hv, he);
1002 }
1003
1004 void
1005 hv_magic(hv, gv, how)
1006 HV* hv;
1007 GV* gv;
1008 int how;
1009 {
1010     sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
1011 }
1012
1013 char*
1014 sharepvn(sv, len, hash)
1015 char* sv;
1016 I32 len;
1017 U32 hash;
1018 {
1019     return HEK_KEY(share_hek(sv, len, hash));
1020 }
1021
1022 /* possibly free a shared string if no one has access to it
1023  * len and hash must both be valid for str.
1024  */
1025 void
1026 unsharepvn(str, len, hash)
1027 char* str;
1028 I32 len;
1029 U32 hash;
1030 {
1031     register XPVHV* xhv;
1032     register HE *entry;
1033     register HE **oentry;
1034     register I32 i = 1;
1035     I32 found = 0;
1036
1037     /* what follows is the moral equivalent of:
1038     if ((Svp = hv_fetch(strtab, tmpsv, FALSE, hash))) {
1039         if (--*Svp == Nullsv)
1040             hv_delete(strtab, str, len, G_DISCARD, hash);
1041     } */
1042     xhv = (XPVHV*)SvANY(strtab);
1043     /* assert(xhv_array != 0) */
1044     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1045     for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
1046         if (HeHASH(entry) != hash)              /* strings can't be equal */
1047             continue;
1048         if (HeKLEN(entry) != len)
1049             continue;
1050         if (memNE(HeKEY(entry),str,len))        /* is this it? */
1051             continue;
1052         found = 1;
1053         if (--HeVAL(entry) == Nullsv) {
1054             *oentry = HeNEXT(entry);
1055             if (i && !*oentry)
1056                 xhv->xhv_fill--;
1057             Safefree(HeKEY_hek(entry));
1058             del_he(entry);
1059             --xhv->xhv_keys;
1060         }
1061         break;
1062     }
1063
1064     if (!found)
1065         warn("Attempt to free non-existent shared string");
1066 }
1067
1068 /* get a (constant) string ptr from the global string table
1069  * string will get added if it is not already there.
1070  * len and hash must both be valid for str.
1071  */
1072 HEK *
1073 share_hek(str, len, hash)
1074 char *str;
1075 I32 len;
1076 register U32 hash;
1077 {
1078     register XPVHV* xhv;
1079     register HE *entry;
1080     register HE **oentry;
1081     register I32 i = 1;
1082     I32 found = 0;
1083
1084     /* what follows is the moral equivalent of:
1085
1086     if (!(Svp = hv_fetch(strtab, str, len, FALSE)))
1087         hv_store(strtab, str, len, Nullsv, hash);
1088     */
1089     xhv = (XPVHV*)SvANY(strtab);
1090     /* assert(xhv_array != 0) */
1091     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1092     for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
1093         if (HeHASH(entry) != hash)              /* strings can't be equal */
1094             continue;
1095         if (HeKLEN(entry) != len)
1096             continue;
1097         if (memNE(HeKEY(entry),str,len))        /* is this it? */
1098             continue;
1099         found = 1;
1100         break;
1101     }
1102     if (!found) {
1103         entry = new_he();
1104         HeKEY_hek(entry) = save_hek(str, len, hash);
1105         HeVAL(entry) = Nullsv;
1106         HeNEXT(entry) = *oentry;
1107         *oentry = entry;
1108         xhv->xhv_keys++;
1109         if (i) {                                /* initial entry? */
1110             ++xhv->xhv_fill;
1111             if (xhv->xhv_keys > xhv->xhv_max)
1112                 hsplit(strtab);
1113         }
1114     }
1115
1116     ++HeVAL(entry);                             /* use value slot as REFCNT */
1117     return HeKEY_hek(entry);
1118 }
1119
1120