patch against t/op/sub_lval.t
[perl.git] / av.c
1 /*    av.c
2  *
3  *    Copyright (c) 1991-2002, 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_ 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 = 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_ packWARN(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)
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     if (AvFILL(av) < 0)
538         return &PL_sv_undef;
539     retval = AvARRAY(av)[AvFILLp(av)];
540     AvARRAY(av)[AvFILLp(av)--] = &PL_sv_undef;
541     if (SvSMAGICAL(av))
542         mg_set((SV*)av);
543     return retval;
544 }
545
546 /*
547 =for apidoc av_unshift
548
549 Unshift the given number of C<undef> values onto the beginning of the
550 array.  The array will grow automatically to accommodate the addition.  You
551 must then use C<av_store> to assign values to these new elements.
552
553 =cut
554 */
555
556 void
557 Perl_av_unshift(pTHX_ register AV *av, register I32 num)
558 {
559     register I32 i;
560     register SV **ary;
561     MAGIC* mg;
562     I32 slide;
563
564     if (!av)
565         return;
566     if (SvREADONLY(av))
567         Perl_croak(aTHX_ PL_no_modify);
568
569     if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
570         dSP;
571         PUSHSTACKi(PERLSI_MAGIC);
572         PUSHMARK(SP);
573         EXTEND(SP,1+num);
574         PUSHs(SvTIED_obj((SV*)av, mg));
575         while (num-- > 0) {
576             PUSHs(&PL_sv_undef);
577         }
578         PUTBACK;
579         ENTER;
580         call_method("UNSHIFT", G_SCALAR|G_DISCARD);
581         LEAVE;
582         POPSTACK;
583         return;
584     }
585
586     if (num <= 0)
587       return;
588     if (!AvREAL(av) && AvREIFY(av))
589         av_reify(av);
590     i = AvARRAY(av) - AvALLOC(av);
591     if (i) {
592         if (i > num)
593             i = num;
594         num -= i;
595     
596         AvMAX(av) += i;
597         AvFILLp(av) += i;
598         SvPVX(av) = (char*)(AvARRAY(av) - i);
599     }
600     if (num) {
601         i = AvFILLp(av);
602         /* Create extra elements */
603         slide = i > 0 ? i : 0;
604         num += slide;
605         av_extend(av, i + num);
606         AvFILLp(av) += num;
607         ary = AvARRAY(av);
608         Move(ary, ary + num, i + 1, SV*);
609         do {
610             ary[--num] = &PL_sv_undef;
611         } while (num);
612         /* Make extra elements into a buffer */
613         AvMAX(av) -= slide;
614         AvFILLp(av) -= slide;
615         SvPVX(av) = (char*)(AvARRAY(av) + slide);
616     }
617 }
618
619 /*
620 =for apidoc av_shift
621
622 Shifts an SV off the beginning of the array.
623
624 =cut
625 */
626
627 SV *
628 Perl_av_shift(pTHX_ register AV *av)
629 {
630     SV *retval;
631     MAGIC* mg;
632
633     if (!av)
634         return &PL_sv_undef;
635     if (SvREADONLY(av))
636         Perl_croak(aTHX_ PL_no_modify);
637     if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
638         dSP;
639         PUSHSTACKi(PERLSI_MAGIC);
640         PUSHMARK(SP);
641         XPUSHs(SvTIED_obj((SV*)av, mg));
642         PUTBACK;
643         ENTER;
644         if (call_method("SHIFT", G_SCALAR)) {
645             retval = newSVsv(*PL_stack_sp--);            
646         } else {    
647             retval = &PL_sv_undef;
648         }     
649         LEAVE;
650         POPSTACK;
651         return retval;
652     }
653     if (AvFILL(av) < 0)
654       return &PL_sv_undef;
655     retval = *AvARRAY(av);
656     if (AvREAL(av))
657         *AvARRAY(av) = &PL_sv_undef;
658     SvPVX(av) = (char*)(AvARRAY(av) + 1);
659     AvMAX(av)--;
660     AvFILLp(av)--;
661     if (SvSMAGICAL(av))
662         mg_set((SV*)av);
663     return retval;
664 }
665
666 /*
667 =for apidoc av_len
668
669 Returns the highest index in the array.  Returns -1 if the array is
670 empty.
671
672 =cut
673 */
674
675 I32
676 Perl_av_len(pTHX_ register AV *av)
677 {
678     return AvFILL(av);
679 }
680
681 /*
682 =for apidoc av_fill
683
684 Ensure than an array has a given number of elements, equivalent to
685 Perl's C<$#array = $fill;>.
686
687 =cut
688 */
689 void
690 Perl_av_fill(pTHX_ register AV *av, I32 fill)
691 {
692     MAGIC *mg;
693     if (!av)
694         Perl_croak(aTHX_ "panic: null array");
695     if (fill < 0)
696         fill = -1;
697     if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
698         dSP;            
699         ENTER;
700         SAVETMPS;
701         PUSHSTACKi(PERLSI_MAGIC);
702         PUSHMARK(SP);
703         EXTEND(SP,2);
704         PUSHs(SvTIED_obj((SV*)av, mg));
705         PUSHs(sv_2mortal(newSViv(fill+1)));
706         PUTBACK;
707         call_method("STORESIZE", G_SCALAR|G_DISCARD);
708         POPSTACK;
709         FREETMPS;
710         LEAVE;
711         return;
712     }
713     if (fill <= AvMAX(av)) {
714         I32 key = AvFILLp(av);
715         SV** ary = AvARRAY(av);
716
717         if (AvREAL(av)) {
718             while (key > fill) {
719                 SvREFCNT_dec(ary[key]);
720                 ary[key--] = &PL_sv_undef;
721             }
722         }
723         else {
724             while (key < fill)
725                 ary[++key] = &PL_sv_undef;
726         }
727             
728         AvFILLp(av) = fill;
729         if (SvSMAGICAL(av))
730             mg_set((SV*)av);
731     }
732     else
733         (void)av_store(av,fill,&PL_sv_undef);
734 }
735
736 /*
737 =for apidoc av_delete
738
739 Deletes the element indexed by C<key> from the array.  Returns the
740 deleted element. C<flags> is currently ignored.
741
742 =cut
743 */
744 SV *
745 Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
746 {
747     SV *sv;
748
749     if (!av)
750         return Nullsv;
751     if (SvREADONLY(av))
752         Perl_croak(aTHX_ PL_no_modify);
753     if (key < 0) {
754         key += AvFILL(av) + 1;
755         if (key < 0)
756             return Nullsv;
757     }
758     if (SvRMAGICAL(av)) {
759         SV **svp;
760         if ((mg_find((SV*)av, PERL_MAGIC_tied) ||
761                 mg_find((SV*)av, PERL_MAGIC_regdata))
762             && (svp = av_fetch(av, key, TRUE)))
763         {
764             sv = *svp;
765             mg_clear(sv);
766             if (mg_find(sv, PERL_MAGIC_tiedelem)) {
767                 sv_unmagic(sv, PERL_MAGIC_tiedelem);    /* No longer an element */
768                 return sv;
769             }
770             return Nullsv;                      /* element cannot be deleted */
771         }
772     }
773     if (key > AvFILLp(av))
774         return Nullsv;
775     else {
776         sv = AvARRAY(av)[key];
777         if (key == AvFILLp(av)) {
778             AvARRAY(av)[key] = &PL_sv_undef;
779             do {
780                 AvFILLp(av)--;
781             } while (--key >= 0 && AvARRAY(av)[key] == &PL_sv_undef);
782         }
783         else
784             AvARRAY(av)[key] = &PL_sv_undef;
785         if (SvSMAGICAL(av))
786             mg_set((SV*)av);
787     }
788     if (flags & G_DISCARD) {
789         SvREFCNT_dec(sv);
790         sv = Nullsv;
791     }
792     return sv;
793 }
794
795 /*
796 =for apidoc av_exists
797
798 Returns true if the element indexed by C<key> has been initialized.
799
800 This relies on the fact that uninitialized array elements are set to
801 C<&PL_sv_undef>.
802
803 =cut
804 */
805 bool
806 Perl_av_exists(pTHX_ AV *av, I32 key)
807 {
808     if (!av)
809         return FALSE;
810     if (key < 0) {
811         key += AvFILL(av) + 1;
812         if (key < 0)
813             return FALSE;
814     }
815     if (SvRMAGICAL(av)) {
816         if (mg_find((SV*)av, PERL_MAGIC_tied) ||
817                 mg_find((SV*)av, PERL_MAGIC_regdata))
818         {
819             SV *sv = sv_newmortal();
820             MAGIC *mg;
821
822             mg_copy((SV*)av, sv, 0, key);
823             mg = mg_find(sv, PERL_MAGIC_tiedelem);
824             if (mg) {
825                 magic_existspack(sv, mg);
826                 return SvTRUE(sv);
827             }
828         }
829     }
830     if (key <= AvFILLp(av) && AvARRAY(av)[key] != &PL_sv_undef
831         && AvARRAY(av)[key])
832     {
833         return TRUE;
834     }
835     else
836         return FALSE;
837 }
838
839 /* AVHV: Support for treating arrays as if they were hashes.  The
840  * first element of the array should be a hash reference that maps
841  * hash keys to array indices.
842  */
843
844 STATIC I32
845 S_avhv_index_sv(pTHX_ SV* sv)
846 {
847     I32 index = SvIV(sv);
848     if (index < 1)
849         Perl_croak(aTHX_ "Bad index while coercing array into hash");
850     return index;    
851 }
852
853 STATIC I32
854 S_avhv_index(pTHX_ AV *av, SV *keysv, U32 hash)
855 {
856     HV *keys;
857     HE *he;
858     STRLEN n_a;
859
860     keys = avhv_keys(av);
861     he = hv_fetch_ent(keys, keysv, FALSE, hash);
862     if (!he)
863         Perl_croak(aTHX_ "No such pseudo-hash field \"%s\"", SvPV(keysv,n_a));
864     return avhv_index_sv(HeVAL(he));
865 }
866
867 HV*
868 Perl_avhv_keys(pTHX_ AV *av)
869 {
870     SV **keysp = av_fetch(av, 0, FALSE);
871     if (keysp) {
872         SV *sv = *keysp;
873         if (SvGMAGICAL(sv))
874             mg_get(sv);
875         if (SvROK(sv)) {
876             sv = SvRV(sv);
877             if (SvTYPE(sv) == SVt_PVHV)
878                 return (HV*)sv;
879         }
880     }
881     Perl_croak(aTHX_ "Can't coerce array into hash");
882     return Nullhv;
883 }
884
885 SV**
886 Perl_avhv_store_ent(pTHX_ AV *av, SV *keysv, SV *val, U32 hash)
887 {
888     return av_store(av, avhv_index(av, keysv, hash), val);
889 }
890
891 SV**
892 Perl_avhv_fetch_ent(pTHX_ AV *av, SV *keysv, I32 lval, U32 hash)
893 {
894     return av_fetch(av, avhv_index(av, keysv, hash), lval);
895 }
896
897 SV *
898 Perl_avhv_delete_ent(pTHX_ AV *av, SV *keysv, I32 flags, U32 hash)
899 {
900     HV *keys = avhv_keys(av);
901     HE *he;
902         
903     he = hv_fetch_ent(keys, keysv, FALSE, hash);
904     if (!he || !SvOK(HeVAL(he)))
905         return Nullsv;
906
907     return av_delete(av, avhv_index_sv(HeVAL(he)), flags);
908 }
909
910 /* Check for the existence of an element named by a given key.
911  *
912  */
913 bool
914 Perl_avhv_exists_ent(pTHX_ AV *av, SV *keysv, U32 hash)
915 {
916     HV *keys = avhv_keys(av);
917     HE *he;
918         
919     he = hv_fetch_ent(keys, keysv, FALSE, hash);
920     if (!he || !SvOK(HeVAL(he)))
921         return FALSE;
922
923     return av_exists(av, avhv_index_sv(HeVAL(he)));
924 }
925
926 HE *
927 Perl_avhv_iternext(pTHX_ AV *av)
928 {
929     HV *keys = avhv_keys(av);
930     return hv_iternext(keys);
931 }
932
933 SV *
934 Perl_avhv_iterval(pTHX_ AV *av, register HE *entry)
935 {
936     SV *sv = hv_iterval(avhv_keys(av), entry);
937     return *av_fetch(av, avhv_index_sv(sv), TRUE);
938 }