3 * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
4 * 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others
6 * You may distribute under the terms of either the GNU General Public
7 * License or the Artistic License, as specified in the README file.
12 * '...for the Entwives desired order, and plenty, and peace (by which they
13 * meant that things should remain where they had set them).' --Treebeard
15 * [p.476 of _The Lord of the Rings_, III/iv: "Treebeard"]
19 =for apidoc_section AV Handling
27 Perl_av_reify(pTHX_ AV *av)
31 PERL_ARGS_ASSERT_AV_REIFY;
32 assert(SvTYPE(av) == SVt_PVAV);
37 if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied))
38 Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "av_reify called on tied array");
41 while (key > AvFILLp(av) + 1)
42 AvARRAY(av)[--key] = NULL;
44 SV * const sv = AvARRAY(av)[--key];
45 if (sv != &PL_sv_undef)
46 SvREFCNT_inc_simple_void(sv);
48 key = AvARRAY(av) - AvALLOC(av);
50 AvALLOC(av)[--key] = NULL;
58 Pre-extend an array so that it is capable of storing values at indexes
59 C<0..key>. Thus C<av_extend(av,99)> guarantees that the array can store 100
60 elements, i.e. that C<av_store(av, 0, sv)> through C<av_store(av, 99, sv)>
61 on a plain array will work without any further memory allocation.
63 If the av argument is a tied array then will call the C<EXTEND> tied
64 array method with an argument of C<(key+1)>.
70 Perl_av_extend(pTHX_ AV *av, SSize_t key)
74 PERL_ARGS_ASSERT_AV_EXTEND;
75 assert(SvTYPE(av) == SVt_PVAV);
77 mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied);
79 SV *arg1 = sv_newmortal();
80 /* NOTE: the API for av_extend() is NOT the same as the tie method EXTEND.
82 * The C function takes an *index* (assumes 0 indexed arrays) and ensures
83 * that the array is at least as large as the index provided.
85 * The tied array method EXTEND takes a *count* and ensures that the array
86 * is at least that many elements large. Thus we have to +1 the key when
87 * we call the tied method.
89 sv_setiv(arg1, (IV)(key + 1));
90 Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(EXTEND), G_DISCARD, 1,
94 av_extend_guts(av,key,&AvMAX(av),&AvALLOC(av),&AvARRAY(av));
97 /* The guts of av_extend. *Not* for general use! */
98 /* Also called directly from pp_assign, padlist_store, padnamelist_store */
100 Perl_av_extend_guts(pTHX_ AV *av, SSize_t key, SSize_t *maxp, SV ***allocp,
103 PERL_ARGS_ASSERT_AV_EXTEND_GUTS;
105 if (key < -1) /* -1 is legal */
107 "panic: av_extend_guts() negative count (%" IVdf ")", (IV)key);
110 SSize_t ary_offset = *maxp + 1;
114 if (av && *allocp != *arrayp) { /* a shifted SV* array exists */
115 to_null = *arrayp - *allocp;
118 Move(*arrayp, *allocp, AvFILLp(av)+1, SV*);
120 if (key > *maxp - 10) {
121 newmax = key + *maxp;
124 } else if (*allocp) { /* a full SV* array exists */
126 #ifdef Perl_safesysmalloc_size
127 /* Whilst it would be quite possible to move this logic around
128 (as I did in the SV code), so as to set AvMAX(av) early,
129 based on calling Perl_safesysmalloc_size() immediately after
130 allocation, I'm not convinced that it is a great idea here.
131 In an array we have to loop round setting everything to
132 NULL, which means writing to memory, potentially lots
133 of it, whereas for the SV buffer case we don't touch the
134 "bonus" memory. So there there is no cost in telling the
135 world about it, whereas here we have to do work before we can
136 tell the world about it, and that work involves writing to
137 memory that might never be read. So, I feel, better to keep
138 the current lazy system of only writing to it if our caller
139 has a need for more space. NWC */
140 newmax = Perl_safesysmalloc_size((void*)*allocp) /
141 sizeof(const SV *) - 1;
146 /* overflow-safe version of newmax = key + *maxp/5 */
148 newmax = (key > SSize_t_MAX - newmax)
149 ? SSize_t_MAX : key + newmax;
152 /* it should really be newmax+1 here, but if newmax
153 * happens to equal SSize_t_MAX, then newmax+1 is
154 * undefined. This means technically we croak one
155 * index lower than we should in theory; in practice
156 * its unlikely the system has SSize_t_MAX/sizeof(SV*)
158 MEM_WRAP_CHECK_s(newmax, SV*, "Out of memory during array extend");
160 #ifdef STRESS_REALLOC
162 SV ** const old_alloc = *allocp;
163 Newx(*allocp, newmax+1, SV*);
164 Copy(old_alloc, *allocp, *maxp + 1, SV*);
168 Renew(*allocp,newmax+1, SV*);
170 #ifdef Perl_safesysmalloc_size
173 to_null += newmax - *maxp;
176 /* See GH#18014 for discussion of when this might be needed: */
177 if (av == PL_curstack) { /* Oops, grew stack (via av_store()?) */
178 PL_stack_sp = *allocp + (PL_stack_sp - PL_stack_base);
179 PL_stack_base = *allocp;
180 PL_stack_max = PL_stack_base + newmax;
182 } else { /* there is no SV* array yet */
183 *maxp = key < 3 ? 3 : key;
185 /* see comment above about newmax+1*/
186 MEM_WRAP_CHECK_s(*maxp, SV*,
187 "Out of memory during array extend");
189 /* Newxz isn't used below because testing showed it to be slower
190 * than Newx+Zero (also slower than Newx + the previous while
191 * loop) for small arrays, which are very common in perl. */
192 Newx(*allocp, *maxp+1, SV*);
193 /* Stacks require only the first element to be &PL_sv_undef
194 * (set elsewhere). However, since non-stack AVs are likely
195 * to dominate in modern production applications, stacks
196 * don't get any special treatment here. */
202 if (av && AvREAL(av)) {
204 Zero(*allocp + ary_offset,to_null,SV*);
214 Returns the SV at the specified index in the array. The C<key> is the
215 index. If lval is true, you are guaranteed to get a real SV back (in case
216 it wasn't real before), which you can then modify. Check that the return
217 value is non-null before dereferencing it to a C<SV*>.
219 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
220 more information on how to use this function on tied arrays.
222 The rough perl equivalent is C<$myarray[$key]>.
228 S_adjust_index(pTHX_ AV *av, const MAGIC *mg, SSize_t *keyp)
230 bool adjust_index = 1;
232 /* Handle negative array indices 20020222 MJD */
233 SV * const ref = SvTIED_obj(MUTABLE_SV(av), mg);
235 if (SvROK(ref) && SvOBJECT(SvRV(ref))) {
236 SV * const * const negative_indices_glob =
237 hv_fetchs(SvSTASH(SvRV(ref)), NEGATIVE_INDICES_VAR, 0);
239 if (negative_indices_glob && isGV(*negative_indices_glob)
240 && SvTRUE(GvSV(*negative_indices_glob)))
246 *keyp += AvFILL(av) + 1;
254 Perl_av_fetch(pTHX_ AV *av, SSize_t key, I32 lval)
259 PERL_ARGS_ASSERT_AV_FETCH;
260 assert(SvTYPE(av) == SVt_PVAV);
262 if (UNLIKELY(SvRMAGICAL(av))) {
263 const MAGIC * const tied_magic
264 = mg_find((const SV *)av, PERL_MAGIC_tied);
265 if (tied_magic || mg_find((const SV *)av, PERL_MAGIC_regdata)) {
268 if (!S_adjust_index(aTHX_ av, tied_magic, &key))
273 sv_upgrade(sv, SVt_PVLV);
274 mg_copy(MUTABLE_SV(av), sv, 0, key);
275 if (!tied_magic) /* for regdata, force leavesub to make copies */
278 LvTARG(sv) = sv; /* fake (SV**) */
279 return &(LvTARG(sv));
284 size = AvFILLp(av) + 1;
285 key += neg * size; /* handle negative index without using branch */
287 /* the cast from SSize_t to Size_t allows both (key < 0) and (key >= size)
288 * to be tested as a single condition */
289 if ((Size_t)key >= (Size_t)size) {
295 if (!AvARRAY(av)[key]) {
297 return lval ? av_store(av,key,newSV(0)) : NULL;
300 return &AvARRAY(av)[key];
306 Stores an SV in an array. The array index is specified as C<key>. The
307 return value will be C<NULL> if the operation failed or if the value did not
308 need to be actually stored within the array (as in the case of tied
309 arrays). Otherwise, it can be dereferenced
310 to get the C<SV*> that was stored
313 Note that the caller is responsible for suitably incrementing the reference
314 count of C<val> before the call, and decrementing it if the function
317 Approximate Perl equivalent: C<splice(@myarray, $key, 1, $val)>.
319 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
320 more information on how to use this function on tied arrays.
326 Perl_av_store(pTHX_ AV *av, SSize_t key, SV *val)
330 PERL_ARGS_ASSERT_AV_STORE;
331 assert(SvTYPE(av) == SVt_PVAV);
333 /* S_regclass relies on being able to pass in a NULL sv
334 (unicode_alternate may be NULL).
337 if (SvRMAGICAL(av)) {
338 const MAGIC * const tied_magic = mg_find((const SV *)av, PERL_MAGIC_tied);
341 if (!S_adjust_index(aTHX_ av, tied_magic, &key))
345 mg_copy(MUTABLE_SV(av), val, 0, key);
353 key += AvFILL(av) + 1;
358 if (SvREADONLY(av) && key >= AvFILL(av))
359 Perl_croak_no_modify();
361 if (!AvREAL(av) && AvREIFY(av))
366 if (AvFILLp(av) < key) {
368 if (av == PL_curstack && key > PL_stack_sp - PL_stack_base)
369 PL_stack_sp = PL_stack_base + key; /* XPUSH in disguise */
371 ary[++AvFILLp(av)] = NULL;
372 } while (AvFILLp(av) < key);
377 SvREFCNT_dec(ary[key]);
379 if (SvSMAGICAL(av)) {
380 const MAGIC *mg = SvMAGIC(av);
382 for (; mg; mg = mg->mg_moremagic) {
383 if (!isUPPER(mg->mg_type)) continue;
385 sv_magic(val, MUTABLE_SV(av), toLOWER(mg->mg_type), 0, key);
387 if (PL_delaymagic && mg->mg_type == PERL_MAGIC_isa) {
388 PL_delaymagic |= DM_ARRAY_ISA;
393 mg_set(MUTABLE_SV(av));
401 Creates a new AV and populates it with a list of SVs. The SVs are copied
402 into the array, so they may be freed after the call to C<av_make>. The new AV
403 will have a reference count of 1.
405 Perl equivalent: C<my @new_array = ($scalar1, $scalar2, $scalar3...);>
411 Perl_av_make(pTHX_ SSize_t size, SV **strp)
413 AV * const av = MUTABLE_AV(newSV_type(SVt_PVAV));
414 /* sv_upgrade does AvREAL_only() */
415 PERL_ARGS_ASSERT_AV_MAKE;
416 assert(SvTYPE(av) == SVt_PVAV);
418 if (size) { /* "defined" was returning undef for size==0 anyway. */
426 AvMAX(av) = size - 1;
428 /* avoid av being leaked if croak when calling magic below */
430 PL_tmps_stack[++PL_tmps_ix] = (SV*)av;
431 orig_ix = PL_tmps_ix;
433 for (i = 0; i < size; i++) {
436 /* Don't let sv_setsv swipe, since our source array might
437 have multiple references to the same temp scalar (e.g.
438 from a list slice) */
440 SvGETMAGIC(*strp); /* before newSV, in case it dies */
443 sv_setsv_flags(ary[i], *strp,
444 SV_DO_COW_SVSETSV|SV_NOSTEAL);
447 /* disarm av's leak guard */
448 if (LIKELY(PL_tmps_ix == orig_ix))
451 PL_tmps_stack[orig_ix] = &PL_sv_undef;
459 Frees the all the elements of an array, leaving it empty.
460 The XS equivalent of C<@array = ()>. See also L</av_undef>.
462 Note that it is possible that the actions of a destructor called directly
463 or indirectly by freeing an element of the array could cause the reference
464 count of the array itself to be reduced (e.g. by deleting an entry in the
465 symbol table). So it is a possibility that the AV could have been freed
466 (or even reallocated) on return from the call unless you hold a reference
473 Perl_av_clear(pTHX_ AV *av)
479 PERL_ARGS_ASSERT_AV_CLEAR;
480 assert(SvTYPE(av) == SVt_PVAV);
483 if (SvREFCNT(av) == 0) {
484 Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "Attempt to clear deleted array");
489 Perl_croak_no_modify();
491 /* Give any tie a chance to cleanup first */
492 if (SvRMAGICAL(av)) {
493 const MAGIC* const mg = SvMAGIC(av);
494 if (PL_delaymagic && mg && mg->mg_type == PERL_MAGIC_isa)
495 PL_delaymagic |= DM_ARRAY_ISA;
497 mg_clear(MUTABLE_SV(av));
503 if ((real = cBOOL(AvREAL(av)))) {
504 SV** const ary = AvARRAY(av);
505 SSize_t index = AvFILLp(av) + 1;
507 /* avoid av being freed when calling destructors below */
509 PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple_NN(av);
510 orig_ix = PL_tmps_ix;
513 SV * const sv = ary[--index];
514 /* undef the slot before freeing the value, because a
515 * destructor might try to modify this array */
520 extra = AvARRAY(av) - AvALLOC(av);
523 AvARRAY(av) = AvALLOC(av);
527 /* disarm av's premature free guard */
528 if (LIKELY(PL_tmps_ix == orig_ix))
531 PL_tmps_stack[orig_ix] = &PL_sv_undef;
539 Undefines the array. The XS equivalent of C<undef(@array)>.
541 As well as freeing all the elements of the array (like C<av_clear()>), this
542 also frees the memory used by the av to store its list of scalars.
544 See L</av_clear> for a note about the array possibly being invalid on
551 Perl_av_undef(pTHX_ AV *av)
554 SSize_t orig_ix = PL_tmps_ix; /* silence bogus warning about possible unitialized use */
556 PERL_ARGS_ASSERT_AV_UNDEF;
557 assert(SvTYPE(av) == SVt_PVAV);
559 /* Give any tie a chance to cleanup first */
560 if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied))
563 real = cBOOL(AvREAL(av));
565 SSize_t key = AvFILLp(av) + 1;
567 /* avoid av being freed when calling destructors below */
569 PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple_NN(av);
570 orig_ix = PL_tmps_ix;
573 SvREFCNT_dec(AvARRAY(av)[--key]);
576 Safefree(AvALLOC(av));
579 AvMAX(av) = AvFILLp(av) = -1;
581 if(SvRMAGICAL(av)) mg_clear(MUTABLE_SV(av));
583 /* disarm av's premature free guard */
584 if (LIKELY(PL_tmps_ix == orig_ix))
587 PL_tmps_stack[orig_ix] = &PL_sv_undef;
594 =for apidoc av_create_and_push
596 Push an SV onto the end of the array, creating the array if necessary.
597 A small internal helper function to remove a commonly duplicated idiom.
603 Perl_av_create_and_push(pTHX_ AV **const avp, SV *const val)
605 PERL_ARGS_ASSERT_AV_CREATE_AND_PUSH;
615 Pushes an SV (transferring control of one reference count) onto the end of the
616 array. The array will grow automatically to accommodate the addition.
618 Perl equivalent: C<push @myarray, $val;>.
624 Perl_av_push(pTHX_ AV *av, SV *val)
628 PERL_ARGS_ASSERT_AV_PUSH;
629 assert(SvTYPE(av) == SVt_PVAV);
632 Perl_croak_no_modify();
634 if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
635 Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(PUSH), G_DISCARD, 1,
639 av_store(av,AvFILLp(av)+1,val);
645 Removes one SV from the end of the array, reducing its size by one and
646 returning the SV (transferring control of one reference count) to the
647 caller. Returns C<&PL_sv_undef> if the array is empty.
649 Perl equivalent: C<pop(@myarray);>
655 Perl_av_pop(pTHX_ AV *av)
660 PERL_ARGS_ASSERT_AV_POP;
661 assert(SvTYPE(av) == SVt_PVAV);
664 Perl_croak_no_modify();
665 if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
666 retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(POP), 0, 0);
668 retval = newSVsv(retval);
673 retval = AvARRAY(av)[AvFILLp(av)];
674 AvARRAY(av)[AvFILLp(av)--] = NULL;
676 mg_set(MUTABLE_SV(av));
677 return retval ? retval : &PL_sv_undef;
682 =for apidoc av_create_and_unshift_one
684 Unshifts an SV onto the beginning of the array, creating the array if
686 A small internal helper function to remove a commonly duplicated idiom.
692 Perl_av_create_and_unshift_one(pTHX_ AV **const avp, SV *const val)
694 PERL_ARGS_ASSERT_AV_CREATE_AND_UNSHIFT_ONE;
699 return av_store(*avp, 0, val);
703 =for apidoc av_unshift
705 Unshift the given number of C<undef> values onto the beginning of the
706 array. The array will grow automatically to accommodate the addition.
708 Perl equivalent: S<C<unshift @myarray, ((undef) x $num);>>
714 Perl_av_unshift(pTHX_ AV *av, SSize_t num)
719 PERL_ARGS_ASSERT_AV_UNSHIFT;
720 assert(SvTYPE(av) == SVt_PVAV);
723 Perl_croak_no_modify();
725 if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
726 Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(UNSHIFT),
727 G_DISCARD | G_UNDEF_FILL, num);
733 if (!AvREAL(av) && AvREIFY(av))
735 i = AvARRAY(av) - AvALLOC(av);
743 AvARRAY(av) = AvARRAY(av) - i;
747 const SSize_t i = AvFILLp(av);
748 /* Create extra elements */
749 const SSize_t slide = i > 0 ? i : 0;
751 av_extend(av, i + num);
754 Move(ary, ary + num, i + 1, SV*);
758 /* Make extra elements into a buffer */
760 AvFILLp(av) -= slide;
761 AvARRAY(av) = AvARRAY(av) + slide;
768 Removes one SV from the start of the array, reducing its size by one and
769 returning the SV (transferring control of one reference count) to the
770 caller. Returns C<&PL_sv_undef> if the array is empty.
772 Perl equivalent: C<shift(@myarray);>
778 Perl_av_shift(pTHX_ AV *av)
783 PERL_ARGS_ASSERT_AV_SHIFT;
784 assert(SvTYPE(av) == SVt_PVAV);
787 Perl_croak_no_modify();
788 if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
789 retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(SHIFT), 0, 0);
791 retval = newSVsv(retval);
796 retval = *AvARRAY(av);
799 AvARRAY(av) = AvARRAY(av) + 1;
803 mg_set(MUTABLE_SV(av));
804 return retval ? retval : &PL_sv_undef;
808 =for apidoc av_tindex
809 =for apidoc_item av_top_index
811 These behave identically.
812 If the array C<av> is empty, these return -1; otherwise they return the maximum
813 value of the indices of all the array elements which are currently defined in
816 They process 'get' magic.
818 The Perl equivalent for these is C<$#av>.
820 Use C<L</av_count>> to get the number of elements in an array.
824 Same as L</av_top_index>. Note that, unlike what the name implies, it returns
825 the maximum index in the array. This is unlike L</sv_len>, which returns what
828 B<To get the true number of elements in the array, instead use C<L</av_count>>>.
834 Perl_av_len(pTHX_ AV *av)
836 PERL_ARGS_ASSERT_AV_LEN;
838 return av_top_index(av);
844 Set the highest index in the array to the given number, equivalent to
845 Perl's S<C<$#array = $fill;>>.
847 The number of elements in the array will be S<C<fill + 1>> after
848 C<av_fill()> returns. If the array was previously shorter, then the
849 additional elements appended are set to NULL. If the array
850 was longer, then the excess elements are freed. S<C<av_fill(av, -1)>> is
851 the same as C<av_clear(av)>.
856 Perl_av_fill(pTHX_ AV *av, SSize_t fill)
860 PERL_ARGS_ASSERT_AV_FILL;
861 assert(SvTYPE(av) == SVt_PVAV);
865 if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
866 SV *arg1 = sv_newmortal();
867 sv_setiv(arg1, (IV)(fill + 1));
868 Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(STORESIZE), G_DISCARD,
872 if (fill <= AvMAX(av)) {
873 SSize_t key = AvFILLp(av);
874 SV** const ary = AvARRAY(av);
878 SvREFCNT_dec(ary[key]);
889 mg_set(MUTABLE_SV(av));
892 (void)av_store(av,fill,NULL);
896 =for apidoc av_delete
898 Deletes the element indexed by C<key> from the array, makes the element
899 mortal, and returns it. If C<flags> equals C<G_DISCARD>, the element is
900 freed and NULL is returned. NULL is also returned if C<key> is out of
903 Perl equivalent: S<C<splice(@myarray, $key, 1, undef)>> (with the
904 C<splice> in void context if C<G_DISCARD> is present).
909 Perl_av_delete(pTHX_ AV *av, SSize_t key, I32 flags)
913 PERL_ARGS_ASSERT_AV_DELETE;
914 assert(SvTYPE(av) == SVt_PVAV);
917 Perl_croak_no_modify();
919 if (SvRMAGICAL(av)) {
920 const MAGIC * const tied_magic
921 = mg_find((const SV *)av, PERL_MAGIC_tied);
922 if ((tied_magic || mg_find((const SV *)av, PERL_MAGIC_regdata))) {
925 if (!S_adjust_index(aTHX_ av, tied_magic, &key))
928 svp = av_fetch(av, key, TRUE);
932 if (mg_find(sv, PERL_MAGIC_tiedelem)) {
933 sv_unmagic(sv, PERL_MAGIC_tiedelem); /* No longer an element */
942 key += AvFILL(av) + 1;
947 if (key > AvFILLp(av))
950 if (!AvREAL(av) && AvREIFY(av))
952 sv = AvARRAY(av)[key];
953 AvARRAY(av)[key] = NULL;
954 if (key == AvFILLp(av)) {
957 } while (--key >= 0 && !AvARRAY(av)[key]);
960 mg_set(MUTABLE_SV(av));
963 if (flags & G_DISCARD) {
974 =for apidoc av_exists
976 Returns true if the element indexed by C<key> has been initialized.
978 This relies on the fact that uninitialized array elements are set to
981 Perl equivalent: C<exists($myarray[$key])>.
986 Perl_av_exists(pTHX_ AV *av, SSize_t key)
988 PERL_ARGS_ASSERT_AV_EXISTS;
989 assert(SvTYPE(av) == SVt_PVAV);
991 if (SvRMAGICAL(av)) {
992 const MAGIC * const tied_magic
993 = mg_find((const SV *)av, PERL_MAGIC_tied);
994 const MAGIC * const regdata_magic
995 = mg_find((const SV *)av, PERL_MAGIC_regdata);
996 if (tied_magic || regdata_magic) {
998 /* Handle negative array indices 20020222 MJD */
1000 if (!S_adjust_index(aTHX_ av, tied_magic, &key))
1004 if(key >= 0 && regdata_magic) {
1005 if (key <= AvFILL(av))
1011 SV * const sv = sv_newmortal();
1012 mg_copy(MUTABLE_SV(av), sv, 0, key);
1013 mg = mg_find(sv, PERL_MAGIC_tiedelem);
1015 magic_existspack(sv, mg);
1017 I32 retbool = SvTRUE_nomg_NN(sv);
1018 return cBOOL(retbool);
1026 key += AvFILL(av) + 1;
1031 if (key <= AvFILLp(av) && AvARRAY(av)[key])
1033 if (SvSMAGICAL(AvARRAY(av)[key])
1034 && mg_find(AvARRAY(av)[key], PERL_MAGIC_nonelem))
1043 S_get_aux_mg(pTHX_ AV *av) {
1046 PERL_ARGS_ASSERT_GET_AUX_MG;
1047 assert(SvTYPE(av) == SVt_PVAV);
1049 mg = mg_find((const SV *)av, PERL_MAGIC_arylen_p);
1052 mg = sv_magicext(MUTABLE_SV(av), 0, PERL_MAGIC_arylen_p,
1053 &PL_vtbl_arylen_p, 0, 0);
1055 /* sv_magicext won't set this for us because we pass in a NULL obj */
1056 mg->mg_flags |= MGf_REFCOUNTED;
1062 Perl_av_arylen_p(pTHX_ AV *av) {
1063 MAGIC *const mg = get_aux_mg(av);
1065 PERL_ARGS_ASSERT_AV_ARYLEN_P;
1066 assert(SvTYPE(av) == SVt_PVAV);
1068 return &(mg->mg_obj);
1072 Perl_av_iter_p(pTHX_ AV *av) {
1073 MAGIC *const mg = get_aux_mg(av);
1075 PERL_ARGS_ASSERT_AV_ITER_P;
1076 assert(SvTYPE(av) == SVt_PVAV);
1078 if (sizeof(IV) == sizeof(SSize_t)) {
1079 return (IV *)&(mg->mg_len);
1083 mg->mg_len = IVSIZE;
1085 mg->mg_ptr = (char *) temp;
1087 return (IV *)mg->mg_ptr;
1092 Perl_av_nonelem(pTHX_ AV *av, SSize_t ix) {
1093 SV * const sv = newSV(0);
1094 PERL_ARGS_ASSERT_AV_NONELEM;
1095 if (!av_store(av,ix,sv))
1096 return sv_2mortal(sv); /* has tie magic */
1097 sv_magic(sv, NULL, PERL_MAGIC_nonelem, NULL, 0);
1102 * ex: set ts=8 sts=4 sw=4 et: