av.c

   1 /*    av.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  * "...for the Entwives desired order, and plenty, and peace (by which they
  12  * meant that things should remain where they had set them)." --Treebeard
  13  */
  14
  15 #include "EXTERN.h"
  16 #include "perl.h"
  17
  18 void
  19 av_reify(AV *av)
  20 {
  21     I32 key;
  22     SV* sv;
  23
  24     if (AvREAL(av))
  25         return;
  26     key = AvMAX(av) + 1;
  27     while (key > AvFILL(av) + 1)
  28         AvARRAY(av)[--key] = &sv_undef;
  29     while (key) {
  30         sv = AvARRAY(av)[--key];
  31         assert(sv);
  32         if (sv != &sv_undef) {
  33             dTHR;
  34             (void)SvREFCNT_inc(sv);
  35         }
  36     }
  37     key = AvARRAY(av) - AvALLOC(av);
  38     while (key)
  39         AvALLOC(av)[--key] = &sv_undef;
  40     AvREAL_on(av);
  41 }
  42
  43 void
  44 av_extend(AV *av, I32 key)
  45 {
  46     dTHR;                       /* only necessary if we have to extend stack */
  47     if (key > AvMAX(av)) {
  48         SV** ary;
  49         I32 tmp;
  50         I32 newmax;
  51
  52         if (AvALLOC(av) != AvARRAY(av)) {
  53             ary = AvALLOC(av) + AvFILL(av) + 1;
  54             tmp = AvARRAY(av) - AvALLOC(av);
  55             Move(AvARRAY(av), AvALLOC(av), AvFILL(av)+1, SV*);
  56             AvMAX(av) += tmp;
  57             SvPVX(av) = (char*)AvALLOC(av);
  58             if (AvREAL(av)) {
  59                 while (tmp)
  60                     ary[--tmp] = &sv_undef;
  61             }
  62
  63             if (key > AvMAX(av) - 10) {
  64                 newmax = key + AvMAX(av);
  65                 goto resize;
  66             }
  67         }
  68         else {
  69             if (AvALLOC(av)) {
  70 #ifndef STRANGE_MALLOC
  71                 U32 bytes;
  72 #endif
  73
  74                 newmax = key + AvMAX(av) / 5;
  75               resize:
  76 #ifdef STRANGE_MALLOC
  77                 Renew(AvALLOC(av),newmax+1, SV*);
  78 #else
  79                 bytes = (newmax + 1) * sizeof(SV*);
  80 #define MALLOC_OVERHEAD 16
  81                 tmp = MALLOC_OVERHEAD;
  82                 while (tmp - MALLOC_OVERHEAD < bytes)
  83                     tmp += tmp;
  84                 tmp -= MALLOC_OVERHEAD;
  85                 tmp /= sizeof(SV*);
  86                 assert(tmp > newmax);
  87                 newmax = tmp - 1;
  88                 New(2,ary, newmax+1, SV*);
  89                 Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*);
  90                 if (AvMAX(av) > 64)
  91                     offer_nice_chunk(AvALLOC(av), (AvMAX(av)+1) * sizeof(SV*));
  92                 else
  93                     Safefree(AvALLOC(av));
  94                 AvALLOC(av) = ary;
  95 #endif
  96                 ary = AvALLOC(av) + AvMAX(av) + 1;
  97                 tmp = newmax - AvMAX(av);
  98                 if (av == curstack) {   /* Oops, grew stack (via av_store()?) */
  99                     stack_sp = AvALLOC(av) + (stack_sp - stack_base);
 100                     stack_base = AvALLOC(av);
 101                     stack_max = stack_base + newmax;
 102                 }
 103             }
 104             else {
 105                 newmax = key < 4 ? 4 : key;
 106                 New(2,AvALLOC(av), newmax+1, SV*);
 107                 ary = AvALLOC(av) + 1;
 108                 tmp = newmax;
 109                 AvALLOC(av)[0] = &sv_undef;     /* For the stacks */
 110             }
 111             if (AvREAL(av)) {
 112                 while (tmp)
 113                     ary[--tmp] = &sv_undef;
 114             }
 115
 116             SvPVX(av) = (char*)AvALLOC(av);
 117             AvMAX(av) = newmax;
 118         }
 119     }
 120 }
 121
 122 SV**
 123 av_fetch(register AV *av, I32 key, I32 lval)
 124 {
 125     SV *sv;
 126
 127     if (!av)
 128         return 0;
 129
 130     if (SvRMAGICAL(av)) {
 131         if (mg_find((SV*)av,'P')) {
 132             dTHR;
 133             sv = sv_newmortal();
 134             mg_copy((SV*)av, sv, 0, key);
 135             Sv = sv;
 136             return &Sv;
 137         }
 138     }
 139
 140     if (key < 0) {
 141         key += AvFILL(av) + 1;
 142         if (key < 0)
 143             return 0;
 144     }
 145     else if (key > AvFILL(av)) {
 146         if (!lval)
 147             return 0;
 148         if (AvREALISH(av))
 149             sv = NEWSV(5,0);
 150         else
 151             sv = sv_newmortal();
 152         return av_store(av,key,sv);
 153     }
 154     if (AvARRAY(av)[key] == &sv_undef) {
 155     emptyness:
 156         if (lval) {
 157             sv = NEWSV(6,0);
 158             return av_store(av,key,sv);
 159         }
 160         return 0;
 161     }
 162     else if (AvREIFY(av)
 163              && (!AvARRAY(av)[key]      /* eg. @_ could have freed elts */
 164                  || SvTYPE(AvARRAY(av)[key]) == SVTYPEMASK)) {
 165         AvARRAY(av)[key] = &sv_undef;   /* 1/2 reify */
 166         goto emptyness;
 167     }
 168     return &AvARRAY(av)[key];
 169 }
 170
 171 SV**
 172 av_store(register AV *av, I32 key, SV *val)
 173 {
 174     SV** ary;
 175
 176     if (!av)
 177         return 0;
 178     if (!val)
 179         val = &sv_undef;
 180
 181     if (SvRMAGICAL(av)) {
 182         if (mg_find((SV*)av,'P')) {
 183             if (val != &sv_undef)
 184                 mg_copy((SV*)av, val, 0, key);
 185             return 0;
 186         }
 187     }
 188
 189     if (key < 0) {
 190         key += AvFILL(av) + 1;
 191         if (key < 0)
 192             return 0;
 193     }
 194     if (SvREADONLY(av) && key >= AvFILL(av))
 195         croak(no_modify);
 196     if (!AvREAL(av) && AvREIFY(av))
 197         av_reify(av);
 198     if (key > AvMAX(av))
 199         av_extend(av,key);
 200     ary = AvARRAY(av);
 201     if (AvFILL(av) < key) {
 202         if (!AvREAL(av)) {
 203             dTHR;
 204             if (av == curstack && key > stack_sp - stack_base)
 205                 stack_sp = stack_base + key;    /* XPUSH in disguise */
 206             do
 207                 ary[++AvFILL(av)] = &sv_undef;
 208             while (AvFILL(av) < key);
 209         }
 210         AvFILL(av) = key;
 211     }
 212     else if (AvREAL(av))
 213         SvREFCNT_dec(ary[key]);
 214     ary[key] = val;
 215     if (SvSMAGICAL(av)) {
 216         if (val != &sv_undef) {
 217             MAGIC* mg = SvMAGIC(av);
 218             sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key);
 219         }
 220         mg_set((SV*)av);
 221     }
 222     return &ary[key];
 223 }
 224
 225 AV *
 226 newAV(void)
 227 {
 228     register AV *av;
 229
 230     av = (AV*)NEWSV(3,0);
 231     sv_upgrade((SV *)av, SVt_PVAV);
 232     AvREAL_on(av);
 233     AvALLOC(av) = 0;
 234     SvPVX(av) = 0;
 235     AvMAX(av) = AvFILL(av) = -1;
 236     return av;
 237 }
 238
 239 AV *
 240 av_make(register I32 size, register SV **strp)
 241 {
 242     register AV *av;
 243     register I32 i;
 244     register SV** ary;
 245
 246     av = (AV*)NEWSV(8,0);
 247     sv_upgrade((SV *) av,SVt_PVAV);
 248     AvFLAGS(av) = AVf_REAL;
 249     if (size) {         /* `defined' was returning undef for size==0 anyway. */
 250         New(4,ary,size,SV*);
 251         AvALLOC(av) = ary;
 252         SvPVX(av) = (char*)ary;
 253         AvFILL(av) = size - 1;
 254         AvMAX(av) = size - 1;
 255         for (i = 0; i < size; i++) {
 256             assert (*strp);
 257             ary[i] = NEWSV(7,0);
 258             sv_setsv(ary[i], *strp);
 259             strp++;
 260         }
 261     }
 262     return av;
 263 }
 264
 265 AV *
 266 av_fake(register I32 size, register SV **strp)
 267 {
 268     register AV *av;
 269     register SV** ary;
 270
 271     av = (AV*)NEWSV(9,0);
 272     sv_upgrade((SV *)av, SVt_PVAV);
 273     New(4,ary,size+1,SV*);
 274     AvALLOC(av) = ary;
 275     Copy(strp,ary,size,SV*);
 276     AvFLAGS(av) = AVf_REIFY;
 277     SvPVX(av) = (char*)ary;
 278     AvFILL(av) = size - 1;
 279     AvMAX(av) = size - 1;
 280     while (size--) {
 281         assert (*strp);
 282         SvTEMP_off(*strp);
 283         strp++;
 284     }
 285     return av;
 286 }
 287
 288 void
 289 av_clear(register AV *av)
 290 {
 291     register I32 key;
 292     SV** ary;
 293
 294 #ifdef DEBUGGING
 295     if (SvREFCNT(av) <= 0) {
 296         warn("Attempt to clear deleted array");
 297     }
 298 #endif
 299     if (!av || AvMAX(av) < 0)
 300         return;
 301     /*SUPPRESS 560*/
 302
 303     if (AvREAL(av)) {
 304         ary = AvARRAY(av);
 305         key = AvFILL(av) + 1;
 306         while (key) {
 307             SvREFCNT_dec(ary[--key]);
 308             ary[key] = &sv_undef;
 309         }
 310     }
 311     if (key = AvARRAY(av) - AvALLOC(av)) {
 312         AvMAX(av) += key;
 313         SvPVX(av) = (char*)AvALLOC(av);
 314     }
 315     AvFILL(av) = -1;
 316
 317     if (SvRMAGICAL(av))
 318         mg_clear((SV*)av);
 319 }
 320
 321 void
 322 av_undef(register AV *av)
 323 {
 324     register I32 key;
 325
 326     if (!av)
 327         return;
 328     /*SUPPRESS 560*/
 329     if (AvREAL(av)) {
 330         key = AvFILL(av) + 1;
 331         while (key)
 332             SvREFCNT_dec(AvARRAY(av)[--key]);
 333     }
 334     Safefree(AvALLOC(av));
 335     AvALLOC(av) = 0;
 336     SvPVX(av) = 0;
 337     AvMAX(av) = AvFILL(av) = -1;
 338     if (AvARYLEN(av)) {
 339         SvREFCNT_dec(AvARYLEN(av));
 340         AvARYLEN(av) = 0;
 341     }
 342 }
 343
 344 void
 345 av_push(register AV *av, SV *val)
 346 {
 347     if (!av)
 348         return;
 349     av_store(av,AvFILL(av)+1,val);
 350 }
 351
 352 SV *
 353 av_pop(register AV *av)
 354 {
 355     SV *retval;
 356
 357     if (!av || AvFILL(av) < 0)
 358         return &sv_undef;
 359     if (SvREADONLY(av))
 360         croak(no_modify);
 361     retval = AvARRAY(av)[AvFILL(av)];
 362     AvARRAY(av)[AvFILL(av)--] = &sv_undef;
 363     if (SvSMAGICAL(av))
 364         mg_set((SV*)av);
 365     return retval;
 366 }
 367
 368 void
 369 av_unshift(register AV *av, register I32 num)
 370 {
 371     register I32 i;
 372     register SV **sstr,**dstr;
 373
 374     if (!av || num <= 0)
 375         return;
 376     if (SvREADONLY(av))
 377         croak(no_modify);
 378     if (!AvREAL(av) && AvREIFY(av))
 379         av_reify(av);
 380     i = AvARRAY(av) - AvALLOC(av);
 381     if (i) {
 382         if (i > num)
 383             i = num;
 384         num -= i;
 385
 386         AvMAX(av) += i;
 387         AvFILL(av) += i;
 388         SvPVX(av) = (char*)(AvARRAY(av) - i);
 389     }
 390     if (num) {
 391         av_extend(av,AvFILL(av)+num);
 392         AvFILL(av) += num;
 393         dstr = AvARRAY(av) + AvFILL(av);
 394         sstr = dstr - num;
 395 #ifdef BUGGY_MSC5
 396  # pragma loop_opt(off) /* don't loop-optimize the following code */
 397 #endif /* BUGGY_MSC5 */
 398         for (i = AvFILL(av) - num; i >= 0; --i) {
 399             *dstr-- = *sstr--;
 400 #ifdef BUGGY_MSC5
 401  # pragma loop_opt()    /* loop-optimization back to command-line setting */
 402 #endif /* BUGGY_MSC5 */
 403         }
 404         while (num)
 405             AvARRAY(av)[--num] = &sv_undef;
 406     }
 407 }
 408
 409 SV *
 410 av_shift(register AV *av)
 411 {
 412     SV *retval;
 413
 414     if (!av || AvFILL(av) < 0)
 415         return &sv_undef;
 416     if (SvREADONLY(av))
 417         croak(no_modify);
 418     retval = *AvARRAY(av);
 419     if (AvREAL(av))
 420         *AvARRAY(av) = &sv_undef;
 421     SvPVX(av) = (char*)(AvARRAY(av) + 1);
 422     AvMAX(av)--;
 423     AvFILL(av)--;
 424     if (SvSMAGICAL(av))
 425         mg_set((SV*)av);
 426     return retval;
 427 }
 428
 429 I32
 430 av_len(register AV *av)
 431 {
 432     return AvFILL(av);
 433 }
 434
 435 void
 436 av_fill(register AV *av, I32 fill)
 437 {
 438     if (!av)
 439         croak("panic: null array");
 440     if (fill < 0)
 441         fill = -1;
 442     if (fill <= AvMAX(av)) {
 443         I32 key = AvFILL(av);
 444         SV** ary = AvARRAY(av);
 445
 446         if (AvREAL(av)) {
 447             while (key > fill) {
 448                 SvREFCNT_dec(ary[key]);
 449                 ary[key--] = &sv_undef;
 450             }
 451         }
 452         else {
 453             while (key < fill)
 454                 ary[++key] = &sv_undef;
 455         }
 456
 457         AvFILL(av) = fill;
 458         if (SvSMAGICAL(av))
 459             mg_set((SV*)av);
 460     }
 461     else
 462         (void)av_store(av,fill,&sv_undef);
 463 }
 464
 465
 466 HV*
 467 avhv_keys(AV *av)
 468 {
 469     SV **keysp;
 470     HV *keys = Nullhv;
 471
 472     keysp = av_fetch(av, 0, FALSE);
 473     if (keysp) {
 474         if (SvGMAGICAL(*keysp))
 475             mg_get(*keysp);
 476         if (SvROK(*keysp)) {
 477             SV *hash = SvRV(*keysp);
 478             if (SvTYPE(hash) == SVt_PVHV)
 479                 keys = (HV*)hash;
 480         }
 481     }
 482     if (!keys)
 483         croak("Can't coerce array into hash");
 484     return keys;
 485 }
 486
 487 SV**
 488 avhv_fetch(AV *av, char *key, U32 klen, I32 lval)
 489 {
 490     SV **indsvp;
 491     HV *keys = avhv_keys(av);
 492     I32 ind;
 493
 494     indsvp = hv_fetch(keys, key, klen, FALSE);
 495     if (indsvp) {
 496         ind = SvIV(*indsvp);
 497         if (ind < 1)
 498             croak("Bad index while coercing array into hash");
 499     } else {
 500         if (!lval)
 501             return 0;
 502
 503         ind = AvFILL(av) + 1;
 504         hv_store(keys, key, klen, newSViv(ind), 0);
 505     }
 506     return av_fetch(av, ind, lval);
 507 }
 508
 509 SV**
 510 avhv_fetch_ent(AV *av, SV *keysv, I32 lval, U32 hash)
 511 {
 512     SV **indsvp;
 513     HV *keys = avhv_keys(av);
 514     HE *he;
 515     I32 ind;
 516
 517     he = hv_fetch_ent(keys, keysv, FALSE, hash);
 518     if (he) {
 519         ind = SvIV(HeVAL(he));
 520         if (ind < 1)
 521             croak("Bad index while coercing array into hash");
 522     } else {
 523         if (!lval)
 524             return 0;
 525
 526         ind = AvFILL(av) + 1;
 527         hv_store_ent(keys, keysv, newSViv(ind), 0);
 528     }
 529     return av_fetch(av, ind, lval);
 530 }
 531
 532 SV**
 533 avhv_store(AV *av, char *key, U32 klen, SV *val, U32 hash)
 534 {
 535     SV **indsvp;
 536     HV *keys = avhv_keys(av);
 537     I32 ind;
 538
 539     indsvp = hv_fetch(keys, key, klen, FALSE);
 540     if (indsvp) {
 541         ind = SvIV(*indsvp);
 542         if (ind < 1)
 543             croak("Bad index while coercing array into hash");
 544     } else {
 545         ind = AvFILL(av) + 1;
 546         hv_store(keys, key, klen, newSViv(ind), hash);
 547     }
 548     return av_store(av, ind, val);
 549 }
 550
 551 SV**
 552 avhv_store_ent(AV *av, SV *keysv, SV *val, U32 hash)
 553 {
 554     HV *keys = avhv_keys(av);
 555     HE *he;
 556     I32 ind;
 557
 558     he = hv_fetch_ent(keys, keysv, FALSE, hash);
 559     if (he) {
 560         ind = SvIV(HeVAL(he));
 561         if (ind < 1)
 562             croak("Bad index while coercing array into hash");
 563     } else {
 564         ind = AvFILL(av) + 1;
 565         hv_store_ent(keys, keysv, newSViv(ind), hash);
 566     }
 567     return av_store(av, ind, val);
 568 }
 569
 570 bool
 571 avhv_exists_ent(AV *av, SV *keysv, U32 hash)
 572 {
 573     HV *keys = avhv_keys(av);
 574     return hv_exists_ent(keys, keysv, hash);
 575 }
 576
 577 bool
 578 avhv_exists(AV *av, char *key, U32 klen)
 579 {
 580     HV *keys = avhv_keys(av);
 581     return hv_exists(keys, key, klen);
 582 }
 583
 584 /* avhv_delete leaks. Caller can re-index and compress if so desired. */
 585 SV *
 586 avhv_delete(AV *av, char *key, U32 klen, I32 flags)
 587 {
 588     HV *keys = avhv_keys(av);
 589     SV *sv;
 590     SV **svp;
 591     I32 ind;
 592
 593     sv = hv_delete(keys, key, klen, 0);
 594     if (!sv)
 595         return Nullsv;
 596     ind = SvIV(sv);
 597     if (ind < 1)
 598         croak("Bad index while coercing array into hash");
 599     svp = av_fetch(av, ind, FALSE);
 600     if (!svp)
 601         return Nullsv;
 602     if (flags & G_DISCARD) {
 603         sv = Nullsv;
 604         SvREFCNT_dec(*svp);
 605     } else {
 606         sv = sv_2mortal(*svp);
 607     }
 608     *svp = &sv_undef;
 609     return sv;
 610 }
 611
 612 /* avhv_delete_ent leaks. Caller can re-index and compress if so desired. */
 613 SV *
 614 avhv_delete_ent(AV *av, SV *keysv, I32 flags, U32 hash)
 615 {
 616     HV *keys = avhv_keys(av);
 617     SV *sv;
 618     SV **svp;
 619     I32 ind;
 620
 621     sv = hv_delete_ent(keys, keysv, 0, hash);
 622     if (!sv)
 623         return Nullsv;
 624     ind = SvIV(sv);
 625     if (ind < 1)
 626         croak("Bad index while coercing array into hash");
 627     svp = av_fetch(av, ind, FALSE);
 628     if (!svp)
 629         return Nullsv;
 630     if (flags & G_DISCARD) {
 631         sv = Nullsv;
 632         SvREFCNT_dec(*svp);
 633     } else {
 634         sv = sv_2mortal(*svp);
 635     }
 636     *svp = &sv_undef;
 637     return sv;
 638 }
 639
 640 I32
 641 avhv_iterinit(AV *av)
 642 {
 643     HV *keys = avhv_keys(av);
 644     return hv_iterinit(keys);
 645 }
 646
 647 HE *
 648 avhv_iternext(AV *av)
 649 {
 650     HV *keys = avhv_keys(av);
 651     return hv_iternext(keys);
 652 }
 653
 654 SV *
 655 avhv_iterval(AV *av, register HE *entry)
 656 {
 657     HV *keys = avhv_keys(av);
 658     SV *sv;
 659     I32 ind;
 660
 661     sv = hv_iterval(keys, entry);
 662     ind = SvIV(sv);
 663     if (ind < 1)
 664         croak("Bad index while coercing array into hash");
 665     return *av_fetch(av, ind, TRUE);
 666 }
 667
 668 SV *
 669 avhv_iternextsv(AV *av, char **key, I32 *retlen)
 670 {
 671     HV *keys = avhv_keys(av);
 672     HE *he;
 673     SV *sv;
 674     I32 ind;
 675
 676     he = hv_iternext(keys);
 677     if (!he)
 678         return Nullsv;
 679     *key = hv_iterkey(he, retlen);
 680     sv = hv_iterval(keys, he);
 681     ind = SvIV(sv);
 682     if (ind < 1)
 683         croak("Bad index while coercing array into hash");
 684     return *av_fetch(av, ind, TRUE);
 685 }