3 * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
4 * 2000, 2001, 2002, 2003, 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
17 =head1 Array Manipulation Functions
25 Perl_av_reify(pTHX_ AV *av)
33 if (SvTIED_mg((SV*)av, PERL_MAGIC_tied) && ckWARN_d(WARN_DEBUGGING))
34 Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "av_reify called on tied array");
37 while (key > AvFILLp(av) + 1)
38 AvARRAY(av)[--key] = &PL_sv_undef;
40 sv = AvARRAY(av)[--key];
42 if (sv != &PL_sv_undef)
43 (void)SvREFCNT_inc(sv);
45 key = AvARRAY(av) - AvALLOC(av);
47 AvALLOC(av)[--key] = &PL_sv_undef;
55 Pre-extend an array. The C<key> is the index to which the array should be
62 Perl_av_extend(pTHX_ AV *av, I32 key)
65 if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
69 PUSHSTACKi(PERLSI_MAGIC);
72 PUSHs(SvTIED_obj((SV*)av, mg));
73 PUSHs(sv_2mortal(newSViv(key+1)));
75 call_method("EXTEND", G_SCALAR|G_DISCARD);
81 if (key > AvMAX(av)) {
86 if (AvALLOC(av) != AvARRAY(av)) {
87 ary = AvALLOC(av) + AvFILLp(av) + 1;
88 tmp = AvARRAY(av) - AvALLOC(av);
89 Move(AvARRAY(av), AvALLOC(av), AvFILLp(av)+1, SV*);
91 SvPVX(av) = (char*)AvALLOC(av);
94 ary[--tmp] = &PL_sv_undef;
97 if (key > AvMAX(av) - 10) {
98 newmax = key + AvMAX(av);
104 #if !defined(STRANGE_MALLOC) && !defined(MYMALLOC)
110 newmax = malloced_size((void*)AvALLOC(av))/sizeof(SV*) - 1;
115 newmax = key + AvMAX(av) / 5;
117 MEM_WRAP_CHECK_1(newmax+1, SV*, "panic: array extend");
118 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
119 Renew(AvALLOC(av),newmax+1, SV*);
121 bytes = (newmax + 1) * sizeof(SV*);
122 #define MALLOC_OVERHEAD 16
123 itmp = MALLOC_OVERHEAD;
124 while ((MEM_SIZE)(itmp - MALLOC_OVERHEAD) < bytes)
126 itmp -= MALLOC_OVERHEAD;
128 assert(itmp > newmax);
130 assert(newmax >= AvMAX(av));
131 New(2,ary, newmax+1, SV*);
132 Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*);
134 offer_nice_chunk(AvALLOC(av), (AvMAX(av)+1) * sizeof(SV*));
136 Safefree(AvALLOC(av));
142 ary = AvALLOC(av) + AvMAX(av) + 1;
143 tmp = newmax - AvMAX(av);
144 if (av == PL_curstack) { /* Oops, grew stack (via av_store()?) */
145 PL_stack_sp = AvALLOC(av) + (PL_stack_sp - PL_stack_base);
146 PL_stack_base = AvALLOC(av);
147 PL_stack_max = PL_stack_base + newmax;
151 newmax = key < 3 ? 3 : key;
152 MEM_WRAP_CHECK_1(newmax+1, SV*, "panic: array extend");
153 New(2,AvALLOC(av), newmax+1, SV*);
154 ary = AvALLOC(av) + 1;
156 AvALLOC(av)[0] = &PL_sv_undef; /* For the stacks */
160 ary[--tmp] = &PL_sv_undef;
163 SvPVX(av) = (char*)AvALLOC(av);
172 Returns the SV at the specified index in the array. The C<key> is the
173 index. If C<lval> is set then the fetch will be part of a store. Check
174 that the return value is non-null before dereferencing it to a C<SV*>.
176 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
177 more information on how to use this function on tied arrays.
183 Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval)
190 if (SvRMAGICAL(av)) {
191 MAGIC *tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
192 if (tied_magic || mg_find((SV*)av, PERL_MAGIC_regdata)) {
193 U32 adjust_index = 1;
195 if (tied_magic && key < 0) {
196 /* Handle negative array indices 20020222 MJD */
197 SV **negative_indices_glob =
198 hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av,
200 NEGATIVE_INDICES_VAR, 16, 0);
202 if (negative_indices_glob
203 && SvTRUE(GvSV(*negative_indices_glob)))
207 if (key < 0 && adjust_index) {
208 key += AvFILL(av) + 1;
214 sv_upgrade(sv, SVt_PVLV);
215 mg_copy((SV*)av, sv, 0, key);
217 LvTARG(sv) = sv; /* fake (SV**) */
218 return &(LvTARG(sv));
223 key += AvFILL(av) + 1;
228 if (key > AvFILLp(av)) {
232 return av_store(av,key,sv);
234 if (AvARRAY(av)[key] == &PL_sv_undef) {
238 return av_store(av,key,sv);
243 && (!AvARRAY(av)[key] /* eg. @_ could have freed elts */
244 || SvTYPE(AvARRAY(av)[key]) == SVTYPEMASK)) {
245 AvARRAY(av)[key] = &PL_sv_undef; /* 1/2 reify */
248 return &AvARRAY(av)[key];
254 Stores an SV in an array. The array index is specified as C<key>. The
255 return value will be NULL if the operation failed or if the value did not
256 need to be actually stored within the array (as in the case of tied
257 arrays). Otherwise it can be dereferenced to get the original C<SV*>. Note
258 that the caller is responsible for suitably incrementing the reference
259 count of C<val> before the call, and decrementing it if the function
262 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
263 more information on how to use this function on tied arrays.
269 Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
278 if (SvRMAGICAL(av)) {
279 MAGIC *tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
281 /* Handle negative array indices 20020222 MJD */
283 unsigned adjust_index = 1;
284 SV **negative_indices_glob =
285 hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av,
287 NEGATIVE_INDICES_VAR, 16, 0);
288 if (negative_indices_glob
289 && SvTRUE(GvSV(*negative_indices_glob)))
292 key += AvFILL(av) + 1;
297 if (val != &PL_sv_undef) {
298 mg_copy((SV*)av, val, 0, key);
306 key += AvFILL(av) + 1;
311 if (SvREADONLY(av) && key >= AvFILL(av))
312 Perl_croak(aTHX_ PL_no_modify);
314 if (!AvREAL(av) && AvREIFY(av))
319 if (AvFILLp(av) < key) {
321 if (av == PL_curstack && key > PL_stack_sp - PL_stack_base)
322 PL_stack_sp = PL_stack_base + key; /* XPUSH in disguise */
324 ary[++AvFILLp(av)] = &PL_sv_undef;
325 while (AvFILLp(av) < key);
330 SvREFCNT_dec(ary[key]);
332 if (SvSMAGICAL(av)) {
333 if (val != &PL_sv_undef) {
334 MAGIC* mg = SvMAGIC(av);
335 sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key);
345 Creates a new AV. The reference count is set to 1.
355 av = (AV*)NEWSV(3,0);
356 sv_upgrade((SV *)av, SVt_PVAV);
360 AvMAX(av) = AvFILLp(av) = -1;
367 Creates a new AV and populates it with a list of SVs. The SVs are copied
368 into the array, so they may be freed after the call to av_make. The new AV
369 will have a reference count of 1.
375 Perl_av_make(pTHX_ register I32 size, register SV **strp)
381 av = (AV*)NEWSV(8,0);
382 sv_upgrade((SV *) av,SVt_PVAV);
383 AvFLAGS(av) = AVf_REAL;
384 if (size) { /* `defined' was returning undef for size==0 anyway. */
387 SvPVX(av) = (char*)ary;
388 AvFILLp(av) = size - 1;
389 AvMAX(av) = size - 1;
390 for (i = 0; i < size; i++) {
393 sv_setsv(ary[i], *strp);
401 Perl_av_fake(pTHX_ register I32 size, register SV **strp)
406 av = (AV*)NEWSV(9,0);
407 sv_upgrade((SV *)av, SVt_PVAV);
408 New(4,ary,size+1,SV*);
410 Copy(strp,ary,size,SV*);
411 AvFLAGS(av) = AVf_REIFY;
412 SvPVX(av) = (char*)ary;
413 AvFILLp(av) = size - 1;
414 AvMAX(av) = size - 1;
426 Clears an array, making it empty. Does not free the memory used by the
433 Perl_av_clear(pTHX_ register AV *av)
439 if (SvREFCNT(av) == 0 && ckWARN_d(WARN_DEBUGGING)) {
440 Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "Attempt to clear deleted array");
448 Perl_croak(aTHX_ PL_no_modify);
450 /* Give any tie a chance to cleanup first */
459 key = AvFILLp(av) + 1;
461 SV * sv = ary[--key];
462 /* undef the slot before freeing the value, because a
463 * destructor might try to modify this arrray */
464 ary[key] = &PL_sv_undef;
468 if ((key = AvARRAY(av) - AvALLOC(av))) {
470 SvPVX(av) = (char*)AvALLOC(av);
479 Undefines the array. Frees the memory used by the array itself.
485 Perl_av_undef(pTHX_ register AV *av)
493 /* Give any tie a chance to cleanup first */
494 if (SvTIED_mg((SV*)av, PERL_MAGIC_tied))
495 av_fill(av, -1); /* mg_clear() ? */
498 key = AvFILLp(av) + 1;
500 SvREFCNT_dec(AvARRAY(av)[--key]);
502 Safefree(AvALLOC(av));
505 AvMAX(av) = AvFILLp(av) = -1;
507 SvREFCNT_dec(AvARYLEN(av));
515 Pushes an SV onto the end of the array. The array will grow automatically
516 to accommodate the addition.
522 Perl_av_push(pTHX_ register AV *av, SV *val)
528 Perl_croak(aTHX_ PL_no_modify);
530 if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
532 PUSHSTACKi(PERLSI_MAGIC);
535 PUSHs(SvTIED_obj((SV*)av, mg));
539 call_method("PUSH", G_SCALAR|G_DISCARD);
544 av_store(av,AvFILLp(av)+1,val);
550 Pops an SV off the end of the array. Returns C<&PL_sv_undef> if the array
557 Perl_av_pop(pTHX_ register AV *av)
565 Perl_croak(aTHX_ PL_no_modify);
566 if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
568 PUSHSTACKi(PERLSI_MAGIC);
570 XPUSHs(SvTIED_obj((SV*)av, mg));
573 if (call_method("POP", G_SCALAR)) {
574 retval = newSVsv(*PL_stack_sp--);
576 retval = &PL_sv_undef;
584 retval = AvARRAY(av)[AvFILLp(av)];
585 AvARRAY(av)[AvFILLp(av)--] = &PL_sv_undef;
592 =for apidoc av_unshift
594 Unshift the given number of C<undef> values onto the beginning of the
595 array. The array will grow automatically to accommodate the addition. You
596 must then use C<av_store> to assign values to these new elements.
602 Perl_av_unshift(pTHX_ register AV *av, register I32 num)
612 Perl_croak(aTHX_ PL_no_modify);
614 if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
616 PUSHSTACKi(PERLSI_MAGIC);
619 PUSHs(SvTIED_obj((SV*)av, mg));
625 call_method("UNSHIFT", G_SCALAR|G_DISCARD);
633 if (!AvREAL(av) && AvREIFY(av))
635 i = AvARRAY(av) - AvALLOC(av);
643 SvPVX(av) = (char*)(AvARRAY(av) - i);
647 /* Create extra elements */
648 slide = i > 0 ? i : 0;
650 av_extend(av, i + num);
653 Move(ary, ary + num, i + 1, SV*);
655 ary[--num] = &PL_sv_undef;
657 /* Make extra elements into a buffer */
659 AvFILLp(av) -= slide;
660 SvPVX(av) = (char*)(AvARRAY(av) + slide);
667 Shifts an SV off the beginning of the array.
673 Perl_av_shift(pTHX_ register AV *av)
681 Perl_croak(aTHX_ PL_no_modify);
682 if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
684 PUSHSTACKi(PERLSI_MAGIC);
686 XPUSHs(SvTIED_obj((SV*)av, mg));
689 if (call_method("SHIFT", G_SCALAR)) {
690 retval = newSVsv(*PL_stack_sp--);
692 retval = &PL_sv_undef;
700 retval = *AvARRAY(av);
702 *AvARRAY(av) = &PL_sv_undef;
703 SvPVX(av) = (char*)(AvARRAY(av) + 1);
714 Returns the highest index in the array. Returns -1 if the array is
721 Perl_av_len(pTHX_ register AV *av)
729 Ensure than an array has a given number of elements, equivalent to
730 Perl's C<$#array = $fill;>.
735 Perl_av_fill(pTHX_ register AV *av, I32 fill)
739 Perl_croak(aTHX_ "panic: null array");
742 if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
746 PUSHSTACKi(PERLSI_MAGIC);
749 PUSHs(SvTIED_obj((SV*)av, mg));
750 PUSHs(sv_2mortal(newSViv(fill+1)));
752 call_method("STORESIZE", G_SCALAR|G_DISCARD);
758 if (fill <= AvMAX(av)) {
759 I32 key = AvFILLp(av);
760 SV** ary = AvARRAY(av);
764 SvREFCNT_dec(ary[key]);
765 ary[key--] = &PL_sv_undef;
770 ary[++key] = &PL_sv_undef;
778 (void)av_store(av,fill,&PL_sv_undef);
782 =for apidoc av_delete
784 Deletes the element indexed by C<key> from the array. Returns the
785 deleted element. C<flags> is currently ignored.
790 Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
797 Perl_croak(aTHX_ PL_no_modify);
799 if (SvRMAGICAL(av)) {
800 MAGIC *tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
802 if ((tied_magic || mg_find((SV*)av, PERL_MAGIC_regdata))) {
803 /* Handle negative array indices 20020222 MJD */
805 unsigned adjust_index = 1;
807 SV **negative_indices_glob =
808 hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av,
810 NEGATIVE_INDICES_VAR, 16, 0);
811 if (negative_indices_glob
812 && SvTRUE(GvSV(*negative_indices_glob)))
816 key += AvFILL(av) + 1;
821 svp = av_fetch(av, key, TRUE);
825 if (mg_find(sv, PERL_MAGIC_tiedelem)) {
826 sv_unmagic(sv, PERL_MAGIC_tiedelem); /* No longer an element */
835 key += AvFILL(av) + 1;
840 if (key > AvFILLp(av))
843 sv = AvARRAY(av)[key];
844 if (key == AvFILLp(av)) {
845 AvARRAY(av)[key] = &PL_sv_undef;
848 } while (--key >= 0 && AvARRAY(av)[key] == &PL_sv_undef);
851 AvARRAY(av)[key] = &PL_sv_undef;
855 if (flags & G_DISCARD) {
863 =for apidoc av_exists
865 Returns true if the element indexed by C<key> has been initialized.
867 This relies on the fact that uninitialized array elements are set to
873 Perl_av_exists(pTHX_ AV *av, I32 key)
879 if (SvRMAGICAL(av)) {
880 MAGIC *tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
881 if (tied_magic || mg_find((SV*)av, PERL_MAGIC_regdata)) {
882 SV *sv = sv_newmortal();
884 /* Handle negative array indices 20020222 MJD */
886 unsigned adjust_index = 1;
888 SV **negative_indices_glob =
889 hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av,
891 NEGATIVE_INDICES_VAR, 16, 0);
892 if (negative_indices_glob
893 && SvTRUE(GvSV(*negative_indices_glob)))
897 key += AvFILL(av) + 1;
903 mg_copy((SV*)av, sv, 0, key);
904 mg = mg_find(sv, PERL_MAGIC_tiedelem);
906 magic_existspack(sv, mg);
907 return (bool)SvTRUE(sv);
914 key += AvFILL(av) + 1;
919 if (key <= AvFILLp(av) && AvARRAY(av)[key] != &PL_sv_undef