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