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 hv_magic_check _((HV *hv, bool *needs_copy, bool *needs_store));
  18 #ifndef PERL_OBJECT
  19 static void hsplit _((HV *hv));
  20 static void hfreeentries _((HV *hv));
  21 static HE* more_he _((void));
  22 #endif
  23
  24 STATIC HE*
  25 new_he(void)
  26 {
  27     HE* he;
  28     if (he_root) {
  29         he = he_root;
  30         he_root = HeNEXT(he);
  31         return he;
  32     }
  33     return more_he();
  34 }
  35
  36 STATIC void
  37 del_he(HE *p)
  38 {
  39     HeNEXT(p) = (HE*)he_root;
  40     he_root = p;
  41 }
  42
  43 STATIC HE*
  44 more_he(void)
  45 {
  46     register HE* he;
  47     register HE* heend;
  48     New(54, he_root, 1008/sizeof(HE), HE);
  49     he = he_root;
  50     heend = &he[1008 / sizeof(HE) - 1];
  51     while (he < heend) {
  52         HeNEXT(he) = (HE*)(he + 1);
  53         he++;
  54     }
  55     HeNEXT(he) = 0;
  56     return new_he();
  57 }
  58
  59 STATIC HEK *
  60 save_hek(char *str, I32 len, U32 hash)
  61 {
  62     char *k;
  63     register HEK *hek;
  64
  65     New(54, k, HEK_BASESIZE + len + 1, char);
  66     hek = (HEK*)k;
  67     Copy(str, HEK_KEY(hek), len, char);
  68     *(HEK_KEY(hek) + len) = '\0';
  69     HEK_LEN(hek) = len;
  70     HEK_HASH(hek) = hash;
  71     return hek;
  72 }
  73
  74 void
  75 unshare_hek(HEK *hek)
  76 {
  77     unsharepvn(HEK_KEY(hek),HEK_LEN(hek),HEK_HASH(hek));
  78 }
  79
  80 /* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot
  81  * contains an SV* */
  82
  83 SV**
  84 hv_fetch(HV *hv, char *key, U32 klen, I32 lval)
  85 {
  86     register XPVHV* xhv;
  87     register U32 hash;
  88     register HE *entry;
  89     SV *sv;
  90
  91     if (!hv)
  92         return 0;
  93
  94     if (SvRMAGICAL(hv)) {
  95         if (mg_find((SV*)hv,'P')) {
  96             dTHR;
  97             sv = sv_newmortal();
  98             mg_copy((SV*)hv, sv, key, klen);
  99             Sv = sv;
 100             return &Sv;
 101         }
 102 #ifdef ENV_IS_CASELESS
 103         else if (mg_find((SV*)hv,'E')) {
 104             U32 i;
 105             for (i = 0; i < klen; ++i)
 106                 if (isLOWER(key[i])) {
 107                     char *nkey = strupr(SvPVX(sv_2mortal(newSVpv(key,klen))));
 108                     SV **ret = hv_fetch(hv, nkey, klen, 0);
 109                     if (!ret && lval)
 110                         ret = hv_store(hv, key, klen, NEWSV(61,0), 0);
 111                     return ret;
 112                 }
 113         }
 114 #endif
 115     }
 116
 117     xhv = (XPVHV*)SvANY(hv);
 118     if (!xhv->xhv_array) {
 119         if (lval
 120 #ifdef DYNAMIC_ENV_FETCH  /* if it's an %ENV lookup, we may get it on the fly */
 121                  || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
 122 #endif
 123                                                                   )
 124             Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
 125         else
 126             return 0;
 127     }
 128
 129     PERL_HASH(hash, key, klen);
 130
 131     entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 132     for (; entry; entry = HeNEXT(entry)) {
 133         if (HeHASH(entry) != hash)              /* strings can't be equal */
 134             continue;
 135         if (HeKLEN(entry) != klen)
 136             continue;
 137         if (memNE(HeKEY(entry),key,klen))       /* is this it? */
 138             continue;
 139         return &HeVAL(entry);
 140     }
 141 #ifdef DYNAMIC_ENV_FETCH  /* %ENV lookup?  If so, try to fetch the value now */
 142     if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
 143       char *gotenv;
 144
 145       if ((gotenv = ENV_getenv(key)) != Nullch) {
 146         sv = newSVpv(gotenv,strlen(gotenv));
 147         SvTAINTED_on(sv);
 148         return hv_store(hv,key,klen,sv,hash);
 149       }
 150     }
 151 #endif
 152     if (lval) {         /* gonna assign to this, so it better be there */
 153         sv = NEWSV(61,0);
 154         return hv_store(hv,key,klen,sv,hash);
 155     }
 156     return 0;
 157 }
 158
 159 /* returns a HE * structure with the all fields set */
 160 /* note that hent_val will be a mortal sv for MAGICAL hashes */
 161 HE *
 162 hv_fetch_ent(HV *hv, SV *keysv, I32 lval, register U32 hash)
 163 {
 164     register XPVHV* xhv;
 165     register char *key;
 166     STRLEN klen;
 167     register HE *entry;
 168     SV *sv;
 169
 170     if (!hv)
 171         return 0;
 172
 173     if (SvRMAGICAL(hv)) {
 174         if (mg_find((SV*)hv,'P')) {
 175             static HE mh;
 176
 177             sv = sv_newmortal();
 178             keysv = sv_2mortal(newSVsv(keysv));
 179             mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
 180             if (!HeKEY_hek(&mh)) {
 181                 char *k;
 182                 New(54, k, HEK_BASESIZE + sizeof(SV*), char);
 183                 HeKEY_hek(&mh) = (HEK*)k;
 184             }
 185             HeSVKEY_set(&mh, keysv);
 186             HeVAL(&mh) = sv;
 187             return &mh;
 188         }
 189 #ifdef ENV_IS_CASELESS
 190         else if (mg_find((SV*)hv,'E')) {
 191             U32 i;
 192             key = SvPV(keysv, klen);
 193             for (i = 0; i < klen; ++i)
 194                 if (isLOWER(key[i])) {
 195                     SV *nkeysv = sv_2mortal(newSVpv(key,klen));
 196                     (void)strupr(SvPVX(nkeysv));
 197                     entry = hv_fetch_ent(hv, nkeysv, 0, 0);
 198                     if (!entry && lval)
 199                         entry = hv_store_ent(hv, keysv, NEWSV(61,0), hash);
 200                     return entry;
 201                 }
 202         }
 203 #endif
 204     }
 205
 206     xhv = (XPVHV*)SvANY(hv);
 207     if (!xhv->xhv_array) {
 208         if (lval
 209 #ifdef DYNAMIC_ENV_FETCH  /* if it's an %ENV lookup, we may get it on the fly */
 210                  || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
 211 #endif
 212                                                                   )
 213             Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
 214         else
 215             return 0;
 216     }
 217
 218     key = SvPV(keysv, klen);
 219
 220     if (!hash)
 221         PERL_HASH(hash, key, klen);
 222
 223     entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 224     for (; entry; entry = HeNEXT(entry)) {
 225         if (HeHASH(entry) != hash)              /* strings can't be equal */
 226             continue;
 227         if (HeKLEN(entry) != klen)
 228             continue;
 229         if (memNE(HeKEY(entry),key,klen))       /* is this it? */
 230             continue;
 231         return entry;
 232     }
 233 #ifdef DYNAMIC_ENV_FETCH  /* %ENV lookup?  If so, try to fetch the value now */
 234     if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
 235       char *gotenv;
 236
 237       if ((gotenv = ENV_getenv(key)) != Nullch) {
 238         sv = newSVpv(gotenv,strlen(gotenv));
 239         SvTAINTED_on(sv);
 240         return hv_store_ent(hv,keysv,sv,hash);
 241       }
 242     }
 243 #endif
 244     if (lval) {         /* gonna assign to this, so it better be there */
 245         sv = NEWSV(61,0);
 246         return hv_store_ent(hv,keysv,sv,hash);
 247     }
 248     return 0;
 249 }
 250
 251 static void
 252 hv_magic_check (HV *hv, bool *needs_copy, bool *needs_store)
 253 {
 254     MAGIC *mg = SvMAGIC(hv);
 255     *needs_copy = FALSE;
 256     *needs_store = TRUE;
 257     while (mg) {
 258         if (isUPPER(mg->mg_type)) {
 259             *needs_copy = TRUE;
 260             switch (mg->mg_type) {
 261             case 'P':
 262             case 'S':
 263                 *needs_store = FALSE;
 264             }
 265         }
 266         mg = mg->mg_moremagic;
 267     }
 268 }
 269
 270 SV**
 271 hv_store(HV *hv, char *key, U32 klen, SV *val, register U32 hash)
 272 {
 273     register XPVHV* xhv;
 274     register I32 i;
 275     register HE *entry;
 276     register HE **oentry;
 277
 278     if (!hv)
 279         return 0;
 280
 281     xhv = (XPVHV*)SvANY(hv);
 282     if (SvMAGICAL(hv)) {
 283         bool needs_copy;
 284         bool needs_store;
 285         hv_magic_check (hv, &needs_copy, &needs_store);
 286         if (needs_copy) {
 287             mg_copy((SV*)hv, val, key, klen);
 288             if (!xhv->xhv_array && !needs_store)
 289                 return 0;
 290 #ifdef ENV_IS_CASELESS
 291             else if (mg_find((SV*)hv,'E')) {
 292                 SV *sv = sv_2mortal(newSVpv(key,klen));
 293                 key = strupr(SvPVX(sv));
 294                 hash = 0;
 295             }
 296 #endif
 297         }
 298     }
 299     if (!hash)
 300         PERL_HASH(hash, key, klen);
 301
 302     if (!xhv->xhv_array)
 303         Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char);
 304
 305     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 306     i = 1;
 307
 308     for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
 309         if (HeHASH(entry) != hash)              /* strings can't be equal */
 310             continue;
 311         if (HeKLEN(entry) != klen)
 312             continue;
 313         if (memNE(HeKEY(entry),key,klen))       /* is this it? */
 314             continue;
 315         SvREFCNT_dec(HeVAL(entry));
 316         HeVAL(entry) = val;
 317         return &HeVAL(entry);
 318     }
 319
 320     entry = new_he();
 321     if (HvSHAREKEYS(hv))
 322         HeKEY_hek(entry) = share_hek(key, klen, hash);
 323     else                                       /* gotta do the real thing */
 324         HeKEY_hek(entry) = save_hek(key, klen, hash);
 325     HeVAL(entry) = val;
 326     HeNEXT(entry) = *oentry;
 327     *oentry = entry;
 328
 329     xhv->xhv_keys++;
 330     if (i) {                            /* initial entry? */
 331         ++xhv->xhv_fill;
 332         if (xhv->xhv_keys > xhv->xhv_max)
 333             hsplit(hv);
 334     }
 335
 336     return &HeVAL(entry);
 337 }
 338
 339 HE *
 340 hv_store_ent(HV *hv, SV *keysv, SV *val, register U32 hash)
 341 {
 342     register XPVHV* xhv;
 343     register char *key;
 344     STRLEN klen;
 345     register I32 i;
 346     register HE *entry;
 347     register HE **oentry;
 348
 349     if (!hv)
 350         return 0;
 351
 352     xhv = (XPVHV*)SvANY(hv);
 353     if (SvMAGICAL(hv)) {
 354         dTHR;
 355         bool needs_copy;
 356         bool needs_store;
 357         hv_magic_check (hv, &needs_copy, &needs_store);
 358         if (needs_copy) {
 359             bool save_taint = tainted;
 360             if (tainting)
 361                 tainted = SvTAINTED(keysv);
 362             keysv = sv_2mortal(newSVsv(keysv));
 363             mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
 364             TAINT_IF(save_taint);
 365             if (!xhv->xhv_array && !needs_store)
 366                 return Nullhe;
 367 #ifdef ENV_IS_CASELESS
 368             else if (mg_find((SV*)hv,'E')) {
 369                 key = SvPV(keysv, klen);
 370                 keysv = sv_2mortal(newSVpv(key,klen));
 371                 (void)strupr(SvPVX(keysv));
 372                 hash = 0;
 373             }
 374 #endif
 375         }
 376     }
 377
 378     key = SvPV(keysv, klen);
 379
 380     if (!hash)
 381         PERL_HASH(hash, key, klen);
 382
 383     if (!xhv->xhv_array)
 384         Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char);
 385
 386     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 387     i = 1;
 388
 389     for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
 390         if (HeHASH(entry) != hash)              /* strings can't be equal */
 391             continue;
 392         if (HeKLEN(entry) != klen)
 393             continue;
 394         if (memNE(HeKEY(entry),key,klen))       /* is this it? */
 395             continue;
 396         SvREFCNT_dec(HeVAL(entry));
 397         HeVAL(entry) = val;
 398         return entry;
 399     }
 400
 401     entry = new_he();
 402     if (HvSHAREKEYS(hv))
 403         HeKEY_hek(entry) = share_hek(key, klen, hash);
 404     else                                       /* gotta do the real thing */
 405         HeKEY_hek(entry) = save_hek(key, klen, hash);
 406     HeVAL(entry) = val;
 407     HeNEXT(entry) = *oentry;
 408     *oentry = entry;
 409
 410     xhv->xhv_keys++;
 411     if (i) {                            /* initial entry? */
 412         ++xhv->xhv_fill;
 413         if (xhv->xhv_keys > xhv->xhv_max)
 414             hsplit(hv);
 415     }
 416
 417     return entry;
 418 }
 419
 420 SV *
 421 hv_delete(HV *hv, char *key, U32 klen, I32 flags)
 422 {
 423     register XPVHV* xhv;
 424     register I32 i;
 425     register U32 hash;
 426     register HE *entry;
 427     register HE **oentry;
 428     SV **svp;
 429     SV *sv;
 430
 431     if (!hv)
 432         return Nullsv;
 433     if (SvRMAGICAL(hv)) {
 434         bool needs_copy;
 435         bool needs_store;
 436         hv_magic_check (hv, &needs_copy, &needs_store);
 437
 438         if (needs_copy && (svp = hv_fetch(hv, key, klen, TRUE))) {
 439             sv = *svp;
 440             mg_clear(sv);
 441             if (!needs_store) {
 442                 if (mg_find(sv, 'p')) {
 443                     sv_unmagic(sv, 'p');        /* No longer an element */
 444                     return sv;
 445                 }
 446                 return Nullsv;          /* element cannot be deleted */
 447             }
 448 #ifdef ENV_IS_CASELESS
 449             else if (mg_find((SV*)hv,'E')) {
 450                 sv = sv_2mortal(newSVpv(key,klen));
 451                 key = strupr(SvPVX(sv));
 452             }
 453 #endif
 454         }
 455     }
 456     xhv = (XPVHV*)SvANY(hv);
 457     if (!xhv->xhv_array)
 458         return Nullsv;
 459
 460     PERL_HASH(hash, key, klen);
 461
 462     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 463     entry = *oentry;
 464     i = 1;
 465     for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
 466         if (HeHASH(entry) != hash)              /* strings can't be equal */
 467             continue;
 468         if (HeKLEN(entry) != klen)
 469             continue;
 470         if (memNE(HeKEY(entry),key,klen))       /* is this it? */
 471             continue;
 472         *oentry = HeNEXT(entry);
 473         if (i && !*oentry)
 474             xhv->xhv_fill--;
 475         if (flags & G_DISCARD)
 476             sv = Nullsv;
 477         else
 478             sv = sv_mortalcopy(HeVAL(entry));
 479         if (entry == xhv->xhv_eiter)
 480             HvLAZYDEL_on(hv);
 481         else
 482             hv_free_ent(hv, entry);
 483         --xhv->xhv_keys;
 484         return sv;
 485     }
 486     return Nullsv;
 487 }
 488
 489 SV *
 490 hv_delete_ent(HV *hv, SV *keysv, I32 flags, U32 hash)
 491 {
 492     register XPVHV* xhv;
 493     register I32 i;
 494     register char *key;
 495     STRLEN klen;
 496     register HE *entry;
 497     register HE **oentry;
 498     SV *sv;
 499
 500     if (!hv)
 501         return Nullsv;
 502     if (SvRMAGICAL(hv)) {
 503         bool needs_copy;
 504         bool needs_store;
 505         hv_magic_check (hv, &needs_copy, &needs_store);
 506
 507         if (needs_copy && (entry = hv_fetch_ent(hv, keysv, TRUE, hash))) {
 508             sv = HeVAL(entry);
 509             mg_clear(sv);
 510             if (!needs_store) {
 511                 if (mg_find(sv, 'p')) {
 512                     sv_unmagic(sv, 'p');        /* No longer an element */
 513                     return sv;
 514                 }
 515                 return Nullsv;          /* element cannot be deleted */
 516             }
 517 #ifdef ENV_IS_CASELESS
 518             else if (mg_find((SV*)hv,'E')) {
 519                 key = SvPV(keysv, klen);
 520                 keysv = sv_2mortal(newSVpv(key,klen));
 521                 (void)strupr(SvPVX(keysv));
 522                 hash = 0;
 523             }
 524 #endif
 525         }
 526     }
 527     xhv = (XPVHV*)SvANY(hv);
 528     if (!xhv->xhv_array)
 529         return Nullsv;
 530
 531     key = SvPV(keysv, klen);
 532
 533     if (!hash)
 534         PERL_HASH(hash, key, klen);
 535
 536     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 537     entry = *oentry;
 538     i = 1;
 539     for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
 540         if (HeHASH(entry) != hash)              /* strings can't be equal */
 541             continue;
 542         if (HeKLEN(entry) != klen)
 543             continue;
 544         if (memNE(HeKEY(entry),key,klen))       /* is this it? */
 545             continue;
 546         *oentry = HeNEXT(entry);
 547         if (i && !*oentry)
 548             xhv->xhv_fill--;
 549         if (flags & G_DISCARD)
 550             sv = Nullsv;
 551         else
 552             sv = sv_mortalcopy(HeVAL(entry));
 553         if (entry == xhv->xhv_eiter)
 554             HvLAZYDEL_on(hv);
 555         else
 556             hv_free_ent(hv, entry);
 557         --xhv->xhv_keys;
 558         return sv;
 559     }
 560     return Nullsv;
 561 }
 562
 563 bool
 564 hv_exists(HV *hv, char *key, U32 klen)
 565 {
 566     register XPVHV* xhv;
 567     register U32 hash;
 568     register HE *entry;
 569     SV *sv;
 570
 571     if (!hv)
 572         return 0;
 573
 574     if (SvRMAGICAL(hv)) {
 575         if (mg_find((SV*)hv,'P')) {
 576             dTHR;
 577             sv = sv_newmortal();
 578             mg_copy((SV*)hv, sv, key, klen);
 579             magic_existspack(sv, mg_find(sv, 'p'));
 580             return SvTRUE(sv);
 581         }
 582 #ifdef ENV_IS_CASELESS
 583         else if (mg_find((SV*)hv,'E')) {
 584             sv = sv_2mortal(newSVpv(key,klen));
 585             key = strupr(SvPVX(sv));
 586         }
 587 #endif
 588     }
 589
 590     xhv = (XPVHV*)SvANY(hv);
 591     if (!xhv->xhv_array)
 592         return 0;
 593
 594     PERL_HASH(hash, key, klen);
 595
 596     entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 597     for (; entry; entry = HeNEXT(entry)) {
 598         if (HeHASH(entry) != hash)              /* strings can't be equal */
 599             continue;
 600         if (HeKLEN(entry) != klen)
 601             continue;
 602         if (memNE(HeKEY(entry),key,klen))       /* is this it? */
 603             continue;
 604         return TRUE;
 605     }
 606     return FALSE;
 607 }
 608
 609
 610 bool
 611 hv_exists_ent(HV *hv, SV *keysv, U32 hash)
 612 {
 613     register XPVHV* xhv;
 614     register char *key;
 615     STRLEN klen;
 616     register HE *entry;
 617     SV *sv;
 618
 619     if (!hv)
 620         return 0;
 621
 622     if (SvRMAGICAL(hv)) {
 623         if (mg_find((SV*)hv,'P')) {
 624             dTHR;               /* just for SvTRUE */
 625             sv = sv_newmortal();
 626             keysv = sv_2mortal(newSVsv(keysv));
 627             mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
 628             magic_existspack(sv, mg_find(sv, 'p'));
 629             return SvTRUE(sv);
 630         }
 631 #ifdef ENV_IS_CASELESS
 632         else if (mg_find((SV*)hv,'E')) {
 633             key = SvPV(keysv, klen);
 634             keysv = sv_2mortal(newSVpv(key,klen));
 635             (void)strupr(SvPVX(keysv));
 636             hash = 0;
 637         }
 638 #endif
 639     }
 640
 641     xhv = (XPVHV*)SvANY(hv);
 642     if (!xhv->xhv_array)
 643         return 0;
 644
 645     key = SvPV(keysv, klen);
 646     if (!hash)
 647         PERL_HASH(hash, key, klen);
 648
 649     entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 650     for (; entry; entry = HeNEXT(entry)) {
 651         if (HeHASH(entry) != hash)              /* strings can't be equal */
 652             continue;
 653         if (HeKLEN(entry) != klen)
 654             continue;
 655         if (memNE(HeKEY(entry),key,klen))       /* is this it? */
 656             continue;
 657         return TRUE;
 658     }
 659     return FALSE;
 660 }
 661
 662 STATIC void
 663 hsplit(HV *hv)
 664 {
 665     register XPVHV* xhv = (XPVHV*)SvANY(hv);
 666     I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
 667     register I32 newsize = oldsize * 2;
 668     register I32 i;
 669     register HE **a;
 670     register HE **b;
 671     register HE *entry;
 672     register HE **oentry;
 673 #ifndef STRANGE_MALLOC
 674     I32 tmp;
 675 #endif
 676
 677     a = (HE**)xhv->xhv_array;
 678     nomemok = TRUE;
 679 #ifdef STRANGE_MALLOC
 680     Renew(a, newsize, HE*);
 681     if (!a) {
 682       nomemok = FALSE;
 683       return;
 684     }
 685 #else
 686     i = newsize * sizeof(HE*);
 687 #define MALLOC_OVERHEAD 16
 688     tmp = MALLOC_OVERHEAD;
 689     while (tmp - MALLOC_OVERHEAD < i)
 690         tmp += tmp;
 691     tmp -= MALLOC_OVERHEAD;
 692     tmp /= sizeof(HE*);
 693     assert(tmp >= newsize);
 694     New(2,a, tmp, HE*);
 695     if (!a) {
 696       nomemok = FALSE;
 697       return;
 698     }
 699     Copy(xhv->xhv_array, a, oldsize, HE*);
 700     if (oldsize >= 64) {
 701         offer_nice_chunk(xhv->xhv_array,
 702                          oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD);
 703     }
 704     else
 705         Safefree(xhv->xhv_array);
 706 #endif
 707
 708     nomemok = FALSE;
 709     Zero(&a[oldsize], oldsize, HE*);            /* zero 2nd half*/
 710     xhv->xhv_max = --newsize;
 711     xhv->xhv_array = (char*)a;
 712
 713     for (i=0; i<oldsize; i++,a++) {
 714         if (!*a)                                /* non-existent */
 715             continue;
 716         b = a+oldsize;
 717         for (oentry = a, entry = *a; entry; entry = *oentry) {
 718             if ((HeHASH(entry) & newsize) != i) {
 719                 *oentry = HeNEXT(entry);
 720                 HeNEXT(entry) = *b;
 721                 if (!*b)
 722                     xhv->xhv_fill++;
 723                 *b = entry;
 724                 continue;
 725             }
 726             else
 727                 oentry = &HeNEXT(entry);
 728         }
 729         if (!*a)                                /* everything moved */
 730             xhv->xhv_fill--;
 731     }
 732 }
 733
 734 void
 735 hv_ksplit(HV *hv, IV newmax)
 736 {
 737     register XPVHV* xhv = (XPVHV*)SvANY(hv);
 738     I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
 739     register I32 newsize;
 740     register I32 i;
 741     register I32 j;
 742     register HE **a;
 743     register HE *entry;
 744     register HE **oentry;
 745
 746     newsize = (I32) newmax;                     /* possible truncation here */
 747     if (newsize != newmax || newmax <= oldsize)
 748         return;
 749     while ((newsize & (1 + ~newsize)) != newsize) {
 750         newsize &= ~(newsize & (1 + ~newsize)); /* get proper power of 2 */
 751     }
 752     if (newsize < newmax)
 753         newsize *= 2;
 754     if (newsize < newmax)
 755         return;                                 /* overflow detection */
 756
 757     a = (HE**)xhv->xhv_array;
 758     if (a) {
 759         nomemok = TRUE;
 760 #ifdef STRANGE_MALLOC
 761         Renew(a, newsize, HE*);
 762         if (!a) {
 763           nomemok = FALSE;
 764           return;
 765         }
 766 #else
 767         i = newsize * sizeof(HE*);
 768         j = MALLOC_OVERHEAD;
 769         while (j - MALLOC_OVERHEAD < i)
 770             j += j;
 771         j -= MALLOC_OVERHEAD;
 772         j /= sizeof(HE*);
 773         assert(j >= newsize);
 774         New(2, a, j, HE*);
 775         if (!a) {
 776           nomemok = FALSE;
 777           return;
 778         }
 779         Copy(xhv->xhv_array, a, oldsize, HE*);
 780         if (oldsize >= 64) {
 781             offer_nice_chunk(xhv->xhv_array,
 782                              oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD);
 783         }
 784         else
 785             Safefree(xhv->xhv_array);
 786 #endif
 787         nomemok = FALSE;
 788         Zero(&a[oldsize], newsize-oldsize, HE*); /* zero 2nd half*/
 789     }
 790     else {
 791         Newz(0, a, newsize, HE*);
 792     }
 793     xhv->xhv_max = --newsize;
 794     xhv->xhv_array = (char*)a;
 795     if (!xhv->xhv_fill)                         /* skip rest if no entries */
 796         return;
 797
 798     for (i=0; i<oldsize; i++,a++) {
 799         if (!*a)                                /* non-existent */
 800             continue;
 801         for (oentry = a, entry = *a; entry; entry = *oentry) {
 802             if ((j = (HeHASH(entry) & newsize)) != i) {
 803                 j -= i;
 804                 *oentry = HeNEXT(entry);
 805                 if (!(HeNEXT(entry) = a[j]))
 806                     xhv->xhv_fill++;
 807                 a[j] = entry;
 808                 continue;
 809             }
 810             else
 811                 oentry = &HeNEXT(entry);
 812         }
 813         if (!*a)                                /* everything moved */
 814             xhv->xhv_fill--;
 815     }
 816 }
 817
 818 HV *
 819 newHV(void)
 820 {
 821     register HV *hv;
 822     register XPVHV* xhv;
 823
 824     hv = (HV*)NEWSV(502,0);
 825     sv_upgrade((SV *)hv, SVt_PVHV);
 826     xhv = (XPVHV*)SvANY(hv);
 827     SvPOK_off(hv);
 828     SvNOK_off(hv);
 829 #ifndef NODEFAULT_SHAREKEYS
 830     HvSHAREKEYS_on(hv);         /* key-sharing on by default */
 831 #endif
 832     xhv->xhv_max = 7;           /* start with 8 buckets */
 833     xhv->xhv_fill = 0;
 834     xhv->xhv_pmroot = 0;
 835     (void)hv_iterinit(hv);      /* so each() will start off right */
 836     return hv;
 837 }
 838
 839 void
 840 hv_free_ent(HV *hv, register HE *entry)
 841 {
 842     if (!entry)
 843         return;
 844     if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv))
 845         sub_generation++;       /* may be deletion of method from stash */
 846     SvREFCNT_dec(HeVAL(entry));
 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_fill;       /* should be xhv->xhv_keys? May change later */
 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