av.c

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