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