signbit detection (was [perl #39875] -0.0 loses signedness upon numeric comparison)
[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             SvREFCNT_inc_simple_void_NN(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             AvARRAY(av) = 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             AvARRAY(av) = 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
198     assert(av);
199
200     if (SvRMAGICAL(av)) {
201         const MAGIC * const tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
202         if (tied_magic || mg_find((SV*)av, PERL_MAGIC_regdata)) {
203             SV *sv;
204             if (key < 0) {
205                 I32 adjust_index = 1;
206                 if (tied_magic) {
207                     /* Handle negative array indices 20020222 MJD */
208                     SV * const * const negative_indices_glob =
209                         hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av, tied_magic))),
210                                 NEGATIVE_INDICES_VAR, 16, 0);
211
212                     if (negative_indices_glob && SvTRUE(GvSV(*negative_indices_glob)))
213                         adjust_index = 0;
214                 }
215
216                 if (adjust_index) {
217                     key += AvFILL(av) + 1;
218                     if (key < 0)
219                         return NULL;
220                 }
221             }
222
223             sv = sv_newmortal();
224             sv_upgrade(sv, SVt_PVLV);
225             mg_copy((SV*)av, sv, 0, key);
226             LvTYPE(sv) = 't';
227             LvTARG(sv) = sv; /* fake (SV**) */
228             return &(LvTARG(sv));
229         }
230     }
231
232     if (key < 0) {
233         key += AvFILL(av) + 1;
234         if (key < 0)
235             return NULL;
236     }
237
238     if (key > AvFILLp(av)) {
239         if (!lval)
240             return NULL;
241         return av_store(av,key,newSV(0));
242     }
243     if (AvARRAY(av)[key] == &PL_sv_undef) {
244     emptyness:
245         if (lval)
246             return av_store(av,key,newSV(0));
247         return NULL;
248     }
249     else if (AvREIFY(av)
250              && (!AvARRAY(av)[key]      /* eg. @_ could have freed elts */
251                  || SvIS_FREED(AvARRAY(av)[key]))) {
252         AvARRAY(av)[key] = &PL_sv_undef;        /* 1/2 reify */
253         goto emptyness;
254     }
255     return &AvARRAY(av)[key];
256 }
257
258 /*
259 =for apidoc av_store
260
261 Stores an SV in an array.  The array index is specified as C<key>.  The
262 return value will be NULL if the operation failed or if the value did not
263 need to be actually stored within the array (as in the case of tied
264 arrays). Otherwise it can be dereferenced to get the original C<SV*>.  Note
265 that the caller is responsible for suitably incrementing the reference
266 count of C<val> before the call, and decrementing it if the function
267 returned NULL.
268
269 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
270 more information on how to use this function on tied arrays.
271
272 =cut
273 */
274
275 SV**
276 Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
277 {
278     dVAR;
279     SV** ary;
280
281     assert(av);
282
283     /* S_regclass relies on being able to pass in a NULL sv
284        (unicode_alternate may be NULL).
285     */
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                 bool 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 NULL;
313         }
314     }
315
316
317     if (key < 0) {
318         key += AvFILL(av) + 1;
319         if (key < 0)
320             return NULL;
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(0);
366
367     sv_upgrade((SV *)av, SVt_PVAV);
368     /* sv_upgrade does AvREAL_only()  */
369     AvALLOC(av) = 0;
370     AvARRAY(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(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         AvARRAY(av) = ary;
398         AvFILLp(av) = AvMAX(av) = size - 1;
399         for (i = 0; i < size; i++) {
400             assert (*strp);
401             ary[i] = newSV(0);
402             sv_setsv(ary[i], *strp);
403             strp++;
404         }
405     }
406     return av;
407 }
408
409 /*
410 =for apidoc av_clear
411
412 Clears an array, making it empty.  Does not free the memory used by the
413 array itself.
414
415 =cut
416 */
417
418 void
419 Perl_av_clear(pTHX_ register AV *av)
420 {
421     dVAR;
422     I32 extra;
423
424     assert(av);
425 #ifdef DEBUGGING
426     if (SvREFCNT(av) == 0 && ckWARN_d(WARN_DEBUGGING)) {
427         Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "Attempt to clear deleted array");
428     }
429 #endif
430
431     if (SvREADONLY(av))
432         Perl_croak(aTHX_ PL_no_modify);
433
434     /* Give any tie a chance to cleanup first */
435     if (SvRMAGICAL(av))
436         mg_clear((SV*)av); 
437
438     if (AvMAX(av) < 0)
439         return;
440
441     if (AvREAL(av)) {
442         SV** const ary = AvARRAY(av);
443         I32 index = AvFILLp(av) + 1;
444         while (index) {
445             SV * const sv = ary[--index];
446             /* undef the slot before freeing the value, because a
447              * destructor might try to modify this array */
448             ary[index] = &PL_sv_undef;
449             SvREFCNT_dec(sv);
450         }
451     }
452     extra = AvARRAY(av) - AvALLOC(av);
453     if (extra) {
454         AvMAX(av) += extra;
455         AvARRAY(av) = 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) = NULL;
485     AvARRAY(av) = NULL;
486     AvMAX(av) = AvFILLp(av) = -1;
487 }
488
489 /*
490
491 =for apidoc av_create_and_push
492
493 Push an SV onto the end of the array, creating the array if necessary.
494 A small internal helper function to remove a commonly duplicated idiom.
495
496 =cut
497 */
498
499 void
500 Perl_av_create_and_push(pTHX_ AV **const avp, SV *const val)
501 {
502     if (!*avp)
503         *avp = newAV();
504     av_push(*avp, val);
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     dVAR;
520     MAGIC *mg;
521     assert(av);
522
523     if (SvREADONLY(av))
524         Perl_croak(aTHX_ PL_no_modify);
525
526     if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
527         dSP;
528         PUSHSTACKi(PERLSI_MAGIC);
529         PUSHMARK(SP);
530         EXTEND(SP,2);
531         PUSHs(SvTIED_obj((SV*)av, mg));
532         PUSHs(val);
533         PUTBACK;
534         ENTER;
535         call_method("PUSH", G_SCALAR|G_DISCARD);
536         LEAVE;
537         POPSTACK;
538         return;
539     }
540     av_store(av,AvFILLp(av)+1,val);
541 }
542
543 /*
544 =for apidoc av_pop
545
546 Pops an SV off the end of the array.  Returns C<&PL_sv_undef> if the array
547 is empty.
548
549 =cut
550 */
551
552 SV *
553 Perl_av_pop(pTHX_ register AV *av)
554 {
555     dVAR;
556     SV *retval;
557     MAGIC* mg;
558
559     assert(av);
560
561     if (SvREADONLY(av))
562         Perl_croak(aTHX_ PL_no_modify);
563     if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
564         dSP;    
565         PUSHSTACKi(PERLSI_MAGIC);
566         PUSHMARK(SP);
567         XPUSHs(SvTIED_obj((SV*)av, mg));
568         PUTBACK;
569         ENTER;
570         if (call_method("POP", G_SCALAR)) {
571             retval = newSVsv(*PL_stack_sp--);    
572         } else {    
573             retval = &PL_sv_undef;
574         }
575         LEAVE;
576         POPSTACK;
577         return retval;
578     }
579     if (AvFILL(av) < 0)
580         return &PL_sv_undef;
581     retval = AvARRAY(av)[AvFILLp(av)];
582     AvARRAY(av)[AvFILLp(av)--] = &PL_sv_undef;
583     if (SvSMAGICAL(av))
584         mg_set((SV*)av);
585     return retval;
586 }
587
588 /*
589
590 =for apidoc av_create_and_unshift_one
591
592 Unshifts an SV onto the beginning of the array, creating the array if
593 necessary.
594 A small internal helper function to remove a commonly duplicated idiom.
595
596 =cut
597 */
598
599 SV **
600 Perl_av_create_and_unshift_one(pTHX_ AV **const avp, SV *const val)
601 {
602     if (!*avp)
603         *avp = newAV();
604     av_unshift(*avp, 1);
605     return av_store(*avp, 0, val);
606 }
607
608 /*
609 =for apidoc av_unshift
610
611 Unshift the given number of C<undef> values onto the beginning of the
612 array.  The array will grow automatically to accommodate the addition.  You
613 must then use C<av_store> to assign values to these new elements.
614
615 =cut
616 */
617
618 void
619 Perl_av_unshift(pTHX_ register AV *av, register I32 num)
620 {
621     dVAR;
622     register I32 i;
623     MAGIC* mg;
624
625     assert(av);
626
627     if (SvREADONLY(av))
628         Perl_croak(aTHX_ PL_no_modify);
629
630     if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
631         dSP;
632         PUSHSTACKi(PERLSI_MAGIC);
633         PUSHMARK(SP);
634         EXTEND(SP,1+num);
635         PUSHs(SvTIED_obj((SV*)av, mg));
636         while (num-- > 0) {
637             PUSHs(&PL_sv_undef);
638         }
639         PUTBACK;
640         ENTER;
641         call_method("UNSHIFT", G_SCALAR|G_DISCARD);
642         LEAVE;
643         POPSTACK;
644         return;
645     }
646
647     if (num <= 0)
648       return;
649     if (!AvREAL(av) && AvREIFY(av))
650         av_reify(av);
651     i = AvARRAY(av) - AvALLOC(av);
652     if (i) {
653         if (i > num)
654             i = num;
655         num -= i;
656     
657         AvMAX(av) += i;
658         AvFILLp(av) += i;
659         AvARRAY(av) = AvARRAY(av) - i;
660     }
661     if (num) {
662         register SV **ary;
663         I32 slide;
664         i = AvFILLp(av);
665         /* Create extra elements */
666         slide = i > 0 ? i : 0;
667         num += slide;
668         av_extend(av, i + num);
669         AvFILLp(av) += num;
670         ary = AvARRAY(av);
671         Move(ary, ary + num, i + 1, SV*);
672         do {
673             ary[--num] = &PL_sv_undef;
674         } while (num);
675         /* Make extra elements into a buffer */
676         AvMAX(av) -= slide;
677         AvFILLp(av) -= slide;
678         AvARRAY(av) = AvARRAY(av) + slide;
679     }
680 }
681
682 /*
683 =for apidoc av_shift
684
685 Shifts an SV off the beginning of the array.
686
687 =cut
688 */
689
690 SV *
691 Perl_av_shift(pTHX_ register AV *av)
692 {
693     dVAR;
694     SV *retval;
695     MAGIC* mg;
696
697     assert(av);
698
699     if (SvREADONLY(av))
700         Perl_croak(aTHX_ PL_no_modify);
701     if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
702         dSP;
703         PUSHSTACKi(PERLSI_MAGIC);
704         PUSHMARK(SP);
705         XPUSHs(SvTIED_obj((SV*)av, mg));
706         PUTBACK;
707         ENTER;
708         if (call_method("SHIFT", G_SCALAR)) {
709             retval = newSVsv(*PL_stack_sp--);            
710         } else {    
711             retval = &PL_sv_undef;
712         }     
713         LEAVE;
714         POPSTACK;
715         return retval;
716     }
717     if (AvFILL(av) < 0)
718       return &PL_sv_undef;
719     retval = *AvARRAY(av);
720     if (AvREAL(av))
721         *AvARRAY(av) = &PL_sv_undef;
722     AvARRAY(av) = AvARRAY(av) + 1;
723     AvMAX(av)--;
724     AvFILLp(av)--;
725     if (SvSMAGICAL(av))
726         mg_set((SV*)av);
727     return retval;
728 }
729
730 /*
731 =for apidoc av_len
732
733 Returns the highest index in the array.  The number of elements in the
734 array is C<av_len(av) + 1>.  Returns -1 if the array is empty.
735
736 =cut
737 */
738
739 I32
740 Perl_av_len(pTHX_ register const AV *av)
741 {
742     assert(av);
743     return AvFILL(av);
744 }
745
746 /*
747 =for apidoc av_fill
748
749 Set the highest index in the array to the given number, equivalent to
750 Perl's C<$#array = $fill;>.
751
752 The number of elements in the an array will be C<fill + 1> after
753 av_fill() returns.  If the array was previously shorter then the
754 additional elements appended are set to C<PL_sv_undef>.  If the array
755 was longer, then the excess elements are freed.  C<av_fill(av, -1)> is
756 the same as C<av_clear(av)>.
757
758 =cut
759 */
760 void
761 Perl_av_fill(pTHX_ register AV *av, I32 fill)
762 {
763     dVAR;
764     MAGIC *mg;
765
766     assert(av);
767
768     if (fill < 0)
769         fill = -1;
770     if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
771         dSP;            
772         ENTER;
773         SAVETMPS;
774         PUSHSTACKi(PERLSI_MAGIC);
775         PUSHMARK(SP);
776         EXTEND(SP,2);
777         PUSHs(SvTIED_obj((SV*)av, mg));
778         PUSHs(sv_2mortal(newSViv(fill+1)));
779         PUTBACK;
780         call_method("STORESIZE", G_SCALAR|G_DISCARD);
781         POPSTACK;
782         FREETMPS;
783         LEAVE;
784         return;
785     }
786     if (fill <= AvMAX(av)) {
787         I32 key = AvFILLp(av);
788         SV** const ary = AvARRAY(av);
789
790         if (AvREAL(av)) {
791             while (key > fill) {
792                 SvREFCNT_dec(ary[key]);
793                 ary[key--] = &PL_sv_undef;
794             }
795         }
796         else {
797             while (key < fill)
798                 ary[++key] = &PL_sv_undef;
799         }
800             
801         AvFILLp(av) = fill;
802         if (SvSMAGICAL(av))
803             mg_set((SV*)av);
804     }
805     else
806         (void)av_store(av,fill,&PL_sv_undef);
807 }
808
809 /*
810 =for apidoc av_delete
811
812 Deletes the element indexed by C<key> from the array.  Returns the
813 deleted element. If C<flags> equals C<G_DISCARD>, the element is freed
814 and null is returned.
815
816 =cut
817 */
818 SV *
819 Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
820 {
821     dVAR;
822     SV *sv;
823
824     assert(av);
825
826     if (SvREADONLY(av))
827         Perl_croak(aTHX_ PL_no_modify);
828
829     if (SvRMAGICAL(av)) {
830         const MAGIC * const tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
831         if ((tied_magic || mg_find((SV*)av, PERL_MAGIC_regdata))) {
832             /* Handle negative array indices 20020222 MJD */
833             SV **svp;
834             if (key < 0) {
835                 unsigned adjust_index = 1;
836                 if (tied_magic) {
837                     SV * const * const negative_indices_glob =
838                         hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av, 
839                                                          tied_magic))), 
840                                  NEGATIVE_INDICES_VAR, 16, 0);
841                     if (negative_indices_glob
842                         && SvTRUE(GvSV(*negative_indices_glob)))
843                         adjust_index = 0;
844                 }
845                 if (adjust_index) {
846                     key += AvFILL(av) + 1;
847                     if (key < 0)
848                         return NULL;
849                 }
850             }
851             svp = av_fetch(av, key, TRUE);
852             if (svp) {
853                 sv = *svp;
854                 mg_clear(sv);
855                 if (mg_find(sv, PERL_MAGIC_tiedelem)) {
856                     sv_unmagic(sv, PERL_MAGIC_tiedelem); /* No longer an element */
857                     return sv;
858                 }
859                 return NULL;
860             }
861         }
862     }
863
864     if (key < 0) {
865         key += AvFILL(av) + 1;
866         if (key < 0)
867             return NULL;
868     }
869
870     if (key > AvFILLp(av))
871         return NULL;
872     else {
873         if (!AvREAL(av) && AvREIFY(av))
874             av_reify(av);
875         sv = AvARRAY(av)[key];
876         if (key == AvFILLp(av)) {
877             AvARRAY(av)[key] = &PL_sv_undef;
878             do {
879                 AvFILLp(av)--;
880             } while (--key >= 0 && AvARRAY(av)[key] == &PL_sv_undef);
881         }
882         else
883             AvARRAY(av)[key] = &PL_sv_undef;
884         if (SvSMAGICAL(av))
885             mg_set((SV*)av);
886     }
887     if (flags & G_DISCARD) {
888         SvREFCNT_dec(sv);
889         sv = NULL;
890     }
891     else if (AvREAL(av))
892         sv = sv_2mortal(sv);
893     return sv;
894 }
895
896 /*
897 =for apidoc av_exists
898
899 Returns true if the element indexed by C<key> has been initialized.
900
901 This relies on the fact that uninitialized array elements are set to
902 C<&PL_sv_undef>.
903
904 =cut
905 */
906 bool
907 Perl_av_exists(pTHX_ AV *av, I32 key)
908 {
909     dVAR;
910     assert(av);
911
912     if (SvRMAGICAL(av)) {
913         const MAGIC * const tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
914         if (tied_magic || mg_find((SV*)av, PERL_MAGIC_regdata)) {
915             SV * const sv = sv_newmortal();
916             MAGIC *mg;
917             /* Handle negative array indices 20020222 MJD */
918             if (key < 0) {
919                 unsigned adjust_index = 1;
920                 if (tied_magic) {
921                     SV * const * const negative_indices_glob =
922                         hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av, 
923                                                          tied_magic))), 
924                                  NEGATIVE_INDICES_VAR, 16, 0);
925                     if (negative_indices_glob
926                         && SvTRUE(GvSV(*negative_indices_glob)))
927                         adjust_index = 0;
928                 }
929                 if (adjust_index) {
930                     key += AvFILL(av) + 1;
931                     if (key < 0)
932                         return FALSE;
933                 }
934             }
935
936             mg_copy((SV*)av, sv, 0, key);
937             mg = mg_find(sv, PERL_MAGIC_tiedelem);
938             if (mg) {
939                 magic_existspack(sv, mg);
940                 return (bool)SvTRUE(sv);
941             }
942
943         }
944     }
945
946     if (key < 0) {
947         key += AvFILL(av) + 1;
948         if (key < 0)
949             return FALSE;
950     }
951
952     if (key <= AvFILLp(av) && AvARRAY(av)[key] != &PL_sv_undef
953         && AvARRAY(av)[key])
954     {
955         return TRUE;
956     }
957     else
958         return FALSE;
959 }
960
961 SV **
962 Perl_av_arylen_p(pTHX_ AV *av) {
963     dVAR;
964     MAGIC *mg;
965
966     assert(av);
967
968     mg = mg_find((SV*)av, PERL_MAGIC_arylen_p);
969
970     if (!mg) {
971         mg = sv_magicext((SV*)av, 0, PERL_MAGIC_arylen_p, &PL_vtbl_arylen_p,
972                          0, 0);
973         assert(mg);
974         /* sv_magicext won't set this for us because we pass in a NULL obj  */
975         mg->mg_flags |= MGf_REFCOUNTED;
976     }
977     return &(mg->mg_obj);
978 }
979
980 /*
981  * Local variables:
982  * c-indentation-style: bsd
983  * c-basic-offset: 4
984  * indent-tabs-mode: t
985  * End:
986  *
987  * ex: set ts=8 sts=4 sw=4 noet:
988  */