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