av.c

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