av.c

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