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