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