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