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