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