This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix Sys::Syslog breakage on domain sockets (from Tom Hughes)
[perl5.git] / av.c
... / ...
CommitLineData
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}