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