av.c

   1 /*    av.c
   2  *
   3  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
   4  *    2000, 2001, 2002, 2003, by Larry Wall and others
   5  *
   6  *    You may distribute under the terms of either the GNU General Public
   7  *    License or the Artistic License, as specified in the README file.
   8  *
   9  */
  10
  11 /*
  12  * "...for the Entwives desired order, and plenty, and peace (by which they
  13  * meant that things should remain where they had set them)." --Treebeard
  14  */
  15
  16 /*
  17 =head1 Array Manipulation Functions
  18 */
  19
  20 #include "EXTERN.h"
  21 #define PERL_IN_AV_C
  22 #include "perl.h"
  23
  24 void
  25 Perl_av_reify(pTHX_ AV *av)
  26 {
  27     I32 key;
  28     SV* sv;
  29
  30     if (AvREAL(av))
  31         return;
  32 #ifdef DEBUGGING
  33     if (SvTIED_mg((SV*)av, PERL_MAGIC_tied) && ckWARN_d(WARN_DEBUGGING))
  34         Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "av_reify called on tied array");
  35 #endif
  36     key = AvMAX(av) + 1;
  37     while (key > AvFILLp(av) + 1)
  38         AvARRAY(av)[--key] = &PL_sv_undef;
  39     while (key) {
  40         sv = AvARRAY(av)[--key];
  41         assert(sv);
  42         if (sv != &PL_sv_undef)
  43             (void)SvREFCNT_inc(sv);
  44     }
  45     key = AvARRAY(av) - AvALLOC(av);
  46     while (key)
  47         AvALLOC(av)[--key] = &PL_sv_undef;
  48     AvREIFY_off(av);
  49     AvREAL_on(av);
  50 }
  51
  52 /*
  53 =for apidoc av_extend
  54
  55 Pre-extend an array.  The C<key> is the index to which the array should be
  56 extended.
  57
  58 =cut
  59 */
  60
  61 void
  62 Perl_av_extend(pTHX_ AV *av, I32 key)
  63 {
  64     MAGIC *mg;
  65     if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
  66         dSP;
  67         ENTER;
  68         SAVETMPS;
  69         PUSHSTACKi(PERLSI_MAGIC);
  70         PUSHMARK(SP);
  71         EXTEND(SP,2);
  72         PUSHs(SvTIED_obj((SV*)av, mg));
  73         PUSHs(sv_2mortal(newSViv(key+1)));
  74         PUTBACK;
  75         call_method("EXTEND", G_SCALAR|G_DISCARD);
  76         POPSTACK;
  77         FREETMPS;
  78         LEAVE;
  79         return;
  80     }
  81     if (key > AvMAX(av)) {
  82         SV** ary;
  83         I32 tmp;
  84         I32 newmax;
  85
  86         if (AvALLOC(av) != AvARRAY(av)) {
  87             ary = AvALLOC(av) + AvFILLp(av) + 1;
  88             tmp = AvARRAY(av) - AvALLOC(av);
  89             Move(AvARRAY(av), AvALLOC(av), AvFILLp(av)+1, SV*);
  90             AvMAX(av) += tmp;
  91             SvPVX(av) = (char*)AvALLOC(av);
  92             if (AvREAL(av)) {
  93                 while (tmp)
  94                     ary[--tmp] = &PL_sv_undef;
  95             }
  96
  97             if (key > AvMAX(av) - 10) {
  98                 newmax = key + AvMAX(av);
  99                 goto resize;
 100             }
 101         }
 102         else {
 103             if (AvALLOC(av)) {
 104 #if !defined(STRANGE_MALLOC) && !defined(MYMALLOC)
 105                 MEM_SIZE bytes;
 106                 IV itmp;
 107 #endif
 108
 109 #ifdef MYMALLOC
 110                 newmax = malloced_size((void*)AvALLOC(av))/sizeof(SV*) - 1;
 111
 112                 if (key <= newmax)
 113                     goto resized;
 114 #endif
 115                 newmax = key + AvMAX(av) / 5;
 116               resize:
 117                 MEM_WRAP_CHECK_1(newmax+1, SV*, "panic: array extend");
 118 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
 119                 Renew(AvALLOC(av),newmax+1, SV*);
 120 #else
 121                 bytes = (newmax + 1) * sizeof(SV*);
 122 #define MALLOC_OVERHEAD 16
 123                 itmp = MALLOC_OVERHEAD;
 124                 while ((MEM_SIZE)(itmp - MALLOC_OVERHEAD) < bytes)
 125                     itmp += itmp;
 126                 itmp -= MALLOC_OVERHEAD;
 127                 itmp /= sizeof(SV*);
 128                 assert(itmp > newmax);
 129                 newmax = itmp - 1;
 130                 assert(newmax >= AvMAX(av));
 131                 New(2,ary, newmax+1, SV*);
 132                 Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*);
 133                 if (AvMAX(av) > 64)
 134                     offer_nice_chunk(AvALLOC(av), (AvMAX(av)+1) * sizeof(SV*));
 135                 else
 136                     Safefree(AvALLOC(av));
 137                 AvALLOC(av) = ary;
 138 #endif
 139 #ifdef MYMALLOC
 140               resized:
 141 #endif
 142                 ary = AvALLOC(av) + AvMAX(av) + 1;
 143                 tmp = newmax - AvMAX(av);
 144                 if (av == PL_curstack) {        /* Oops, grew stack (via av_store()?) */
 145                     PL_stack_sp = AvALLOC(av) + (PL_stack_sp - PL_stack_base);
 146                     PL_stack_base = AvALLOC(av);
 147                     PL_stack_max = PL_stack_base + newmax;
 148                 }
 149             }
 150             else {
 151                 newmax = key < 3 ? 3 : key;
 152                 MEM_WRAP_CHECK_1(newmax+1, SV*, "panic: array extend");
 153                 New(2,AvALLOC(av), newmax+1, SV*);
 154                 ary = AvALLOC(av) + 1;
 155                 tmp = newmax;
 156                 AvALLOC(av)[0] = &PL_sv_undef;  /* For the stacks */
 157             }
 158             if (AvREAL(av)) {
 159                 while (tmp)
 160                     ary[--tmp] = &PL_sv_undef;
 161             }
 162
 163             SvPVX(av) = (char*)AvALLOC(av);
 164             AvMAX(av) = newmax;
 165         }
 166     }
 167 }
 168
 169 /*
 170 =for apidoc av_fetch
 171
 172 Returns the SV at the specified index in the array.  The C<key> is the
 173 index.  If C<lval> is set then the fetch will be part of a store.  Check
 174 that the return value is non-null before dereferencing it to a C<SV*>.
 175
 176 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
 177 more information on how to use this function on tied arrays.
 178
 179 =cut
 180 */
 181
 182 SV**
 183 Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval)
 184 {
 185     SV *sv;
 186
 187     if (!av)
 188         return 0;
 189
 190     if (SvRMAGICAL(av)) {
 191         MAGIC *tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
 192         if (tied_magic || mg_find((SV*)av, PERL_MAGIC_regdata)) {
 193             U32 adjust_index = 1;
 194
 195             if (tied_magic && key < 0) {
 196                 /* Handle negative array indices 20020222 MJD */
 197                 SV **negative_indices_glob =
 198                     hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av,
 199                                                      tied_magic))),
 200                              NEGATIVE_INDICES_VAR, 16, 0);
 201
 202                 if (negative_indices_glob
 203                     && SvTRUE(GvSV(*negative_indices_glob)))
 204                     adjust_index = 0;
 205             }
 206
 207             if (key < 0 && adjust_index) {
 208                 key += AvFILL(av) + 1;
 209                 if (key < 0)
 210                     return 0;
 211             }
 212
 213             sv = sv_newmortal();
 214             sv_upgrade(sv, SVt_PVLV);
 215             mg_copy((SV*)av, sv, 0, key);
 216             LvTYPE(sv) = 't';
 217             LvTARG(sv) = sv; /* fake (SV**) */
 218             return &(LvTARG(sv));
 219         }
 220     }
 221
 222     if (key < 0) {
 223         key += AvFILL(av) + 1;
 224         if (key < 0)
 225             return 0;
 226     }
 227
 228     if (key > AvFILLp(av)) {
 229         if (!lval)
 230             return 0;
 231         sv = NEWSV(5,0);
 232         return av_store(av,key,sv);
 233     }
 234     if (AvARRAY(av)[key] == &PL_sv_undef) {
 235     emptyness:
 236         if (lval) {
 237             sv = NEWSV(6,0);
 238             return av_store(av,key,sv);
 239         }
 240         return 0;
 241     }
 242     else if (AvREIFY(av)
 243              && (!AvARRAY(av)[key]      /* eg. @_ could have freed elts */
 244                  || SvTYPE(AvARRAY(av)[key]) == SVTYPEMASK)) {
 245         AvARRAY(av)[key] = &PL_sv_undef;        /* 1/2 reify */
 246         goto emptyness;
 247     }
 248     return &AvARRAY(av)[key];
 249 }
 250
 251 /*
 252 =for apidoc av_store
 253
 254 Stores an SV in an array.  The array index is specified as C<key>.  The
 255 return value will be NULL if the operation failed or if the value did not
 256 need to be actually stored within the array (as in the case of tied
 257 arrays). Otherwise it can be dereferenced to get the original C<SV*>.  Note
 258 that the caller is responsible for suitably incrementing the reference
 259 count of C<val> before the call, and decrementing it if the function
 260 returned NULL.
 261
 262 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
 263 more information on how to use this function on tied arrays.
 264
 265 =cut
 266 */
 267
 268 SV**
 269 Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
 270 {
 271     SV** ary;
 272
 273     if (!av)
 274         return 0;
 275     if (!val)
 276         val = &PL_sv_undef;
 277
 278     if (SvRMAGICAL(av)) {
 279         MAGIC *tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
 280         if (tied_magic) {
 281             /* Handle negative array indices 20020222 MJD */
 282             if (key < 0) {
 283                 unsigned adjust_index = 1;
 284                 SV **negative_indices_glob =
 285                     hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av,
 286                                                      tied_magic))),
 287                              NEGATIVE_INDICES_VAR, 16, 0);
 288                 if (negative_indices_glob
 289                     && SvTRUE(GvSV(*negative_indices_glob)))
 290                     adjust_index = 0;
 291                 if (adjust_index) {
 292                     key += AvFILL(av) + 1;
 293                     if (key < 0)
 294                         return 0;
 295                 }
 296             }
 297             if (val != &PL_sv_undef) {
 298                 mg_copy((SV*)av, val, 0, key);
 299             }
 300             return 0;
 301         }
 302     }
 303
 304
 305     if (key < 0) {
 306         key += AvFILL(av) + 1;
 307         if (key < 0)
 308             return 0;
 309     }
 310
 311     if (SvREADONLY(av) && key >= AvFILL(av))
 312         Perl_croak(aTHX_ PL_no_modify);
 313
 314     if (!AvREAL(av) && AvREIFY(av))
 315         av_reify(av);
 316     if (key > AvMAX(av))
 317         av_extend(av,key);
 318     ary = AvARRAY(av);
 319     if (AvFILLp(av) < key) {
 320         if (!AvREAL(av)) {
 321             if (av == PL_curstack && key > PL_stack_sp - PL_stack_base)
 322                 PL_stack_sp = PL_stack_base + key;      /* XPUSH in disguise */
 323             do
 324                 ary[++AvFILLp(av)] = &PL_sv_undef;
 325             while (AvFILLp(av) < key);
 326         }
 327         AvFILLp(av) = key;
 328     }
 329     else if (AvREAL(av))
 330         SvREFCNT_dec(ary[key]);
 331     ary[key] = val;
 332     if (SvSMAGICAL(av)) {
 333         if (val != &PL_sv_undef) {
 334             MAGIC* mg = SvMAGIC(av);
 335             sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key);
 336         }
 337         mg_set((SV*)av);
 338     }
 339     return &ary[key];
 340 }
 341
 342 /*
 343 =for apidoc newAV
 344
 345 Creates a new AV.  The reference count is set to 1.
 346
 347 =cut
 348 */
 349
 350 AV *
 351 Perl_newAV(pTHX)
 352 {
 353     register AV *av;
 354
 355     av = (AV*)NEWSV(3,0);
 356     sv_upgrade((SV *)av, SVt_PVAV);
 357     AvREAL_on(av);
 358     AvALLOC(av) = 0;
 359     SvPVX(av) = 0;
 360     AvMAX(av) = AvFILLp(av) = -1;
 361     return av;
 362 }
 363
 364 /*
 365 =for apidoc av_make
 366
 367 Creates a new AV and populates it with a list of SVs.  The SVs are copied
 368 into the array, so they may be freed after the call to av_make.  The new AV
 369 will have a reference count of 1.
 370
 371 =cut
 372 */
 373
 374 AV *
 375 Perl_av_make(pTHX_ register I32 size, register SV **strp)
 376 {
 377     register AV *av;
 378     register I32 i;
 379     register SV** ary;
 380
 381     av = (AV*)NEWSV(8,0);
 382     sv_upgrade((SV *) av,SVt_PVAV);
 383     AvFLAGS(av) = AVf_REAL;
 384     if (size) {         /* `defined' was returning undef for size==0 anyway. */
 385         New(4,ary,size,SV*);
 386         AvALLOC(av) = ary;
 387         SvPVX(av) = (char*)ary;
 388         AvFILLp(av) = size - 1;
 389         AvMAX(av) = size - 1;
 390         for (i = 0; i < size; i++) {
 391             assert (*strp);
 392             ary[i] = NEWSV(7,0);
 393             sv_setsv(ary[i], *strp);
 394             strp++;
 395         }
 396     }
 397     return av;
 398 }
 399
 400 AV *
 401 Perl_av_fake(pTHX_ register I32 size, register SV **strp)
 402 {
 403     register AV *av;
 404     register SV** ary;
 405
 406     av = (AV*)NEWSV(9,0);
 407     sv_upgrade((SV *)av, SVt_PVAV);
 408     New(4,ary,size+1,SV*);
 409     AvALLOC(av) = ary;
 410     Copy(strp,ary,size,SV*);
 411     AvFLAGS(av) = AVf_REIFY;
 412     SvPVX(av) = (char*)ary;
 413     AvFILLp(av) = size - 1;
 414     AvMAX(av) = size - 1;
 415     while (size--) {
 416         assert (*strp);
 417         SvTEMP_off(*strp);
 418         strp++;
 419     }
 420     return av;
 421 }
 422
 423 /*
 424 =for apidoc av_clear
 425
 426 Clears an array, making it empty.  Does not free the memory used by the
 427 array itself.
 428
 429 =cut
 430 */
 431
 432 void
 433 Perl_av_clear(pTHX_ register AV *av)
 434 {
 435     register I32 key;
 436     SV** ary;
 437
 438 #ifdef DEBUGGING
 439     if (SvREFCNT(av) == 0 && ckWARN_d(WARN_DEBUGGING)) {
 440         Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "Attempt to clear deleted array");
 441     }
 442 #endif
 443     if (!av)
 444         return;
 445     /*SUPPRESS 560*/
 446
 447     if (SvREADONLY(av))
 448         Perl_croak(aTHX_ PL_no_modify);
 449
 450     /* Give any tie a chance to cleanup first */
 451     if (SvRMAGICAL(av))
 452         mg_clear((SV*)av);
 453
 454     if (AvMAX(av) < 0)
 455         return;
 456
 457     if (AvREAL(av)) {
 458         ary = AvARRAY(av);
 459         key = AvFILLp(av) + 1;
 460         while (key) {
 461             SV * sv = ary[--key];
 462             /* undef the slot before freeing the value, because a
 463              * destructor might try to modify this arrray */
 464             ary[key] = &PL_sv_undef;
 465             SvREFCNT_dec(sv);
 466         }
 467     }
 468     if ((key = AvARRAY(av) - AvALLOC(av))) {
 469         AvMAX(av) += key;
 470         SvPVX(av) = (char*)AvALLOC(av);
 471     }
 472     AvFILLp(av) = -1;
 473
 474 }
 475
 476 /*
 477 =for apidoc av_undef
 478
 479 Undefines the array.  Frees the memory used by the array itself.
 480
 481 =cut
 482 */
 483
 484 void
 485 Perl_av_undef(pTHX_ register AV *av)
 486 {
 487     register I32 key;
 488
 489     if (!av)
 490         return;
 491     /*SUPPRESS 560*/
 492
 493     /* Give any tie a chance to cleanup first */
 494     if (SvTIED_mg((SV*)av, PERL_MAGIC_tied))
 495         av_fill(av, -1);   /* mg_clear() ? */
 496
 497     if (AvREAL(av)) {
 498         key = AvFILLp(av) + 1;
 499         while (key)
 500             SvREFCNT_dec(AvARRAY(av)[--key]);
 501     }
 502     Safefree(AvALLOC(av));
 503     AvALLOC(av) = 0;
 504     SvPVX(av) = 0;
 505     AvMAX(av) = AvFILLp(av) = -1;
 506     if (AvARYLEN(av)) {
 507         SvREFCNT_dec(AvARYLEN(av));
 508         AvARYLEN(av) = 0;
 509     }
 510 }
 511
 512 /*
 513 =for apidoc av_push
 514
 515 Pushes an SV onto the end of the array.  The array will grow automatically
 516 to accommodate the addition.
 517
 518 =cut
 519 */
 520
 521 void
 522 Perl_av_push(pTHX_ register AV *av, SV *val)
 523 {
 524     MAGIC *mg;
 525     if (!av)
 526         return;
 527     if (SvREADONLY(av))
 528         Perl_croak(aTHX_ PL_no_modify);
 529
 530     if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
 531         dSP;
 532         PUSHSTACKi(PERLSI_MAGIC);
 533         PUSHMARK(SP);
 534         EXTEND(SP,2);
 535         PUSHs(SvTIED_obj((SV*)av, mg));
 536         PUSHs(val);
 537         PUTBACK;
 538         ENTER;
 539         call_method("PUSH", G_SCALAR|G_DISCARD);
 540         LEAVE;
 541         POPSTACK;
 542         return;
 543     }
 544     av_store(av,AvFILLp(av)+1,val);
 545 }
 546
 547 /*
 548 =for apidoc av_pop
 549
 550 Pops an SV off the end of the array.  Returns C<&PL_sv_undef> if the array
 551 is empty.
 552
 553 =cut
 554 */
 555
 556 SV *
 557 Perl_av_pop(pTHX_ register AV *av)
 558 {
 559     SV *retval;
 560     MAGIC* mg;
 561
 562     if (!av)
 563       return &PL_sv_undef;
 564     if (SvREADONLY(av))
 565         Perl_croak(aTHX_ PL_no_modify);
 566     if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
 567         dSP;
 568         PUSHSTACKi(PERLSI_MAGIC);
 569         PUSHMARK(SP);
 570         XPUSHs(SvTIED_obj((SV*)av, mg));
 571         PUTBACK;
 572         ENTER;
 573         if (call_method("POP", G_SCALAR)) {
 574             retval = newSVsv(*PL_stack_sp--);
 575         } else {
 576             retval = &PL_sv_undef;
 577         }
 578         LEAVE;
 579         POPSTACK;
 580         return retval;
 581     }
 582     if (AvFILL(av) < 0)
 583         return &PL_sv_undef;
 584     retval = AvARRAY(av)[AvFILLp(av)];
 585     AvARRAY(av)[AvFILLp(av)--] = &PL_sv_undef;
 586     if (SvSMAGICAL(av))
 587         mg_set((SV*)av);
 588     return retval;
 589 }
 590
 591 /*
 592 =for apidoc av_unshift
 593
 594 Unshift the given number of C<undef> values onto the beginning of the
 595 array.  The array will grow automatically to accommodate the addition.  You
 596 must then use C<av_store> to assign values to these new elements.
 597
 598 =cut
 599 */
 600
 601 void
 602 Perl_av_unshift(pTHX_ register AV *av, register I32 num)
 603 {
 604     register I32 i;
 605     register SV **ary;
 606     MAGIC* mg;
 607     I32 slide;
 608
 609     if (!av)
 610         return;
 611     if (SvREADONLY(av))
 612         Perl_croak(aTHX_ PL_no_modify);
 613
 614     if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
 615         dSP;
 616         PUSHSTACKi(PERLSI_MAGIC);
 617         PUSHMARK(SP);
 618         EXTEND(SP,1+num);
 619         PUSHs(SvTIED_obj((SV*)av, mg));
 620         while (num-- > 0) {
 621             PUSHs(&PL_sv_undef);
 622         }
 623         PUTBACK;
 624         ENTER;
 625         call_method("UNSHIFT", G_SCALAR|G_DISCARD);
 626         LEAVE;
 627         POPSTACK;
 628         return;
 629     }
 630
 631     if (num <= 0)
 632       return;
 633     if (!AvREAL(av) && AvREIFY(av))
 634         av_reify(av);
 635     i = AvARRAY(av) - AvALLOC(av);
 636     if (i) {
 637         if (i > num)
 638             i = num;
 639         num -= i;
 640
 641         AvMAX(av) += i;
 642         AvFILLp(av) += i;
 643         SvPVX(av) = (char*)(AvARRAY(av) - i);
 644     }
 645     if (num) {
 646         i = AvFILLp(av);
 647         /* Create extra elements */
 648         slide = i > 0 ? i : 0;
 649         num += slide;
 650         av_extend(av, i + num);
 651         AvFILLp(av) += num;
 652         ary = AvARRAY(av);
 653         Move(ary, ary + num, i + 1, SV*);
 654         do {
 655             ary[--num] = &PL_sv_undef;
 656         } while (num);
 657         /* Make extra elements into a buffer */
 658         AvMAX(av) -= slide;
 659         AvFILLp(av) -= slide;
 660         SvPVX(av) = (char*)(AvARRAY(av) + slide);
 661     }
 662 }
 663
 664 /*
 665 =for apidoc av_shift
 666
 667 Shifts an SV off the beginning of the array.
 668
 669 =cut
 670 */
 671
 672 SV *
 673 Perl_av_shift(pTHX_ register AV *av)
 674 {
 675     SV *retval;
 676     MAGIC* mg;
 677
 678     if (!av)
 679         return &PL_sv_undef;
 680     if (SvREADONLY(av))
 681         Perl_croak(aTHX_ PL_no_modify);
 682     if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
 683         dSP;
 684         PUSHSTACKi(PERLSI_MAGIC);
 685         PUSHMARK(SP);
 686         XPUSHs(SvTIED_obj((SV*)av, mg));
 687         PUTBACK;
 688         ENTER;
 689         if (call_method("SHIFT", G_SCALAR)) {
 690             retval = newSVsv(*PL_stack_sp--);
 691         } else {
 692             retval = &PL_sv_undef;
 693         }
 694         LEAVE;
 695         POPSTACK;
 696         return retval;
 697     }
 698     if (AvFILL(av) < 0)
 699       return &PL_sv_undef;
 700     retval = *AvARRAY(av);
 701     if (AvREAL(av))
 702         *AvARRAY(av) = &PL_sv_undef;
 703     SvPVX(av) = (char*)(AvARRAY(av) + 1);
 704     AvMAX(av)--;
 705     AvFILLp(av)--;
 706     if (SvSMAGICAL(av))
 707         mg_set((SV*)av);
 708     return retval;
 709 }
 710
 711 /*
 712 =for apidoc av_len
 713
 714 Returns the highest index in the array.  Returns -1 if the array is
 715 empty.
 716
 717 =cut
 718 */
 719
 720 I32
 721 Perl_av_len(pTHX_ register AV *av)
 722 {
 723     return AvFILL(av);
 724 }
 725
 726 /*
 727 =for apidoc av_fill
 728
 729 Ensure than an array has a given number of elements, equivalent to
 730 Perl's C<$#array = $fill;>.
 731
 732 =cut
 733 */
 734 void
 735 Perl_av_fill(pTHX_ register AV *av, I32 fill)
 736 {
 737     MAGIC *mg;
 738     if (!av)
 739         Perl_croak(aTHX_ "panic: null array");
 740     if (fill < 0)
 741         fill = -1;
 742     if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
 743         dSP;
 744         ENTER;
 745         SAVETMPS;
 746         PUSHSTACKi(PERLSI_MAGIC);
 747         PUSHMARK(SP);
 748         EXTEND(SP,2);
 749         PUSHs(SvTIED_obj((SV*)av, mg));
 750         PUSHs(sv_2mortal(newSViv(fill+1)));
 751         PUTBACK;
 752         call_method("STORESIZE", G_SCALAR|G_DISCARD);
 753         POPSTACK;
 754         FREETMPS;
 755         LEAVE;
 756         return;
 757     }
 758     if (fill <= AvMAX(av)) {
 759         I32 key = AvFILLp(av);
 760         SV** ary = AvARRAY(av);
 761
 762         if (AvREAL(av)) {
 763             while (key > fill) {
 764                 SvREFCNT_dec(ary[key]);
 765                 ary[key--] = &PL_sv_undef;
 766             }
 767         }
 768         else {
 769             while (key < fill)
 770                 ary[++key] = &PL_sv_undef;
 771         }
 772
 773         AvFILLp(av) = fill;
 774         if (SvSMAGICAL(av))
 775             mg_set((SV*)av);
 776     }
 777     else
 778         (void)av_store(av,fill,&PL_sv_undef);
 779 }
 780
 781 /*
 782 =for apidoc av_delete
 783
 784 Deletes the element indexed by C<key> from the array.  Returns the
 785 deleted element. C<flags> is currently ignored.
 786
 787 =cut
 788 */
 789 SV *
 790 Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
 791 {
 792     SV *sv;
 793
 794     if (!av)
 795         return Nullsv;
 796     if (SvREADONLY(av))
 797         Perl_croak(aTHX_ PL_no_modify);
 798
 799     if (SvRMAGICAL(av)) {
 800         MAGIC *tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
 801         SV **svp;
 802         if ((tied_magic || mg_find((SV*)av, PERL_MAGIC_regdata))) {
 803             /* Handle negative array indices 20020222 MJD */
 804             if (key < 0) {
 805                 unsigned adjust_index = 1;
 806                 if (tied_magic) {
 807                     SV **negative_indices_glob =
 808                         hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av,
 809                                                          tied_magic))),
 810                                  NEGATIVE_INDICES_VAR, 16, 0);
 811                     if (negative_indices_glob
 812                         && SvTRUE(GvSV(*negative_indices_glob)))
 813                         adjust_index = 0;
 814                 }
 815                 if (adjust_index) {
 816                     key += AvFILL(av) + 1;
 817                     if (key < 0)
 818                         return Nullsv;
 819                 }
 820             }
 821             svp = av_fetch(av, key, TRUE);
 822             if (svp) {
 823                 sv = *svp;
 824                 mg_clear(sv);
 825                 if (mg_find(sv, PERL_MAGIC_tiedelem)) {
 826                     sv_unmagic(sv, PERL_MAGIC_tiedelem); /* No longer an element */
 827                     return sv;
 828                 }
 829                 return Nullsv;
 830             }
 831         }
 832     }
 833
 834     if (key < 0) {
 835         key += AvFILL(av) + 1;
 836         if (key < 0)
 837             return Nullsv;
 838     }
 839
 840     if (key > AvFILLp(av))
 841         return Nullsv;
 842     else {
 843         sv = AvARRAY(av)[key];
 844         if (key == AvFILLp(av)) {
 845             AvARRAY(av)[key] = &PL_sv_undef;
 846             do {
 847                 AvFILLp(av)--;
 848             } while (--key >= 0 && AvARRAY(av)[key] == &PL_sv_undef);
 849         }
 850         else
 851             AvARRAY(av)[key] = &PL_sv_undef;
 852         if (SvSMAGICAL(av))
 853             mg_set((SV*)av);
 854     }
 855     if (flags & G_DISCARD) {
 856         SvREFCNT_dec(sv);
 857         sv = Nullsv;
 858     }
 859     return sv;
 860 }
 861
 862 /*
 863 =for apidoc av_exists
 864
 865 Returns true if the element indexed by C<key> has been initialized.
 866
 867 This relies on the fact that uninitialized array elements are set to
 868 C<&PL_sv_undef>.
 869
 870 =cut
 871 */
 872 bool
 873 Perl_av_exists(pTHX_ AV *av, I32 key)
 874 {
 875     if (!av)
 876         return FALSE;
 877
 878
 879     if (SvRMAGICAL(av)) {
 880         MAGIC *tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
 881         if (tied_magic || mg_find((SV*)av, PERL_MAGIC_regdata)) {
 882             SV *sv = sv_newmortal();
 883             MAGIC *mg;
 884             /* Handle negative array indices 20020222 MJD */
 885             if (key < 0) {
 886                 unsigned adjust_index = 1;
 887                 if (tied_magic) {
 888                     SV **negative_indices_glob =
 889                         hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av,
 890                                                          tied_magic))),
 891                                  NEGATIVE_INDICES_VAR, 16, 0);
 892                     if (negative_indices_glob
 893                         && SvTRUE(GvSV(*negative_indices_glob)))
 894                         adjust_index = 0;
 895                 }
 896                 if (adjust_index) {
 897                     key += AvFILL(av) + 1;
 898                     if (key < 0)
 899                         return FALSE;
 900                 }
 901             }
 902
 903             mg_copy((SV*)av, sv, 0, key);
 904             mg = mg_find(sv, PERL_MAGIC_tiedelem);
 905             if (mg) {
 906                 magic_existspack(sv, mg);
 907                 return (bool)SvTRUE(sv);
 908             }
 909
 910         }
 911     }
 912
 913     if (key < 0) {
 914         key += AvFILL(av) + 1;
 915         if (key < 0)
 916             return FALSE;
 917     }
 918
 919     if (key <= AvFILLp(av) && AvARRAY(av)[key] != &PL_sv_undef
 920         && AvARRAY(av)[key])
 921     {
 922         return TRUE;
 923     }
 924     else
 925         return FALSE;
 926 }