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