hv.c

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