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