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             HvLAZYDEL_on(hv);
 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             HvLAZYDEL_on(hv);
 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 void
 623 hv_ksplit(hv, newmax)
 624 HV *hv;
 625 IV newmax;
 626 {
 627     register XPVHV* xhv = (XPVHV*)SvANY(hv);
 628     I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
 629     register I32 newsize;
 630     register I32 i;
 631     register I32 j;
 632     register HE **a;
 633     register HE *entry;
 634     register HE **oentry;
 635
 636     newsize = (I32) newmax;                     /* possible truncation here */
 637     if (newsize != newmax || newmax <= oldsize)
 638         return;
 639     while ((newsize & (1 + ~newsize)) != newsize) {
 640         newsize &= ~(newsize & (1 + ~newsize)); /* get proper power of 2 */
 641     }
 642     if (newsize < newmax)
 643         newsize *= 2;
 644     if (newsize < newmax)
 645         return;                                 /* overflow detection */
 646
 647     a = (HE**)xhv->xhv_array;
 648     if (a) {
 649         nomemok = TRUE;
 650 #ifdef STRANGE_MALLOC
 651         Renew(a, newsize, HE*);
 652 #else
 653         i = newsize * sizeof(HE*);
 654         j = MALLOC_OVERHEAD;
 655         while (j - MALLOC_OVERHEAD < i)
 656             j += j;
 657         j -= MALLOC_OVERHEAD;
 658         j /= sizeof(HE*);
 659         assert(j >= newsize);
 660         New(2, a, j, HE*);
 661         Copy(xhv->xhv_array, a, oldsize, HE*);
 662         if (oldsize >= 64 && !nice_chunk) {
 663             nice_chunk = (char*)xhv->xhv_array;
 664             nice_chunk_size = oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD;
 665         }
 666         else
 667             Safefree(xhv->xhv_array);
 668 #endif
 669         nomemok = FALSE;
 670         Zero(&a[oldsize], newsize-oldsize, HE*); /* zero 2nd half*/
 671     }
 672     else {
 673         Newz(0, a, newsize, HE*);
 674     }
 675     xhv->xhv_max = --newsize;
 676     xhv->xhv_array = (char*)a;
 677     if (!xhv->xhv_fill)                         /* skip rest if no entries */
 678         return;
 679
 680     for (i=0; i<oldsize; i++,a++) {
 681         if (!*a)                                /* non-existent */
 682             continue;
 683         for (oentry = a, entry = *a; entry; entry = *oentry) {
 684             if ((j = (HeHASH(entry) & newsize)) != i) {
 685                 j -= i;
 686                 *oentry = HeNEXT(entry);
 687                 if (!(HeNEXT(entry) = a[j]))
 688                     xhv->xhv_fill++;
 689                 a[j] = entry;
 690                 continue;
 691             }
 692             else
 693                 oentry = &HeNEXT(entry);
 694         }
 695         if (!*a)                                /* everything moved */
 696             xhv->xhv_fill--;
 697     }
 698 }
 699
 700 HV *
 701 newHV()
 702 {
 703     register HV *hv;
 704     register XPVHV* xhv;
 705
 706     hv = (HV*)NEWSV(502,0);
 707     sv_upgrade((SV *)hv, SVt_PVHV);
 708     xhv = (XPVHV*)SvANY(hv);
 709     SvPOK_off(hv);
 710     SvNOK_off(hv);
 711 #ifndef NODEFAULT_SHAREKEYS
 712     HvSHAREKEYS_on(hv);         /* key-sharing on by default */
 713 #endif
 714     xhv->xhv_max = 7;           /* start with 8 buckets */
 715     xhv->xhv_fill = 0;
 716     xhv->xhv_pmroot = 0;
 717     (void)hv_iterinit(hv);      /* so each() will start off right */
 718     return hv;
 719 }
 720
 721 void
 722 he_free(hent, shared)
 723 register HE *hent;
 724 I32 shared;
 725 {
 726     if (!hent)
 727         return;
 728     SvREFCNT_dec(HeVAL(hent));
 729     if (HeKLEN(hent) == HEf_SVKEY)
 730         SvREFCNT_dec((SV*)HeKEY(hent));
 731     else if (shared)
 732         unsharepvn(HeKEY(hent), HeKLEN(hent), HeHASH(hent));
 733     else
 734         Safefree(HeKEY(hent));
 735     del_he(hent);
 736 }
 737
 738 void
 739 he_delayfree(hent, shared)
 740 register HE *hent;
 741 I32 shared;
 742 {
 743     if (!hent)
 744         return;
 745     sv_2mortal(HeVAL(hent));    /* free between statements */
 746     if (HeKLEN(hent) == HEf_SVKEY)
 747         sv_2mortal((SV*)HeKEY(hent));
 748     else if (shared)
 749         unsharepvn(HeKEY(hent), HeKLEN(hent), HeHASH(hent));
 750     else
 751         Safefree(HeKEY(hent));
 752     del_he(hent);
 753 }
 754
 755 void
 756 hv_clear(hv)
 757 HV *hv;
 758 {
 759     register XPVHV* xhv;
 760     if (!hv)
 761         return;
 762     xhv = (XPVHV*)SvANY(hv);
 763     hfreeentries(hv);
 764     xhv->xhv_fill = 0;
 765     xhv->xhv_keys = 0;
 766     if (xhv->xhv_array)
 767         (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*));
 768
 769     if (SvRMAGICAL(hv))
 770         mg_clear((SV*)hv);
 771 }
 772
 773 static void
 774 hfreeentries(hv)
 775 HV *hv;
 776 {
 777     register HE **array;
 778     register HE *hent;
 779     register HE *ohent = Null(HE*);
 780     I32 riter;
 781     I32 max;
 782     I32 shared;
 783
 784     if (!hv)
 785         return;
 786     if (!HvARRAY(hv))
 787         return;
 788
 789     riter = 0;
 790     max = HvMAX(hv);
 791     array = HvARRAY(hv);
 792     hent = array[0];
 793     shared = HvSHAREKEYS(hv);
 794     for (;;) {
 795         if (hent) {
 796             ohent = hent;
 797             hent = HeNEXT(hent);
 798             he_free(ohent, shared);
 799         }
 800         if (!hent) {
 801             if (++riter > max)
 802                 break;
 803             hent = array[riter];
 804         }
 805     }
 806     (void)hv_iterinit(hv);
 807 }
 808
 809 void
 810 hv_undef(hv)
 811 HV *hv;
 812 {
 813     register XPVHV* xhv;
 814     if (!hv)
 815         return;
 816     xhv = (XPVHV*)SvANY(hv);
 817     hfreeentries(hv);
 818     Safefree(xhv->xhv_array);
 819     if (HvNAME(hv)) {
 820         Safefree(HvNAME(hv));
 821         HvNAME(hv) = 0;
 822     }
 823     xhv->xhv_array = 0;
 824     xhv->xhv_max = 7;           /* it's a normal associative array */
 825     xhv->xhv_fill = 0;
 826     xhv->xhv_keys = 0;
 827
 828     if (SvRMAGICAL(hv))
 829         mg_clear((SV*)hv);
 830 }
 831
 832 I32
 833 hv_iterinit(hv)
 834 HV *hv;
 835 {
 836     register XPVHV* xhv = (XPVHV*)SvANY(hv);
 837     HE *entry = xhv->xhv_eiter;
 838 #ifdef DYNAMIC_ENV_FETCH  /* set up %ENV for iteration */
 839     if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) prime_env_iter();
 840 #endif
 841     if (entry && HvLAZYDEL(hv)) {       /* was deleted earlier? */
 842         HvLAZYDEL_off(hv);
 843         he_free(entry, HvSHAREKEYS(hv));
 844     }
 845     xhv->xhv_riter = -1;
 846     xhv->xhv_eiter = Null(HE*);
 847     return xhv->xhv_fill;
 848 }
 849
 850 HE *
 851 hv_iternext(hv)
 852 HV *hv;
 853 {
 854     register XPVHV* xhv;
 855     register HE *entry;
 856     HE *oldentry;
 857     MAGIC* mg;
 858
 859     if (!hv)
 860         croak("Bad associative array");
 861     xhv = (XPVHV*)SvANY(hv);
 862     oldentry = entry = xhv->xhv_eiter;
 863
 864     if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) {
 865         SV *key = sv_newmortal();
 866         if (entry) {
 867             sv_setsv(key, HeSVKEY_force(entry));
 868             SvREFCNT_dec(HeSVKEY(entry));       /* get rid of previous key */
 869         }
 870         else {
 871             xhv->xhv_eiter = entry = new_he();  /* only one HE per MAGICAL hash */
 872             Zero(entry, 1, HE);
 873             HeKLEN(entry) = HEf_SVKEY;
 874         }
 875         magic_nextpack((SV*) hv,mg,key);
 876         if (SvOK(key)) {
 877             /* force key to stay around until next time */
 878             HeKEY(entry) = (char*)SvREFCNT_inc(key);
 879             return entry;                       /* beware, hent_val is not set */
 880         }
 881         if (HeVAL(entry))
 882             SvREFCNT_dec(HeVAL(entry));
 883         del_he(entry);
 884         xhv->xhv_eiter = Null(HE*);
 885         return Null(HE*);
 886     }
 887
 888     if (!xhv->xhv_array)
 889         Newz(506,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
 890     if (entry)
 891         entry = HeNEXT(entry);
 892     while (!entry) {
 893         ++xhv->xhv_riter;
 894         if (xhv->xhv_riter > xhv->xhv_max) {
 895             xhv->xhv_riter = -1;
 896             break;
 897         }
 898         entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
 899     }
 900
 901     if (oldentry && HvLAZYDEL(hv)) {            /* was deleted earlier? */
 902         HvLAZYDEL_off(hv);
 903         he_free(oldentry, HvSHAREKEYS(hv));
 904     }
 905
 906     xhv->xhv_eiter = entry;
 907     return entry;
 908 }
 909
 910 char *
 911 hv_iterkey(entry,retlen)
 912 register HE *entry;
 913 I32 *retlen;
 914 {
 915     if (HeKLEN(entry) == HEf_SVKEY) {
 916         return SvPV((SV*)HeKEY(entry), *(STRLEN*)retlen);
 917     }
 918     else {
 919         *retlen = HeKLEN(entry);
 920         return HeKEY(entry);
 921     }
 922 }
 923
 924 /* unlike hv_iterval(), this always returns a mortal copy of the key */
 925 SV *
 926 hv_iterkeysv(entry)
 927 register HE *entry;
 928 {
 929     if (HeKLEN(entry) == HEf_SVKEY)
 930         return sv_mortalcopy((SV*)HeKEY(entry));
 931     else
 932         return sv_2mortal(newSVpv((HeKLEN(entry) ? HeKEY(entry) : ""),
 933                                   HeKLEN(entry)));
 934 }
 935
 936 SV *
 937 hv_iterval(hv,entry)
 938 HV *hv;
 939 register HE *entry;
 940 {
 941     if (SvRMAGICAL(hv)) {
 942         if (mg_find((SV*)hv,'P')) {
 943             SV* sv = sv_newmortal();
 944             mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry));
 945             return sv;
 946         }
 947     }
 948     return HeVAL(entry);
 949 }
 950
 951 SV *
 952 hv_iternextsv(hv, key, retlen)
 953     HV *hv;
 954     char **key;
 955     I32 *retlen;
 956 {
 957     HE *he;
 958     if ( (he = hv_iternext(hv)) == NULL)
 959         return NULL;
 960     *key = hv_iterkey(he, retlen);
 961     return hv_iterval(hv, he);
 962 }
 963
 964 void
 965 hv_magic(hv, gv, how)
 966 HV* hv;
 967 GV* gv;
 968 int how;
 969 {
 970     sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
 971 }
 972
 973 /* get a (constant) string ptr from the global string table
 974  * string will get added if it is not already there.
 975  * len and hash must both be valid for str.
 976  */
 977 char *
 978 sharepvn(str, len, hash)
 979 char *str;
 980 I32 len;
 981 register U32 hash;
 982 {
 983     register XPVHV* xhv;
 984     register HE *entry;
 985     register HE **oentry;
 986     register I32 i = 1;
 987     I32 found = 0;
 988
 989     /* what follows is the moral equivalent of:
 990
 991     if (!(Svp = hv_fetch(strtab, str, len, FALSE)))
 992         hv_store(strtab, str, len, Nullsv, hash);
 993     */
 994     xhv = (XPVHV*)SvANY(strtab);
 995     /* assert(xhv_array != 0) */
 996     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 997     for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
 998         if (HeHASH(entry) != hash)              /* strings can't be equal */
 999             continue;
1000         if (HeKLEN(entry) != len)
1001             continue;
1002         if (memcmp(HeKEY(entry),str,len))               /* is this it? */
1003             continue;
1004         found = 1;
1005         break;
1006     }
1007     if (!found) {
1008         entry = new_he();
1009         HeKLEN(entry) = len;
1010         HeKEY(entry) = savepvn(str,len);
1011         HeVAL(entry) = Nullsv;
1012         HeHASH(entry) = hash;
1013         HeNEXT(entry) = *oentry;
1014         *oentry = entry;
1015         xhv->xhv_keys++;
1016         if (i) {                                /* initial entry? */
1017             ++xhv->xhv_fill;
1018             if (xhv->xhv_keys > xhv->xhv_max)
1019                 hsplit(strtab);
1020         }
1021     }
1022
1023     ++HeVAL(entry);                             /* use value slot as REFCNT */
1024     return HeKEY(entry);
1025 }
1026
1027 /* possibly free a shared string if no one has access to it
1028  * len and hash must both be valid for str.
1029  */
1030 void
1031 unsharepvn(str, len, hash)
1032 char *str;
1033 I32 len;
1034 register U32 hash;
1035 {
1036     register XPVHV* xhv;
1037     register HE *entry;
1038     register HE **oentry;
1039     register I32 i = 1;
1040     I32 found = 0;
1041
1042     /* what follows is the moral equivalent of:
1043     if ((Svp = hv_fetch(strtab, tmpsv, FALSE, hash))) {
1044         if (--*Svp == Nullsv)
1045             hv_delete(strtab, str, len, G_DISCARD, hash);
1046     } */
1047     xhv = (XPVHV*)SvANY(strtab);
1048     /* assert(xhv_array != 0) */
1049     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1050     for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
1051         if (HeHASH(entry) != hash)              /* strings can't be equal */
1052             continue;
1053         if (HeKLEN(entry) != len)
1054             continue;
1055         if (memcmp(HeKEY(entry),str,len))               /* is this it? */
1056             continue;
1057         found = 1;
1058         if (--HeVAL(entry) == Nullsv) {
1059             *oentry = HeNEXT(entry);
1060             if (i && !*oentry)
1061                 xhv->xhv_fill--;
1062             Safefree(HeKEY(entry));
1063             del_he(entry);
1064             --xhv->xhv_keys;
1065         }
1066         break;
1067     }
1068
1069     if (!found)
1070         warn("Attempt to free non-existent shared string");
1071 }
1072