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 = (HE*)he->hent_next;
  29         return he;
  30     }
  31     return more_he();
  32 }
  33
  34 static void
  35 del_he(p)
  36 HE* p;
  37 {
  38     p->hent_next = (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         he->hent_next = (HE*)(he + 1);
  52         he++;
  53     }
  54     he->hent_next = 0;
  55     return new_he();
  56 }
  57
  58 SV**
  59 hv_fetch(hv,key,klen,lval)
  60 HV *hv;
  61 char *key;
  62 U32 klen;
  63 I32 lval;
  64 {
  65     register XPVHV* xhv;
  66     register char *s;
  67     register I32 i;
  68     register I32 hash;
  69     register HE *entry;
  70     SV *sv;
  71
  72     if (!hv)
  73         return 0;
  74
  75     if (SvRMAGICAL(hv)) {
  76         if (mg_find((SV*)hv,'P')) {
  77             sv = sv_newmortal();
  78             mg_copy((SV*)hv, sv, key, klen);
  79             Sv = sv;
  80             return &Sv;
  81         }
  82     }
  83
  84     xhv = (XPVHV*)SvANY(hv);
  85     if (!xhv->xhv_array) {
  86         if (lval
  87 #ifdef DYNAMIC_ENV_FETCH  /* if it's an %ENV lookup, we may get it on the fly */
  88                  || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
  89 #endif
  90                                                                   )
  91             Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
  92         else
  93             return 0;
  94     }
  95
  96     i = klen;
  97     hash = 0;
  98     s = key;
  99     while (i--)
 100         hash = hash * 33 + *s++;
 101
 102     entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 103     for (; entry; entry = entry->hent_next) {
 104         if (entry->hent_hash != hash)           /* strings can't be equal */
 105             continue;
 106         if (entry->hent_klen != klen)
 107             continue;
 108         if (bcmp(entry->hent_key,key,klen))     /* is this it? */
 109             continue;
 110         return &entry->hent_val;
 111     }
 112 #ifdef DYNAMIC_ENV_FETCH  /* %ENV lookup?  If so, try to fetch the value now */
 113     if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
 114       char *gotenv;
 115
 116       gotenv = my_getenv(key);
 117       if (gotenv != NULL) {
 118         sv = newSVpv(gotenv,strlen(gotenv));
 119         return hv_store(hv,key,klen,sv,hash);
 120       }
 121     }
 122 #endif
 123     if (lval) {         /* gonna assign to this, so it better be there */
 124         sv = NEWSV(61,0);
 125         return hv_store(hv,key,klen,sv,hash);
 126     }
 127     return 0;
 128 }
 129
 130 SV**
 131 hv_store(hv,key,klen,val,hash)
 132 HV *hv;
 133 char *key;
 134 U32 klen;
 135 SV *val;
 136 register U32 hash;
 137 {
 138     register XPVHV* xhv;
 139     register char *s;
 140     register I32 i;
 141     register HE *entry;
 142     register HE **oentry;
 143
 144     if (!hv)
 145         return 0;
 146
 147     xhv = (XPVHV*)SvANY(hv);
 148     if (SvMAGICAL(hv)) {
 149         mg_copy((SV*)hv, val, key, klen);
 150 #ifndef OVERLOAD
 151         if (!xhv->xhv_array)
 152             return 0;
 153 #else
 154         if (!xhv->xhv_array && (SvMAGIC(hv)->mg_type != 'A'
 155                                 || SvMAGIC(hv)->mg_moremagic))
 156           return 0;
 157 #endif /* OVERLOAD */
 158     }
 159     if (!hash) {
 160     i = klen;
 161     s = key;
 162     while (i--)
 163         hash = hash * 33 + *s++;
 164     }
 165
 166     if (!xhv->xhv_array)
 167         Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char);
 168
 169     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 170     i = 1;
 171
 172     for (entry = *oentry; entry; i=0, entry = entry->hent_next) {
 173         if (entry->hent_hash != hash)           /* strings can't be equal */
 174             continue;
 175         if (entry->hent_klen != klen)
 176             continue;
 177         if (bcmp(entry->hent_key,key,klen))     /* is this it? */
 178             continue;
 179         SvREFCNT_dec(entry->hent_val);
 180         entry->hent_val = val;
 181         return &entry->hent_val;
 182     }
 183
 184     entry = new_he();
 185     entry->hent_klen = klen;
 186     entry->hent_key = savepvn(key,klen);
 187     entry->hent_val = val;
 188     entry->hent_hash = hash;
 189     entry->hent_next = *oentry;
 190     *oentry = entry;
 191
 192     xhv->xhv_keys++;
 193     if (i) {                            /* initial entry? */
 194         ++xhv->xhv_fill;
 195         if (xhv->xhv_keys > xhv->xhv_max)
 196             hsplit(hv);
 197     }
 198
 199     return &entry->hent_val;
 200 }
 201
 202 SV *
 203 hv_delete(hv,key,klen,flags)
 204 HV *hv;
 205 char *key;
 206 U32 klen;
 207 I32 flags;
 208 {
 209     register XPVHV* xhv;
 210     register char *s;
 211     register I32 i;
 212     register I32 hash;
 213     register HE *entry;
 214     register HE **oentry;
 215     SV *sv;
 216
 217     if (!hv)
 218         return Nullsv;
 219     if (SvRMAGICAL(hv)) {
 220         sv = *hv_fetch(hv, key, klen, TRUE);
 221         mg_clear(sv);
 222         if (mg_find(sv, 'p')) {
 223             sv_unmagic(sv, 'p');        /* No longer an element */
 224             return sv;
 225         }
 226     }
 227     xhv = (XPVHV*)SvANY(hv);
 228     if (!xhv->xhv_array)
 229         return Nullsv;
 230     i = klen;
 231     hash = 0;
 232     s = key;
 233     while (i--)
 234         hash = hash * 33 + *s++;
 235
 236     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 237     entry = *oentry;
 238     i = 1;
 239     for (; entry; i=0, oentry = &entry->hent_next, entry = *oentry) {
 240         if (entry->hent_hash != hash)           /* strings can't be equal */
 241             continue;
 242         if (entry->hent_klen != klen)
 243             continue;
 244         if (bcmp(entry->hent_key,key,klen))     /* is this it? */
 245             continue;
 246         *oentry = entry->hent_next;
 247         if (i && !*oentry)
 248             xhv->xhv_fill--;
 249         if (flags & G_DISCARD)
 250             sv = Nullsv;
 251         else
 252             sv = sv_mortalcopy(entry->hent_val);
 253         if (entry == xhv->xhv_eiter)
 254             entry->hent_klen = -1;
 255         else
 256             he_free(entry);
 257         --xhv->xhv_keys;
 258         return sv;
 259     }
 260     return Nullsv;
 261 }
 262
 263 bool
 264 hv_exists(hv,key,klen)
 265 HV *hv;
 266 char *key;
 267 U32 klen;
 268 {
 269     register XPVHV* xhv;
 270     register char *s;
 271     register I32 i;
 272     register I32 hash;
 273     register HE *entry;
 274     SV *sv;
 275
 276     if (!hv)
 277         return 0;
 278
 279     if (SvRMAGICAL(hv)) {
 280         if (mg_find((SV*)hv,'P')) {
 281             sv = sv_newmortal();
 282             mg_copy((SV*)hv, sv, key, klen);
 283             magic_existspack(sv, mg_find(sv, 'p'));
 284             return SvTRUE(sv);
 285         }
 286     }
 287
 288     xhv = (XPVHV*)SvANY(hv);
 289     if (!xhv->xhv_array)
 290         return 0;
 291
 292     i = klen;
 293     hash = 0;
 294     s = key;
 295     while (i--)
 296         hash = hash * 33 + *s++;
 297
 298     entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 299     for (; entry; entry = entry->hent_next) {
 300         if (entry->hent_hash != hash)           /* strings can't be equal */
 301             continue;
 302         if (entry->hent_klen != klen)
 303             continue;
 304         if (bcmp(entry->hent_key,key,klen))     /* is this it? */
 305             continue;
 306         return TRUE;
 307     }
 308     return FALSE;
 309 }
 310
 311 static void
 312 hsplit(hv)
 313 HV *hv;
 314 {
 315     register XPVHV* xhv = (XPVHV*)SvANY(hv);
 316     I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
 317     register I32 newsize = oldsize * 2;
 318     register I32 i;
 319     register HE **a;
 320     register HE **b;
 321     register HE *entry;
 322     register HE **oentry;
 323 #ifndef STRANGE_MALLOC
 324     I32 tmp;
 325 #endif
 326
 327     a = (HE**)xhv->xhv_array;
 328     nomemok = TRUE;
 329 #ifdef STRANGE_MALLOC
 330     Renew(a, newsize, HE*);
 331 #else
 332     i = newsize * sizeof(HE*);
 333 #define MALLOC_OVERHEAD 16
 334     tmp = MALLOC_OVERHEAD;
 335     while (tmp - MALLOC_OVERHEAD < i)
 336         tmp += tmp;
 337     tmp -= MALLOC_OVERHEAD;
 338     tmp /= sizeof(HE*);
 339     assert(tmp >= newsize);
 340     New(2,a, tmp, HE*);
 341     Copy(xhv->xhv_array, a, oldsize, HE*);
 342     if (oldsize >= 64 && !nice_chunk) {
 343         nice_chunk = (char*)xhv->xhv_array;
 344         nice_chunk_size = oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD;
 345     }
 346     else
 347         Safefree(xhv->xhv_array);
 348 #endif
 349
 350     nomemok = FALSE;
 351     Zero(&a[oldsize], oldsize, HE*);            /* zero 2nd half*/
 352     xhv->xhv_max = --newsize;
 353     xhv->xhv_array = (char*)a;
 354
 355     for (i=0; i<oldsize; i++,a++) {
 356         if (!*a)                                /* non-existent */
 357             continue;
 358         b = a+oldsize;
 359         for (oentry = a, entry = *a; entry; entry = *oentry) {
 360             if ((entry->hent_hash & newsize) != i) {
 361                 *oentry = entry->hent_next;
 362                 entry->hent_next = *b;
 363                 if (!*b)
 364                     xhv->xhv_fill++;
 365                 *b = entry;
 366                 continue;
 367             }
 368             else
 369                 oentry = &entry->hent_next;
 370         }
 371         if (!*a)                                /* everything moved */
 372             xhv->xhv_fill--;
 373     }
 374 }
 375
 376 HV *
 377 newHV()
 378 {
 379     register HV *hv;
 380     register XPVHV* xhv;
 381
 382     hv = (HV*)NEWSV(502,0);
 383     sv_upgrade((SV *)hv, SVt_PVHV);
 384     xhv = (XPVHV*)SvANY(hv);
 385     SvPOK_off(hv);
 386     SvNOK_off(hv);
 387     xhv->xhv_max = 7;           /* start with 8 buckets */
 388     xhv->xhv_fill = 0;
 389     xhv->xhv_pmroot = 0;
 390     (void)hv_iterinit(hv);      /* so each() will start off right */
 391     return hv;
 392 }
 393
 394 void
 395 he_free(hent)
 396 register HE *hent;
 397 {
 398     if (!hent)
 399         return;
 400     SvREFCNT_dec(hent->hent_val);
 401     Safefree(hent->hent_key);
 402     del_he(hent);
 403 }
 404
 405 void
 406 he_delayfree(hent)
 407 register HE *hent;
 408 {
 409     if (!hent)
 410         return;
 411     sv_2mortal(hent->hent_val); /* free between statements */
 412     Safefree(hent->hent_key);
 413     del_he(hent);
 414 }
 415
 416 void
 417 hv_clear(hv)
 418 HV *hv;
 419 {
 420     register XPVHV* xhv;
 421     if (!hv)
 422         return;
 423     xhv = (XPVHV*)SvANY(hv);
 424     hfreeentries(hv);
 425     xhv->xhv_fill = 0;
 426     xhv->xhv_keys = 0;
 427     if (xhv->xhv_array)
 428         (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*));
 429
 430     if (SvRMAGICAL(hv))
 431         mg_clear((SV*)hv);
 432 }
 433
 434 static void
 435 hfreeentries(hv)
 436 HV *hv;
 437 {
 438     register HE **array;
 439     register HE *hent;
 440     register HE *ohent = Null(HE*);
 441     I32 riter;
 442     I32 max;
 443
 444     if (!hv)
 445         return;
 446     if (!HvARRAY(hv))
 447         return;
 448
 449     riter = 0;
 450     max = HvMAX(hv);
 451     array = HvARRAY(hv);
 452     hent = array[0];
 453     for (;;) {
 454         if (hent) {
 455             ohent = hent;
 456             hent = hent->hent_next;
 457             he_free(ohent);
 458         }
 459         if (!hent) {
 460             if (++riter > max)
 461                 break;
 462             hent = array[riter];
 463         }
 464     }
 465     (void)hv_iterinit(hv);
 466 }
 467
 468 void
 469 hv_undef(hv)
 470 HV *hv;
 471 {
 472     register XPVHV* xhv;
 473     if (!hv)
 474         return;
 475     xhv = (XPVHV*)SvANY(hv);
 476     hfreeentries(hv);
 477     Safefree(xhv->xhv_array);
 478     if (HvNAME(hv)) {
 479         Safefree(HvNAME(hv));
 480         HvNAME(hv) = 0;
 481     }
 482     xhv->xhv_array = 0;
 483     xhv->xhv_max = 7;           /* it's a normal associative array */
 484     xhv->xhv_fill = 0;
 485     xhv->xhv_keys = 0;
 486
 487     if (SvRMAGICAL(hv))
 488         mg_clear((SV*)hv);
 489 }
 490
 491 I32
 492 hv_iterinit(hv)
 493 HV *hv;
 494 {
 495     register XPVHV* xhv = (XPVHV*)SvANY(hv);
 496     HE *entry = xhv->xhv_eiter;
 497     if (entry && entry->hent_klen < 0)  /* was deleted earlier? */
 498         he_free(entry);
 499     xhv->xhv_riter = -1;
 500     xhv->xhv_eiter = Null(HE*);
 501     return xhv->xhv_fill;
 502 }
 503
 504 HE *
 505 hv_iternext(hv)
 506 HV *hv;
 507 {
 508     register XPVHV* xhv;
 509     register HE *entry;
 510     HE *oldentry;
 511     MAGIC* mg;
 512
 513     if (!hv)
 514         croak("Bad associative array");
 515     xhv = (XPVHV*)SvANY(hv);
 516     oldentry = entry = xhv->xhv_eiter;
 517
 518     if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) {
 519         SV *key = sv_newmortal();
 520         if (entry) {
 521             sv_usepvn(key, entry->hent_key, entry->hent_klen);
 522             entry->hent_key = 0;
 523         }
 524         else {
 525             xhv->xhv_eiter = entry = new_he();
 526             Zero(entry, 1, HE);
 527         }
 528         magic_nextpack((SV*) hv,mg,key);
 529         if (SvOK(key)) {
 530             STRLEN len;
 531             entry->hent_key = SvPV_force(key, len);
 532             entry->hent_klen = len;
 533             SvPOK_off(key);
 534             SvPVX(key) = 0;
 535             return entry;
 536         }
 537         if (entry->hent_val)
 538             SvREFCNT_dec(entry->hent_val);
 539         del_he(entry);
 540         xhv->xhv_eiter = Null(HE*);
 541         return Null(HE*);
 542     }
 543
 544     if (!xhv->xhv_array)
 545         Newz(506,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
 546     do {
 547         if (entry)
 548             entry = entry->hent_next;
 549         if (!entry) {
 550             ++xhv->xhv_riter;
 551             if (xhv->xhv_riter > xhv->xhv_max) {
 552                 xhv->xhv_riter = -1;
 553                 break;
 554             }
 555             entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
 556         }
 557     } while (!entry);
 558
 559     if (oldentry && oldentry->hent_klen < 0)    /* was deleted earlier? */
 560         he_free(oldentry);
 561
 562     xhv->xhv_eiter = entry;
 563     return entry;
 564 }
 565
 566 char *
 567 hv_iterkey(entry,retlen)
 568 register HE *entry;
 569 I32 *retlen;
 570 {
 571     *retlen = entry->hent_klen;
 572     return entry->hent_key;
 573 }
 574
 575 SV *
 576 hv_iterval(hv,entry)
 577 HV *hv;
 578 register HE *entry;
 579 {
 580     if (SvRMAGICAL(hv)) {
 581         if (mg_find((SV*)hv,'P')) {
 582             SV* sv = sv_newmortal();
 583             mg_copy((SV*)hv, sv, entry->hent_key, entry->hent_klen);
 584             return sv;
 585         }
 586     }
 587     return entry->hent_val;
 588 }
 589
 590 SV *
 591 hv_iternextsv(hv, key, retlen)
 592     HV *hv;
 593     char **key;
 594     I32 *retlen;
 595 {
 596     HE *he;
 597     if ( (he = hv_iternext(hv)) == NULL)
 598         return NULL;
 599     *key = hv_iterkey(he, retlen);
 600     return hv_iterval(hv, he);
 601 }
 602
 603 void
 604 hv_magic(hv, gv, how)
 605 HV* hv;
 606 GV* gv;
 607 int how;
 608 {
 609     sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
 610 }