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