hv.c

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