Re: [perl #41574] cond_wait hang ups under MSWin32
[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_type(SVt_PVAV);
366     /* sv_upgrade does AvREAL_only()  */
367     AvALLOC(av) = 0;
368     AvARRAY(av) = NULL;
369     AvMAX(av) = AvFILLp(av) = -1;
370     return av;
371 }
372
373 /*
374 =for apidoc av_make
375
376 Creates a new AV and populates it with a list of SVs.  The SVs are copied
377 into the array, so they may be freed after the call to av_make.  The new AV
378 will have a reference count of 1.
379
380 =cut
381 */
382
383 AV *
384 Perl_av_make(pTHX_ register I32 size, register SV **strp)
385 {
386     register AV * const av = (AV*)newSV_type(SVt_PVAV);
387     /* sv_upgrade does AvREAL_only()  */
388     if (size) {         /* "defined" was returning undef for size==0 anyway. */
389         register SV** ary;
390         register I32 i;
391         Newx(ary,size,SV*);
392         AvALLOC(av) = ary;
393         AvARRAY(av) = ary;
394         AvFILLp(av) = AvMAX(av) = size - 1;
395         for (i = 0; i < size; i++) {
396             assert (*strp);
397             ary[i] = newSV(0);
398             sv_setsv(ary[i], *strp);
399             strp++;
400         }
401     }
402     return av;
403 }
404
405 /*
406 =for apidoc av_clear
407
408 Clears an array, making it empty.  Does not free the memory used by the
409 array itself.
410
411 =cut
412 */
413
414 void
415 Perl_av_clear(pTHX_ register AV *av)
416 {
417     dVAR;
418     I32 extra;
419
420     assert(av);
421 #ifdef DEBUGGING
422     if (SvREFCNT(av) == 0 && ckWARN_d(WARN_DEBUGGING)) {
423         Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "Attempt to clear deleted array");
424     }
425 #endif
426
427     if (SvREADONLY(av))
428         Perl_croak(aTHX_ PL_no_modify);
429
430     /* Give any tie a chance to cleanup first */
431     if (SvRMAGICAL(av))
432         mg_clear((SV*)av); 
433
434     if (AvMAX(av) < 0)
435         return;
436
437     if (AvREAL(av)) {
438         SV** const ary = AvARRAY(av);
439         I32 index = AvFILLp(av) + 1;
440         while (index) {
441             SV * const sv = ary[--index];
442             /* undef the slot before freeing the value, because a
443              * destructor might try to modify this array */
444             ary[index] = &PL_sv_undef;
445             SvREFCNT_dec(sv);
446         }
447     }
448     extra = AvARRAY(av) - AvALLOC(av);
449     if (extra) {
450         AvMAX(av) += extra;
451         AvARRAY(av) = AvALLOC(av);
452     }
453     AvFILLp(av) = -1;
454
455 }
456
457 /*
458 =for apidoc av_undef
459
460 Undefines the array.  Frees the memory used by the array itself.
461
462 =cut
463 */
464
465 void
466 Perl_av_undef(pTHX_ register AV *av)
467 {
468     assert(av);
469
470     /* Give any tie a chance to cleanup first */
471     if (SvTIED_mg((SV*)av, PERL_MAGIC_tied)) 
472         av_fill(av, -1);   /* mg_clear() ? */
473
474     if (AvREAL(av)) {
475         register I32 key = AvFILLp(av) + 1;
476         while (key)
477             SvREFCNT_dec(AvARRAY(av)[--key]);
478     }
479     Safefree(AvALLOC(av));
480     AvALLOC(av) = NULL;
481     AvARRAY(av) = NULL;
482     AvMAX(av) = AvFILLp(av) = -1;
483 }
484
485 /*
486
487 =for apidoc av_create_and_push
488
489 Push an SV onto the end of the array, creating the array if necessary.
490 A small internal helper function to remove a commonly duplicated idiom.
491
492 =cut
493 */
494
495 void
496 Perl_av_create_and_push(pTHX_ AV **const avp, SV *const val)
497 {
498     if (!*avp)
499         *avp = newAV();
500     av_push(*avp, val);
501 }
502
503 /*
504 =for apidoc av_push
505
506 Pushes an SV onto the end of the array.  The array will grow automatically
507 to accommodate the addition.
508
509 =cut
510 */
511
512 void
513 Perl_av_push(pTHX_ register AV *av, SV *val)
514 {             
515     dVAR;
516     MAGIC *mg;
517     assert(av);
518
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     dVAR;
552     SV *retval;
553     MAGIC* mg;
554
555     assert(av);
556
557     if (SvREADONLY(av))
558         Perl_croak(aTHX_ PL_no_modify);
559     if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
560         dSP;    
561         PUSHSTACKi(PERLSI_MAGIC);
562         PUSHMARK(SP);
563         XPUSHs(SvTIED_obj((SV*)av, mg));
564         PUTBACK;
565         ENTER;
566         if (call_method("POP", G_SCALAR)) {
567             retval = newSVsv(*PL_stack_sp--);    
568         } else {    
569             retval = &PL_sv_undef;
570         }
571         LEAVE;
572         POPSTACK;
573         return retval;
574     }
575     if (AvFILL(av) < 0)
576         return &PL_sv_undef;
577     retval = AvARRAY(av)[AvFILLp(av)];
578     AvARRAY(av)[AvFILLp(av)--] = &PL_sv_undef;
579     if (SvSMAGICAL(av))
580         mg_set((SV*)av);
581     return retval;
582 }
583
584 /*
585
586 =for apidoc av_create_and_unshift_one
587
588 Unshifts an SV onto the beginning of the array, creating the array if
589 necessary.
590 A small internal helper function to remove a commonly duplicated idiom.
591
592 =cut
593 */
594
595 SV **
596 Perl_av_create_and_unshift_one(pTHX_ AV **const avp, SV *const val)
597 {
598     if (!*avp)
599         *avp = newAV();
600     av_unshift(*avp, 1);
601     return av_store(*avp, 0, val);
602 }
603
604 /*
605 =for apidoc av_unshift
606
607 Unshift the given number of C<undef> values onto the beginning of the
608 array.  The array will grow automatically to accommodate the addition.  You
609 must then use C<av_store> to assign values to these new elements.
610
611 =cut
612 */
613
614 void
615 Perl_av_unshift(pTHX_ register AV *av, register I32 num)
616 {
617     dVAR;
618     register I32 i;
619     MAGIC* mg;
620
621     assert(av);
622
623     if (SvREADONLY(av))
624         Perl_croak(aTHX_ PL_no_modify);
625
626     if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
627         dSP;
628         PUSHSTACKi(PERLSI_MAGIC);
629         PUSHMARK(SP);
630         EXTEND(SP,1+num);
631         PUSHs(SvTIED_obj((SV*)av, mg));
632         while (num-- > 0) {
633             PUSHs(&PL_sv_undef);
634         }
635         PUTBACK;
636         ENTER;
637         call_method("UNSHIFT", G_SCALAR|G_DISCARD);
638         LEAVE;
639         POPSTACK;
640         return;
641     }
642
643     if (num <= 0)
644       return;
645     if (!AvREAL(av) && AvREIFY(av))
646         av_reify(av);
647     i = AvARRAY(av) - AvALLOC(av);
648     if (i) {
649         if (i > num)
650             i = num;
651         num -= i;
652     
653         AvMAX(av) += i;
654         AvFILLp(av) += i;
655         AvARRAY(av) = AvARRAY(av) - i;
656     }
657     if (num) {
658         register SV **ary;
659         I32 slide;
660         i = AvFILLp(av);
661         /* Create extra elements */
662         slide = i > 0 ? i : 0;
663         num += slide;
664         av_extend(av, i + num);
665         AvFILLp(av) += num;
666         ary = AvARRAY(av);
667         Move(ary, ary + num, i + 1, SV*);
668         do {
669             ary[--num] = &PL_sv_undef;
670         } while (num);
671         /* Make extra elements into a buffer */
672         AvMAX(av) -= slide;
673         AvFILLp(av) -= slide;
674         AvARRAY(av) = AvARRAY(av) + slide;
675     }
676 }
677
678 /*
679 =for apidoc av_shift
680
681 Shifts an SV off the beginning of the array.
682
683 =cut
684 */
685
686 SV *
687 Perl_av_shift(pTHX_ register AV *av)
688 {
689     dVAR;
690     SV *retval;
691     MAGIC* mg;
692
693     assert(av);
694
695     if (SvREADONLY(av))
696         Perl_croak(aTHX_ PL_no_modify);
697     if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
698         dSP;
699         PUSHSTACKi(PERLSI_MAGIC);
700         PUSHMARK(SP);
701         XPUSHs(SvTIED_obj((SV*)av, mg));
702         PUTBACK;
703         ENTER;
704         if (call_method("SHIFT", G_SCALAR)) {
705             retval = newSVsv(*PL_stack_sp--);            
706         } else {    
707             retval = &PL_sv_undef;
708         }     
709         LEAVE;
710         POPSTACK;
711         return retval;
712     }
713     if (AvFILL(av) < 0)
714       return &PL_sv_undef;
715     retval = *AvARRAY(av);
716     if (AvREAL(av))
717         *AvARRAY(av) = &PL_sv_undef;
718     AvARRAY(av) = AvARRAY(av) + 1;
719     AvMAX(av)--;
720     AvFILLp(av)--;
721     if (SvSMAGICAL(av))
722         mg_set((SV*)av);
723     return retval;
724 }
725
726 /*
727 =for apidoc av_len
728
729 Returns the highest index in the array.  The number of elements in the
730 array is C<av_len(av) + 1>.  Returns -1 if the array is empty.
731
732 =cut
733 */
734
735 I32
736 Perl_av_len(pTHX_ register const AV *av)
737 {
738     assert(av);
739     return AvFILL(av);
740 }
741
742 /*
743 =for apidoc av_fill
744
745 Set the highest index in the array to the given number, equivalent to
746 Perl's C<$#array = $fill;>.
747
748 The number of elements in the an array will be C<fill + 1> after
749 av_fill() returns.  If the array was previously shorter then the
750 additional elements appended are set to C<PL_sv_undef>.  If the array
751 was longer, then the excess elements are freed.  C<av_fill(av, -1)> is
752 the same as C<av_clear(av)>.
753
754 =cut
755 */
756 void
757 Perl_av_fill(pTHX_ register AV *av, I32 fill)
758 {
759     dVAR;
760     MAGIC *mg;
761
762     assert(av);
763
764     if (fill < 0)
765         fill = -1;
766     if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
767         dSP;            
768         ENTER;
769         SAVETMPS;
770         PUSHSTACKi(PERLSI_MAGIC);
771         PUSHMARK(SP);
772         EXTEND(SP,2);
773         PUSHs(SvTIED_obj((SV*)av, mg));
774         PUSHs(sv_2mortal(newSViv(fill+1)));
775         PUTBACK;
776         call_method("STORESIZE", G_SCALAR|G_DISCARD);
777         POPSTACK;
778         FREETMPS;
779         LEAVE;
780         return;
781     }
782     if (fill <= AvMAX(av)) {
783         I32 key = AvFILLp(av);
784         SV** const ary = AvARRAY(av);
785
786         if (AvREAL(av)) {
787             while (key > fill) {
788                 SvREFCNT_dec(ary[key]);
789                 ary[key--] = &PL_sv_undef;
790             }
791         }
792         else {
793             while (key < fill)
794                 ary[++key] = &PL_sv_undef;
795         }
796             
797         AvFILLp(av) = fill;
798         if (SvSMAGICAL(av))
799             mg_set((SV*)av);
800     }
801     else
802         (void)av_store(av,fill,&PL_sv_undef);
803 }
804
805 /*
806 =for apidoc av_delete
807
808 Deletes the element indexed by C<key> from the array.  Returns the
809 deleted element. If C<flags> equals C<G_DISCARD>, the element is freed
810 and null is returned.
811
812 =cut
813 */
814 SV *
815 Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
816 {
817     dVAR;
818     SV *sv;
819
820     assert(av);
821
822     if (SvREADONLY(av))
823         Perl_croak(aTHX_ PL_no_modify);
824
825     if (SvRMAGICAL(av)) {
826         const MAGIC * const tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
827         if ((tied_magic || mg_find((SV*)av, PERL_MAGIC_regdata))) {
828             /* Handle negative array indices 20020222 MJD */
829             SV **svp;
830             if (key < 0) {
831                 unsigned adjust_index = 1;
832                 if (tied_magic) {
833                     SV * const * const negative_indices_glob =
834                         hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av, 
835                                                          tied_magic))), 
836                                  NEGATIVE_INDICES_VAR, 16, 0);
837                     if (negative_indices_glob
838                         && SvTRUE(GvSV(*negative_indices_glob)))
839                         adjust_index = 0;
840                 }
841                 if (adjust_index) {
842                     key += AvFILL(av) + 1;
843                     if (key < 0)
844                         return NULL;
845                 }
846             }
847             svp = av_fetch(av, key, TRUE);
848             if (svp) {
849                 sv = *svp;
850                 mg_clear(sv);
851                 if (mg_find(sv, PERL_MAGIC_tiedelem)) {
852                     sv_unmagic(sv, PERL_MAGIC_tiedelem); /* No longer an element */
853                     return sv;
854                 }
855                 return NULL;
856             }
857         }
858     }
859
860     if (key < 0) {
861         key += AvFILL(av) + 1;
862         if (key < 0)
863             return NULL;
864     }
865
866     if (key > AvFILLp(av))
867         return NULL;
868     else {
869         if (!AvREAL(av) && AvREIFY(av))
870             av_reify(av);
871         sv = AvARRAY(av)[key];
872         if (key == AvFILLp(av)) {
873             AvARRAY(av)[key] = &PL_sv_undef;
874             do {
875                 AvFILLp(av)--;
876             } while (--key >= 0 && AvARRAY(av)[key] == &PL_sv_undef);
877         }
878         else
879             AvARRAY(av)[key] = &PL_sv_undef;
880         if (SvSMAGICAL(av))
881             mg_set((SV*)av);
882     }
883     if (flags & G_DISCARD) {
884         SvREFCNT_dec(sv);
885         sv = NULL;
886     }
887     else if (AvREAL(av))
888         sv = sv_2mortal(sv);
889     return sv;
890 }
891
892 /*
893 =for apidoc av_exists
894
895 Returns true if the element indexed by C<key> has been initialized.
896
897 This relies on the fact that uninitialized array elements are set to
898 C<&PL_sv_undef>.
899
900 =cut
901 */
902 bool
903 Perl_av_exists(pTHX_ AV *av, I32 key)
904 {
905     dVAR;
906     assert(av);
907
908     if (SvRMAGICAL(av)) {
909         const MAGIC * const tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
910         if (tied_magic || mg_find((SV*)av, PERL_MAGIC_regdata)) {
911             SV * const sv = sv_newmortal();
912             MAGIC *mg;
913             /* Handle negative array indices 20020222 MJD */
914             if (key < 0) {
915                 unsigned adjust_index = 1;
916                 if (tied_magic) {
917                     SV * const * const negative_indices_glob =
918                         hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av, 
919                                                          tied_magic))), 
920                                  NEGATIVE_INDICES_VAR, 16, 0);
921                     if (negative_indices_glob
922                         && SvTRUE(GvSV(*negative_indices_glob)))
923                         adjust_index = 0;
924                 }
925                 if (adjust_index) {
926                     key += AvFILL(av) + 1;
927                     if (key < 0)
928                         return FALSE;
929                 }
930             }
931
932             mg_copy((SV*)av, sv, 0, key);
933             mg = mg_find(sv, PERL_MAGIC_tiedelem);
934             if (mg) {
935                 magic_existspack(sv, mg);
936                 return (bool)SvTRUE(sv);
937             }
938
939         }
940     }
941
942     if (key < 0) {
943         key += AvFILL(av) + 1;
944         if (key < 0)
945             return FALSE;
946     }
947
948     if (key <= AvFILLp(av) && AvARRAY(av)[key] != &PL_sv_undef
949         && AvARRAY(av)[key])
950     {
951         return TRUE;
952     }
953     else
954         return FALSE;
955 }
956
957 SV **
958 Perl_av_arylen_p(pTHX_ AV *av) {
959     dVAR;
960     MAGIC *mg;
961
962     assert(av);
963
964     mg = mg_find((SV*)av, PERL_MAGIC_arylen_p);
965
966     if (!mg) {
967         mg = sv_magicext((SV*)av, 0, PERL_MAGIC_arylen_p, &PL_vtbl_arylen_p,
968                          0, 0);
969         assert(mg);
970         /* sv_magicext won't set this for us because we pass in a NULL obj  */
971         mg->mg_flags |= MGf_REFCOUNTED;
972     }
973     return &(mg->mg_obj);
974 }
975
976 /*
977  * Local variables:
978  * c-indentation-style: bsd
979  * c-basic-offset: 4
980  * indent-tabs-mode: t
981  * End:
982  *
983  * ex: set ts=8 sts=4 sw=4 noet:
984  */