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