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