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"]
23 Perl_av_reify(pTHX_ AV *av)
27 PERL_ARGS_ASSERT_AV_REIFY;
28 assert(SvTYPE(av) == SVt_PVAV);
33 if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied))
34 Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "av_reify called on tied array");
37 while (key > AvFILLp(av) + 1)
38 AvARRAY(av)[--key] = NULL;
40 SV * const sv = AvARRAY(av)[--key];
41 if (sv != &PL_sv_undef)
42 SvREFCNT_inc_simple_void(sv);
44 key = AvARRAY(av) - AvALLOC(av);
46 AvALLOC(av)[--key] = NULL;
54 Pre-extend an array so that it is capable of storing values at indexes
55 C<0..key>. Thus C<av_extend(av,99)> guarantees that the array can store 100
56 elements, i.e. that C<av_store(av, 0, sv)> through C<av_store(av, 99, sv)>
57 on a plain array will work without any further memory allocation.
59 If the av argument is a tied array then will call the C<EXTEND> tied
60 array method with an argument of C<(key+1)>.
66 Perl_av_extend(pTHX_ AV *av, SSize_t key)
70 PERL_ARGS_ASSERT_AV_EXTEND;
71 assert(SvTYPE(av) == SVt_PVAV);
73 mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied);
75 SV *arg1 = sv_newmortal();
76 /* NOTE: the API for av_extend() is NOT the same as the tie method EXTEND.
78 * The C function takes an *index* (assumes 0 indexed arrays) and ensures
79 * that the array is at least as large as the index provided.
81 * The tied array method EXTEND takes a *count* and ensures that the array
82 * is at least that many elements large. Thus we have to +1 the key when
83 * we call the tied method.
85 sv_setiv(arg1, (IV)(key + 1));
86 Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(EXTEND), G_DISCARD, 1,
90 av_extend_guts(av,key,&AvMAX(av),&AvALLOC(av),&AvARRAY(av));
93 /* The guts of av_extend. *Not* for general use! */
94 /* Also called directly from pp_assign, padlist_store, padnamelist_store */
96 Perl_av_extend_guts(pTHX_ AV *av, SSize_t key, SSize_t *maxp, SV ***allocp,
99 PERL_ARGS_ASSERT_AV_EXTEND_GUTS;
101 if (key < -1) /* -1 is legal */
103 "panic: av_extend_guts() negative count (%" IVdf ")", (IV)key);
106 SSize_t ary_offset = *maxp + 1;
110 if (av && *allocp != *arrayp) { /* a shifted SV* array exists */
111 to_null = *arrayp - *allocp;
113 ary_offset = AvFILLp(av) + 1;
115 Move(*arrayp, *allocp, AvFILLp(av)+1, SV*);
117 if (key > *maxp - 10) {
118 newmax = key + *maxp;
121 } else if (*allocp) { /* a full SV* array exists */
123 #ifdef Perl_safesysmalloc_size
124 /* Whilst it would be quite possible to move this logic around
125 (as I did in the SV code), so as to set AvMAX(av) early,
126 based on calling Perl_safesysmalloc_size() immediately after
127 allocation, I'm not convinced that it is a great idea here.
128 In an array we have to loop round setting everything to
129 NULL, which means writing to memory, potentially lots
130 of it, whereas for the SV buffer case we don't touch the
131 "bonus" memory. So there there is no cost in telling the
132 world about it, whereas here we have to do work before we can
133 tell the world about it, and that work involves writing to
134 memory that might never be read. So, I feel, better to keep
135 the current lazy system of only writing to it if our caller
136 has a need for more space. NWC */
137 newmax = Perl_safesysmalloc_size((void*)*allocp) /
138 sizeof(const SV *) - 1;
143 /* overflow-safe version of newmax = key + *maxp/5 */
145 newmax = (key > SSize_t_MAX - newmax)
146 ? SSize_t_MAX : key + newmax;
149 /* it should really be newmax+1 here, but if newmax
150 * happens to equal SSize_t_MAX, then newmax+1 is
151 * undefined. This means technically we croak one
152 * index lower than we should in theory; in practice
153 * its unlikely the system has SSize_t_MAX/sizeof(SV*)
155 MEM_WRAP_CHECK_s(newmax, SV*, "Out of memory during array extend");
157 #ifdef STRESS_REALLOC
159 SV ** const old_alloc = *allocp;
160 Newx(*allocp, newmax+1, SV*);
161 Copy(old_alloc, *allocp, *maxp + 1, SV*);
165 Renew(*allocp,newmax+1, SV*);
167 #ifdef Perl_safesysmalloc_size
170 to_null += newmax - *maxp;
173 /* See GH#18014 for discussion of when this might be needed: */
174 if (av == PL_curstack) { /* Oops, grew stack (via av_store()?) */
175 PL_stack_sp = *allocp + (PL_stack_sp - PL_stack_base);
176 PL_stack_base = *allocp;
177 PL_stack_max = PL_stack_base + newmax;
179 } else { /* there is no SV* array yet */
180 *maxp = key < 3 ? 3 : key;
182 /* see comment above about newmax+1*/
183 MEM_WRAP_CHECK_s(*maxp, SV*,
184 "Out of memory during array extend");
186 /* Newxz isn't used below because testing showed it to be slower
187 * than Newx+Zero (also slower than Newx + the previous while
188 * loop) for small arrays, which are very common in perl. */
189 Newx(*allocp, *maxp+1, SV*);
190 /* Stacks require only the first element to be &PL_sv_undef
191 * (set elsewhere). However, since non-stack AVs are likely
192 * to dominate in modern production applications, stacks
193 * don't get any special treatment here.
194 * See https://github.com/Perl/perl5/pull/18690 for more detail */
200 if (av && AvREAL(av)) {
202 Zero(*allocp + ary_offset,to_null,SV*);
212 Returns the SV at the specified index in the array. The C<key> is the
213 index. If lval is true, you are guaranteed to get a real SV back (in case
214 it wasn't real before), which you can then modify. Check that the return
215 value is non-null before dereferencing it to a C<SV*>.
217 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
218 more information on how to use this function on tied arrays.
220 The rough perl equivalent is C<$myarray[$key]>.
226 S_adjust_index(pTHX_ AV *av, const MAGIC *mg, SSize_t *keyp)
228 bool adjust_index = 1;
230 /* Handle negative array indices 20020222 MJD */
231 SV * const ref = SvTIED_obj(MUTABLE_SV(av), mg);
233 if (SvROK(ref) && SvOBJECT(SvRV(ref))) {
234 SV * const * const negative_indices_glob =
235 hv_fetchs(SvSTASH(SvRV(ref)), NEGATIVE_INDICES_VAR, 0);
237 if (negative_indices_glob && isGV(*negative_indices_glob)
238 && SvTRUE(GvSV(*negative_indices_glob)))
244 *keyp += AvFILL(av) + 1;
252 Perl_av_fetch(pTHX_ AV *av, SSize_t key, I32 lval)
257 PERL_ARGS_ASSERT_AV_FETCH;
258 assert(SvTYPE(av) == SVt_PVAV);
260 if (UNLIKELY(SvRMAGICAL(av))) {
261 const MAGIC * const tied_magic
262 = mg_find((const SV *)av, PERL_MAGIC_tied);
263 if (tied_magic || mg_find((const SV *)av, PERL_MAGIC_regdata)) {
266 if (!S_adjust_index(aTHX_ av, tied_magic, &key))
271 sv_upgrade(sv, SVt_PVLV);
272 mg_copy(MUTABLE_SV(av), sv, 0, key);
273 if (!tied_magic) /* for regdata, force leavesub to make copies */
276 LvTARG(sv) = sv; /* fake (SV**) */
277 return &(LvTARG(sv));
282 size = AvFILLp(av) + 1;
283 key += neg * size; /* handle negative index without using branch */
285 /* the cast from SSize_t to Size_t allows both (key < 0) and (key >= size)
286 * to be tested as a single condition */
287 if ((Size_t)key >= (Size_t)size) {
293 if (!AvARRAY(av)[key]) {
295 return lval ? av_store(av,key,newSV(0)) : NULL;
298 return &AvARRAY(av)[key];
304 Stores an SV in an array. The array index is specified as C<key>. The
305 return value will be C<NULL> if the operation failed or if the value did not
306 need to be actually stored within the array (as in the case of tied
307 arrays). Otherwise, it can be dereferenced
308 to get the C<SV*> that was stored
311 Note that the caller is responsible for suitably incrementing the reference
312 count of C<val> before the call, and decrementing it if the function
315 Approximate Perl equivalent: C<splice(@myarray, $key, 1, $val)>.
317 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
318 more information on how to use this function on tied arrays.
324 Perl_av_store(pTHX_ AV *av, SSize_t key, SV *val)
328 PERL_ARGS_ASSERT_AV_STORE;
329 assert(SvTYPE(av) == SVt_PVAV);
331 /* S_regclass relies on being able to pass in a NULL sv
332 (unicode_alternate may be NULL).
335 if (SvRMAGICAL(av)) {
336 const MAGIC * const tied_magic = mg_find((const SV *)av, PERL_MAGIC_tied);
339 if (!S_adjust_index(aTHX_ av, tied_magic, &key))
343 mg_copy(MUTABLE_SV(av), val, 0, key);
351 key += AvFILL(av) + 1;
356 if (SvREADONLY(av) && key >= AvFILL(av))
357 Perl_croak_no_modify();
359 if (!AvREAL(av) && AvREIFY(av))
364 if (AvFILLp(av) < key) {
366 if (av == PL_curstack && key > PL_stack_sp - PL_stack_base)
367 PL_stack_sp = PL_stack_base + key; /* XPUSH in disguise */
369 ary[++AvFILLp(av)] = NULL;
370 } while (AvFILLp(av) < key);
375 SvREFCNT_dec(ary[key]);
377 if (SvSMAGICAL(av)) {
378 const MAGIC *mg = SvMAGIC(av);
380 for (; mg; mg = mg->mg_moremagic) {
381 if (!isUPPER(mg->mg_type)) continue;
383 sv_magic(val, MUTABLE_SV(av), toLOWER(mg->mg_type), 0, key);
385 if (PL_delaymagic && mg->mg_type == PERL_MAGIC_isa) {
386 PL_delaymagic |= DM_ARRAY_ISA;
391 mg_set(MUTABLE_SV(av));
399 Creates a new AV and populates it with a list of SVs. The SVs are copied
400 into the array, so they may be freed after the call to C<av_make>. The new AV
401 will have a reference count of 1.
403 Perl equivalent: C<my @new_array = ($scalar1, $scalar2, $scalar3...);>
409 Perl_av_make(pTHX_ SSize_t size, SV **strp)
411 AV * const av = newAV();
412 /* sv_upgrade does AvREAL_only() */
413 PERL_ARGS_ASSERT_AV_MAKE;
414 assert(SvTYPE(av) == SVt_PVAV);
416 if (size) { /* "defined" was returning undef for size==0 anyway. */
424 AvMAX(av) = size - 1;
425 /* avoid av being leaked if croak when calling magic below */
427 PL_tmps_stack[++PL_tmps_ix] = (SV*)av;
428 orig_ix = PL_tmps_ix;
430 for (i = 0; i < size; i++) {
433 /* Don't let sv_setsv swipe, since our source array might
434 have multiple references to the same temp scalar (e.g.
435 from a list slice) */
437 SvGETMAGIC(*strp); /* before newSV, in case it dies */
440 sv_setsv_flags(ary[i], *strp,
441 SV_DO_COW_SVSETSV|SV_NOSTEAL);
444 /* disarm av's leak guard */
445 if (LIKELY(PL_tmps_ix == orig_ix))
448 PL_tmps_stack[orig_ix] = &PL_sv_undef;
456 Frees all the elements of an array, leaving it empty.
457 The XS equivalent of C<@array = ()>. See also L</av_undef>.
459 Note that it is possible that the actions of a destructor called directly
460 or indirectly by freeing an element of the array could cause the reference
461 count of the array itself to be reduced (e.g. by deleting an entry in the
462 symbol table). So it is a possibility that the AV could have been freed
463 (or even reallocated) on return from the call unless you hold a reference
470 Perl_av_clear(pTHX_ AV *av)
476 PERL_ARGS_ASSERT_AV_CLEAR;
477 assert(SvTYPE(av) == SVt_PVAV);
480 if (SvREFCNT(av) == 0) {
481 Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "Attempt to clear deleted array");
486 Perl_croak_no_modify();
488 /* Give any tie a chance to cleanup first */
489 if (SvRMAGICAL(av)) {
490 const MAGIC* const mg = SvMAGIC(av);
491 if (PL_delaymagic && mg && mg->mg_type == PERL_MAGIC_isa)
492 PL_delaymagic |= DM_ARRAY_ISA;
494 mg_clear(MUTABLE_SV(av));
500 if ((real = cBOOL(AvREAL(av)))) {
501 SV** const ary = AvARRAY(av);
502 SSize_t index = AvFILLp(av) + 1;
504 /* avoid av being freed when calling destructors below */
506 PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple_NN(av);
507 orig_ix = PL_tmps_ix;
510 SV * const sv = ary[--index];
511 /* undef the slot before freeing the value, because a
512 * destructor might try to modify this array */
517 extra = AvARRAY(av) - AvALLOC(av);
520 AvARRAY(av) = AvALLOC(av);
524 /* disarm av's premature free guard */
525 if (LIKELY(PL_tmps_ix == orig_ix))
528 PL_tmps_stack[orig_ix] = &PL_sv_undef;
536 Undefines the array. The XS equivalent of C<undef(@array)>.
538 As well as freeing all the elements of the array (like C<av_clear()>), this
539 also frees the memory used by the av to store its list of scalars.
541 See L</av_clear> for a note about the array possibly being invalid on
548 Perl_av_undef(pTHX_ AV *av)
551 SSize_t orig_ix = PL_tmps_ix; /* silence bogus warning about possible unitialized use */
553 PERL_ARGS_ASSERT_AV_UNDEF;
554 assert(SvTYPE(av) == SVt_PVAV);
556 /* Give any tie a chance to cleanup first */
557 if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied))
560 real = cBOOL(AvREAL(av));
562 SSize_t key = AvFILLp(av) + 1;
564 /* avoid av being freed when calling destructors below */
566 PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple_NN(av);
567 orig_ix = PL_tmps_ix;
570 SvREFCNT_dec(AvARRAY(av)[--key]);
573 Safefree(AvALLOC(av));
576 AvMAX(av) = AvFILLp(av) = -1;
578 if(SvRMAGICAL(av)) mg_clear(MUTABLE_SV(av));
580 /* disarm av's premature free guard */
581 if (LIKELY(PL_tmps_ix == orig_ix))
584 PL_tmps_stack[orig_ix] = &PL_sv_undef;
591 =for apidoc av_create_and_push
593 Push an SV onto the end of the array, creating the array if necessary.
594 A small internal helper function to remove a commonly duplicated idiom.
600 Perl_av_create_and_push(pTHX_ AV **const avp, SV *const val)
602 PERL_ARGS_ASSERT_AV_CREATE_AND_PUSH;
612 Pushes an SV (transferring control of one reference count) onto the end of the
613 array. The array will grow automatically to accommodate the addition.
615 Perl equivalent: C<push @myarray, $val;>.
621 Perl_av_push(pTHX_ AV *av, SV *val)
625 PERL_ARGS_ASSERT_AV_PUSH;
626 assert(SvTYPE(av) == SVt_PVAV);
629 Perl_croak_no_modify();
631 if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
632 Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(PUSH), G_DISCARD, 1,
636 av_store(av,AvFILLp(av)+1,val);
642 Removes one SV from the end of the array, reducing its size by one and
643 returning the SV (transferring control of one reference count) to the
644 caller. Returns C<&PL_sv_undef> if the array is empty.
646 Perl equivalent: C<pop(@myarray);>
652 Perl_av_pop(pTHX_ AV *av)
657 PERL_ARGS_ASSERT_AV_POP;
658 assert(SvTYPE(av) == SVt_PVAV);
661 Perl_croak_no_modify();
662 if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
663 retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(POP), 0, 0);
665 retval = newSVsv(retval);
670 retval = AvARRAY(av)[AvFILLp(av)];
671 AvARRAY(av)[AvFILLp(av)--] = NULL;
673 mg_set(MUTABLE_SV(av));
674 return retval ? retval : &PL_sv_undef;
679 =for apidoc av_create_and_unshift_one
681 Unshifts an SV onto the beginning of the array, creating the array if
683 A small internal helper function to remove a commonly duplicated idiom.
689 Perl_av_create_and_unshift_one(pTHX_ AV **const avp, SV *const val)
691 PERL_ARGS_ASSERT_AV_CREATE_AND_UNSHIFT_ONE;
696 return av_store(*avp, 0, val);
700 =for apidoc av_unshift
702 Unshift the given number of C<undef> values onto the beginning of the
703 array. The array will grow automatically to accommodate the addition.
705 Perl equivalent: S<C<unshift @myarray, ((undef) x $num);>>
711 Perl_av_unshift(pTHX_ AV *av, SSize_t num)
716 PERL_ARGS_ASSERT_AV_UNSHIFT;
717 assert(SvTYPE(av) == SVt_PVAV);
720 Perl_croak_no_modify();
722 if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
723 Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(UNSHIFT),
724 G_DISCARD | G_UNDEF_FILL, num);
730 if (!AvREAL(av) && AvREIFY(av))
732 i = AvARRAY(av) - AvALLOC(av);
740 AvARRAY(av) = AvARRAY(av) - i;
744 const SSize_t i = AvFILLp(av);
745 /* Create extra elements */
746 const SSize_t slide = i > 0 ? i : 0;
748 av_extend(av, i + num);
751 Move(ary, ary + num, i + 1, SV*);
755 /* Make extra elements into a buffer */
757 AvFILLp(av) -= slide;
758 AvARRAY(av) = AvARRAY(av) + slide;
765 Removes one SV from the start of the array, reducing its size by one and
766 returning the SV (transferring control of one reference count) to the
767 caller. Returns C<&PL_sv_undef> if the array is empty.
769 Perl equivalent: C<shift(@myarray);>
775 Perl_av_shift(pTHX_ AV *av)
780 PERL_ARGS_ASSERT_AV_SHIFT;
781 assert(SvTYPE(av) == SVt_PVAV);
784 Perl_croak_no_modify();
785 if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
786 retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(SHIFT), 0, 0);
788 retval = newSVsv(retval);
793 retval = *AvARRAY(av);
796 AvARRAY(av) = AvARRAY(av) + 1;
800 mg_set(MUTABLE_SV(av));
801 return retval ? retval : &PL_sv_undef;
805 =for apidoc av_tindex
806 =for apidoc_item av_top_index
808 These behave identically.
809 If the array C<av> is empty, these return -1; otherwise they return the maximum
810 value of the indices of all the array elements which are currently defined in
813 They process 'get' magic.
815 The Perl equivalent for these is C<$#av>.
817 Use C<L</av_count>> to get the number of elements in an array.
821 Same as L</av_top_index>. Note that, unlike what the name implies, it returns
822 the maximum index in the array. This is unlike L</sv_len>, which returns what
825 B<To get the true number of elements in the array, instead use C<L</av_count>>>.
831 Perl_av_len(pTHX_ AV *av)
833 PERL_ARGS_ASSERT_AV_LEN;
835 return av_top_index(av);
841 Set the highest index in the array to the given number, equivalent to
842 Perl's S<C<$#array = $fill;>>.
844 The number of elements in the array will be S<C<fill + 1>> after
845 C<av_fill()> returns. If the array was previously shorter, then the
846 additional elements appended are set to NULL. If the array
847 was longer, then the excess elements are freed. S<C<av_fill(av, -1)>> is
848 the same as C<av_clear(av)>.
853 Perl_av_fill(pTHX_ AV *av, SSize_t fill)
857 PERL_ARGS_ASSERT_AV_FILL;
858 assert(SvTYPE(av) == SVt_PVAV);
862 if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
863 SV *arg1 = sv_newmortal();
864 sv_setiv(arg1, (IV)(fill + 1));
865 Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(STORESIZE), G_DISCARD,
869 if (fill <= AvMAX(av)) {
870 SSize_t key = AvFILLp(av);
871 SV** const ary = AvARRAY(av);
875 SvREFCNT_dec(ary[key]);
886 mg_set(MUTABLE_SV(av));
889 (void)av_store(av,fill,NULL);
893 =for apidoc av_delete
895 Deletes the element indexed by C<key> from the array, makes the element
896 mortal, and returns it. If C<flags> equals C<G_DISCARD>, the element is
897 freed and NULL is returned. NULL is also returned if C<key> is out of
900 Perl equivalent: S<C<splice(@myarray, $key, 1, undef)>> (with the
901 C<splice> in void context if C<G_DISCARD> is present).
906 Perl_av_delete(pTHX_ AV *av, SSize_t key, I32 flags)
910 PERL_ARGS_ASSERT_AV_DELETE;
911 assert(SvTYPE(av) == SVt_PVAV);
914 Perl_croak_no_modify();
916 if (SvRMAGICAL(av)) {
917 const MAGIC * const tied_magic
918 = mg_find((const SV *)av, PERL_MAGIC_tied);
919 if ((tied_magic || mg_find((const SV *)av, PERL_MAGIC_regdata))) {
922 if (!S_adjust_index(aTHX_ av, tied_magic, &key))
925 svp = av_fetch(av, key, TRUE);
929 if (mg_find(sv, PERL_MAGIC_tiedelem)) {
930 sv_unmagic(sv, PERL_MAGIC_tiedelem); /* No longer an element */
939 key += AvFILL(av) + 1;
944 if (key > AvFILLp(av))
947 if (!AvREAL(av) && AvREIFY(av))
949 sv = AvARRAY(av)[key];
950 AvARRAY(av)[key] = NULL;
951 if (key == AvFILLp(av)) {
954 } while (--key >= 0 && !AvARRAY(av)[key]);
957 mg_set(MUTABLE_SV(av));
960 if (flags & G_DISCARD) {
971 =for apidoc av_exists
973 Returns true if the element indexed by C<key> has been initialized.
975 This relies on the fact that uninitialized array elements are set to
978 Perl equivalent: C<exists($myarray[$key])>.
983 Perl_av_exists(pTHX_ AV *av, SSize_t key)
985 PERL_ARGS_ASSERT_AV_EXISTS;
986 assert(SvTYPE(av) == SVt_PVAV);
988 if (SvRMAGICAL(av)) {
989 const MAGIC * const tied_magic
990 = mg_find((const SV *)av, PERL_MAGIC_tied);
991 const MAGIC * const regdata_magic
992 = mg_find((const SV *)av, PERL_MAGIC_regdata);
993 if (tied_magic || regdata_magic) {
995 /* Handle negative array indices 20020222 MJD */
997 if (!S_adjust_index(aTHX_ av, tied_magic, &key))
1001 if(key >= 0 && regdata_magic) {
1002 if (key <= AvFILL(av))
1008 SV * const sv = sv_newmortal();
1009 mg_copy(MUTABLE_SV(av), sv, 0, key);
1010 mg = mg_find(sv, PERL_MAGIC_tiedelem);
1012 magic_existspack(sv, mg);
1014 I32 retbool = SvTRUE_nomg_NN(sv);
1015 return cBOOL(retbool);
1023 key += AvFILL(av) + 1;
1028 if (key <= AvFILLp(av) && AvARRAY(av)[key])
1030 if (SvSMAGICAL(AvARRAY(av)[key])
1031 && mg_find(AvARRAY(av)[key], PERL_MAGIC_nonelem))
1040 S_get_aux_mg(pTHX_ AV *av) {
1043 PERL_ARGS_ASSERT_GET_AUX_MG;
1044 assert(SvTYPE(av) == SVt_PVAV);
1046 mg = mg_find((const SV *)av, PERL_MAGIC_arylen_p);
1049 mg = sv_magicext(MUTABLE_SV(av), 0, PERL_MAGIC_arylen_p,
1050 &PL_vtbl_arylen_p, 0, 0);
1052 /* sv_magicext won't set this for us because we pass in a NULL obj */
1053 mg->mg_flags |= MGf_REFCOUNTED;
1059 Perl_av_arylen_p(pTHX_ AV *av) {
1060 MAGIC *const mg = get_aux_mg(av);
1062 PERL_ARGS_ASSERT_AV_ARYLEN_P;
1063 assert(SvTYPE(av) == SVt_PVAV);
1065 return &(mg->mg_obj);
1069 Perl_av_iter_p(pTHX_ AV *av) {
1070 MAGIC *const mg = get_aux_mg(av);
1072 PERL_ARGS_ASSERT_AV_ITER_P;
1073 assert(SvTYPE(av) == SVt_PVAV);
1075 if (sizeof(IV) == sizeof(SSize_t)) {
1076 return (IV *)&(mg->mg_len);
1080 mg->mg_len = IVSIZE;
1082 mg->mg_ptr = (char *) temp;
1084 return (IV *)mg->mg_ptr;
1089 Perl_av_nonelem(pTHX_ AV *av, SSize_t ix) {
1090 SV * const sv = newSV(0);
1091 PERL_ARGS_ASSERT_AV_NONELEM;
1092 if (!av_store(av,ix,sv))
1093 return sv_2mortal(sv); /* has tie magic */
1094 sv_magic(sv, NULL, PERL_MAGIC_nonelem, NULL, 0);
1099 * ex: set ts=8 sts=4 sw=4 et: