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