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