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     I32 tmp;
 324
 325     a = (HE**)xhv->xhv_array;
 326     nomemok = TRUE;
 327 #ifdef STRANGE_MALLOC
 328     Renew(a, newsize, HE*);
 329 #else
 330     i = newsize * sizeof(HE*);
 331 #define MALLOC_OVERHEAD 16
 332     tmp = MALLOC_OVERHEAD;
 333     while (tmp - MALLOC_OVERHEAD < i)
 334         tmp += tmp;
 335     tmp -= MALLOC_OVERHEAD;
 336     tmp /= sizeof(HE*);
 337     assert(tmp >= newsize);
 338     New(2,a, tmp, HE*);
 339     Copy(xhv->xhv_array, a, oldsize, HE*);
 340     if (oldsize >= 64 && *(char*)&xhv->xnv_nv == 0) {
 341         sv_add_arena((char*)xhv->xhv_array, oldsize * sizeof(HE*), 0);
 342         sv_add_arena(((char*)a) + newsize * sizeof(HE*),
 343                      newsize * sizeof(HE*) - MALLOC_OVERHEAD,
 344                      SVf_FAKE);
 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     *(char*)&xhv->xnv_nv = 0;
 391     (void)hv_iterinit(hv);      /* so each() will start off right */
 392     return hv;
 393 }
 394
 395 void
 396 he_free(hent)
 397 register HE *hent;
 398 {
 399     if (!hent)
 400         return;
 401     SvREFCNT_dec(hent->hent_val);
 402     Safefree(hent->hent_key);
 403     del_he(hent);
 404 }
 405
 406 void
 407 he_delayfree(hent)
 408 register HE *hent;
 409 {
 410     if (!hent)
 411         return;
 412     sv_2mortal(hent->hent_val); /* free between statements */
 413     Safefree(hent->hent_key);
 414     del_he(hent);
 415 }
 416
 417 void
 418 hv_clear(hv)
 419 HV *hv;
 420 {
 421     register XPVHV* xhv;
 422     if (!hv)
 423         return;
 424     xhv = (XPVHV*)SvANY(hv);
 425     hfreeentries(hv);
 426     xhv->xhv_fill = 0;
 427     xhv->xhv_keys = 0;
 428     if (xhv->xhv_array)
 429         (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*));
 430
 431     if (SvRMAGICAL(hv))
 432         mg_clear((SV*)hv);
 433 }
 434
 435 static void
 436 hfreeentries(hv)
 437 HV *hv;
 438 {
 439     register HE **array;
 440     register HE *hent;
 441     register HE *ohent = Null(HE*);
 442     I32 riter;
 443     I32 max;
 444
 445     if (!hv)
 446         return;
 447     if (!HvARRAY(hv))
 448         return;
 449
 450     riter = 0;
 451     max = HvMAX(hv);
 452     array = HvARRAY(hv);
 453     hent = array[0];
 454     for (;;) {
 455         if (hent) {
 456             ohent = hent;
 457             hent = hent->hent_next;
 458             he_free(ohent);
 459         }
 460         if (!hent) {
 461             if (++riter > max)
 462                 break;
 463             hent = array[riter];
 464         }
 465     }
 466     (void)hv_iterinit(hv);
 467 }
 468
 469 void
 470 hv_undef(hv)
 471 HV *hv;
 472 {
 473     register XPVHV* xhv;
 474     if (!hv)
 475         return;
 476     xhv = (XPVHV*)SvANY(hv);
 477     hfreeentries(hv);
 478 #ifdef STRANGE_MALLOC
 479     Safefree(xhv->xhv_array);
 480 #else
 481     if (xhv->xhv_max < 127 || *(char*)&xhv->xnv_nv)
 482         Safefree(xhv->xhv_array);
 483     else  /* We used last half, so use first half for SV arena too. */
 484         sv_add_arena((char*)xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*),0);
 485 #endif
 486     if (HvNAME(hv)) {
 487         Safefree(HvNAME(hv));
 488         HvNAME(hv) = 0;
 489     }
 490     xhv->xhv_array = 0;
 491     xhv->xhv_max = 7;           /* it's a normal associative array */
 492     xhv->xhv_fill = 0;
 493     xhv->xhv_keys = 0;
 494     *(char*)&xhv->xnv_nv = 1;
 495
 496     if (SvRMAGICAL(hv))
 497         mg_clear((SV*)hv);
 498 }
 499
 500 I32
 501 hv_iterinit(hv)
 502 HV *hv;
 503 {
 504     register XPVHV* xhv = (XPVHV*)SvANY(hv);
 505     HE *entry = xhv->xhv_eiter;
 506     if (entry && entry->hent_klen < 0)  /* was deleted earlier? */
 507         he_free(entry);
 508     xhv->xhv_riter = -1;
 509     xhv->xhv_eiter = Null(HE*);
 510     return xhv->xhv_fill;
 511 }
 512
 513 HE *
 514 hv_iternext(hv)
 515 HV *hv;
 516 {
 517     register XPVHV* xhv;
 518     register HE *entry;
 519     HE *oldentry;
 520     MAGIC* mg;
 521
 522     if (!hv)
 523         croak("Bad associative array");
 524     xhv = (XPVHV*)SvANY(hv);
 525     oldentry = entry = xhv->xhv_eiter;
 526
 527     if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) {
 528         SV *key = sv_newmortal();
 529         if (entry) {
 530             sv_usepvn(key, entry->hent_key, entry->hent_klen);
 531             entry->hent_key = 0;
 532         }
 533         else {
 534             xhv->xhv_eiter = entry = new_he();
 535             Zero(entry, 1, HE);
 536         }
 537         magic_nextpack((SV*) hv,mg,key);
 538         if (SvOK(key)) {
 539             STRLEN len;
 540             entry->hent_key = SvPV_force(key, len);
 541             entry->hent_klen = len;
 542             SvPOK_off(key);
 543             SvPVX(key) = 0;
 544             return entry;
 545         }
 546         if (entry->hent_val)
 547             SvREFCNT_dec(entry->hent_val);
 548         del_he(entry);
 549         xhv->xhv_eiter = Null(HE*);
 550         return Null(HE*);
 551     }
 552
 553     if (!xhv->xhv_array)
 554         Newz(506,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
 555     do {
 556         if (entry)
 557             entry = entry->hent_next;
 558         if (!entry) {
 559             ++xhv->xhv_riter;
 560             if (xhv->xhv_riter > xhv->xhv_max) {
 561                 xhv->xhv_riter = -1;
 562                 break;
 563             }
 564             entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
 565         }
 566     } while (!entry);
 567
 568     if (oldentry && oldentry->hent_klen < 0)    /* was deleted earlier? */
 569         he_free(oldentry);
 570
 571     xhv->xhv_eiter = entry;
 572     return entry;
 573 }
 574
 575 char *
 576 hv_iterkey(entry,retlen)
 577 register HE *entry;
 578 I32 *retlen;
 579 {
 580     *retlen = entry->hent_klen;
 581     return entry->hent_key;
 582 }
 583
 584 SV *
 585 hv_iterval(hv,entry)
 586 HV *hv;
 587 register HE *entry;
 588 {
 589     if (SvRMAGICAL(hv)) {
 590         if (mg_find((SV*)hv,'P')) {
 591             SV* sv = sv_newmortal();
 592             mg_copy((SV*)hv, sv, entry->hent_key, entry->hent_klen);
 593             return sv;
 594         }
 595     }
 596     return entry->hent_val;
 597 }
 598
 599 SV *
 600 hv_iternextsv(hv, key, retlen)
 601     HV *hv;
 602     char **key;
 603     I32 *retlen;
 604 {
 605     HE *he;
 606     if ( (he = hv_iternext(hv)) == NULL)
 607         return NULL;
 608     *key = hv_iterkey(he, retlen);
 609     return hv_iterval(hv, he);
 610 }
 611
 612 void
 613 hv_magic(hv, gv, how)
 614 HV* hv;
 615 GV* gv;
 616 int how;
 617 {
 618     sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
 619 }