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     New(54, he_root, 1008/sizeof(HE), HE);
  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 **svp;
 427     SV *sv;
 428
 429     if (!hv)
 430         return Nullsv;
 431     if (SvRMAGICAL(hv)) {
 432         bool needs_copy;
 433         bool needs_store;
 434         hv_magic_check (hv, &needs_copy, &needs_store);
 435
 436         if (needs_copy && (svp = hv_fetch(hv, key, klen, TRUE))) {
 437             sv = *svp;
 438             mg_clear(sv);
 439             if (!needs_store) {
 440                 if (mg_find(sv, 'p')) {
 441                     sv_unmagic(sv, 'p');        /* No longer an element */
 442                     return sv;
 443                 }
 444                 return Nullsv;          /* element cannot be deleted */
 445             }
 446 #ifdef ENV_IS_CASELESS
 447             else if (mg_find((SV*)hv,'E')) {
 448                 sv = sv_2mortal(newSVpv(key,klen));
 449                 key = strupr(SvPVX(sv));
 450             }
 451 #endif
 452         }
 453     }
 454     xhv = (XPVHV*)SvANY(hv);
 455     if (!xhv->xhv_array)
 456         return Nullsv;
 457
 458     PERL_HASH(hash, key, klen);
 459
 460     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 461     entry = *oentry;
 462     i = 1;
 463     for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
 464         if (HeHASH(entry) != hash)              /* strings can't be equal */
 465             continue;
 466         if (HeKLEN(entry) != klen)
 467             continue;
 468         if (memNE(HeKEY(entry),key,klen))       /* is this it? */
 469             continue;
 470         *oentry = HeNEXT(entry);
 471         if (i && !*oentry)
 472             xhv->xhv_fill--;
 473         if (flags & G_DISCARD)
 474             sv = Nullsv;
 475         else
 476             sv = sv_mortalcopy(HeVAL(entry));
 477         if (entry == xhv->xhv_eiter)
 478             HvLAZYDEL_on(hv);
 479         else
 480             hv_free_ent(hv, entry);
 481         --xhv->xhv_keys;
 482         return sv;
 483     }
 484     return Nullsv;
 485 }
 486
 487 SV *
 488 hv_delete_ent(HV *hv, SV *keysv, I32 flags, U32 hash)
 489 {
 490     register XPVHV* xhv;
 491     register I32 i;
 492     register char *key;
 493     STRLEN klen;
 494     register HE *entry;
 495     register HE **oentry;
 496     SV *sv;
 497
 498     if (!hv)
 499         return Nullsv;
 500     if (SvRMAGICAL(hv)) {
 501         bool needs_copy;
 502         bool needs_store;
 503         hv_magic_check (hv, &needs_copy, &needs_store);
 504
 505         if (needs_copy && (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     if (!a) {
 680       nomemok = FALSE;
 681       return;
 682     }
 683 #else
 684     i = newsize * sizeof(HE*);
 685 #define MALLOC_OVERHEAD 16
 686     tmp = MALLOC_OVERHEAD;
 687     while (tmp - MALLOC_OVERHEAD < i)
 688         tmp += tmp;
 689     tmp -= MALLOC_OVERHEAD;
 690     tmp /= sizeof(HE*);
 691     assert(tmp >= newsize);
 692     New(2,a, tmp, HE*);
 693     if (!a) {
 694       nomemok = FALSE;
 695       return;
 696     }
 697     Copy(xhv->xhv_array, a, oldsize, HE*);
 698     if (oldsize >= 64) {
 699         offer_nice_chunk(xhv->xhv_array,
 700                          oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD);
 701     }
 702     else
 703         Safefree(xhv->xhv_array);
 704 #endif
 705
 706     nomemok = FALSE;
 707     Zero(&a[oldsize], oldsize, HE*);            /* zero 2nd half*/
 708     xhv->xhv_max = --newsize;
 709     xhv->xhv_array = (char*)a;
 710
 711     for (i=0; i<oldsize; i++,a++) {
 712         if (!*a)                                /* non-existent */
 713             continue;
 714         b = a+oldsize;
 715         for (oentry = a, entry = *a; entry; entry = *oentry) {
 716             if ((HeHASH(entry) & newsize) != i) {
 717                 *oentry = HeNEXT(entry);
 718                 HeNEXT(entry) = *b;
 719                 if (!*b)
 720                     xhv->xhv_fill++;
 721                 *b = entry;
 722                 continue;
 723             }
 724             else
 725                 oentry = &HeNEXT(entry);
 726         }
 727         if (!*a)                                /* everything moved */
 728             xhv->xhv_fill--;
 729     }
 730 }
 731
 732 void
 733 hv_ksplit(HV *hv, IV newmax)
 734 {
 735     register XPVHV* xhv = (XPVHV*)SvANY(hv);
 736     I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
 737     register I32 newsize;
 738     register I32 i;
 739     register I32 j;
 740     register HE **a;
 741     register HE *entry;
 742     register HE **oentry;
 743
 744     newsize = (I32) newmax;                     /* possible truncation here */
 745     if (newsize != newmax || newmax <= oldsize)
 746         return;
 747     while ((newsize & (1 + ~newsize)) != newsize) {
 748         newsize &= ~(newsize & (1 + ~newsize)); /* get proper power of 2 */
 749     }
 750     if (newsize < newmax)
 751         newsize *= 2;
 752     if (newsize < newmax)
 753         return;                                 /* overflow detection */
 754
 755     a = (HE**)xhv->xhv_array;
 756     if (a) {
 757         nomemok = TRUE;
 758 #ifdef STRANGE_MALLOC
 759         Renew(a, newsize, HE*);
 760         if (!a) {
 761           nomemok = FALSE;
 762           return;
 763         }
 764 #else
 765         i = newsize * sizeof(HE*);
 766         j = MALLOC_OVERHEAD;
 767         while (j - MALLOC_OVERHEAD < i)
 768             j += j;
 769         j -= MALLOC_OVERHEAD;
 770         j /= sizeof(HE*);
 771         assert(j >= newsize);
 772         New(2, a, j, HE*);
 773         if (!a) {
 774           nomemok = FALSE;
 775           return;
 776         }
 777         Copy(xhv->xhv_array, a, oldsize, HE*);
 778         if (oldsize >= 64) {
 779             offer_nice_chunk(xhv->xhv_array,
 780                              oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD);
 781         }
 782         else
 783             Safefree(xhv->xhv_array);
 784 #endif
 785         nomemok = FALSE;
 786         Zero(&a[oldsize], newsize-oldsize, HE*); /* zero 2nd half*/
 787     }
 788     else {
 789         Newz(0, a, newsize, HE*);
 790     }
 791     xhv->xhv_max = --newsize;
 792     xhv->xhv_array = (char*)a;
 793     if (!xhv->xhv_fill)                         /* skip rest if no entries */
 794         return;
 795
 796     for (i=0; i<oldsize; i++,a++) {
 797         if (!*a)                                /* non-existent */
 798             continue;
 799         for (oentry = a, entry = *a; entry; entry = *oentry) {
 800             if ((j = (HeHASH(entry) & newsize)) != i) {
 801                 j -= i;
 802                 *oentry = HeNEXT(entry);
 803                 if (!(HeNEXT(entry) = a[j]))
 804                     xhv->xhv_fill++;
 805                 a[j] = entry;
 806                 continue;
 807             }
 808             else
 809                 oentry = &HeNEXT(entry);
 810         }
 811         if (!*a)                                /* everything moved */
 812             xhv->xhv_fill--;
 813     }
 814 }
 815
 816 HV *
 817 newHV(void)
 818 {
 819     register HV *hv;
 820     register XPVHV* xhv;
 821
 822     hv = (HV*)NEWSV(502,0);
 823     sv_upgrade((SV *)hv, SVt_PVHV);
 824     xhv = (XPVHV*)SvANY(hv);
 825     SvPOK_off(hv);
 826     SvNOK_off(hv);
 827 #ifndef NODEFAULT_SHAREKEYS
 828     HvSHAREKEYS_on(hv);         /* key-sharing on by default */
 829 #endif
 830     xhv->xhv_max = 7;           /* start with 8 buckets */
 831     xhv->xhv_fill = 0;
 832     xhv->xhv_pmroot = 0;
 833     (void)hv_iterinit(hv);      /* so each() will start off right */
 834     return hv;
 835 }
 836
 837 void
 838 hv_free_ent(HV *hv, register HE *entry)
 839 {
 840     if (!entry)
 841         return;
 842     if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv))
 843         sub_generation++;       /* may be deletion of method from stash */
 844     SvREFCNT_dec(HeVAL(entry));
 845     if (HeKLEN(entry) == HEf_SVKEY) {
 846         SvREFCNT_dec(HeKEY_sv(entry));
 847         Safefree(HeKEY_hek(entry));
 848     }
 849     else if (HvSHAREKEYS(hv))
 850         unshare_hek(HeKEY_hek(entry));
 851     else
 852         Safefree(HeKEY_hek(entry));
 853     del_he(entry);
 854 }
 855
 856 void
 857 hv_delayfree_ent(HV *hv, register HE *entry)
 858 {
 859     if (!entry)
 860         return;
 861     if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv))
 862         sub_generation++;       /* may be deletion of method from stash */
 863     sv_2mortal(HeVAL(entry));   /* free between statements */
 864     if (HeKLEN(entry) == HEf_SVKEY) {
 865         sv_2mortal(HeKEY_sv(entry));
 866         Safefree(HeKEY_hek(entry));
 867     }
 868     else if (HvSHAREKEYS(hv))
 869         unshare_hek(HeKEY_hek(entry));
 870     else
 871         Safefree(HeKEY_hek(entry));
 872     del_he(entry);
 873 }
 874
 875 void
 876 hv_clear(HV *hv)
 877 {
 878     register XPVHV* xhv;
 879     if (!hv)
 880         return;
 881     xhv = (XPVHV*)SvANY(hv);
 882     hfreeentries(hv);
 883     xhv->xhv_fill = 0;
 884     xhv->xhv_keys = 0;
 885     if (xhv->xhv_array)
 886         (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*));
 887
 888     if (SvRMAGICAL(hv))
 889         mg_clear((SV*)hv);
 890 }
 891
 892 static void
 893 hfreeentries(HV *hv)
 894 {
 895     register HE **array;
 896     register HE *entry;
 897     register HE *oentry = Null(HE*);
 898     I32 riter;
 899     I32 max;
 900
 901     if (!hv)
 902         return;
 903     if (!HvARRAY(hv))
 904         return;
 905
 906     riter = 0;
 907     max = HvMAX(hv);
 908     array = HvARRAY(hv);
 909     entry = array[0];
 910     for (;;) {
 911         if (entry) {
 912             oentry = entry;
 913             entry = HeNEXT(entry);
 914             hv_free_ent(hv, oentry);
 915         }
 916         if (!entry) {
 917             if (++riter > max)
 918                 break;
 919             entry = array[riter];
 920         }
 921     }
 922     (void)hv_iterinit(hv);
 923 }
 924
 925 void
 926 hv_undef(HV *hv)
 927 {
 928     register XPVHV* xhv;
 929     if (!hv)
 930         return;
 931     xhv = (XPVHV*)SvANY(hv);
 932     hfreeentries(hv);
 933     Safefree(xhv->xhv_array);
 934     if (HvNAME(hv)) {
 935         Safefree(HvNAME(hv));
 936         HvNAME(hv) = 0;
 937     }
 938     xhv->xhv_array = 0;
 939     xhv->xhv_max = 7;           /* it's a normal hash */
 940     xhv->xhv_fill = 0;
 941     xhv->xhv_keys = 0;
 942
 943     if (SvRMAGICAL(hv))
 944         mg_clear((SV*)hv);
 945 }
 946
 947 I32
 948 hv_iterinit(HV *hv)
 949 {
 950     register XPVHV* xhv;
 951     HE *entry;
 952
 953     if (!hv)
 954         croak("Bad hash");
 955     xhv = (XPVHV*)SvANY(hv);
 956     entry = xhv->xhv_eiter;
 957 #ifdef DYNAMIC_ENV_FETCH  /* set up %ENV for iteration */
 958     if (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME))
 959         prime_env_iter();
 960 #endif
 961     if (entry && HvLAZYDEL(hv)) {       /* was deleted earlier? */
 962         HvLAZYDEL_off(hv);
 963         hv_free_ent(hv, entry);
 964     }
 965     xhv->xhv_riter = -1;
 966     xhv->xhv_eiter = Null(HE*);
 967     return xhv->xhv_fill;       /* should be xhv->xhv_keys? May change later */
 968 }
 969
 970 HE *
 971 hv_iternext(HV *hv)
 972 {
 973     register XPVHV* xhv;
 974     register HE *entry;
 975     HE *oldentry;
 976     MAGIC* mg;
 977
 978     if (!hv)
 979         croak("Bad hash");
 980     xhv = (XPVHV*)SvANY(hv);
 981     oldentry = entry = xhv->xhv_eiter;
 982
 983     if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) {
 984         SV *key = sv_newmortal();
 985         if (entry) {
 986             sv_setsv(key, HeSVKEY_force(entry));
 987             SvREFCNT_dec(HeSVKEY(entry));       /* get rid of previous key */
 988         }
 989         else {
 990             char *k;
 991             HEK *hek;
 992
 993             xhv->xhv_eiter = entry = new_he();  /* one HE per MAGICAL hash */
 994             Zero(entry, 1, HE);
 995             Newz(54, k, HEK_BASESIZE + sizeof(SV*), char);
 996             hek = (HEK*)k;
 997             HeKEY_hek(entry) = hek;
 998             HeKLEN(entry) = HEf_SVKEY;
 999         }
1000         magic_nextpack((SV*) hv,mg,key);
1001         if (SvOK(key)) {
1002             /* force key to stay around until next time */
1003             HeSVKEY_set(entry, SvREFCNT_inc(key));
1004             return entry;               /* beware, hent_val is not set */
1005         }
1006         if (HeVAL(entry))
1007             SvREFCNT_dec(HeVAL(entry));
1008         Safefree(HeKEY_hek(entry));
1009         del_he(entry);
1010         xhv->xhv_eiter = Null(HE*);
1011         return Null(HE*);
1012     }
1013
1014     if (!xhv->xhv_array)
1015         Newz(506,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
1016     if (entry)
1017         entry = HeNEXT(entry);
1018     while (!entry) {
1019         ++xhv->xhv_riter;
1020         if (xhv->xhv_riter > xhv->xhv_max) {
1021             xhv->xhv_riter = -1;
1022             break;
1023         }
1024         entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
1025     }
1026
1027     if (oldentry && HvLAZYDEL(hv)) {            /* was deleted earlier? */
1028         HvLAZYDEL_off(hv);
1029         hv_free_ent(hv, oldentry);
1030     }
1031
1032     xhv->xhv_eiter = entry;
1033     return entry;
1034 }
1035
1036 char *
1037 hv_iterkey(register HE *entry, I32 *retlen)
1038 {
1039     if (HeKLEN(entry) == HEf_SVKEY) {
1040         STRLEN len;
1041         char *p = SvPV(HeKEY_sv(entry), len);
1042         *retlen = len;
1043         return p;
1044     }
1045     else {
1046         *retlen = HeKLEN(entry);
1047         return HeKEY(entry);
1048     }
1049 }
1050
1051 /* unlike hv_iterval(), this always returns a mortal copy of the key */
1052 SV *
1053 hv_iterkeysv(register HE *entry)
1054 {
1055     if (HeKLEN(entry) == HEf_SVKEY)
1056         return sv_mortalcopy(HeKEY_sv(entry));
1057     else
1058         return sv_2mortal(newSVpv((HeKLEN(entry) ? HeKEY(entry) : ""),
1059                                   HeKLEN(entry)));
1060 }
1061
1062 SV *
1063 hv_iterval(HV *hv, register HE *entry)
1064 {
1065     if (SvRMAGICAL(hv)) {
1066         if (mg_find((SV*)hv,'P')) {
1067             SV* sv = sv_newmortal();
1068             if (HeKLEN(entry) == HEf_SVKEY)
1069                 mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY);
1070             else mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry));
1071             return sv;
1072         }
1073     }
1074     return HeVAL(entry);
1075 }
1076
1077 SV *
1078 hv_iternextsv(HV *hv, char **key, I32 *retlen)
1079 {
1080     HE *he;
1081     if ( (he = hv_iternext(hv)) == NULL)
1082         return NULL;
1083     *key = hv_iterkey(he, retlen);
1084     return hv_iterval(hv, he);
1085 }
1086
1087 void
1088 hv_magic(HV *hv, GV *gv, int how)
1089 {
1090     sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
1091 }
1092
1093 char*
1094 sharepvn(char *sv, I32 len, U32 hash)
1095 {
1096     return HEK_KEY(share_hek(sv, len, hash));
1097 }
1098
1099 /* possibly free a shared string if no one has access to it
1100  * len and hash must both be valid for str.
1101  */
1102 void
1103 unsharepvn(char *str, I32 len, U32 hash)
1104 {
1105     register XPVHV* xhv;
1106     register HE *entry;
1107     register HE **oentry;
1108     register I32 i = 1;
1109     I32 found = 0;
1110
1111     /* what follows is the moral equivalent of:
1112     if ((Svp = hv_fetch(strtab, tmpsv, FALSE, hash))) {
1113         if (--*Svp == Nullsv)
1114             hv_delete(strtab, str, len, G_DISCARD, hash);
1115     } */
1116     xhv = (XPVHV*)SvANY(strtab);
1117     /* assert(xhv_array != 0) */
1118     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1119     for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
1120         if (HeHASH(entry) != hash)              /* strings can't be equal */
1121             continue;
1122         if (HeKLEN(entry) != len)
1123             continue;
1124         if (memNE(HeKEY(entry),str,len))        /* is this it? */
1125             continue;
1126         found = 1;
1127         if (--HeVAL(entry) == Nullsv) {
1128             *oentry = HeNEXT(entry);
1129             if (i && !*oentry)
1130                 xhv->xhv_fill--;
1131             Safefree(HeKEY_hek(entry));
1132             del_he(entry);
1133             --xhv->xhv_keys;
1134         }
1135         break;
1136     }
1137
1138     if (!found)
1139         warn("Attempt to free non-existent shared string");
1140 }
1141
1142 /* get a (constant) string ptr from the global string table
1143  * string will get added if it is not already there.
1144  * len and hash must both be valid for str.
1145  */
1146 HEK *
1147 share_hek(char *str, I32 len, register U32 hash)
1148 {
1149     register XPVHV* xhv;
1150     register HE *entry;
1151     register HE **oentry;
1152     register I32 i = 1;
1153     I32 found = 0;
1154
1155     /* what follows is the moral equivalent of:
1156
1157     if (!(Svp = hv_fetch(strtab, str, len, FALSE)))
1158         hv_store(strtab, str, len, Nullsv, hash);
1159     */
1160     xhv = (XPVHV*)SvANY(strtab);
1161     /* assert(xhv_array != 0) */
1162     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1163     for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
1164         if (HeHASH(entry) != hash)              /* strings can't be equal */
1165             continue;
1166         if (HeKLEN(entry) != len)
1167             continue;
1168         if (memNE(HeKEY(entry),str,len))        /* is this it? */
1169             continue;
1170         found = 1;
1171         break;
1172     }
1173     if (!found) {
1174         entry = new_he();
1175         HeKEY_hek(entry) = save_hek(str, len, hash);
1176         HeVAL(entry) = Nullsv;
1177         HeNEXT(entry) = *oentry;
1178         *oentry = entry;
1179         xhv->xhv_keys++;
1180         if (i) {                                /* initial entry? */
1181             ++xhv->xhv_fill;
1182             if (xhv->xhv_keys > xhv->xhv_max)
1183                 hsplit(strtab);
1184         }
1185     }
1186
1187     ++HeVAL(entry);                             /* use value slot as REFCNT */
1188     return HeKEY_hek(entry);
1189 }
1190
1191
1192