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