source: trunk/third/perl/av.c @ 14545

Revision 14545, 17.2 KB checked in by ghudson, 25 years ago (diff)
This commit was generated by cvs2svn to compensate for changes in r14544, which included commits to RCS files with non-trunk default branches.
Line 
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
19void
20Perl_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
52Pre-extend an array.  The C<key> is the index to which the array should be
53extended.
54
55=cut
56*/
57
58void
59Perl_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
166Returns the SV at the specified index in the array.  The C<key> is the
167index.  If C<lval> is set then the fetch will be part of a store.  Check
168that the return value is non-null before dereferencing it to a C<SV*>.
169
170See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
171more information on how to use this function on tied arrays.
172
173=cut
174*/
175
176SV**
177Perl_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
226Stores an SV in an array.  The array index is specified as C<key>.  The
227return value will be NULL if the operation failed or if the value did not
228need to be actually stored within the array (as in the case of tied
229arrays). Otherwise it can be dereferenced to get the original C<SV*>.  Note
230that the caller is responsible for suitably incrementing the reference
231count of C<val> before the call, and decrementing it if the function
232returned NULL.
233
234See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
235more information on how to use this function on tied arrays.
236
237=cut
238*/
239
240SV**
241Perl_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
300Creates a new AV.  The reference count is set to 1.
301
302=cut
303*/
304
305AV *
306Perl_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
322Creates a new AV and populates it with a list of SVs.  The SVs are copied
323into the array, so they may be freed after the call to av_make.  The new AV
324will have a reference count of 1.
325
326=cut
327*/
328
329AV *
330Perl_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
355AV *
356Perl_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
381Clears an array, making it empty.  Does not free the memory used by the
382array itself.
383
384=cut
385*/
386
387void
388Perl_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
431Undefines the array.  Frees the memory used by the array itself.
432
433=cut
434*/
435
436void
437Perl_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
467Pushes an SV onto the end of the array.  The array will grow automatically
468to accommodate the addition.
469
470=cut
471*/
472
473void
474Perl_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
502Pops an SV off the end of the array.  Returns C<&PL_sv_undef> if the array
503is empty.
504
505=cut
506*/
507
508SV *
509Perl_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
544Unshift the given number of C<undef> values onto the beginning of the
545array.  The array will grow automatically to accommodate the addition.  You
546must then use C<av_store> to assign values to these new elements.
547
548=cut
549*/
550
551void
552Perl_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
607Shifts an SV off the beginning of the array.
608
609=cut
610*/
611
612SV *
613Perl_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
652Returns the highest index in the array.  Returns -1 if the array is
653empty.
654
655=cut
656*/
657
658I32
659Perl_av_len(pTHX_ register AV *av)
660{
661    return AvFILL(av);
662}
663
664void
665Perl_av_fill(pTHX_ register AV *av, I32 fill)
666{
667    MAGIC *mg;
668    if (!av)
669        Perl_croak(aTHX_ "panic: null array");
670    if (fill < 0)
671        fill = -1;
672    if ((mg = SvTIED_mg((SV*)av, 'P'))) {
673        dSP;           
674        ENTER;
675        SAVETMPS;
676        PUSHSTACKi(PERLSI_MAGIC);
677        PUSHMARK(SP);
678        EXTEND(SP,2);
679        PUSHs(SvTIED_obj((SV*)av, mg));
680        PUSHs(sv_2mortal(newSViv(fill+1)));
681        PUTBACK;
682        call_method("STORESIZE", G_SCALAR|G_DISCARD);
683        POPSTACK;
684        FREETMPS;
685        LEAVE;
686        return;
687    }
688    if (fill <= AvMAX(av)) {
689        I32 key = AvFILLp(av);
690        SV** ary = AvARRAY(av);
691
692        if (AvREAL(av)) {
693            while (key > fill) {
694                SvREFCNT_dec(ary[key]);
695                ary[key--] = &PL_sv_undef;
696            }
697        }
698        else {
699            while (key < fill)
700                ary[++key] = &PL_sv_undef;
701        }
702           
703        AvFILLp(av) = fill;
704        if (SvSMAGICAL(av))
705            mg_set((SV*)av);
706    }
707    else
708        (void)av_store(av,fill,&PL_sv_undef);
709}
710
711SV *
712Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
713{
714    SV *sv;
715
716    if (!av)
717        return Nullsv;
718    if (SvREADONLY(av))
719        Perl_croak(aTHX_ PL_no_modify);
720    if (key < 0) {
721        key += AvFILL(av) + 1;
722        if (key < 0)
723            return Nullsv;
724    }
725    if (SvRMAGICAL(av)) {
726        SV **svp;
727        if ((mg_find((SV*)av,'P') || mg_find((SV*)av,'D'))
728            && (svp = av_fetch(av, key, TRUE)))
729        {
730            sv = *svp;
731            mg_clear(sv);
732            if (mg_find(sv, 'p')) {
733                sv_unmagic(sv, 'p');            /* No longer an element */
734                return sv;
735            }
736            return Nullsv;                      /* element cannot be deleted */
737        }
738    }
739    if (key > AvFILLp(av))
740        return Nullsv;
741    else {
742        sv = AvARRAY(av)[key];
743        if (key == AvFILLp(av)) {
744            do {
745                AvFILLp(av)--;
746            } while (--key >= 0 && AvARRAY(av)[key] == &PL_sv_undef);
747        }
748        else
749            AvARRAY(av)[key] = &PL_sv_undef;
750        if (SvSMAGICAL(av))
751            mg_set((SV*)av);
752    }
753    if (flags & G_DISCARD) {
754        SvREFCNT_dec(sv);
755        sv = Nullsv;
756    }
757    return sv;
758}
759
760/*
761 * This relies on the fact that uninitialized array elements
762 * are set to &PL_sv_undef.
763 */
764
765bool
766Perl_av_exists(pTHX_ AV *av, I32 key)
767{
768    if (!av)
769        return FALSE;
770    if (key < 0) {
771        key += AvFILL(av) + 1;
772        if (key < 0)
773            return FALSE;
774    }
775    if (SvRMAGICAL(av)) {
776        if (mg_find((SV*)av,'P') || mg_find((SV*)av,'D')) {
777            SV *sv = sv_newmortal();
778            mg_copy((SV*)av, sv, 0, key);
779            magic_existspack(sv, mg_find(sv, 'p'));
780            return SvTRUE(sv);
781        }
782    }
783    if (key <= AvFILLp(av) && AvARRAY(av)[key] != &PL_sv_undef
784        && AvARRAY(av)[key])
785    {
786        return TRUE;
787    }
788    else
789        return FALSE;
790}
791
792/* AVHV: Support for treating arrays as if they were hashes.  The
793 * first element of the array should be a hash reference that maps
794 * hash keys to array indices.
795 */
796
797STATIC I32
798S_avhv_index_sv(pTHX_ SV* sv)
799{
800    I32 index = SvIV(sv);
801    if (index < 1)
802        Perl_croak(aTHX_ "Bad index while coercing array into hash");
803    return index;   
804}
805
806STATIC I32
807S_avhv_index(pTHX_ AV *av, SV *keysv, U32 hash)
808{
809    HV *keys;
810    HE *he;
811    STRLEN n_a;
812
813    keys = avhv_keys(av);
814    he = hv_fetch_ent(keys, keysv, FALSE, hash);
815    if (!he)
816        Perl_croak(aTHX_ "No such pseudo-hash field \"%s\"", SvPV(keysv,n_a));
817    return avhv_index_sv(HeVAL(he));
818}
819
820HV*
821Perl_avhv_keys(pTHX_ AV *av)
822{
823    SV **keysp = av_fetch(av, 0, FALSE);
824    if (keysp) {
825        SV *sv = *keysp;
826        if (SvGMAGICAL(sv))
827            mg_get(sv);
828        if (SvROK(sv)) {
829            sv = SvRV(sv);
830            if (SvTYPE(sv) == SVt_PVHV)
831                return (HV*)sv;
832        }
833    }
834    Perl_croak(aTHX_ "Can't coerce array into hash");
835    return Nullhv;
836}
837
838SV**
839Perl_avhv_store_ent(pTHX_ AV *av, SV *keysv, SV *val, U32 hash)
840{
841    return av_store(av, avhv_index(av, keysv, hash), val);
842}
843
844SV**
845Perl_avhv_fetch_ent(pTHX_ AV *av, SV *keysv, I32 lval, U32 hash)
846{
847    return av_fetch(av, avhv_index(av, keysv, hash), lval);
848}
849
850SV *
851Perl_avhv_delete_ent(pTHX_ AV *av, SV *keysv, I32 flags, U32 hash)
852{
853    HV *keys = avhv_keys(av);
854    HE *he;
855       
856    he = hv_fetch_ent(keys, keysv, FALSE, hash);
857    if (!he || !SvOK(HeVAL(he)))
858        return Nullsv;
859
860    return av_delete(av, avhv_index_sv(HeVAL(he)), flags);
861}
862
863/* Check for the existence of an element named by a given key.
864 *
865 */
866bool
867Perl_avhv_exists_ent(pTHX_ AV *av, SV *keysv, U32 hash)
868{
869    HV *keys = avhv_keys(av);
870    HE *he;
871       
872    he = hv_fetch_ent(keys, keysv, FALSE, hash);
873    if (!he || !SvOK(HeVAL(he)))
874        return FALSE;
875
876    return av_exists(av, avhv_index_sv(HeVAL(he)));
877}
878
879HE *
880Perl_avhv_iternext(pTHX_ AV *av)
881{
882    HV *keys = avhv_keys(av);
883    return hv_iternext(keys);
884}
885
886SV *
887Perl_avhv_iterval(pTHX_ AV *av, register HE *entry)
888{
889    SV *sv = hv_iterval(avhv_keys(av), entry);
890    return *av_fetch(av, avhv_index_sv(sv), TRUE);
891}
Note: See TracBrowser for help on using the repository browser.