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