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