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