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         SV *sv = *keysp;
 475         if (SvGMAGICAL(sv))
 476             mg_get(sv);
 477         if (SvROK(sv)) {
 478             sv = SvRV(sv);
 479             if (SvTYPE(sv) == SVt_PVHV)
 480                 keys = (HV*)sv;
 481         }
 482     }
 483     if (!keys)
 484         croak("Can't coerce array into hash");
 485     return keys;
 486 }
 487
 488 SV**
 489 avhv_fetch(AV *av, char *key, U32 klen, I32 lval)
 490 {
 491     SV **indsvp;
 492     HV *keys = avhv_keys(av);
 493     I32 ind;
 494
 495     indsvp = hv_fetch(keys, key, klen, FALSE);
 496     if (indsvp) {
 497         ind = SvIV(*indsvp);
 498         if (ind < 1)
 499             croak("Bad index while coercing array into hash");
 500     } else {
 501         if (!lval)
 502             return 0;
 503
 504         ind = AvFILL(av) + 1;
 505         hv_store(keys, key, klen, newSViv(ind), 0);
 506     }
 507     return av_fetch(av, ind, lval);
 508 }
 509
 510 SV**
 511 avhv_fetch_ent(AV *av, SV *keysv, I32 lval, U32 hash)
 512 {
 513     SV **indsvp;
 514     HV *keys = avhv_keys(av);
 515     HE *he;
 516     I32 ind;
 517
 518     he = hv_fetch_ent(keys, keysv, FALSE, hash);
 519     if (he) {
 520         ind = SvIV(HeVAL(he));
 521         if (ind < 1)
 522             croak("Bad index while coercing array into hash");
 523     } else {
 524         if (!lval)
 525             return 0;
 526
 527         ind = AvFILL(av) + 1;
 528         hv_store_ent(keys, keysv, newSViv(ind), 0);
 529     }
 530     return av_fetch(av, ind, lval);
 531 }
 532
 533 SV**
 534 avhv_store(AV *av, char *key, U32 klen, SV *val, U32 hash)
 535 {
 536     SV **indsvp;
 537     HV *keys = avhv_keys(av);
 538     I32 ind;
 539
 540     indsvp = hv_fetch(keys, key, klen, FALSE);
 541     if (indsvp) {
 542         ind = SvIV(*indsvp);
 543         if (ind < 1)
 544             croak("Bad index while coercing array into hash");
 545     } else {
 546         ind = AvFILL(av) + 1;
 547         hv_store(keys, key, klen, newSViv(ind), hash);
 548     }
 549     return av_store(av, ind, val);
 550 }
 551
 552 SV**
 553 avhv_store_ent(AV *av, SV *keysv, SV *val, U32 hash)
 554 {
 555     HV *keys = avhv_keys(av);
 556     HE *he;
 557     I32 ind;
 558
 559     he = hv_fetch_ent(keys, keysv, FALSE, hash);
 560     if (he) {
 561         ind = SvIV(HeVAL(he));
 562         if (ind < 1)
 563             croak("Bad index while coercing array into hash");
 564     } else {
 565         ind = AvFILL(av) + 1;
 566         hv_store_ent(keys, keysv, newSViv(ind), hash);
 567     }
 568     return av_store(av, ind, val);
 569 }
 570
 571 bool
 572 avhv_exists_ent(AV *av, SV *keysv, U32 hash)
 573 {
 574     HV *keys = avhv_keys(av);
 575     return hv_exists_ent(keys, keysv, hash);
 576 }
 577
 578 bool
 579 avhv_exists(AV *av, char *key, U32 klen)
 580 {
 581     HV *keys = avhv_keys(av);
 582     return hv_exists(keys, key, klen);
 583 }
 584
 585 /* avhv_delete leaks. Caller can re-index and compress if so desired. */
 586 SV *
 587 avhv_delete(AV *av, char *key, U32 klen, I32 flags)
 588 {
 589     HV *keys = avhv_keys(av);
 590     SV *sv;
 591     SV **svp;
 592     I32 ind;
 593
 594     sv = hv_delete(keys, key, klen, 0);
 595     if (!sv)
 596         return Nullsv;
 597     ind = SvIV(sv);
 598     if (ind < 1)
 599         croak("Bad index while coercing array into hash");
 600     svp = av_fetch(av, ind, FALSE);
 601     if (!svp)
 602         return Nullsv;
 603     if (flags & G_DISCARD) {
 604         sv = Nullsv;
 605         SvREFCNT_dec(*svp);
 606     } else {
 607         sv = sv_2mortal(*svp);
 608     }
 609     *svp = &sv_undef;
 610     return sv;
 611 }
 612
 613 /* avhv_delete_ent leaks. Caller can re-index and compress if so desired. */
 614 SV *
 615 avhv_delete_ent(AV *av, SV *keysv, I32 flags, U32 hash)
 616 {
 617     HV *keys = avhv_keys(av);
 618     SV *sv;
 619     SV **svp;
 620     I32 ind;
 621
 622     sv = hv_delete_ent(keys, keysv, 0, hash);
 623     if (!sv)
 624         return Nullsv;
 625     ind = SvIV(sv);
 626     if (ind < 1)
 627         croak("Bad index while coercing array into hash");
 628     svp = av_fetch(av, ind, FALSE);
 629     if (!svp)
 630         return Nullsv;
 631     if (flags & G_DISCARD) {
 632         sv = Nullsv;
 633         SvREFCNT_dec(*svp);
 634     } else {
 635         sv = sv_2mortal(*svp);
 636     }
 637     *svp = &sv_undef;
 638     return sv;
 639 }
 640
 641 I32
 642 avhv_iterinit(AV *av)
 643 {
 644     HV *keys = avhv_keys(av);
 645     return hv_iterinit(keys);
 646 }
 647
 648 HE *
 649 avhv_iternext(AV *av)
 650 {
 651     HV *keys = avhv_keys(av);
 652     return hv_iternext(keys);
 653 }
 654
 655 SV *
 656 avhv_iterval(AV *av, register HE *entry)
 657 {
 658     HV *keys = avhv_keys(av);
 659     SV *sv;
 660     I32 ind;
 661
 662     sv = hv_iterval(keys, entry);
 663     ind = SvIV(sv);
 664     if (ind < 1)
 665         croak("Bad index while coercing array into hash");
 666     return *av_fetch(av, ind, TRUE);
 667 }
 668
 669 SV *
 670 avhv_iternextsv(AV *av, char **key, I32 *retlen)
 671 {
 672     HV *keys = avhv_keys(av);
 673     HE *he;
 674     SV *sv;
 675     I32 ind;
 676
 677     he = hv_iternext(keys);
 678     if (!he)
 679         return Nullsv;
 680     *key = hv_iterkey(he, retlen);
 681     sv = hv_iterval(keys, he);
 682     ind = SvIV(sv);
 683     if (ind < 1)
 684         croak("Bad index while coercing array into hash");
 685     return *av_fetch(av, ind, TRUE);
 686 }