This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Perl_av_extend_guts: tabs converted to spaces; unnecessary nesting removed
[perl5.git] / av.c
CommitLineData
a0d0e21e 1/* av.c
79072805 2 *
1129b882
NC
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
79072805
LW
5 *
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.
8 *
a0d0e21e
LW
9 */
10
11/*
4ac71550
TC
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
14 *
15 * [p.476 of _The Lord of the Rings_, III/iv: "Treebeard"]
79072805
LW
16 */
17
ccfc67b7 18/*
51b56f5c 19=for apidoc_section AV Handling
ccfc67b7
JH
20*/
21
79072805 22#include "EXTERN.h"
864dbfa3 23#define PERL_IN_AV_C
79072805
LW
24#include "perl.h"
25
fb73857a 26void
864dbfa3 27Perl_av_reify(pTHX_ AV *av)
a0d0e21e 28{
c70927a6 29 SSize_t key;
fb73857a 30
7918f24d 31 PERL_ARGS_ASSERT_AV_REIFY;
2fed2a1b 32 assert(SvTYPE(av) == SVt_PVAV);
ba5d1d60 33
3c78fafa
GS
34 if (AvREAL(av))
35 return;
93965878 36#ifdef DEBUGGING
9b387841
NC
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");
93965878 39#endif
a0d0e21e 40 key = AvMAX(av) + 1;
93965878 41 while (key > AvFILLp(av) + 1)
ce0d59fd 42 AvARRAY(av)[--key] = NULL;
a0d0e21e 43 while (key) {
4373e329 44 SV * const sv = AvARRAY(av)[--key];
411caa50 45 if (sv != &PL_sv_undef)
ce0d59fd 46 SvREFCNT_inc_simple_void(sv);
a0d0e21e 47 }
29de640a
CS
48 key = AvARRAY(av) - AvALLOC(av);
49 while (key)
ce0d59fd 50 AvALLOC(av)[--key] = NULL;
62b1ebc2 51 AvREIFY_off(av);
a0d0e21e
LW
52 AvREAL_on(av);
53}
54
cb50131a
CB
55/*
56=for apidoc av_extend
57
2b301921
YO
58Pre-extend an array so that it is capable of storing values at indexes
59C<0..key>. Thus C<av_extend(av,99)> guarantees that the array can store 100
60elements, i.e. that C<av_store(av, 0, sv)> through C<av_store(av, 99, sv)>
61on a plain array will work without any further memory allocation.
62
63If the av argument is a tied array then will call the C<EXTEND> tied
64array method with an argument of C<(key+1)>.
cb50131a
CB
65
66=cut
67*/
68
a0d0e21e 69void
fc16c392 70Perl_av_extend(pTHX_ AV *av, SSize_t key)
a0d0e21e 71{
7a5b473e
AL
72 MAGIC *mg;
73
7918f24d 74 PERL_ARGS_ASSERT_AV_EXTEND;
2fed2a1b 75 assert(SvTYPE(av) == SVt_PVAV);
ba5d1d60 76
ad64d0ec 77 mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied);
823a54a3 78 if (mg) {
efaf3674 79 SV *arg1 = sv_newmortal();
2b301921
YO
80 /* NOTE: the API for av_extend() is NOT the same as the tie method EXTEND.
81 *
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.
84 *
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.
88 */
efaf3674 89 sv_setiv(arg1, (IV)(key + 1));
36925d9e 90 Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(EXTEND), G_DISCARD, 1,
046b0c7d 91 arg1);
93965878
NIS
92 return;
93 }
7261499d
FC
94 av_extend_guts(av,key,&AvMAX(av),&AvALLOC(av),&AvARRAY(av));
95}
96
97/* The guts of av_extend. *Not* for general use! */
98void
fc16c392 99Perl_av_extend_guts(pTHX_ AV *av, SSize_t key, SSize_t *maxp, SV ***allocp,
440c1856 100 SV ***arrayp)
7261499d 101{
7261499d
FC
102 PERL_ARGS_ASSERT_AV_EXTEND_GUTS;
103
6768377c
DM
104 if (key < -1) /* -1 is legal */
105 Perl_croak(aTHX_
147e3846 106 "panic: av_extend_guts() negative count (%" IVdf ")", (IV)key);
6768377c 107
7261499d 108 if (key > *maxp) {
440c1856
RL
109 SV** ary;
110 SSize_t tmp;
111 SSize_t newmax;
112
113 if (av && *allocp != *arrayp) {
114 ary = *allocp + AvFILLp(av) + 1;
115 tmp = *arrayp - *allocp;
116 Move(*arrayp, *allocp, AvFILLp(av)+1, SV*);
117 *maxp += tmp;
118 *arrayp = *allocp;
119 if (AvREAL(av)) {
120 while (tmp)
121 ary[--tmp] = NULL;
122 }
123 if (key > *maxp - 10) {
124 newmax = key + *maxp;
125 goto resize;
126 }
127 } else if (*allocp) {
4633a7c4 128
ca7c1a29 129#ifdef Perl_safesysmalloc_size
440c1856
RL
130 /* Whilst it would be quite possible to move this logic around
131 (as I did in the SV code), so as to set AvMAX(av) early,
132 based on calling Perl_safesysmalloc_size() immediately after
133 allocation, I'm not convinced that it is a great idea here.
134 In an array we have to loop round setting everything to
135 NULL, which means writing to memory, potentially lots
136 of it, whereas for the SV buffer case we don't touch the
137 "bonus" memory. So there there is no cost in telling the
138 world about it, whereas here we have to do work before we can
139 tell the world about it, and that work involves writing to
140 memory that might never be read. So, I feel, better to keep
141 the current lazy system of only writing to it if our caller
142 has a need for more space. NWC */
143 newmax = Perl_safesysmalloc_size((void*)*allocp) /
144 sizeof(const SV *) - 1;
145
146 if (key <= newmax)
147 goto resized;
8d6dde3e 148#endif
440c1856
RL
149 /* overflow-safe version of newmax = key + *maxp/5 */
150 newmax = *maxp / 5;
151 newmax = (key > SSize_t_MAX - newmax)
152 ? SSize_t_MAX : key + newmax;
153 resize:
154 {
155 /* it should really be newmax+1 here, but if newmax
156 * happens to equal SSize_t_MAX, then newmax+1 is
157 * undefined. This means technically we croak one
158 * index lower than we should in theory; in practice
159 * its unlikely the system has SSize_t_MAX/sizeof(SV*)
160 * bytes to spare! */
161 MEM_WRAP_CHECK_s(newmax, SV*, "Out of memory during array extend");
162 }
865e3ae0 163#ifdef STRESS_REALLOC
440c1856
RL
164 {
165 SV ** const old_alloc = *allocp;
166 Newx(*allocp, newmax+1, SV*);
167 Copy(old_alloc, *allocp, *maxp + 1, SV*);
168 Safefree(old_alloc);
169 }
865e3ae0 170#else
440c1856 171 Renew(*allocp,newmax+1, SV*);
865e3ae0 172#endif
ca7c1a29 173#ifdef Perl_safesysmalloc_size
440c1856 174 resized:
9c5ffd7c 175#endif
440c1856
RL
176 ary = *allocp + *maxp + 1;
177 tmp = newmax - *maxp;
178 if (av == PL_curstack) { /* Oops, grew stack (via av_store()?) */
179 PL_stack_sp = *allocp + (PL_stack_sp - PL_stack_base);
180 PL_stack_base = *allocp;
181 PL_stack_max = PL_stack_base + newmax;
182 }
183 } else {
184 newmax = key < 3 ? 3 : key;
185 {
186 /* see comment above about newmax+1*/
187 MEM_WRAP_CHECK_s(newmax, SV*, "Out of memory during array extend");
188 }
189 Newx(*allocp, newmax+1, SV*);
190 ary = *allocp + 1;
191 tmp = newmax;
192 *allocp[0] = NULL; /* For the stacks */
193 }
194 if (av && AvREAL(av)) {
195 while (tmp)
196 ary[--tmp] = NULL;
197 }
198
199 *arrayp = *allocp;
200 *maxp = newmax;
a0d0e21e
LW
201 }
202}
203
cb50131a
CB
204/*
205=for apidoc av_fetch
206
207Returns the SV at the specified index in the array. The C<key> is the
1a328862
SF
208index. If lval is true, you are guaranteed to get a real SV back (in case
209it wasn't real before), which you can then modify. Check that the return
210value is non-null before dereferencing it to a C<SV*>.
cb50131a
CB
211
212See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
213more information on how to use this function on tied arrays.
214
17b0bd77 215The rough perl equivalent is C<$myarray[$key]>.
3347919d 216
cb50131a
CB
217=cut
218*/
219
ac9f75b5 220static bool
c70927a6 221S_adjust_index(pTHX_ AV *av, const MAGIC *mg, SSize_t *keyp)
ac9f75b5
FC
222{
223 bool adjust_index = 1;
224 if (mg) {
225 /* Handle negative array indices 20020222 MJD */
226 SV * const ref = SvTIED_obj(MUTABLE_SV(av), mg);
227 SvGETMAGIC(ref);
228 if (SvROK(ref) && SvOBJECT(SvRV(ref))) {
229 SV * const * const negative_indices_glob =
230 hv_fetchs(SvSTASH(SvRV(ref)), NEGATIVE_INDICES_VAR, 0);
231
7274b33c
FC
232 if (negative_indices_glob && isGV(*negative_indices_glob)
233 && SvTRUE(GvSV(*negative_indices_glob)))
ac9f75b5
FC
234 adjust_index = 0;
235 }
236 }
237
238 if (adjust_index) {
239 *keyp += AvFILL(av) + 1;
240 if (*keyp < 0)
241 return FALSE;
242 }
243 return TRUE;
244}
245
79072805 246SV**
c70927a6 247Perl_av_fetch(pTHX_ AV *av, SSize_t key, I32 lval)
79072805 248{
f4d8be8b
DM
249 SSize_t neg;
250 SSize_t size;
251
7918f24d 252 PERL_ARGS_ASSERT_AV_FETCH;
2fed2a1b 253 assert(SvTYPE(av) == SVt_PVAV);
a0d0e21e 254
11b62bc4 255 if (UNLIKELY(SvRMAGICAL(av))) {
ad64d0ec
NC
256 const MAGIC * const tied_magic
257 = mg_find((const SV *)av, PERL_MAGIC_tied);
258 if (tied_magic || mg_find((const SV *)av, PERL_MAGIC_regdata)) {
e2d306cb
AL
259 SV *sv;
260 if (key < 0) {
ac9f75b5 261 if (!S_adjust_index(aTHX_ av, tied_magic, &key))
e2d306cb 262 return NULL;
e2d306cb 263 }
6f12eb6d
MJD
264
265 sv = sv_newmortal();
dd28f7bb 266 sv_upgrade(sv, SVt_PVLV);
ad64d0ec 267 mg_copy(MUTABLE_SV(av), sv, 0, key);
2d961f6d
DM
268 if (!tied_magic) /* for regdata, force leavesub to make copies */
269 SvTEMP_off(sv);
dd28f7bb
DM
270 LvTYPE(sv) = 't';
271 LvTARG(sv) = sv; /* fake (SV**) */
272 return &(LvTARG(sv));
6f12eb6d
MJD
273 }
274 }
275
f4d8be8b 276 neg = (key < 0);
25cf9644 277 size = AvFILLp(av) + 1;
f4d8be8b
DM
278 key += neg * size; /* handle negative index without using branch */
279
280 /* the cast from SSize_t to Size_t allows both (key < 0) and (key >= size)
281 * to be tested as a single condition */
282 if ((Size_t)key >= (Size_t)size) {
283 if (UNLIKELY(neg))
e2d306cb 284 return NULL;
f4d8be8b 285 goto emptyness;
93965878 286 }
f4d8be8b
DM
287
288 if (!AvARRAY(av)[key]) {
55d3f3e5
DM
289 emptyness:
290 return lval ? av_store(av,key,newSV(0)) : NULL;
79072805 291 }
55d3f3e5 292
463ee0b2 293 return &AvARRAY(av)[key];
79072805
LW
294}
295
cb50131a
CB
296/*
297=for apidoc av_store
298
299Stores an SV in an array. The array index is specified as C<key>. The
796b6530 300return value will be C<NULL> if the operation failed or if the value did not
cb50131a 301need to be actually stored within the array (as in the case of tied
72d33970 302arrays). Otherwise, it can be dereferenced
4f540dd3 303to get the C<SV*> that was stored
f0b90de1
SF
304there (= C<val>)).
305
306Note that the caller is responsible for suitably incrementing the reference
cb50131a 307count of C<val> before the call, and decrementing it if the function
796b6530 308returned C<NULL>.
cb50131a 309
17b0bd77 310Approximate Perl equivalent: C<splice(@myarray, $key, 1, $val)>.
f0b90de1 311
cb50131a
CB
312See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
313more information on how to use this function on tied arrays.
314
315=cut
316*/
317
79072805 318SV**
c70927a6 319Perl_av_store(pTHX_ AV *av, SSize_t key, SV *val)
79072805 320{
79072805
LW
321 SV** ary;
322
7918f24d 323 PERL_ARGS_ASSERT_AV_STORE;
2fed2a1b 324 assert(SvTYPE(av) == SVt_PVAV);
ba5d1d60 325
725ac12f
NC
326 /* S_regclass relies on being able to pass in a NULL sv
327 (unicode_alternate may be NULL).
328 */
329
6f12eb6d 330 if (SvRMAGICAL(av)) {
ad64d0ec 331 const MAGIC * const tied_magic = mg_find((const SV *)av, PERL_MAGIC_tied);
6f12eb6d 332 if (tied_magic) {
6f12eb6d 333 if (key < 0) {
ac9f75b5 334 if (!S_adjust_index(aTHX_ av, tied_magic, &key))
6f12eb6d 335 return 0;
6f12eb6d 336 }
ce0d59fd 337 if (val) {
ad64d0ec 338 mg_copy(MUTABLE_SV(av), val, 0, key);
6f12eb6d 339 }
e2d306cb 340 return NULL;
6f12eb6d
MJD
341 }
342 }
343
344
a0d0e21e
LW
345 if (key < 0) {
346 key += AvFILL(av) + 1;
347 if (key < 0)
e2d306cb 348 return NULL;
79072805 349 }
93965878 350
43fcc5d2 351 if (SvREADONLY(av) && key >= AvFILL(av))
cb077ed2 352 Perl_croak_no_modify();
93965878 353
49beac48 354 if (!AvREAL(av) && AvREIFY(av))
a0d0e21e 355 av_reify(av);
a0d0e21e
LW
356 if (key > AvMAX(av))
357 av_extend(av,key);
463ee0b2 358 ary = AvARRAY(av);
93965878 359 if (AvFILLp(av) < key) {
a0d0e21e 360 if (!AvREAL(av)) {
3280af22
NIS
361 if (av == PL_curstack && key > PL_stack_sp - PL_stack_base)
362 PL_stack_sp = PL_stack_base + key; /* XPUSH in disguise */
e2d306cb 363 do {
ce0d59fd 364 ary[++AvFILLp(av)] = NULL;
e2d306cb 365 } while (AvFILLp(av) < key);
79072805 366 }
93965878 367 AvFILLp(av) = key;
79072805 368 }
811f8a24
KW
369 else if (AvREAL(av))
370 SvREFCNT_dec(ary[key]);
79072805 371 ary[key] = val;
8990e307 372 if (SvSMAGICAL(av)) {
70ce9249
FC
373 const MAGIC *mg = SvMAGIC(av);
374 bool set = TRUE;
375 for (; mg; mg = mg->mg_moremagic) {
4806b7eb 376 if (!isUPPER(mg->mg_type)) continue;
ce0d59fd 377 if (val) {
ad64d0ec 378 sv_magic(val, MUTABLE_SV(av), toLOWER(mg->mg_type), 0, key);
70ce9249
FC
379 }
380 if (PL_delaymagic && mg->mg_type == PERL_MAGIC_isa) {
354b0578 381 PL_delaymagic |= DM_ARRAY_ISA;
70ce9249
FC
382 set = FALSE;
383 }
384 }
385 if (set)
ad64d0ec 386 mg_set(MUTABLE_SV(av));
463ee0b2 387 }
79072805
LW
388 return &ary[key];
389}
390
cb50131a 391/*
cb50131a
CB
392=for apidoc av_make
393
394Creates a new AV and populates it with a list of SVs. The SVs are copied
796b6530 395into the array, so they may be freed after the call to C<av_make>. The new AV
cb50131a
CB
396will have a reference count of 1.
397
775f1d61
SF
398Perl equivalent: C<my @new_array = ($scalar1, $scalar2, $scalar3...);>
399
cb50131a
CB
400=cut
401*/
402
79072805 403AV *
c70927a6 404Perl_av_make(pTHX_ SSize_t size, SV **strp)
79072805 405{
eb578fdb 406 AV * const av = MUTABLE_AV(newSV_type(SVt_PVAV));
a7f5e44d 407 /* sv_upgrade does AvREAL_only() */
7918f24d 408 PERL_ARGS_ASSERT_AV_MAKE;
2fed2a1b
NC
409 assert(SvTYPE(av) == SVt_PVAV);
410
a0288114 411 if (size) { /* "defined" was returning undef for size==0 anyway. */
eb578fdb 412 SV** ary;
c70927a6 413 SSize_t i;
be988557
DM
414 SSize_t orig_ix;
415
a02a5408 416 Newx(ary,size,SV*);
573fa4ea 417 AvALLOC(av) = ary;
9c6bc640 418 AvARRAY(av) = ary;
3ed356df
FC
419 AvMAX(av) = size - 1;
420 AvFILLp(av) = -1;
be988557
DM
421 /* avoid av being leaked if croak when calling magic below */
422 EXTEND_MORTAL(1);
423 PL_tmps_stack[++PL_tmps_ix] = (SV*)av;
424 orig_ix = PL_tmps_ix;
425
573fa4ea
TB
426 for (i = 0; i < size; i++) {
427 assert (*strp);
2b676593
BB
428
429 /* Don't let sv_setsv swipe, since our source array might
430 have multiple references to the same temp scalar (e.g.
431 from a list slice) */
432
3ed356df
FC
433 SvGETMAGIC(*strp); /* before newSV, in case it dies */
434 AvFILLp(av)++;
561b68a9 435 ary[i] = newSV(0);
2b676593 436 sv_setsv_flags(ary[i], *strp,
3ed356df 437 SV_DO_COW_SVSETSV|SV_NOSTEAL);
573fa4ea
TB
438 strp++;
439 }
be988557
DM
440 /* disarm av's leak guard */
441 if (LIKELY(PL_tmps_ix == orig_ix))
442 PL_tmps_ix--;
443 else
444 PL_tmps_stack[orig_ix] = &PL_sv_undef;
79072805 445 }
463ee0b2 446 return av;
79072805
LW
447}
448
cb50131a
CB
449/*
450=for apidoc av_clear
451
a4395eba
DM
452Frees the all the elements of an array, leaving it empty.
453The XS equivalent of C<@array = ()>. See also L</av_undef>.
8b9a1153 454
a4395eba
DM
455Note that it is possible that the actions of a destructor called directly
456or indirectly by freeing an element of the array could cause the reference
457count of the array itself to be reduced (e.g. by deleting an entry in the
458symbol table). So it is a possibility that the AV could have been freed
459(or even reallocated) on return from the call unless you hold a reference
460to it.
cb50131a
CB
461
462=cut
463*/
464
79072805 465void
5aaab254 466Perl_av_clear(pTHX_ AV *av)
79072805 467{
c70927a6 468 SSize_t extra;
60edcf09 469 bool real;
be988557 470 SSize_t orig_ix = 0;
79072805 471
7918f24d 472 PERL_ARGS_ASSERT_AV_CLEAR;
2fed2a1b
NC
473 assert(SvTYPE(av) == SVt_PVAV);
474
7d55f622 475#ifdef DEBUGGING
9b387841
NC
476 if (SvREFCNT(av) == 0) {
477 Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "Attempt to clear deleted array");
7d55f622
PP
478 }
479#endif
a0d0e21e 480
39caa665 481 if (SvREADONLY(av))
cb077ed2 482 Perl_croak_no_modify();
39caa665 483
93965878 484 /* Give any tie a chance to cleanup first */
89c14e2e
BB
485 if (SvRMAGICAL(av)) {
486 const MAGIC* const mg = SvMAGIC(av);
b63c7c55 487 if (PL_delaymagic && mg && mg->mg_type == PERL_MAGIC_isa)
354b0578 488 PL_delaymagic |= DM_ARRAY_ISA;
89c14e2e 489 else
ad64d0ec 490 mg_clear(MUTABLE_SV(av));
89c14e2e 491 }
93965878 492
a60c0954
NIS
493 if (AvMAX(av) < 0)
494 return;
495
be988557 496 if ((real = cBOOL(AvREAL(av)))) {
823a54a3 497 SV** const ary = AvARRAY(av);
c70927a6 498 SSize_t index = AvFILLp(av) + 1;
be988557
DM
499
500 /* avoid av being freed when calling destructors below */
501 EXTEND_MORTAL(1);
502 PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple_NN(av);
503 orig_ix = PL_tmps_ix;
504
e2d306cb
AL
505 while (index) {
506 SV * const sv = ary[--index];
6b42d12b 507 /* undef the slot before freeing the value, because a
e2d306cb 508 * destructor might try to modify this array */
ce0d59fd 509 ary[index] = NULL;
6b42d12b 510 SvREFCNT_dec(sv);
a0d0e21e
LW
511 }
512 }
e2d306cb
AL
513 extra = AvARRAY(av) - AvALLOC(av);
514 if (extra) {
515 AvMAX(av) += extra;
9c6bc640 516 AvARRAY(av) = AvALLOC(av);
79072805 517 }
93965878 518 AvFILLp(av) = -1;
be988557
DM
519 if (real) {
520 /* disarm av's premature free guard */
521 if (LIKELY(PL_tmps_ix == orig_ix))
522 PL_tmps_ix--;
523 else
524 PL_tmps_stack[orig_ix] = &PL_sv_undef;
525 SvREFCNT_dec_NN(av);
526 }
79072805
LW
527}
528
cb50131a
CB
529/*
530=for apidoc av_undef
531
a4395eba
DM
532Undefines the array. The XS equivalent of C<undef(@array)>.
533
534As well as freeing all the elements of the array (like C<av_clear()>), this
535also frees the memory used by the av to store its list of scalars.
536
537See L</av_clear> for a note about the array possibly being invalid on
538return.
cb50131a
CB
539
540=cut
541*/
542
79072805 543void
5aaab254 544Perl_av_undef(pTHX_ AV *av)
79072805 545{
60edcf09 546 bool real;
84610c52 547 SSize_t orig_ix = PL_tmps_ix; /* silence bogus warning about possible unitialized use */
60edcf09 548
7918f24d 549 PERL_ARGS_ASSERT_AV_UNDEF;
2fed2a1b 550 assert(SvTYPE(av) == SVt_PVAV);
93965878
NIS
551
552 /* Give any tie a chance to cleanup first */
ad64d0ec 553 if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied))
22717f83 554 av_fill(av, -1);
93965878 555
84610c52
YO
556 real = cBOOL(AvREAL(av));
557 if (real) {
c70927a6 558 SSize_t key = AvFILLp(av) + 1;
be988557
DM
559
560 /* avoid av being freed when calling destructors below */
561 EXTEND_MORTAL(1);
562 PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple_NN(av);
563 orig_ix = PL_tmps_ix;
564
a0d0e21e
LW
565 while (key)
566 SvREFCNT_dec(AvARRAY(av)[--key]);
567 }
22717f83 568
463ee0b2 569 Safefree(AvALLOC(av));
35da51f7 570 AvALLOC(av) = NULL;
9c6bc640 571 AvARRAY(av) = NULL;
93965878 572 AvMAX(av) = AvFILLp(av) = -1;
22717f83 573
ad64d0ec 574 if(SvRMAGICAL(av)) mg_clear(MUTABLE_SV(av));
be988557
DM
575 if (real) {
576 /* disarm av's premature free guard */
577 if (LIKELY(PL_tmps_ix == orig_ix))
578 PL_tmps_ix--;
579 else
580 PL_tmps_stack[orig_ix] = &PL_sv_undef;
581 SvREFCNT_dec_NN(av);
582 }
79072805
LW
583}
584
cb50131a 585/*
29a861e7
NC
586
587=for apidoc av_create_and_push
588
589Push an SV onto the end of the array, creating the array if necessary.
590A small internal helper function to remove a commonly duplicated idiom.
591
592=cut
593*/
594
595void
596Perl_av_create_and_push(pTHX_ AV **const avp, SV *const val)
597{
7918f24d 598 PERL_ARGS_ASSERT_AV_CREATE_AND_PUSH;
2fed2a1b 599
29a861e7
NC
600 if (!*avp)
601 *avp = newAV();
602 av_push(*avp, val);
603}
604
605/*
cb50131a
CB
606=for apidoc av_push
607
b895c103
KW
608Pushes an SV (transferring control of one reference count) onto the end of the
609array. The array will grow automatically to accommodate the addition.
cb50131a 610
17b0bd77 611Perl equivalent: C<push @myarray, $val;>.
f0b90de1 612
cb50131a
CB
613=cut
614*/
615
a0d0e21e 616void
5aaab254 617Perl_av_push(pTHX_ AV *av, SV *val)
93965878
NIS
618{
619 MAGIC *mg;
7918f24d
NC
620
621 PERL_ARGS_ASSERT_AV_PUSH;
2fed2a1b 622 assert(SvTYPE(av) == SVt_PVAV);
ba5d1d60 623
93965878 624 if (SvREADONLY(av))
cb077ed2 625 Perl_croak_no_modify();
93965878 626
ad64d0ec 627 if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
36925d9e 628 Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(PUSH), G_DISCARD, 1,
046b0c7d 629 val);
93965878
NIS
630 return;
631 }
632 av_store(av,AvFILLp(av)+1,val);
79072805
LW
633}
634
cb50131a
CB
635/*
636=for apidoc av_pop
637
f5d13a25
KW
638Removes one SV from the end of the array, reducing its size by one and
639returning the SV (transferring control of one reference count) to the
640caller. Returns C<&PL_sv_undef> if the array is empty.
cb50131a 641
f0b90de1
SF
642Perl equivalent: C<pop(@myarray);>
643
cb50131a
CB
644=cut
645*/
646
79072805 647SV *
5aaab254 648Perl_av_pop(pTHX_ AV *av)
79072805
LW
649{
650 SV *retval;
93965878 651 MAGIC* mg;
79072805 652
7918f24d 653 PERL_ARGS_ASSERT_AV_POP;
2fed2a1b 654 assert(SvTYPE(av) == SVt_PVAV);
ba5d1d60 655
43fcc5d2 656 if (SvREADONLY(av))
cb077ed2 657 Perl_croak_no_modify();
ad64d0ec 658 if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
36925d9e 659 retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(POP), 0, 0);
efaf3674
DM
660 if (retval)
661 retval = newSVsv(retval);
93965878
NIS
662 return retval;
663 }
d19c0e07
MJD
664 if (AvFILL(av) < 0)
665 return &PL_sv_undef;
93965878 666 retval = AvARRAY(av)[AvFILLp(av)];
ce0d59fd 667 AvARRAY(av)[AvFILLp(av)--] = NULL;
8990e307 668 if (SvSMAGICAL(av))
ad64d0ec 669 mg_set(MUTABLE_SV(av));
ce0d59fd 670 return retval ? retval : &PL_sv_undef;
79072805
LW
671}
672
cb50131a 673/*
29a861e7
NC
674
675=for apidoc av_create_and_unshift_one
676
677Unshifts an SV onto the beginning of the array, creating the array if
678necessary.
679A small internal helper function to remove a commonly duplicated idiom.
680
681=cut
682*/
683
684SV **
685Perl_av_create_and_unshift_one(pTHX_ AV **const avp, SV *const val)
686{
7918f24d 687 PERL_ARGS_ASSERT_AV_CREATE_AND_UNSHIFT_ONE;
2fed2a1b 688
29a861e7
NC
689 if (!*avp)
690 *avp = newAV();
691 av_unshift(*avp, 1);
692 return av_store(*avp, 0, val);
693}
694
695/*
cb50131a
CB
696=for apidoc av_unshift
697
698Unshift the given number of C<undef> values onto the beginning of the
17b0bd77 699array. The array will grow automatically to accommodate the addition.
cb50131a 700
17b0bd77 701Perl equivalent: S<C<unshift @myarray, ((undef) x $num);>>
f703fc96 702
cb50131a
CB
703=cut
704*/
705
79072805 706void
c70927a6 707Perl_av_unshift(pTHX_ AV *av, SSize_t num)
79072805 708{
c70927a6 709 SSize_t i;
93965878 710 MAGIC* mg;
79072805 711
7918f24d 712 PERL_ARGS_ASSERT_AV_UNSHIFT;
2fed2a1b 713 assert(SvTYPE(av) == SVt_PVAV);
ba5d1d60 714
43fcc5d2 715 if (SvREADONLY(av))
cb077ed2 716 Perl_croak_no_modify();
93965878 717
ad64d0ec 718 if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
36925d9e 719 Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(UNSHIFT),
046b0c7d 720 G_DISCARD | G_UNDEF_FILL, num);
93965878
NIS
721 return;
722 }
723
d19c0e07
MJD
724 if (num <= 0)
725 return;
49beac48
CS
726 if (!AvREAL(av) && AvREIFY(av))
727 av_reify(av);
a0d0e21e
LW
728 i = AvARRAY(av) - AvALLOC(av);
729 if (i) {
730 if (i > num)
731 i = num;
732 num -= i;
733
734 AvMAX(av) += i;
93965878 735 AvFILLp(av) += i;
9c6bc640 736 AvARRAY(av) = AvARRAY(av) - i;
a0d0e21e 737 }
d2719217 738 if (num) {
eb578fdb 739 SV **ary;
c70927a6 740 const SSize_t i = AvFILLp(av);
e2b534e7 741 /* Create extra elements */
c70927a6 742 const SSize_t slide = i > 0 ? i : 0;
e2b534e7 743 num += slide;
67a38de0 744 av_extend(av, i + num);
93965878 745 AvFILLp(av) += num;
67a38de0
NIS
746 ary = AvARRAY(av);
747 Move(ary, ary + num, i + 1, SV*);
748 do {
ce0d59fd 749 ary[--num] = NULL;
67a38de0 750 } while (num);
e2b534e7
BT
751 /* Make extra elements into a buffer */
752 AvMAX(av) -= slide;
753 AvFILLp(av) -= slide;
9c6bc640 754 AvARRAY(av) = AvARRAY(av) + slide;
79072805
LW
755 }
756}
757
cb50131a
CB
758/*
759=for apidoc av_shift
760
dbc2ea0c
SM
761Removes one SV from the start of the array, reducing its size by one and
762returning the SV (transferring control of one reference count) to the
763caller. Returns C<&PL_sv_undef> if the array is empty.
cb50131a 764
f0b90de1
SF
765Perl equivalent: C<shift(@myarray);>
766
cb50131a
CB
767=cut
768*/
769
79072805 770SV *
5aaab254 771Perl_av_shift(pTHX_ AV *av)
79072805
LW
772{
773 SV *retval;
93965878 774 MAGIC* mg;
79072805 775
7918f24d 776 PERL_ARGS_ASSERT_AV_SHIFT;
2fed2a1b 777 assert(SvTYPE(av) == SVt_PVAV);
ba5d1d60 778
43fcc5d2 779 if (SvREADONLY(av))
cb077ed2 780 Perl_croak_no_modify();
ad64d0ec 781 if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
36925d9e 782 retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(SHIFT), 0, 0);
efaf3674
DM
783 if (retval)
784 retval = newSVsv(retval);
93965878
NIS
785 return retval;
786 }
d19c0e07
MJD
787 if (AvFILL(av) < 0)
788 return &PL_sv_undef;
463ee0b2 789 retval = *AvARRAY(av);
a0d0e21e 790 if (AvREAL(av))
ce0d59fd 791 *AvARRAY(av) = NULL;
9c6bc640 792 AvARRAY(av) = AvARRAY(av) + 1;
463ee0b2 793 AvMAX(av)--;
93965878 794 AvFILLp(av)--;
8990e307 795 if (SvSMAGICAL(av))
ad64d0ec 796 mg_set(MUTABLE_SV(av));
ce0d59fd 797 return retval ? retval : &PL_sv_undef;
79072805
LW
798}
799
cb50131a 800/*
a56541eb
KW
801=for apidoc av_tindex
802=for apidoc_item av_top_index
cb50131a 803
a56541eb
KW
804These behave identically.
805If the array C<av> is empty, these return -1; otherwise they return the maximum
806value of the indices of all the array elements which are currently defined in
807C<av>.
cb50131a 808
a56541eb 809They process 'get' magic.
a8676f70 810
a56541eb
KW
811The Perl equivalent for these is C<$#av>.
812
813Use C<L</av_count>> to get the number of elements in an array.
12719193 814
36baafc9
KW
815=for apidoc av_len
816
b985ae61 817Same as L</av_top_index>. Note that, unlike what the name implies, it returns
a56541eb 818the maximum index in the array. This is unlike L</sv_len>, which returns what
87306e06
KW
819you would expect.
820
821B<To get the true number of elements in the array, instead use C<L</av_count>>>.
36baafc9 822
cb50131a
CB
823=cut
824*/
825
c70927a6 826SSize_t
bb5dd93d 827Perl_av_len(pTHX_ AV *av)
79072805 828{
7918f24d 829 PERL_ARGS_ASSERT_AV_LEN;
36baafc9 830
be3a7a5d 831 return av_top_index(av);
36baafc9
KW
832}
833
f3b76584
SC
834/*
835=for apidoc av_fill
836
977a499b 837Set the highest index in the array to the given number, equivalent to
61b16eb9 838Perl's S<C<$#array = $fill;>>.
f3b76584 839
61b16eb9 840The number of elements in the array will be S<C<fill + 1>> after
796b6530 841C<av_fill()> returns. If the array was previously shorter, then the
ce0d59fd 842additional elements appended are set to NULL. If the array
61b16eb9 843was longer, then the excess elements are freed. S<C<av_fill(av, -1)>> is
977a499b
GA
844the same as C<av_clear(av)>.
845
f3b76584
SC
846=cut
847*/
79072805 848void
c70927a6 849Perl_av_fill(pTHX_ AV *av, SSize_t fill)
79072805 850{
93965878 851 MAGIC *mg;
ba5d1d60 852
7918f24d 853 PERL_ARGS_ASSERT_AV_FILL;
2fed2a1b 854 assert(SvTYPE(av) == SVt_PVAV);
ba5d1d60 855
79072805
LW
856 if (fill < 0)
857 fill = -1;
ad64d0ec 858 if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
efaf3674
DM
859 SV *arg1 = sv_newmortal();
860 sv_setiv(arg1, (IV)(fill + 1));
36925d9e 861 Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(STORESIZE), G_DISCARD,
046b0c7d 862 1, arg1);
93965878
NIS
863 return;
864 }
463ee0b2 865 if (fill <= AvMAX(av)) {
c70927a6 866 SSize_t key = AvFILLp(av);
fabdb6c0 867 SV** const ary = AvARRAY(av);
a0d0e21e
LW
868
869 if (AvREAL(av)) {
870 while (key > fill) {
871 SvREFCNT_dec(ary[key]);
ce0d59fd 872 ary[key--] = NULL;
a0d0e21e
LW
873 }
874 }
875 else {
876 while (key < fill)
ce0d59fd 877 ary[++key] = NULL;
a0d0e21e
LW
878 }
879
93965878 880 AvFILLp(av) = fill;
8990e307 881 if (SvSMAGICAL(av))
ad64d0ec 882 mg_set(MUTABLE_SV(av));
463ee0b2 883 }
a0d0e21e 884 else
ce0d59fd 885 (void)av_store(av,fill,NULL);
79072805 886}
c750a3ec 887
f3b76584
SC
888/*
889=for apidoc av_delete
890
17b0bd77
DM
891Deletes the element indexed by C<key> from the array, makes the element
892mortal, and returns it. If C<flags> equals C<G_DISCARD>, the element is
893freed and NULL is returned. NULL is also returned if C<key> is out of
894range.
895
896Perl equivalent: S<C<splice(@myarray, $key, 1, undef)>> (with the
897C<splice> in void context if C<G_DISCARD> is present).
f3b76584
SC
898
899=cut
900*/
146174a9 901SV *
c70927a6 902Perl_av_delete(pTHX_ AV *av, SSize_t key, I32 flags)
146174a9
CB
903{
904 SV *sv;
905
7918f24d 906 PERL_ARGS_ASSERT_AV_DELETE;
2fed2a1b 907 assert(SvTYPE(av) == SVt_PVAV);
ba5d1d60 908
146174a9 909 if (SvREADONLY(av))
cb077ed2 910 Perl_croak_no_modify();
6f12eb6d
MJD
911
912 if (SvRMAGICAL(av)) {
ad64d0ec
NC
913 const MAGIC * const tied_magic
914 = mg_find((const SV *)av, PERL_MAGIC_tied);
915 if ((tied_magic || mg_find((const SV *)av, PERL_MAGIC_regdata))) {
35a4481c 916 SV **svp;
6f12eb6d 917 if (key < 0) {
ac9f75b5 918 if (!S_adjust_index(aTHX_ av, tied_magic, &key))
fabdb6c0 919 return NULL;
6f12eb6d
MJD
920 }
921 svp = av_fetch(av, key, TRUE);
922 if (svp) {
923 sv = *svp;
924 mg_clear(sv);
925 if (mg_find(sv, PERL_MAGIC_tiedelem)) {
926 sv_unmagic(sv, PERL_MAGIC_tiedelem); /* No longer an element */
927 return sv;
928 }
fabdb6c0 929 return NULL;
6f12eb6d
MJD
930 }
931 }
932 }
933
146174a9
CB
934 if (key < 0) {
935 key += AvFILL(av) + 1;
936 if (key < 0)
fabdb6c0 937 return NULL;
146174a9 938 }
6f12eb6d 939
146174a9 940 if (key > AvFILLp(av))
fabdb6c0 941 return NULL;
146174a9 942 else {
a6214072
DM
943 if (!AvREAL(av) && AvREIFY(av))
944 av_reify(av);
146174a9 945 sv = AvARRAY(av)[key];
725995b4 946 AvARRAY(av)[key] = NULL;
146174a9
CB
947 if (key == AvFILLp(av)) {
948 do {
949 AvFILLp(av)--;
ce0d59fd 950 } while (--key >= 0 && !AvARRAY(av)[key]);
146174a9 951 }
146174a9 952 if (SvSMAGICAL(av))
ad64d0ec 953 mg_set(MUTABLE_SV(av));
146174a9 954 }
725995b4
DD
955 if(sv != NULL) {
956 if (flags & G_DISCARD) {
957 SvREFCNT_dec_NN(sv);
958 return NULL;
959 }
960 else if (AvREAL(av))
961 sv_2mortal(sv);
146174a9
CB
962 }
963 return sv;
964}
965
966/*
f3b76584
SC
967=for apidoc av_exists
968
969Returns true if the element indexed by C<key> has been initialized.
146174a9 970
f3b76584 971This relies on the fact that uninitialized array elements are set to
796b6530 972C<NULL>.
f3b76584 973
b7ff7ff2
SF
974Perl equivalent: C<exists($myarray[$key])>.
975
f3b76584
SC
976=cut
977*/
146174a9 978bool
c70927a6 979Perl_av_exists(pTHX_ AV *av, SSize_t key)
146174a9 980{
7918f24d 981 PERL_ARGS_ASSERT_AV_EXISTS;
2fed2a1b 982 assert(SvTYPE(av) == SVt_PVAV);
6f12eb6d
MJD
983
984 if (SvRMAGICAL(av)) {
ad64d0ec
NC
985 const MAGIC * const tied_magic
986 = mg_find((const SV *)av, PERL_MAGIC_tied);
54a4274e
PM
987 const MAGIC * const regdata_magic
988 = mg_find((const SV *)av, PERL_MAGIC_regdata);
989 if (tied_magic || regdata_magic) {
6f12eb6d
MJD
990 MAGIC *mg;
991 /* Handle negative array indices 20020222 MJD */
992 if (key < 0) {
ac9f75b5 993 if (!S_adjust_index(aTHX_ av, tied_magic, &key))
6f12eb6d 994 return FALSE;
6f12eb6d
MJD
995 }
996
54a4274e
PM
997 if(key >= 0 && regdata_magic) {
998 if (key <= AvFILL(av))
999 return TRUE;
1000 else
1001 return FALSE;
1002 }
716ae3b0
R
1003 {
1004 SV * const sv = sv_newmortal();
1005 mg_copy(MUTABLE_SV(av), sv, 0, key);
1006 mg = mg_find(sv, PERL_MAGIC_tiedelem);
1007 if (mg) {
1008 magic_existspack(sv, mg);
1009 {
1010 I32 retbool = SvTRUE_nomg_NN(sv);
1011 return cBOOL(retbool);
1012 }
1013 }
1014 }
6f12eb6d
MJD
1015 }
1016 }
1017
146174a9
CB
1018 if (key < 0) {
1019 key += AvFILL(av) + 1;
1020 if (key < 0)
1021 return FALSE;
1022 }
6f12eb6d 1023
ce0d59fd 1024 if (key <= AvFILLp(av) && AvARRAY(av)[key])
146174a9 1025 {
1f1dcfb5
FC
1026 if (SvSMAGICAL(AvARRAY(av)[key])
1027 && mg_find(AvARRAY(av)[key], PERL_MAGIC_nonelem))
1028 return FALSE;
146174a9
CB
1029 return TRUE;
1030 }
1031 else
1032 return FALSE;
1033}
66610fdd 1034
c33269f7 1035static MAGIC *
878d132a 1036S_get_aux_mg(pTHX_ AV *av) {
ba5d1d60
GA
1037 MAGIC *mg;
1038
7918f24d 1039 PERL_ARGS_ASSERT_GET_AUX_MG;
2fed2a1b 1040 assert(SvTYPE(av) == SVt_PVAV);
ba5d1d60 1041
ad64d0ec 1042 mg = mg_find((const SV *)av, PERL_MAGIC_arylen_p);
a3874608
NC
1043
1044 if (!mg) {
ad64d0ec
NC
1045 mg = sv_magicext(MUTABLE_SV(av), 0, PERL_MAGIC_arylen_p,
1046 &PL_vtbl_arylen_p, 0, 0);
c82c7adc 1047 assert(mg);
a3874608
NC
1048 /* sv_magicext won't set this for us because we pass in a NULL obj */
1049 mg->mg_flags |= MGf_REFCOUNTED;
1050 }
878d132a
NC
1051 return mg;
1052}
1053
1054SV **
1055Perl_av_arylen_p(pTHX_ AV *av) {
1056 MAGIC *const mg = get_aux_mg(av);
7918f24d
NC
1057
1058 PERL_ARGS_ASSERT_AV_ARYLEN_P;
2fed2a1b 1059 assert(SvTYPE(av) == SVt_PVAV);
7918f24d 1060
a3874608
NC
1061 return &(mg->mg_obj);
1062}
1063
453d94a9 1064IV *
878d132a
NC
1065Perl_av_iter_p(pTHX_ AV *av) {
1066 MAGIC *const mg = get_aux_mg(av);
7918f24d
NC
1067
1068 PERL_ARGS_ASSERT_AV_ITER_P;
2fed2a1b 1069 assert(SvTYPE(av) == SVt_PVAV);
7918f24d 1070
4803e7f7
Z
1071 if (sizeof(IV) == sizeof(SSize_t)) {
1072 return (IV *)&(mg->mg_len);
1073 } else {
1074 if (!mg->mg_ptr) {
1075 IV *temp;
1076 mg->mg_len = IVSIZE;
1077 Newxz(temp, 1, IV);
1078 mg->mg_ptr = (char *) temp;
1079 }
1080 return (IV *)mg->mg_ptr;
453d94a9 1081 }
878d132a
NC
1082}
1083
1f1dcfb5
FC
1084SV *
1085Perl_av_nonelem(pTHX_ AV *av, SSize_t ix) {
1086 SV * const sv = newSV(0);
1087 PERL_ARGS_ASSERT_AV_NONELEM;
1088 if (!av_store(av,ix,sv))
1089 return sv_2mortal(sv); /* has tie magic */
1090 sv_magic(sv, NULL, PERL_MAGIC_nonelem, NULL, 0);
1091 return sv;
1092}
1093
66610fdd 1094/*
14d04a33 1095 * ex: set ts=8 sts=4 sw=4 et:
37442d52 1096 */