av.c

   1 /*    av.c
   2  *
   3  *    Copyright (c) 1991-2003, 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             SV * sv = ary[--key];
 457             /* undef the slot before freeing the value, because a
 458              * destructor might try to modify this arrray */
 459             ary[key] = &PL_sv_undef;
 460             SvREFCNT_dec(sv);
 461         }
 462     }
 463     if ((key = AvARRAY(av) - AvALLOC(av))) {
 464         AvMAX(av) += key;
 465         SvPVX(av) = (char*)AvALLOC(av);
 466     }
 467     AvFILLp(av) = -1;
 468
 469 }
 470
 471 /*
 472 =for apidoc av_undef
 473
 474 Undefines the array.  Frees the memory used by the array itself.
 475
 476 =cut
 477 */
 478
 479 void
 480 Perl_av_undef(pTHX_ register AV *av)
 481 {
 482     register I32 key;
 483
 484     if (!av)
 485         return;
 486     /*SUPPRESS 560*/
 487
 488     /* Give any tie a chance to cleanup first */
 489     if (SvTIED_mg((SV*)av, PERL_MAGIC_tied))
 490         av_fill(av, -1);   /* mg_clear() ? */
 491
 492     if (AvREAL(av)) {
 493         key = AvFILLp(av) + 1;
 494         while (key)
 495             SvREFCNT_dec(AvARRAY(av)[--key]);
 496     }
 497     Safefree(AvALLOC(av));
 498     AvALLOC(av) = 0;
 499     SvPVX(av) = 0;
 500     AvMAX(av) = AvFILLp(av) = -1;
 501     if (AvARYLEN(av)) {
 502         SvREFCNT_dec(AvARYLEN(av));
 503         AvARYLEN(av) = 0;
 504     }
 505 }
 506
 507 /*
 508 =for apidoc av_push
 509
 510 Pushes an SV onto the end of the array.  The array will grow automatically
 511 to accommodate the addition.
 512
 513 =cut
 514 */
 515
 516 void
 517 Perl_av_push(pTHX_ register AV *av, SV *val)
 518 {
 519     MAGIC *mg;
 520     if (!av)
 521         return;
 522     if (SvREADONLY(av))
 523         Perl_croak(aTHX_ PL_no_modify);
 524
 525     if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
 526         dSP;
 527         PUSHSTACKi(PERLSI_MAGIC);
 528         PUSHMARK(SP);
 529         EXTEND(SP,2);
 530         PUSHs(SvTIED_obj((SV*)av, mg));
 531         PUSHs(val);
 532         PUTBACK;
 533         ENTER;
 534         call_method("PUSH", G_SCALAR|G_DISCARD);
 535         LEAVE;
 536         POPSTACK;
 537         return;
 538     }
 539     av_store(av,AvFILLp(av)+1,val);
 540 }
 541
 542 /*
 543 =for apidoc av_pop
 544
 545 Pops an SV off the end of the array.  Returns C<&PL_sv_undef> if the array
 546 is empty.
 547
 548 =cut
 549 */
 550
 551 SV *
 552 Perl_av_pop(pTHX_ register AV *av)
 553 {
 554     SV *retval;
 555     MAGIC* mg;
 556
 557     if (!av)
 558       return &PL_sv_undef;
 559     if (SvREADONLY(av))
 560         Perl_croak(aTHX_ PL_no_modify);
 561     if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
 562         dSP;
 563         PUSHSTACKi(PERLSI_MAGIC);
 564         PUSHMARK(SP);
 565         XPUSHs(SvTIED_obj((SV*)av, mg));
 566         PUTBACK;
 567         ENTER;
 568         if (call_method("POP", G_SCALAR)) {
 569             retval = newSVsv(*PL_stack_sp--);
 570         } else {
 571             retval = &PL_sv_undef;
 572         }
 573         LEAVE;
 574         POPSTACK;
 575         return retval;
 576     }
 577     if (AvFILL(av) < 0)
 578         return &PL_sv_undef;
 579     retval = AvARRAY(av)[AvFILLp(av)];
 580     AvARRAY(av)[AvFILLp(av)--] = &PL_sv_undef;
 581     if (SvSMAGICAL(av))
 582         mg_set((SV*)av);
 583     return retval;
 584 }
 585
 586 /*
 587 =for apidoc av_unshift
 588
 589 Unshift the given number of C<undef> values onto the beginning of the
 590 array.  The array will grow automatically to accommodate the addition.  You
 591 must then use C<av_store> to assign values to these new elements.
 592
 593 =cut
 594 */
 595
 596 void
 597 Perl_av_unshift(pTHX_ register AV *av, register I32 num)
 598 {
 599     register I32 i;
 600     register SV **ary;
 601     MAGIC* mg;
 602     I32 slide;
 603
 604     if (!av)
 605         return;
 606     if (SvREADONLY(av))
 607         Perl_croak(aTHX_ PL_no_modify);
 608
 609     if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
 610         dSP;
 611         PUSHSTACKi(PERLSI_MAGIC);
 612         PUSHMARK(SP);
 613         EXTEND(SP,1+num);
 614         PUSHs(SvTIED_obj((SV*)av, mg));
 615         while (num-- > 0) {
 616             PUSHs(&PL_sv_undef);
 617         }
 618         PUTBACK;
 619         ENTER;
 620         call_method("UNSHIFT", G_SCALAR|G_DISCARD);
 621         LEAVE;
 622         POPSTACK;
 623         return;
 624     }
 625
 626     if (num <= 0)
 627       return;
 628     if (!AvREAL(av) && AvREIFY(av))
 629         av_reify(av);
 630     i = AvARRAY(av) - AvALLOC(av);
 631     if (i) {
 632         if (i > num)
 633             i = num;
 634         num -= i;
 635
 636         AvMAX(av) += i;
 637         AvFILLp(av) += i;
 638         SvPVX(av) = (char*)(AvARRAY(av) - i);
 639     }
 640     if (num) {
 641         i = AvFILLp(av);
 642         /* Create extra elements */
 643         slide = i > 0 ? i : 0;
 644         num += slide;
 645         av_extend(av, i + num);
 646         AvFILLp(av) += num;
 647         ary = AvARRAY(av);
 648         Move(ary, ary + num, i + 1, SV*);
 649         do {
 650             ary[--num] = &PL_sv_undef;
 651         } while (num);
 652         /* Make extra elements into a buffer */
 653         AvMAX(av) -= slide;
 654         AvFILLp(av) -= slide;
 655         SvPVX(av) = (char*)(AvARRAY(av) + slide);
 656     }
 657 }
 658
 659 /*
 660 =for apidoc av_shift
 661
 662 Shifts an SV off the beginning of the array.
 663
 664 =cut
 665 */
 666
 667 SV *
 668 Perl_av_shift(pTHX_ register AV *av)
 669 {
 670     SV *retval;
 671     MAGIC* mg;
 672
 673     if (!av)
 674         return &PL_sv_undef;
 675     if (SvREADONLY(av))
 676         Perl_croak(aTHX_ PL_no_modify);
 677     if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
 678         dSP;
 679         PUSHSTACKi(PERLSI_MAGIC);
 680         PUSHMARK(SP);
 681         XPUSHs(SvTIED_obj((SV*)av, mg));
 682         PUTBACK;
 683         ENTER;
 684         if (call_method("SHIFT", G_SCALAR)) {
 685             retval = newSVsv(*PL_stack_sp--);
 686         } else {
 687             retval = &PL_sv_undef;
 688         }
 689         LEAVE;
 690         POPSTACK;
 691         return retval;
 692     }
 693     if (AvFILL(av) < 0)
 694       return &PL_sv_undef;
 695     retval = *AvARRAY(av);
 696     if (AvREAL(av))
 697         *AvARRAY(av) = &PL_sv_undef;
 698     SvPVX(av) = (char*)(AvARRAY(av) + 1);
 699     AvMAX(av)--;
 700     AvFILLp(av)--;
 701     if (SvSMAGICAL(av))
 702         mg_set((SV*)av);
 703     return retval;
 704 }
 705
 706 /*
 707 =for apidoc av_len
 708
 709 Returns the highest index in the array.  Returns -1 if the array is
 710 empty.
 711
 712 =cut
 713 */
 714
 715 I32
 716 Perl_av_len(pTHX_ register AV *av)
 717 {
 718     return AvFILL(av);
 719 }
 720
 721 /*
 722 =for apidoc av_fill
 723
 724 Ensure than an array has a given number of elements, equivalent to
 725 Perl's C<$#array = $fill;>.
 726
 727 =cut
 728 */
 729 void
 730 Perl_av_fill(pTHX_ register AV *av, I32 fill)
 731 {
 732     MAGIC *mg;
 733     if (!av)
 734         Perl_croak(aTHX_ "panic: null array");
 735     if (fill < 0)
 736         fill = -1;
 737     if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
 738         dSP;
 739         ENTER;
 740         SAVETMPS;
 741         PUSHSTACKi(PERLSI_MAGIC);
 742         PUSHMARK(SP);
 743         EXTEND(SP,2);
 744         PUSHs(SvTIED_obj((SV*)av, mg));
 745         PUSHs(sv_2mortal(newSViv(fill+1)));
 746         PUTBACK;
 747         call_method("STORESIZE", G_SCALAR|G_DISCARD);
 748         POPSTACK;
 749         FREETMPS;
 750         LEAVE;
 751         return;
 752     }
 753     if (fill <= AvMAX(av)) {
 754         I32 key = AvFILLp(av);
 755         SV** ary = AvARRAY(av);
 756
 757         if (AvREAL(av)) {
 758             while (key > fill) {
 759                 SvREFCNT_dec(ary[key]);
 760                 ary[key--] = &PL_sv_undef;
 761             }
 762         }
 763         else {
 764             while (key < fill)
 765                 ary[++key] = &PL_sv_undef;
 766         }
 767
 768         AvFILLp(av) = fill;
 769         if (SvSMAGICAL(av))
 770             mg_set((SV*)av);
 771     }
 772     else
 773         (void)av_store(av,fill,&PL_sv_undef);
 774 }
 775
 776 /*
 777 =for apidoc av_delete
 778
 779 Deletes the element indexed by C<key> from the array.  Returns the
 780 deleted element. C<flags> is currently ignored.
 781
 782 =cut
 783 */
 784 SV *
 785 Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
 786 {
 787     SV *sv;
 788
 789     if (!av)
 790         return Nullsv;
 791     if (SvREADONLY(av))
 792         Perl_croak(aTHX_ PL_no_modify);
 793
 794     if (SvRMAGICAL(av)) {
 795         MAGIC *tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
 796         SV **svp;
 797         if ((tied_magic || mg_find((SV*)av, PERL_MAGIC_regdata))) {
 798             /* Handle negative array indices 20020222 MJD */
 799             if (key < 0) {
 800                 unsigned adjust_index = 1;
 801                 if (tied_magic) {
 802                     SV **negative_indices_glob =
 803                         hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av,
 804                                                          tied_magic))),
 805                                  NEGATIVE_INDICES_VAR, 16, 0);
 806                     if (negative_indices_glob
 807                         && SvTRUE(GvSV(*negative_indices_glob)))
 808                         adjust_index = 0;
 809                 }
 810                 if (adjust_index) {
 811                     key += AvFILL(av) + 1;
 812                     if (key < 0)
 813                         return Nullsv;
 814                 }
 815             }
 816             svp = av_fetch(av, key, TRUE);
 817             if (svp) {
 818                 sv = *svp;
 819                 mg_clear(sv);
 820                 if (mg_find(sv, PERL_MAGIC_tiedelem)) {
 821                     sv_unmagic(sv, PERL_MAGIC_tiedelem); /* No longer an element */
 822                     return sv;
 823                 }
 824                 return Nullsv;
 825             }
 826         }
 827     }
 828
 829     if (key < 0) {
 830         key += AvFILL(av) + 1;
 831         if (key < 0)
 832             return Nullsv;
 833     }
 834
 835     if (key > AvFILLp(av))
 836         return Nullsv;
 837     else {
 838         sv = AvARRAY(av)[key];
 839         if (key == AvFILLp(av)) {
 840             AvARRAY(av)[key] = &PL_sv_undef;
 841             do {
 842                 AvFILLp(av)--;
 843             } while (--key >= 0 && AvARRAY(av)[key] == &PL_sv_undef);
 844         }
 845         else
 846             AvARRAY(av)[key] = &PL_sv_undef;
 847         if (SvSMAGICAL(av))
 848             mg_set((SV*)av);
 849     }
 850     if (flags & G_DISCARD) {
 851         SvREFCNT_dec(sv);
 852         sv = Nullsv;
 853     }
 854     return sv;
 855 }
 856
 857 /*
 858 =for apidoc av_exists
 859
 860 Returns true if the element indexed by C<key> has been initialized.
 861
 862 This relies on the fact that uninitialized array elements are set to
 863 C<&PL_sv_undef>.
 864
 865 =cut
 866 */
 867 bool
 868 Perl_av_exists(pTHX_ AV *av, I32 key)
 869 {
 870     if (!av)
 871         return FALSE;
 872
 873
 874     if (SvRMAGICAL(av)) {
 875         MAGIC *tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
 876         if (tied_magic || mg_find((SV*)av, PERL_MAGIC_regdata)) {
 877             SV *sv = sv_newmortal();
 878             MAGIC *mg;
 879             /* Handle negative array indices 20020222 MJD */
 880             if (key < 0) {
 881                 unsigned adjust_index = 1;
 882                 if (tied_magic) {
 883                     SV **negative_indices_glob =
 884                         hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av,
 885                                                          tied_magic))),
 886                                  NEGATIVE_INDICES_VAR, 16, 0);
 887                     if (negative_indices_glob
 888                         && SvTRUE(GvSV(*negative_indices_glob)))
 889                         adjust_index = 0;
 890                 }
 891                 if (adjust_index) {
 892                     key += AvFILL(av) + 1;
 893                     if (key < 0)
 894                         return FALSE;
 895                 }
 896             }
 897
 898             mg_copy((SV*)av, sv, 0, key);
 899             mg = mg_find(sv, PERL_MAGIC_tiedelem);
 900             if (mg) {
 901                 magic_existspack(sv, mg);
 902                 return (bool)SvTRUE(sv);
 903             }
 904
 905         }
 906     }
 907
 908     if (key < 0) {
 909         key += AvFILL(av) + 1;
 910         if (key < 0)
 911             return FALSE;
 912     }
 913
 914     if (key <= AvFILLp(av) && AvARRAY(av)[key] != &PL_sv_undef
 915         && AvARRAY(av)[key])
 916     {
 917         return TRUE;
 918     }
 919     else
 920         return FALSE;
 921 }