document how to set APPLLIB_EXP
[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             SvREFCNT_dec(ary[--key]);
457             ary[key] = &PL_sv_undef;
458         }
459     }
460     if ((key = AvARRAY(av) - AvALLOC(av))) {
461         AvMAX(av) += key;
462         SvPVX(av) = (char*)AvALLOC(av);
463     }
464     AvFILLp(av) = -1;
465
466 }
467
468 /*
469 =for apidoc av_undef
470
471 Undefines the array.  Frees the memory used by the array itself.
472
473 =cut
474 */
475
476 void
477 Perl_av_undef(pTHX_ register AV *av)
478 {
479     register I32 key;
480
481     if (!av)
482         return;
483     /*SUPPRESS 560*/
484
485     /* Give any tie a chance to cleanup first */
486     if (SvTIED_mg((SV*)av, PERL_MAGIC_tied)) 
487         av_fill(av, -1);   /* mg_clear() ? */
488
489     if (AvREAL(av)) {
490         key = AvFILLp(av) + 1;
491         while (key)
492             SvREFCNT_dec(AvARRAY(av)[--key]);
493     }
494     Safefree(AvALLOC(av));
495     AvALLOC(av) = 0;
496     SvPVX(av) = 0;
497     AvMAX(av) = AvFILLp(av) = -1;
498     if (AvARYLEN(av)) {
499         SvREFCNT_dec(AvARYLEN(av));
500         AvARYLEN(av) = 0;
501     }
502 }
503
504 /*
505 =for apidoc av_push
506
507 Pushes an SV onto the end of the array.  The array will grow automatically
508 to accommodate the addition.
509
510 =cut
511 */
512
513 void
514 Perl_av_push(pTHX_ register AV *av, SV *val)
515 {             
516     MAGIC *mg;
517     if (!av)
518         return;
519     if (SvREADONLY(av))
520         Perl_croak(aTHX_ PL_no_modify);
521
522     if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
523         dSP;
524         PUSHSTACKi(PERLSI_MAGIC);
525         PUSHMARK(SP);
526         EXTEND(SP,2);
527         PUSHs(SvTIED_obj((SV*)av, mg));
528         PUSHs(val);
529         PUTBACK;
530         ENTER;
531         call_method("PUSH", G_SCALAR|G_DISCARD);
532         LEAVE;
533         POPSTACK;
534         return;
535     }
536     av_store(av,AvFILLp(av)+1,val);
537 }
538
539 /*
540 =for apidoc av_pop
541
542 Pops an SV off the end of the array.  Returns C<&PL_sv_undef> if the array
543 is empty.
544
545 =cut
546 */
547
548 SV *
549 Perl_av_pop(pTHX_ register AV *av)
550 {
551     SV *retval;
552     MAGIC* mg;
553
554     if (!av)
555       return &PL_sv_undef;
556     if (SvREADONLY(av))
557         Perl_croak(aTHX_ PL_no_modify);
558     if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
559         dSP;    
560         PUSHSTACKi(PERLSI_MAGIC);
561         PUSHMARK(SP);
562         XPUSHs(SvTIED_obj((SV*)av, mg));
563         PUTBACK;
564         ENTER;
565         if (call_method("POP", G_SCALAR)) {
566             retval = newSVsv(*PL_stack_sp--);    
567         } else {    
568             retval = &PL_sv_undef;
569         }
570         LEAVE;
571         POPSTACK;
572         return retval;
573     }
574     if (AvFILL(av) < 0)
575         return &PL_sv_undef;
576     retval = AvARRAY(av)[AvFILLp(av)];
577     AvARRAY(av)[AvFILLp(av)--] = &PL_sv_undef;
578     if (SvSMAGICAL(av))
579         mg_set((SV*)av);
580     return retval;
581 }
582
583 /*
584 =for apidoc av_unshift
585
586 Unshift the given number of C<undef> values onto the beginning of the
587 array.  The array will grow automatically to accommodate the addition.  You
588 must then use C<av_store> to assign values to these new elements.
589
590 =cut
591 */
592
593 void
594 Perl_av_unshift(pTHX_ register AV *av, register I32 num)
595 {
596     register I32 i;
597     register SV **ary;
598     MAGIC* mg;
599     I32 slide;
600
601     if (!av)
602         return;
603     if (SvREADONLY(av))
604         Perl_croak(aTHX_ PL_no_modify);
605
606     if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
607         dSP;
608         PUSHSTACKi(PERLSI_MAGIC);
609         PUSHMARK(SP);
610         EXTEND(SP,1+num);
611         PUSHs(SvTIED_obj((SV*)av, mg));
612         while (num-- > 0) {
613             PUSHs(&PL_sv_undef);
614         }
615         PUTBACK;
616         ENTER;
617         call_method("UNSHIFT", G_SCALAR|G_DISCARD);
618         LEAVE;
619         POPSTACK;
620         return;
621     }
622
623     if (num <= 0)
624       return;
625     if (!AvREAL(av) && AvREIFY(av))
626         av_reify(av);
627     i = AvARRAY(av) - AvALLOC(av);
628     if (i) {
629         if (i > num)
630             i = num;
631         num -= i;
632     
633         AvMAX(av) += i;
634         AvFILLp(av) += i;
635         SvPVX(av) = (char*)(AvARRAY(av) - i);
636     }
637     if (num) {
638         i = AvFILLp(av);
639         /* Create extra elements */
640         slide = i > 0 ? i : 0;
641         num += slide;
642         av_extend(av, i + num);
643         AvFILLp(av) += num;
644         ary = AvARRAY(av);
645         Move(ary, ary + num, i + 1, SV*);
646         do {
647             ary[--num] = &PL_sv_undef;
648         } while (num);
649         /* Make extra elements into a buffer */
650         AvMAX(av) -= slide;
651         AvFILLp(av) -= slide;
652         SvPVX(av) = (char*)(AvARRAY(av) + slide);
653     }
654 }
655
656 /*
657 =for apidoc av_shift
658
659 Shifts an SV off the beginning of the array.
660
661 =cut
662 */
663
664 SV *
665 Perl_av_shift(pTHX_ register AV *av)
666 {
667     SV *retval;
668     MAGIC* mg;
669
670     if (!av)
671         return &PL_sv_undef;
672     if (SvREADONLY(av))
673         Perl_croak(aTHX_ PL_no_modify);
674     if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
675         dSP;
676         PUSHSTACKi(PERLSI_MAGIC);
677         PUSHMARK(SP);
678         XPUSHs(SvTIED_obj((SV*)av, mg));
679         PUTBACK;
680         ENTER;
681         if (call_method("SHIFT", G_SCALAR)) {
682             retval = newSVsv(*PL_stack_sp--);            
683         } else {    
684             retval = &PL_sv_undef;
685         }     
686         LEAVE;
687         POPSTACK;
688         return retval;
689     }
690     if (AvFILL(av) < 0)
691       return &PL_sv_undef;
692     retval = *AvARRAY(av);
693     if (AvREAL(av))
694         *AvARRAY(av) = &PL_sv_undef;
695     SvPVX(av) = (char*)(AvARRAY(av) + 1);
696     AvMAX(av)--;
697     AvFILLp(av)--;
698     if (SvSMAGICAL(av))
699         mg_set((SV*)av);
700     return retval;
701 }
702
703 /*
704 =for apidoc av_len
705
706 Returns the highest index in the array.  Returns -1 if the array is
707 empty.
708
709 =cut
710 */
711
712 I32
713 Perl_av_len(pTHX_ register AV *av)
714 {
715     return AvFILL(av);
716 }
717
718 /*
719 =for apidoc av_fill
720
721 Ensure than an array has a given number of elements, equivalent to
722 Perl's C<$#array = $fill;>.
723
724 =cut
725 */
726 void
727 Perl_av_fill(pTHX_ register AV *av, I32 fill)
728 {
729     MAGIC *mg;
730     if (!av)
731         Perl_croak(aTHX_ "panic: null array");
732     if (fill < 0)
733         fill = -1;
734     if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
735         dSP;            
736         ENTER;
737         SAVETMPS;
738         PUSHSTACKi(PERLSI_MAGIC);
739         PUSHMARK(SP);
740         EXTEND(SP,2);
741         PUSHs(SvTIED_obj((SV*)av, mg));
742         PUSHs(sv_2mortal(newSViv(fill+1)));
743         PUTBACK;
744         call_method("STORESIZE", G_SCALAR|G_DISCARD);
745         POPSTACK;
746         FREETMPS;
747         LEAVE;
748         return;
749     }
750     if (fill <= AvMAX(av)) {
751         I32 key = AvFILLp(av);
752         SV** ary = AvARRAY(av);
753
754         if (AvREAL(av)) {
755             while (key > fill) {
756                 SvREFCNT_dec(ary[key]);
757                 ary[key--] = &PL_sv_undef;
758             }
759         }
760         else {
761             while (key < fill)
762                 ary[++key] = &PL_sv_undef;
763         }
764             
765         AvFILLp(av) = fill;
766         if (SvSMAGICAL(av))
767             mg_set((SV*)av);
768     }
769     else
770         (void)av_store(av,fill,&PL_sv_undef);
771 }
772
773 /*
774 =for apidoc av_delete
775
776 Deletes the element indexed by C<key> from the array.  Returns the
777 deleted element. C<flags> is currently ignored.
778
779 =cut
780 */
781 SV *
782 Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
783 {
784     SV *sv;
785
786     if (!av)
787         return Nullsv;
788     if (SvREADONLY(av))
789         Perl_croak(aTHX_ PL_no_modify);
790
791     if (SvRMAGICAL(av)) {
792         MAGIC *tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
793         SV **svp;
794         if ((tied_magic || mg_find((SV*)av, PERL_MAGIC_regdata))) {
795             /* Handle negative array indices 20020222 MJD */
796             if (key < 0) {
797                 unsigned adjust_index = 1;
798                 if (tied_magic) {
799                     SV **negative_indices_glob = 
800                         hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av, 
801                                                          tied_magic))), 
802                                  NEGATIVE_INDICES_VAR, 16, 0);
803                     if (negative_indices_glob
804                         && SvTRUE(GvSV(*negative_indices_glob)))
805                         adjust_index = 0;
806                 }
807                 if (adjust_index) {
808                     key += AvFILL(av) + 1;
809                     if (key < 0)
810                         return Nullsv;
811                 }
812             }
813             svp = av_fetch(av, key, TRUE);
814             if (svp) {
815                 sv = *svp;
816                 mg_clear(sv);
817                 if (mg_find(sv, PERL_MAGIC_tiedelem)) {
818                     sv_unmagic(sv, PERL_MAGIC_tiedelem); /* No longer an element */
819                     return sv;
820                 }
821                 return Nullsv;     
822             }
823         }
824     }
825
826     if (key < 0) {
827         key += AvFILL(av) + 1;
828         if (key < 0)
829             return Nullsv;
830     }
831
832     if (key > AvFILLp(av))
833         return Nullsv;
834     else {
835         sv = AvARRAY(av)[key];
836         if (key == AvFILLp(av)) {
837             AvARRAY(av)[key] = &PL_sv_undef;
838             do {
839                 AvFILLp(av)--;
840             } while (--key >= 0 && AvARRAY(av)[key] == &PL_sv_undef);
841         }
842         else
843             AvARRAY(av)[key] = &PL_sv_undef;
844         if (SvSMAGICAL(av))
845             mg_set((SV*)av);
846     }
847     if (flags & G_DISCARD) {
848         SvREFCNT_dec(sv);
849         sv = Nullsv;
850     }
851     return sv;
852 }
853
854 /*
855 =for apidoc av_exists
856
857 Returns true if the element indexed by C<key> has been initialized.
858
859 This relies on the fact that uninitialized array elements are set to
860 C<&PL_sv_undef>.
861
862 =cut
863 */
864 bool
865 Perl_av_exists(pTHX_ AV *av, I32 key)
866 {
867     if (!av)
868         return FALSE;
869
870
871     if (SvRMAGICAL(av)) {
872         MAGIC *tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
873         if (tied_magic || mg_find((SV*)av, PERL_MAGIC_regdata)) {
874             SV *sv = sv_newmortal();
875             MAGIC *mg;
876             /* Handle negative array indices 20020222 MJD */
877             if (key < 0) {
878                 unsigned adjust_index = 1;
879                 if (tied_magic) {
880                     SV **negative_indices_glob = 
881                         hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av, 
882                                                          tied_magic))), 
883                                  NEGATIVE_INDICES_VAR, 16, 0);
884                     if (negative_indices_glob
885                         && SvTRUE(GvSV(*negative_indices_glob)))
886                         adjust_index = 0;
887                 }
888                 if (adjust_index) {
889                     key += AvFILL(av) + 1;
890                     if (key < 0)
891                         return FALSE;
892                 }
893             }
894
895             mg_copy((SV*)av, sv, 0, key);
896             mg = mg_find(sv, PERL_MAGIC_tiedelem);
897             if (mg) {
898                 magic_existspack(sv, mg);
899                 return (bool)SvTRUE(sv);
900             }
901
902         }
903     }
904
905     if (key < 0) {
906         key += AvFILL(av) + 1;
907         if (key < 0)
908             return FALSE;
909     }
910
911     if (key <= AvFILLp(av) && AvARRAY(av)[key] != &PL_sv_undef
912         && AvARRAY(av)[key])
913     {
914         return TRUE;
915     }
916     else
917         return FALSE;
918 }