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