This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
assert(av); Cleanup the way that the av_*() functions check
[perl5.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     assert(av);
66
67     MAGIC * const mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied);
68     if (mg) {
69         dSP;
70         ENTER;
71         SAVETMPS;
72         PUSHSTACKi(PERLSI_MAGIC);
73         PUSHMARK(SP);
74         EXTEND(SP,2);
75         PUSHs(SvTIED_obj((SV*)av, mg));
76         PUSHs(sv_2mortal(newSViv(key+1)));
77         PUTBACK;
78         call_method("EXTEND", G_SCALAR|G_DISCARD);
79         POPSTACK;
80         FREETMPS;
81         LEAVE;
82         return;
83     }
84     if (key > AvMAX(av)) {
85         SV** ary;
86         I32 tmp;
87         I32 newmax;
88
89         if (AvALLOC(av) != AvARRAY(av)) {
90             ary = AvALLOC(av) + AvFILLp(av) + 1;
91             tmp = AvARRAY(av) - AvALLOC(av);
92             Move(AvARRAY(av), AvALLOC(av), AvFILLp(av)+1, SV*);
93             AvMAX(av) += tmp;
94             SvPV_set(av, (char*)AvALLOC(av));
95             if (AvREAL(av)) {
96                 while (tmp)
97                     ary[--tmp] = &PL_sv_undef;
98             }
99             if (key > AvMAX(av) - 10) {
100                 newmax = key + AvMAX(av);
101                 goto resize;
102             }
103         }
104         else {
105 #ifdef PERL_MALLOC_WRAP
106             static const char oom_array_extend[] =
107               "Out of memory during array extend"; /* Duplicated in pp_hot.c */
108 #endif
109
110             if (AvALLOC(av)) {
111 #if !defined(STRANGE_MALLOC) && !defined(MYMALLOC)
112                 MEM_SIZE bytes;
113                 IV itmp;
114 #endif
115
116 #ifdef MYMALLOC
117                 newmax = malloced_size((void*)AvALLOC(av))/sizeof(SV*) - 1;
118
119                 if (key <= newmax) 
120                     goto resized;
121 #endif 
122                 newmax = key + AvMAX(av) / 5;
123               resize:
124                 MEM_WRAP_CHECK_1(newmax+1, SV*, oom_array_extend);
125 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
126                 Renew(AvALLOC(av),newmax+1, SV*);
127 #else
128                 bytes = (newmax + 1) * sizeof(SV*);
129 #define MALLOC_OVERHEAD 16
130                 itmp = MALLOC_OVERHEAD;
131                 while ((MEM_SIZE)(itmp - MALLOC_OVERHEAD) < bytes)
132                     itmp += itmp;
133                 itmp -= MALLOC_OVERHEAD;
134                 itmp /= sizeof(SV*);
135                 assert(itmp > newmax);
136                 newmax = itmp - 1;
137                 assert(newmax >= AvMAX(av));
138                 Newx(ary, newmax+1, SV*);
139                 Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*);
140                 if (AvMAX(av) > 64)
141                     offer_nice_chunk(AvALLOC(av), (AvMAX(av)+1) * sizeof(SV*));
142                 else
143                     Safefree(AvALLOC(av));
144                 AvALLOC(av) = ary;
145 #endif
146 #ifdef MYMALLOC
147               resized:
148 #endif
149                 ary = AvALLOC(av) + AvMAX(av) + 1;
150                 tmp = newmax - AvMAX(av);
151                 if (av == PL_curstack) {        /* Oops, grew stack (via av_store()?) */
152                     PL_stack_sp = AvALLOC(av) + (PL_stack_sp - PL_stack_base);
153                     PL_stack_base = AvALLOC(av);
154                     PL_stack_max = PL_stack_base + newmax;
155                 }
156             }
157             else {
158                 newmax = key < 3 ? 3 : key;
159                 MEM_WRAP_CHECK_1(newmax+1, SV*, oom_array_extend);
160                 Newx(AvALLOC(av), newmax+1, SV*);
161                 ary = AvALLOC(av) + 1;
162                 tmp = newmax;
163                 AvALLOC(av)[0] = &PL_sv_undef;  /* For the stacks */
164             }
165             if (AvREAL(av)) {
166                 while (tmp)
167                     ary[--tmp] = &PL_sv_undef;
168             }
169             
170             SvPV_set(av, (char*)AvALLOC(av));
171             AvMAX(av) = newmax;
172         }
173     }
174 }
175
176 /*
177 =for apidoc av_fetch
178
179 Returns the SV at the specified index in the array.  The C<key> is the
180 index.  If C<lval> is set then the fetch will be part of a store.  Check
181 that the return value is non-null before dereferencing it to a C<SV*>.
182
183 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
184 more information on how to use this function on tied arrays. 
185
186 =cut
187 */
188
189 SV**
190 Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval)
191 {
192     SV *sv;
193
194     assert(av);
195
196     if (SvRMAGICAL(av)) {
197         const MAGIC * const tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
198         if (tied_magic || mg_find((SV*)av, PERL_MAGIC_regdata)) {
199             U32 adjust_index = 1;
200
201             if (tied_magic && key < 0) {
202                 /* Handle negative array indices 20020222 MJD */
203                 SV * const * const negative_indices_glob =
204                     hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av, 
205                                                      tied_magic))), 
206                              NEGATIVE_INDICES_VAR, 16, 0);
207
208                 if (negative_indices_glob
209                     && SvTRUE(GvSV(*negative_indices_glob)))
210                     adjust_index = 0;
211             }
212
213             if (key < 0 && adjust_index) {
214                 key += AvFILL(av) + 1;
215                 if (key < 0)
216                     return 0;
217             }
218
219             sv = sv_newmortal();
220             sv_upgrade(sv, SVt_PVLV);
221             mg_copy((SV*)av, sv, 0, key);
222             LvTYPE(sv) = 't';
223             LvTARG(sv) = sv; /* fake (SV**) */
224             return &(LvTARG(sv));
225         }
226     }
227
228     if (key < 0) {
229         key += AvFILL(av) + 1;
230         if (key < 0)
231             return 0;
232     }
233
234     if (key > AvFILLp(av)) {
235         if (!lval)
236             return 0;
237         sv = NEWSV(5,0);
238         return av_store(av,key,sv);
239     }
240     if (AvARRAY(av)[key] == &PL_sv_undef) {
241     emptyness:
242         if (lval) {
243             sv = NEWSV(6,0);
244             return av_store(av,key,sv);
245         }
246         return 0;
247     }
248     else if (AvREIFY(av)
249              && (!AvARRAY(av)[key]      /* eg. @_ could have freed elts */
250                  || SvIS_FREED(AvARRAY(av)[key]))) {
251         AvARRAY(av)[key] = &PL_sv_undef;        /* 1/2 reify */
252         goto emptyness;
253     }
254     return &AvARRAY(av)[key];
255 }
256
257 /*
258 =for apidoc av_store
259
260 Stores an SV in an array.  The array index is specified as C<key>.  The
261 return value will be NULL if the operation failed or if the value did not
262 need to be actually stored within the array (as in the case of tied
263 arrays). Otherwise it can be dereferenced to get the original C<SV*>.  Note
264 that the caller is responsible for suitably incrementing the reference
265 count of C<val> before the call, and decrementing it if the function
266 returned NULL.
267
268 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
269 more information on how to use this function on tied arrays.
270
271 =cut
272 */
273
274 SV**
275 Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
276 {
277     SV** ary;
278
279     assert(av);
280
281     if (!val)
282         val = &PL_sv_undef;
283
284     if (SvRMAGICAL(av)) {
285         const MAGIC * const tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
286         if (tied_magic) {
287             /* Handle negative array indices 20020222 MJD */
288             if (key < 0) {
289                 unsigned adjust_index = 1;
290                 SV * const * const negative_indices_glob =
291                     hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av, 
292                                                      tied_magic))), 
293                              NEGATIVE_INDICES_VAR, 16, 0);
294                 if (negative_indices_glob
295                     && SvTRUE(GvSV(*negative_indices_glob)))
296                     adjust_index = 0;
297                 if (adjust_index) {
298                     key += AvFILL(av) + 1;
299                     if (key < 0)
300                         return 0;
301                 }
302             }
303             if (val != &PL_sv_undef) {
304                 mg_copy((SV*)av, val, 0, key);
305             }
306             return 0;
307         }
308     }
309
310
311     if (key < 0) {
312         key += AvFILL(av) + 1;
313         if (key < 0)
314             return 0;
315     }
316
317     if (SvREADONLY(av) && key >= AvFILL(av))
318         Perl_croak(aTHX_ PL_no_modify);
319
320     if (!AvREAL(av) && AvREIFY(av))
321         av_reify(av);
322     if (key > AvMAX(av))
323         av_extend(av,key);
324     ary = AvARRAY(av);
325     if (AvFILLp(av) < key) {
326         if (!AvREAL(av)) {
327             if (av == PL_curstack && key > PL_stack_sp - PL_stack_base)
328                 PL_stack_sp = PL_stack_base + key;      /* XPUSH in disguise */
329             do
330                 ary[++AvFILLp(av)] = &PL_sv_undef;
331             while (AvFILLp(av) < key);
332         }
333         AvFILLp(av) = key;
334     }
335     else if (AvREAL(av))
336         SvREFCNT_dec(ary[key]);
337     ary[key] = val;
338     if (SvSMAGICAL(av)) {
339         if (val != &PL_sv_undef) {
340             const MAGIC* const mg = SvMAGIC(av);
341             sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key);
342         }
343         mg_set((SV*)av);
344     }
345     return &ary[key];
346 }
347
348 /*
349 =for apidoc newAV
350
351 Creates a new AV.  The reference count is set to 1.
352
353 =cut
354 */
355
356 AV *
357 Perl_newAV(pTHX)
358 {
359     register AV * const av = (AV*)NEWSV(3,0);
360
361     sv_upgrade((SV *)av, SVt_PVAV);
362     /* sv_upgrade does AvREAL_only()  */
363     AvALLOC(av) = 0;
364     SvPV_set(av, (char*)0);
365     AvMAX(av) = AvFILLp(av) = -1;
366     return av;
367 }
368
369 /*
370 =for apidoc av_make
371
372 Creates a new AV and populates it with a list of SVs.  The SVs are copied
373 into the array, so they may be freed after the call to av_make.  The new AV
374 will have a reference count of 1.
375
376 =cut
377 */
378
379 AV *
380 Perl_av_make(pTHX_ register I32 size, register SV **strp)
381 {
382     register AV * const av = (AV*)NEWSV(8,0);
383
384     sv_upgrade((SV *) av,SVt_PVAV);
385     /* sv_upgrade does AvREAL_only()  */
386     if (size) {         /* "defined" was returning undef for size==0 anyway. */
387         register SV** ary;
388         register I32 i;
389         Newx(ary,size,SV*);
390         AvALLOC(av) = ary;
391         SvPV_set(av, (char*)ary);
392         AvFILLp(av) = size - 1;
393         AvMAX(av) = size - 1;
394         for (i = 0; i < size; i++) {
395             assert (*strp);
396             ary[i] = NEWSV(7,0);
397             sv_setsv(ary[i], *strp);
398             strp++;
399         }
400     }
401     return av;
402 }
403
404 /*
405 =for apidoc av_clear
406
407 Clears an array, making it empty.  Does not free the memory used by the
408 array itself.
409
410 =cut
411 */
412
413 void
414 Perl_av_clear(pTHX_ register AV *av)
415 {
416     register I32 key;
417
418     assert(av);
419
420 /* XXX Should av_clear really be NN? */
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
923         if (!mg) {
924             Perl_die(aTHX_ "panic: av_arylen_p");
925         }
926         /* sv_magicext won't set this for us because we pass in a NULL obj  */
927         mg->mg_flags |= MGf_REFCOUNTED;
928     }
929     return &(mg->mg_obj);
930 }
931
932 /*
933  * Local variables:
934  * c-indentation-style: bsd
935  * c-basic-offset: 4
936  * indent-tabs-mode: t
937  * End:
938  *
939  * ex: set ts=8 sts=4 sw=4 noet:
940  */