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;
114 Move(*arrayp, *allocp, AvFILLp(av)+1, SV*);
116 if (key > *maxp - 10) {
117 newmax = key + *maxp;
120 } else if (*allocp) { /* a full SV* array exists */
122 #ifdef Perl_safesysmalloc_size
123 /* Whilst it would be quite possible to move this logic around
124 (as I did in the SV code), so as to set AvMAX(av) early,
125 based on calling Perl_safesysmalloc_size() immediately after
126 allocation, I'm not convinced that it is a great idea here.
127 In an array we have to loop round setting everything to
128 NULL, which means writing to memory, potentially lots
129 of it, whereas for the SV buffer case we don't touch the
130 "bonus" memory. So there there is no cost in telling the
131 world about it, whereas here we have to do work before we can
132 tell the world about it, and that work involves writing to
133 memory that might never be read. So, I feel, better to keep
134 the current lazy system of only writing to it if our caller
135 has a need for more space. NWC */
136 newmax = Perl_safesysmalloc_size((void*)*allocp) /
137 sizeof(const SV *) - 1;
142 /* overflow-safe version of newmax = key + *maxp/5 */
144 newmax = (key > SSize_t_MAX - newmax)
145 ? SSize_t_MAX : key + newmax;
148 /* it should really be newmax+1 here, but if newmax
149 * happens to equal SSize_t_MAX, then newmax+1 is
150 * undefined. This means technically we croak one
151 * index lower than we should in theory; in practice
152 * its unlikely the system has SSize_t_MAX/sizeof(SV*)
154 MEM_WRAP_CHECK_s(newmax, SV*, "Out of memory during array extend");
156 #ifdef STRESS_REALLOC
158 SV ** const old_alloc = *allocp;
159 Newx(*allocp, newmax+1, SV*);
160 Copy(old_alloc, *allocp, *maxp + 1, SV*);
164 Renew(*allocp,newmax+1, SV*);
166 #ifdef Perl_safesysmalloc_size
169 to_null += newmax - *maxp;
172 /* See GH#18014 for discussion of when this might be needed: */
173 if (av == PL_curstack) { /* Oops, grew stack (via av_store()?) */
174 PL_stack_sp = *allocp + (PL_stack_sp - PL_stack_base);
175 PL_stack_base = *allocp;
176 PL_stack_max = PL_stack_base + newmax;
178 } else { /* there is no SV* array yet */
179 *maxp = key < 3 ? 3 : key;
181 /* see comment above about newmax+1*/
182 MEM_WRAP_CHECK_s(*maxp, SV*,
183 "Out of memory during array extend");
185 /* Newxz isn't used below because testing showed it to be slower
186 * than Newx+Zero (also slower than Newx + the previous while
187 * loop) for small arrays, which are very common in perl. */
188 Newx(*allocp, *maxp+1, SV*);
189 /* Stacks require only the first element to be &PL_sv_undef
190 * (set elsewhere). However, since non-stack AVs are likely
191 * to dominate in modern production applications, stacks
192 * don't get any special treatment here. */
198 if (av && AvREAL(av)) {
200 Zero(*allocp + ary_offset,to_null,SV*);
210 Returns the SV at the specified index in the array. The C<key> is the
211 index. If lval is true, you are guaranteed to get a real SV back (in case
212 it wasn't real before), which you can then modify. Check that the return
213 value is non-null before dereferencing it to a C<SV*>.
215 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
216 more information on how to use this function on tied arrays.
218 The rough perl equivalent is C<$myarray[$key]>.
224 S_adjust_index(pTHX_ AV *av, const MAGIC *mg, SSize_t *keyp)
226 bool adjust_index = 1;
228 /* Handle negative array indices 20020222 MJD */
229 SV * const ref = SvTIED_obj(MUTABLE_SV(av), mg);
231 if (SvROK(ref) && SvOBJECT(SvRV(ref))) {
232 SV * const * const negative_indices_glob =
233 hv_fetchs(SvSTASH(SvRV(ref)), NEGATIVE_INDICES_VAR, 0);
235 if (negative_indices_glob && isGV(*negative_indices_glob)
236 && SvTRUE(GvSV(*negative_indices_glob)))
242 *keyp += AvFILL(av) + 1;
250 Perl_av_fetch(pTHX_ AV *av, SSize_t key, I32 lval)
255 PERL_ARGS_ASSERT_AV_FETCH;
256 assert(SvTYPE(av) == SVt_PVAV);
258 if (UNLIKELY(SvRMAGICAL(av))) {
259 const MAGIC * const tied_magic
260 = mg_find((const SV *)av, PERL_MAGIC_tied);
261 if (tied_magic || mg_find((const SV *)av, PERL_MAGIC_regdata)) {
264 if (!S_adjust_index(aTHX_ av, tied_magic, &key))
269 sv_upgrade(sv, SVt_PVLV);
270 mg_copy(MUTABLE_SV(av), sv, 0, key);
271 if (!tied_magic) /* for regdata, force leavesub to make copies */
274 LvTARG(sv) = sv; /* fake (SV**) */
275 return &(LvTARG(sv));
280 size = AvFILLp(av) + 1;
281 key += neg * size; /* handle negative index without using branch */
283 /* the cast from SSize_t to Size_t allows both (key < 0) and (key >= size)
284 * to be tested as a single condition */
285 if ((Size_t)key >= (Size_t)size) {
291 if (!AvARRAY(av)[key]) {
293 return lval ? av_store(av,key,newSV(0)) : NULL;
296 return &AvARRAY(av)[key];
302 Stores an SV in an array. The array index is specified as C<key>. The
303 return value will be C<NULL> if the operation failed or if the value did not
304 need to be actually stored within the array (as in the case of tied
305 arrays). Otherwise, it can be dereferenced
306 to get the C<SV*> that was stored
309 Note that the caller is responsible for suitably incrementing the reference
310 count of C<val> before the call, and decrementing it if the function
313 Approximate Perl equivalent: C<splice(@myarray, $key, 1, $val)>.
315 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
316 more information on how to use this function on tied arrays.
322 Perl_av_store(pTHX_ AV *av, SSize_t key, SV *val)
326 PERL_ARGS_ASSERT_AV_STORE;
327 assert(SvTYPE(av) == SVt_PVAV);
329 /* S_regclass relies on being able to pass in a NULL sv
330 (unicode_alternate may be NULL).
333 if (SvRMAGICAL(av)) {
334 const MAGIC * const tied_magic = mg_find((const SV *)av, PERL_MAGIC_tied);
337 if (!S_adjust_index(aTHX_ av, tied_magic, &key))
341 mg_copy(MUTABLE_SV(av), val, 0, key);
349 key += AvFILL(av) + 1;
354 if (SvREADONLY(av) && key >= AvFILL(av))
355 Perl_croak_no_modify();
357 if (!AvREAL(av) && AvREIFY(av))
362 if (AvFILLp(av) < key) {
364 if (av == PL_curstack && key > PL_stack_sp - PL_stack_base)
365 PL_stack_sp = PL_stack_base + key; /* XPUSH in disguise */
367 ary[++AvFILLp(av)] = NULL;
368 } while (AvFILLp(av) < key);
373 SvREFCNT_dec(ary[key]);
375 if (SvSMAGICAL(av)) {
376 const MAGIC *mg = SvMAGIC(av);
378 for (; mg; mg = mg->mg_moremagic) {
379 if (!isUPPER(mg->mg_type)) continue;
381 sv_magic(val, MUTABLE_SV(av), toLOWER(mg->mg_type), 0, key);
383 if (PL_delaymagic && mg->mg_type == PERL_MAGIC_isa) {
384 PL_delaymagic |= DM_ARRAY_ISA;
389 mg_set(MUTABLE_SV(av));
397 Creates a new AV and populates it with a list of SVs. The SVs are copied
398 into the array, so they may be freed after the call to C<av_make>. The new AV
399 will have a reference count of 1.
401 Perl equivalent: C<my @new_array = ($scalar1, $scalar2, $scalar3...);>
407 Perl_av_make(pTHX_ SSize_t size, SV **strp)
409 AV * const av = newAV();
410 /* sv_upgrade does AvREAL_only() */
411 PERL_ARGS_ASSERT_AV_MAKE;
412 assert(SvTYPE(av) == SVt_PVAV);
414 if (size) { /* "defined" was returning undef for size==0 anyway. */
422 AvMAX(av) = size - 1;
423 /* avoid av being leaked if croak when calling magic below */
425 PL_tmps_stack[++PL_tmps_ix] = (SV*)av;
426 orig_ix = PL_tmps_ix;
428 for (i = 0; i < size; i++) {
431 /* Don't let sv_setsv swipe, since our source array might
432 have multiple references to the same temp scalar (e.g.
433 from a list slice) */
435 SvGETMAGIC(*strp); /* before newSV, in case it dies */
438 sv_setsv_flags(ary[i], *strp,
439 SV_DO_COW_SVSETSV|SV_NOSTEAL);
442 /* disarm av's leak guard */
443 if (LIKELY(PL_tmps_ix == orig_ix))
446 PL_tmps_stack[orig_ix] = &PL_sv_undef;
454 Frees all the elements of an array, leaving it empty.
455 The XS equivalent of C<@array = ()>. See also L</av_undef>.
457 Note that it is possible that the actions of a destructor called directly
458 or indirectly by freeing an element of the array could cause the reference
459 count of the array itself to be reduced (e.g. by deleting an entry in the
460 symbol table). So it is a possibility that the AV could have been freed
461 (or even reallocated) on return from the call unless you hold a reference
468 Perl_av_clear(pTHX_ AV *av)
474 PERL_ARGS_ASSERT_AV_CLEAR;
475 assert(SvTYPE(av) == SVt_PVAV);
478 if (SvREFCNT(av) == 0) {
479 Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "Attempt to clear deleted array");
484 Perl_croak_no_modify();
486 /* Give any tie a chance to cleanup first */
487 if (SvRMAGICAL(av)) {
488 const MAGIC* const mg = SvMAGIC(av);
489 if (PL_delaymagic && mg && mg->mg_type == PERL_MAGIC_isa)
490 PL_delaymagic |= DM_ARRAY_ISA;
492 mg_clear(MUTABLE_SV(av));
498 if ((real = cBOOL(AvREAL(av)))) {
499 SV** const ary = AvARRAY(av);
500 SSize_t index = AvFILLp(av) + 1;
502 /* avoid av being freed when calling destructors below */
504 PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple_NN(av);
505 orig_ix = PL_tmps_ix;
508 SV * const sv = ary[--index];
509 /* undef the slot before freeing the value, because a
510 * destructor might try to modify this array */
515 extra = AvARRAY(av) - AvALLOC(av);
518 AvARRAY(av) = AvALLOC(av);
522 /* disarm av's premature free guard */
523 if (LIKELY(PL_tmps_ix == orig_ix))
526 PL_tmps_stack[orig_ix] = &PL_sv_undef;
534 Undefines the array. The XS equivalent of C<undef(@array)>.
536 As well as freeing all the elements of the array (like C<av_clear()>), this
537 also frees the memory used by the av to store its list of scalars.
539 See L</av_clear> for a note about the array possibly being invalid on
546 Perl_av_undef(pTHX_ AV *av)
549 SSize_t orig_ix = PL_tmps_ix; /* silence bogus warning about possible unitialized use */
551 PERL_ARGS_ASSERT_AV_UNDEF;
552 assert(SvTYPE(av) == SVt_PVAV);
554 /* Give any tie a chance to cleanup first */
555 if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied))
558 real = cBOOL(AvREAL(av));
560 SSize_t key = AvFILLp(av) + 1;
562 /* avoid av being freed when calling destructors below */
564 PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple_NN(av);
565 orig_ix = PL_tmps_ix;
568 SvREFCNT_dec(AvARRAY(av)[--key]);
571 Safefree(AvALLOC(av));
574 AvMAX(av) = AvFILLp(av) = -1;
576 if(SvRMAGICAL(av)) mg_clear(MUTABLE_SV(av));
578 /* disarm av's premature free guard */
579 if (LIKELY(PL_tmps_ix == orig_ix))
582 PL_tmps_stack[orig_ix] = &PL_sv_undef;
589 =for apidoc av_create_and_push
591 Push an SV onto the end of the array, creating the array if necessary.
592 A small internal helper function to remove a commonly duplicated idiom.
598 Perl_av_create_and_push(pTHX_ AV **const avp, SV *const val)
600 PERL_ARGS_ASSERT_AV_CREATE_AND_PUSH;
610 Pushes an SV (transferring control of one reference count) onto the end of the
611 array. The array will grow automatically to accommodate the addition.
613 Perl equivalent: C<push @myarray, $val;>.
619 Perl_av_push(pTHX_ AV *av, SV *val)
623 PERL_ARGS_ASSERT_AV_PUSH;
624 assert(SvTYPE(av) == SVt_PVAV);
627 Perl_croak_no_modify();
629 if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
630 Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(PUSH), G_DISCARD, 1,
634 av_store(av,AvFILLp(av)+1,val);
640 Removes one SV from the end of the array, reducing its size by one and
641 returning the SV (transferring control of one reference count) to the
642 caller. Returns C<&PL_sv_undef> if the array is empty.
644 Perl equivalent: C<pop(@myarray);>
650 Perl_av_pop(pTHX_ AV *av)
655 PERL_ARGS_ASSERT_AV_POP;
656 assert(SvTYPE(av) == SVt_PVAV);
659 Perl_croak_no_modify();
660 if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
661 retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(POP), 0, 0);
663 retval = newSVsv(retval);
668 retval = AvARRAY(av)[AvFILLp(av)];
669 AvARRAY(av)[AvFILLp(av)--] = NULL;
671 mg_set(MUTABLE_SV(av));
672 return retval ? retval : &PL_sv_undef;
677 =for apidoc av_create_and_unshift_one
679 Unshifts an SV onto the beginning of the array, creating the array if
681 A small internal helper function to remove a commonly duplicated idiom.
687 Perl_av_create_and_unshift_one(pTHX_ AV **const avp, SV *const val)
689 PERL_ARGS_ASSERT_AV_CREATE_AND_UNSHIFT_ONE;
694 return av_store(*avp, 0, val);
698 =for apidoc av_unshift
700 Unshift the given number of C<undef> values onto the beginning of the
701 array. The array will grow automatically to accommodate the addition.
703 Perl equivalent: S<C<unshift @myarray, ((undef) x $num);>>
709 Perl_av_unshift(pTHX_ AV *av, SSize_t num)
714 PERL_ARGS_ASSERT_AV_UNSHIFT;
715 assert(SvTYPE(av) == SVt_PVAV);
718 Perl_croak_no_modify();
720 if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
721 Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(UNSHIFT),
722 G_DISCARD | G_UNDEF_FILL, num);
728 if (!AvREAL(av) && AvREIFY(av))
730 i = AvARRAY(av) - AvALLOC(av);
738 AvARRAY(av) = AvARRAY(av) - i;
742 const SSize_t i = AvFILLp(av);
743 /* Create extra elements */
744 const SSize_t slide = i > 0 ? i : 0;
746 av_extend(av, i + num);
749 Move(ary, ary + num, i + 1, SV*);
753 /* Make extra elements into a buffer */
755 AvFILLp(av) -= slide;
756 AvARRAY(av) = AvARRAY(av) + slide;
763 Removes one SV from the start of the array, reducing its size by one and
764 returning the SV (transferring control of one reference count) to the
765 caller. Returns C<&PL_sv_undef> if the array is empty.
767 Perl equivalent: C<shift(@myarray);>
773 Perl_av_shift(pTHX_ AV *av)
778 PERL_ARGS_ASSERT_AV_SHIFT;
779 assert(SvTYPE(av) == SVt_PVAV);
782 Perl_croak_no_modify();
783 if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
784 retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(SHIFT), 0, 0);
786 retval = newSVsv(retval);
791 retval = *AvARRAY(av);
794 AvARRAY(av) = AvARRAY(av) + 1;
798 mg_set(MUTABLE_SV(av));
799 return retval ? retval : &PL_sv_undef;
803 =for apidoc av_tindex
804 =for apidoc_item av_top_index
806 These behave identically.
807 If the array C<av> is empty, these return -1; otherwise they return the maximum
808 value of the indices of all the array elements which are currently defined in
811 They process 'get' magic.
813 The Perl equivalent for these is C<$#av>.
815 Use C<L</av_count>> to get the number of elements in an array.
819 Same as L</av_top_index>. Note that, unlike what the name implies, it returns
820 the maximum index in the array. This is unlike L</sv_len>, which returns what
823 B<To get the true number of elements in the array, instead use C<L</av_count>>>.
829 Perl_av_len(pTHX_ AV *av)
831 PERL_ARGS_ASSERT_AV_LEN;
833 return av_top_index(av);
839 Set the highest index in the array to the given number, equivalent to
840 Perl's S<C<$#array = $fill;>>.
842 The number of elements in the array will be S<C<fill + 1>> after
843 C<av_fill()> returns. If the array was previously shorter, then the
844 additional elements appended are set to NULL. If the array
845 was longer, then the excess elements are freed. S<C<av_fill(av, -1)>> is
846 the same as C<av_clear(av)>.
851 Perl_av_fill(pTHX_ AV *av, SSize_t fill)
855 PERL_ARGS_ASSERT_AV_FILL;
856 assert(SvTYPE(av) == SVt_PVAV);
860 if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
861 SV *arg1 = sv_newmortal();
862 sv_setiv(arg1, (IV)(fill + 1));
863 Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(STORESIZE), G_DISCARD,
867 if (fill <= AvMAX(av)) {
868 SSize_t key = AvFILLp(av);
869 SV** const ary = AvARRAY(av);
873 SvREFCNT_dec(ary[key]);
884 mg_set(MUTABLE_SV(av));
887 (void)av_store(av,fill,NULL);
891 =for apidoc av_delete
893 Deletes the element indexed by C<key> from the array, makes the element
894 mortal, and returns it. If C<flags> equals C<G_DISCARD>, the element is
895 freed and NULL is returned. NULL is also returned if C<key> is out of
898 Perl equivalent: S<C<splice(@myarray, $key, 1, undef)>> (with the
899 C<splice> in void context if C<G_DISCARD> is present).
904 Perl_av_delete(pTHX_ AV *av, SSize_t key, I32 flags)
908 PERL_ARGS_ASSERT_AV_DELETE;
909 assert(SvTYPE(av) == SVt_PVAV);
912 Perl_croak_no_modify();
914 if (SvRMAGICAL(av)) {
915 const MAGIC * const tied_magic
916 = mg_find((const SV *)av, PERL_MAGIC_tied);
917 if ((tied_magic || mg_find((const SV *)av, PERL_MAGIC_regdata))) {
920 if (!S_adjust_index(aTHX_ av, tied_magic, &key))
923 svp = av_fetch(av, key, TRUE);
927 if (mg_find(sv, PERL_MAGIC_tiedelem)) {
928 sv_unmagic(sv, PERL_MAGIC_tiedelem); /* No longer an element */
937 key += AvFILL(av) + 1;
942 if (key > AvFILLp(av))
945 if (!AvREAL(av) && AvREIFY(av))
947 sv = AvARRAY(av)[key];
948 AvARRAY(av)[key] = NULL;
949 if (key == AvFILLp(av)) {
952 } while (--key >= 0 && !AvARRAY(av)[key]);
955 mg_set(MUTABLE_SV(av));
958 if (flags & G_DISCARD) {
969 =for apidoc av_exists
971 Returns true if the element indexed by C<key> has been initialized.
973 This relies on the fact that uninitialized array elements are set to
976 Perl equivalent: C<exists($myarray[$key])>.
981 Perl_av_exists(pTHX_ AV *av, SSize_t key)
983 PERL_ARGS_ASSERT_AV_EXISTS;
984 assert(SvTYPE(av) == SVt_PVAV);
986 if (SvRMAGICAL(av)) {
987 const MAGIC * const tied_magic
988 = mg_find((const SV *)av, PERL_MAGIC_tied);
989 const MAGIC * const regdata_magic
990 = mg_find((const SV *)av, PERL_MAGIC_regdata);
991 if (tied_magic || regdata_magic) {
993 /* Handle negative array indices 20020222 MJD */
995 if (!S_adjust_index(aTHX_ av, tied_magic, &key))
999 if(key >= 0 && regdata_magic) {
1000 if (key <= AvFILL(av))
1006 SV * const sv = sv_newmortal();
1007 mg_copy(MUTABLE_SV(av), sv, 0, key);
1008 mg = mg_find(sv, PERL_MAGIC_tiedelem);
1010 magic_existspack(sv, mg);
1012 I32 retbool = SvTRUE_nomg_NN(sv);
1013 return cBOOL(retbool);
1021 key += AvFILL(av) + 1;
1026 if (key <= AvFILLp(av) && AvARRAY(av)[key])
1028 if (SvSMAGICAL(AvARRAY(av)[key])
1029 && mg_find(AvARRAY(av)[key], PERL_MAGIC_nonelem))
1038 S_get_aux_mg(pTHX_ AV *av) {
1041 PERL_ARGS_ASSERT_GET_AUX_MG;
1042 assert(SvTYPE(av) == SVt_PVAV);
1044 mg = mg_find((const SV *)av, PERL_MAGIC_arylen_p);
1047 mg = sv_magicext(MUTABLE_SV(av), 0, PERL_MAGIC_arylen_p,
1048 &PL_vtbl_arylen_p, 0, 0);
1050 /* sv_magicext won't set this for us because we pass in a NULL obj */
1051 mg->mg_flags |= MGf_REFCOUNTED;
1057 Perl_av_arylen_p(pTHX_ AV *av) {
1058 MAGIC *const mg = get_aux_mg(av);
1060 PERL_ARGS_ASSERT_AV_ARYLEN_P;
1061 assert(SvTYPE(av) == SVt_PVAV);
1063 return &(mg->mg_obj);
1067 Perl_av_iter_p(pTHX_ AV *av) {
1068 MAGIC *const mg = get_aux_mg(av);
1070 PERL_ARGS_ASSERT_AV_ITER_P;
1071 assert(SvTYPE(av) == SVt_PVAV);
1073 if (sizeof(IV) == sizeof(SSize_t)) {
1074 return (IV *)&(mg->mg_len);
1078 mg->mg_len = IVSIZE;
1080 mg->mg_ptr = (char *) temp;
1082 return (IV *)mg->mg_ptr;
1087 Perl_av_nonelem(pTHX_ AV *av, SSize_t ix) {
1088 SV * const sv = newSV(0);
1089 PERL_ARGS_ASSERT_AV_NONELEM;
1090 if (!av_store(av,ix,sv))
1091 return sv_2mortal(sv); /* has tie magic */
1092 sv_magic(sv, NULL, PERL_MAGIC_nonelem, NULL, 0);
1097 * ex: set ts=8 sts=4 sw=4 et: