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     if (!entry)
 840         return;
 841     if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv))
 842         sub_generation++;       /* may be deletion of method from stash */
 843     SvREFCNT_dec(HeVAL(entry));
 844     if (HeKLEN(entry) == HEf_SVKEY) {
 845         SvREFCNT_dec(HeKEY_sv(entry));
 846         Safefree(HeKEY_hek(entry));
 847     }
 848     else if (HvSHAREKEYS(hv))
 849         unshare_hek(HeKEY_hek(entry));
 850     else
 851         Safefree(HeKEY_hek(entry));
 852     del_he(entry);
 853 }
 854
 855 void
 856 hv_delayfree_ent(HV *hv, register HE *entry)
 857 {
 858     if (!entry)
 859         return;
 860     if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv))
 861         sub_generation++;       /* may be deletion of method from stash */
 862     sv_2mortal(HeVAL(entry));   /* free between statements */
 863     if (HeKLEN(entry) == HEf_SVKEY) {
 864         sv_2mortal(HeKEY_sv(entry));
 865         Safefree(HeKEY_hek(entry));
 866     }
 867     else if (HvSHAREKEYS(hv))
 868         unshare_hek(HeKEY_hek(entry));
 869     else
 870         Safefree(HeKEY_hek(entry));
 871     del_he(entry);
 872 }
 873
 874 void
 875 hv_clear(HV *hv)
 876 {
 877     register XPVHV* xhv;
 878     if (!hv)
 879         return;
 880     xhv = (XPVHV*)SvANY(hv);
 881     hfreeentries(hv);
 882     xhv->xhv_fill = 0;
 883     xhv->xhv_keys = 0;
 884     if (xhv->xhv_array)
 885         (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*));
 886
 887     if (SvRMAGICAL(hv))
 888         mg_clear((SV*)hv);
 889 }
 890
 891 static void
 892 hfreeentries(HV *hv)
 893 {
 894     register HE **array;
 895     register HE *entry;
 896     register HE *oentry = Null(HE*);
 897     I32 riter;
 898     I32 max;
 899
 900     if (!hv)
 901         return;
 902     if (!HvARRAY(hv))
 903         return;
 904
 905     riter = 0;
 906     max = HvMAX(hv);
 907     array = HvARRAY(hv);
 908     entry = array[0];
 909     for (;;) {
 910         if (entry) {
 911             oentry = entry;
 912             entry = HeNEXT(entry);
 913             hv_free_ent(hv, oentry);
 914         }
 915         if (!entry) {
 916             if (++riter > max)
 917                 break;
 918             entry = array[riter];
 919         }
 920     }
 921     (void)hv_iterinit(hv);
 922 }
 923
 924 void
 925 hv_undef(HV *hv)
 926 {
 927     register XPVHV* xhv;
 928     if (!hv)
 929         return;
 930     xhv = (XPVHV*)SvANY(hv);
 931     hfreeentries(hv);
 932     Safefree(xhv->xhv_array);
 933     if (HvNAME(hv)) {
 934         Safefree(HvNAME(hv));
 935         HvNAME(hv) = 0;
 936     }
 937     xhv->xhv_array = 0;
 938     xhv->xhv_max = 7;           /* it's a normal hash */
 939     xhv->xhv_fill = 0;
 940     xhv->xhv_keys = 0;
 941
 942     if (SvRMAGICAL(hv))
 943         mg_clear((SV*)hv);
 944 }
 945
 946 I32
 947 hv_iterinit(HV *hv)
 948 {
 949     register XPVHV* xhv;
 950     HE *entry;
 951
 952     if (!hv)
 953         croak("Bad hash");
 954     xhv = (XPVHV*)SvANY(hv);
 955     entry = xhv->xhv_eiter;
 956 #ifdef DYNAMIC_ENV_FETCH  /* set up %ENV for iteration */
 957     if (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME))
 958         prime_env_iter();
 959 #endif
 960     if (entry && HvLAZYDEL(hv)) {       /* was deleted earlier? */
 961         HvLAZYDEL_off(hv);
 962         hv_free_ent(hv, entry);
 963     }
 964     xhv->xhv_riter = -1;
 965     xhv->xhv_eiter = Null(HE*);
 966     return xhv->xhv_fill;       /* should be xhv->xhv_keys? May change later */
 967 }
 968
 969 HE *
 970 hv_iternext(HV *hv)
 971 {
 972     register XPVHV* xhv;
 973     register HE *entry;
 974     HE *oldentry;
 975     MAGIC* mg;
 976
 977     if (!hv)
 978         croak("Bad hash");
 979     xhv = (XPVHV*)SvANY(hv);
 980     oldentry = entry = xhv->xhv_eiter;
 981
 982     if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) {
 983         SV *key = sv_newmortal();
 984         if (entry) {
 985             sv_setsv(key, HeSVKEY_force(entry));
 986             SvREFCNT_dec(HeSVKEY(entry));       /* get rid of previous key */
 987         }
 988         else {
 989             char *k;
 990             HEK *hek;
 991
 992             xhv->xhv_eiter = entry = new_he();  /* one HE per MAGICAL hash */
 993             Zero(entry, 1, HE);
 994             Newz(54, k, HEK_BASESIZE + sizeof(SV*), char);
 995             hek = (HEK*)k;
 996             HeKEY_hek(entry) = hek;
 997             HeKLEN(entry) = HEf_SVKEY;
 998         }
 999         magic_nextpack((SV*) hv,mg,key);
1000         if (SvOK(key)) {
1001             /* force key to stay around until next time */
1002             HeSVKEY_set(entry, SvREFCNT_inc(key));
1003             return entry;               /* beware, hent_val is not set */
1004         }
1005         if (HeVAL(entry))
1006             SvREFCNT_dec(HeVAL(entry));
1007         Safefree(HeKEY_hek(entry));
1008         del_he(entry);
1009         xhv->xhv_eiter = Null(HE*);
1010         return Null(HE*);
1011     }
1012
1013     if (!xhv->xhv_array)
1014         Newz(506,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
1015     if (entry)
1016         entry = HeNEXT(entry);
1017     while (!entry) {
1018         ++xhv->xhv_riter;
1019         if (xhv->xhv_riter > xhv->xhv_max) {
1020             xhv->xhv_riter = -1;
1021             break;
1022         }
1023         entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
1024     }
1025
1026     if (oldentry && HvLAZYDEL(hv)) {            /* was deleted earlier? */
1027         HvLAZYDEL_off(hv);
1028         hv_free_ent(hv, oldentry);
1029     }
1030
1031     xhv->xhv_eiter = entry;
1032     return entry;
1033 }
1034
1035 char *
1036 hv_iterkey(register HE *entry, I32 *retlen)
1037 {
1038     if (HeKLEN(entry) == HEf_SVKEY) {
1039         STRLEN len;
1040         char *p = SvPV(HeKEY_sv(entry), len);
1041         *retlen = len;
1042         return p;
1043     }
1044     else {
1045         *retlen = HeKLEN(entry);
1046         return HeKEY(entry);
1047     }
1048 }
1049
1050 /* unlike hv_iterval(), this always returns a mortal copy of the key */
1051 SV *
1052 hv_iterkeysv(register HE *entry)
1053 {
1054     if (HeKLEN(entry) == HEf_SVKEY)
1055         return sv_mortalcopy(HeKEY_sv(entry));
1056     else
1057         return sv_2mortal(newSVpv((HeKLEN(entry) ? HeKEY(entry) : ""),
1058                                   HeKLEN(entry)));
1059 }
1060
1061 SV *
1062 hv_iterval(HV *hv, register HE *entry)
1063 {
1064     if (SvRMAGICAL(hv)) {
1065         if (mg_find((SV*)hv,'P')) {
1066             SV* sv = sv_newmortal();
1067             if (HeKLEN(entry) == HEf_SVKEY)
1068                 mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY);
1069             else mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry));
1070             return sv;
1071         }
1072     }
1073     return HeVAL(entry);
1074 }
1075
1076 SV *
1077 hv_iternextsv(HV *hv, char **key, I32 *retlen)
1078 {
1079     HE *he;
1080     if ( (he = hv_iternext(hv)) == NULL)
1081         return NULL;
1082     *key = hv_iterkey(he, retlen);
1083     return hv_iterval(hv, he);
1084 }
1085
1086 void
1087 hv_magic(HV *hv, GV *gv, int how)
1088 {
1089     sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
1090 }
1091
1092 char*
1093 sharepvn(char *sv, I32 len, U32 hash)
1094 {
1095     return HEK_KEY(share_hek(sv, len, hash));
1096 }
1097
1098 /* possibly free a shared string if no one has access to it
1099  * len and hash must both be valid for str.
1100  */
1101 void
1102 unsharepvn(char *str, I32 len, U32 hash)
1103 {
1104     register XPVHV* xhv;
1105     register HE *entry;
1106     register HE **oentry;
1107     register I32 i = 1;
1108     I32 found = 0;
1109
1110     /* what follows is the moral equivalent of:
1111     if ((Svp = hv_fetch(strtab, tmpsv, FALSE, hash))) {
1112         if (--*Svp == Nullsv)
1113             hv_delete(strtab, str, len, G_DISCARD, hash);
1114     } */
1115     xhv = (XPVHV*)SvANY(strtab);
1116     /* assert(xhv_array != 0) */
1117     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1118     for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
1119         if (HeHASH(entry) != hash)              /* strings can't be equal */
1120             continue;
1121         if (HeKLEN(entry) != len)
1122             continue;
1123         if (memNE(HeKEY(entry),str,len))        /* is this it? */
1124             continue;
1125         found = 1;
1126         if (--HeVAL(entry) == Nullsv) {
1127             *oentry = HeNEXT(entry);
1128             if (i && !*oentry)
1129                 xhv->xhv_fill--;
1130             Safefree(HeKEY_hek(entry));
1131             del_he(entry);
1132             --xhv->xhv_keys;
1133         }
1134         break;
1135     }
1136
1137     if (!found)
1138         warn("Attempt to free non-existent shared string");
1139 }
1140
1141 /* get a (constant) string ptr from the global string table
1142  * string will get added if it is not already there.
1143  * len and hash must both be valid for str.
1144  */
1145 HEK *
1146 share_hek(char *str, I32 len, register U32 hash)
1147 {
1148     register XPVHV* xhv;
1149     register HE *entry;
1150     register HE **oentry;
1151     register I32 i = 1;
1152     I32 found = 0;
1153
1154     /* what follows is the moral equivalent of:
1155
1156     if (!(Svp = hv_fetch(strtab, str, len, FALSE)))
1157         hv_store(strtab, str, len, Nullsv, hash);
1158     */
1159     xhv = (XPVHV*)SvANY(strtab);
1160     /* assert(xhv_array != 0) */
1161     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1162     for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
1163         if (HeHASH(entry) != hash)              /* strings can't be equal */
1164             continue;
1165         if (HeKLEN(entry) != len)
1166             continue;
1167         if (memNE(HeKEY(entry),str,len))        /* is this it? */
1168             continue;
1169         found = 1;
1170         break;
1171     }
1172     if (!found) {
1173         entry = new_he();
1174         HeKEY_hek(entry) = save_hek(str, len, hash);
1175         HeVAL(entry) = Nullsv;
1176         HeNEXT(entry) = *oentry;
1177         *oentry = entry;
1178         xhv->xhv_keys++;
1179         if (i) {                                /* initial entry? */
1180             ++xhv->xhv_fill;
1181             if (xhv->xhv_keys > xhv->xhv_max)
1182                 hsplit(strtab);
1183         }
1184     }
1185
1186     ++HeVAL(entry);                             /* use value slot as REFCNT */
1187     return HeKEY_hek(entry);
1188 }
1189
1190
1191