hv.c

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