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