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