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