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