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