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