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