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