hv.c

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