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