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