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