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. If C<flags> equals C<G_DISCARD>, the element is freed
 786 and null is returned.
 787
 788 =cut
 789 */
 790 SV *
 791 Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
 792 {
 793     SV *sv;
 794
 795     if (!av)
 796         return Nullsv;
 797     if (SvREADONLY(av))
 798         Perl_croak(aTHX_ PL_no_modify);
 799
 800     if (SvRMAGICAL(av)) {
 801         MAGIC *tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
 802         SV **svp;
 803         if ((tied_magic || mg_find((SV*)av, PERL_MAGIC_regdata))) {
 804             /* Handle negative array indices 20020222 MJD */
 805             if (key < 0) {
 806                 unsigned adjust_index = 1;
 807                 if (tied_magic) {
 808                     SV **negative_indices_glob =
 809                         hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av,
 810                                                          tied_magic))),
 811                                  NEGATIVE_INDICES_VAR, 16, 0);
 812                     if (negative_indices_glob
 813                         && SvTRUE(GvSV(*negative_indices_glob)))
 814                         adjust_index = 0;
 815                 }
 816                 if (adjust_index) {
 817                     key += AvFILL(av) + 1;
 818                     if (key < 0)
 819                         return Nullsv;
 820                 }
 821             }
 822             svp = av_fetch(av, key, TRUE);
 823             if (svp) {
 824                 sv = *svp;
 825                 mg_clear(sv);
 826                 if (mg_find(sv, PERL_MAGIC_tiedelem)) {
 827                     sv_unmagic(sv, PERL_MAGIC_tiedelem); /* No longer an element */
 828                     return sv;
 829                 }
 830                 return Nullsv;
 831             }
 832         }
 833     }
 834
 835     if (key < 0) {
 836         key += AvFILL(av) + 1;
 837         if (key < 0)
 838             return Nullsv;
 839     }
 840
 841     if (key > AvFILLp(av))
 842         return Nullsv;
 843     else {
 844         if (!AvREAL(av) && AvREIFY(av))
 845             av_reify(av);
 846         sv = AvARRAY(av)[key];
 847         if (key == AvFILLp(av)) {
 848             AvARRAY(av)[key] = &PL_sv_undef;
 849             do {
 850                 AvFILLp(av)--;
 851             } while (--key >= 0 && AvARRAY(av)[key] == &PL_sv_undef);
 852         }
 853         else
 854             AvARRAY(av)[key] = &PL_sv_undef;
 855         if (SvSMAGICAL(av))
 856             mg_set((SV*)av);
 857     }
 858     if (flags & G_DISCARD) {
 859         SvREFCNT_dec(sv);
 860         sv = Nullsv;
 861     }
 862     return sv;
 863 }
 864
 865 /*
 866 =for apidoc av_exists
 867
 868 Returns true if the element indexed by C<key> has been initialized.
 869
 870 This relies on the fact that uninitialized array elements are set to
 871 C<&PL_sv_undef>.
 872
 873 =cut
 874 */
 875 bool
 876 Perl_av_exists(pTHX_ AV *av, I32 key)
 877 {
 878     if (!av)
 879         return FALSE;
 880
 881
 882     if (SvRMAGICAL(av)) {
 883         MAGIC *tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
 884         if (tied_magic || mg_find((SV*)av, PERL_MAGIC_regdata)) {
 885             SV *sv = sv_newmortal();
 886             MAGIC *mg;
 887             /* Handle negative array indices 20020222 MJD */
 888             if (key < 0) {
 889                 unsigned adjust_index = 1;
 890                 if (tied_magic) {
 891                     SV **negative_indices_glob =
 892                         hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av,
 893                                                          tied_magic))),
 894                                  NEGATIVE_INDICES_VAR, 16, 0);
 895                     if (negative_indices_glob
 896                         && SvTRUE(GvSV(*negative_indices_glob)))
 897                         adjust_index = 0;
 898                 }
 899                 if (adjust_index) {
 900                     key += AvFILL(av) + 1;
 901                     if (key < 0)
 902                         return FALSE;
 903                 }
 904             }
 905
 906             mg_copy((SV*)av, sv, 0, key);
 907             mg = mg_find(sv, PERL_MAGIC_tiedelem);
 908             if (mg) {
 909                 magic_existspack(sv, mg);
 910                 return (bool)SvTRUE(sv);
 911             }
 912
 913         }
 914     }
 915
 916     if (key < 0) {
 917         key += AvFILL(av) + 1;
 918         if (key < 0)
 919             return FALSE;
 920     }
 921
 922     if (key <= AvFILLp(av) && AvARRAY(av)[key] != &PL_sv_undef
 923         && AvARRAY(av)[key])
 924     {
 925         return TRUE;
 926     }
 927     else
 928         return FALSE;
 929 }