This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
build missing utilities on windows; clean stray files
[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
93965878
NIS
187 if (key < 0) {
188 key += AvFILL(av) + 1;
189 if (key < 0)
190 return 0;
191 }
192
8990e307 193 if (SvRMAGICAL(av)) {
14befaf4
DM
194 if (mg_find((SV*)av, PERL_MAGIC_tied) ||
195 mg_find((SV*)av, PERL_MAGIC_regdata))
196 {
8990e307 197 sv = sv_newmortal();
463ee0b2 198 mg_copy((SV*)av, sv, 0, key);
3280af22
NIS
199 PL_av_fetch_sv = sv;
200 return &PL_av_fetch_sv;
463ee0b2
LW
201 }
202 }
203
93965878 204 if (key > AvFILLp(av)) {
a0d0e21e
LW
205 if (!lval)
206 return 0;
352edd90 207 sv = NEWSV(5,0);
a0d0e21e 208 return av_store(av,key,sv);
79072805 209 }
3280af22 210 if (AvARRAY(av)[key] == &PL_sv_undef) {
4dbf4341 211 emptyness:
79072805
LW
212 if (lval) {
213 sv = NEWSV(6,0);
463ee0b2 214 return av_store(av,key,sv);
79072805
LW
215 }
216 return 0;
217 }
4dbf4341 218 else if (AvREIFY(av)
219 && (!AvARRAY(av)[key] /* eg. @_ could have freed elts */
220 || SvTYPE(AvARRAY(av)[key]) == SVTYPEMASK)) {
3280af22 221 AvARRAY(av)[key] = &PL_sv_undef; /* 1/2 reify */
4dbf4341 222 goto emptyness;
223 }
463ee0b2 224 return &AvARRAY(av)[key];
79072805
LW
225}
226
cb50131a
CB
227/*
228=for apidoc av_store
229
230Stores an SV in an array. The array index is specified as C<key>. The
231return value will be NULL if the operation failed or if the value did not
232need to be actually stored within the array (as in the case of tied
233arrays). Otherwise it can be dereferenced to get the original C<SV*>. Note
234that the caller is responsible for suitably incrementing the reference
235count of C<val> before the call, and decrementing it if the function
236returned NULL.
237
238See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
239more information on how to use this function on tied arrays.
240
241=cut
242*/
243
79072805 244SV**
864dbfa3 245Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
79072805 246{
79072805
LW
247 SV** ary;
248
a0d0e21e
LW
249 if (!av)
250 return 0;
43fcc5d2 251 if (!val)
3280af22 252 val = &PL_sv_undef;
463ee0b2 253
a0d0e21e
LW
254 if (key < 0) {
255 key += AvFILL(av) + 1;
256 if (key < 0)
257 return 0;
79072805 258 }
93965878 259
43fcc5d2 260 if (SvREADONLY(av) && key >= AvFILL(av))
cea2e8a9 261 Perl_croak(aTHX_ PL_no_modify);
93965878
NIS
262
263 if (SvRMAGICAL(av)) {
14befaf4 264 if (mg_find((SV*)av, PERL_MAGIC_tied)) {
3280af22 265 if (val != &PL_sv_undef) {
93965878
NIS
266 mg_copy((SV*)av, val, 0, key);
267 }
268 return 0;
269 }
270 }
271
49beac48 272 if (!AvREAL(av) && AvREIFY(av))
a0d0e21e 273 av_reify(av);
a0d0e21e
LW
274 if (key > AvMAX(av))
275 av_extend(av,key);
463ee0b2 276 ary = AvARRAY(av);
93965878 277 if (AvFILLp(av) < key) {
a0d0e21e 278 if (!AvREAL(av)) {
3280af22
NIS
279 if (av == PL_curstack && key > PL_stack_sp - PL_stack_base)
280 PL_stack_sp = PL_stack_base + key; /* XPUSH in disguise */
a0d0e21e 281 do
3280af22 282 ary[++AvFILLp(av)] = &PL_sv_undef;
93965878 283 while (AvFILLp(av) < key);
79072805 284 }
93965878 285 AvFILLp(av) = key;
79072805 286 }
a0d0e21e
LW
287 else if (AvREAL(av))
288 SvREFCNT_dec(ary[key]);
79072805 289 ary[key] = val;
8990e307 290 if (SvSMAGICAL(av)) {
3280af22 291 if (val != &PL_sv_undef) {
a0d0e21e
LW
292 MAGIC* mg = SvMAGIC(av);
293 sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key);
294 }
463ee0b2
LW
295 mg_set((SV*)av);
296 }
79072805
LW
297 return &ary[key];
298}
299
cb50131a
CB
300/*
301=for apidoc newAV
302
303Creates a new AV. The reference count is set to 1.
304
305=cut
306*/
307
79072805 308AV *
864dbfa3 309Perl_newAV(pTHX)
79072805 310{
463ee0b2 311 register AV *av;
79072805 312
a0d0e21e
LW
313 av = (AV*)NEWSV(3,0);
314 sv_upgrade((SV *)av, SVt_PVAV);
463ee0b2
LW
315 AvREAL_on(av);
316 AvALLOC(av) = 0;
317 SvPVX(av) = 0;
93965878 318 AvMAX(av) = AvFILLp(av) = -1;
463ee0b2 319 return av;
79072805
LW
320}
321
cb50131a
CB
322/*
323=for apidoc av_make
324
325Creates a new AV and populates it with a list of SVs. The SVs are copied
326into the array, so they may be freed after the call to av_make. The new AV
327will have a reference count of 1.
328
329=cut
330*/
331
79072805 332AV *
864dbfa3 333Perl_av_make(pTHX_ register I32 size, register SV **strp)
79072805 334{
463ee0b2 335 register AV *av;
79072805
LW
336 register I32 i;
337 register SV** ary;
338
a0d0e21e
LW
339 av = (AV*)NEWSV(8,0);
340 sv_upgrade((SV *) av,SVt_PVAV);
a0d0e21e 341 AvFLAGS(av) = AVf_REAL;
573fa4ea
TB
342 if (size) { /* `defined' was returning undef for size==0 anyway. */
343 New(4,ary,size,SV*);
344 AvALLOC(av) = ary;
345 SvPVX(av) = (char*)ary;
93965878 346 AvFILLp(av) = size - 1;
573fa4ea
TB
347 AvMAX(av) = size - 1;
348 for (i = 0; i < size; i++) {
349 assert (*strp);
350 ary[i] = NEWSV(7,0);
351 sv_setsv(ary[i], *strp);
352 strp++;
353 }
79072805 354 }
463ee0b2 355 return av;
79072805
LW
356}
357
358AV *
864dbfa3 359Perl_av_fake(pTHX_ register I32 size, register SV **strp)
79072805 360{
463ee0b2 361 register AV *av;
79072805
LW
362 register SV** ary;
363
a0d0e21e
LW
364 av = (AV*)NEWSV(9,0);
365 sv_upgrade((SV *)av, SVt_PVAV);
79072805 366 New(4,ary,size+1,SV*);
463ee0b2 367 AvALLOC(av) = ary;
79072805 368 Copy(strp,ary,size,SV*);
a0d0e21e 369 AvFLAGS(av) = AVf_REIFY;
463ee0b2 370 SvPVX(av) = (char*)ary;
93965878 371 AvFILLp(av) = size - 1;
463ee0b2 372 AvMAX(av) = size - 1;
79072805 373 while (size--) {
a0d0e21e
LW
374 assert (*strp);
375 SvTEMP_off(*strp);
79072805
LW
376 strp++;
377 }
463ee0b2 378 return av;
79072805
LW
379}
380
cb50131a
CB
381/*
382=for apidoc av_clear
383
384Clears an array, making it empty. Does not free the memory used by the
385array itself.
386
387=cut
388*/
389
79072805 390void
864dbfa3 391Perl_av_clear(pTHX_ register AV *av)
79072805
LW
392{
393 register I32 key;
a0d0e21e 394 SV** ary;
79072805 395
7d55f622 396#ifdef DEBUGGING
32da55ab 397 if (SvREFCNT(av) == 0 && ckWARN_d(WARN_DEBUGGING)) {
9014280d 398 Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "Attempt to clear deleted array");
7d55f622 399 }
400#endif
a60c0954 401 if (!av)
79072805
LW
402 return;
403 /*SUPPRESS 560*/
a0d0e21e 404
39caa665 405 if (SvREADONLY(av))
cea2e8a9 406 Perl_croak(aTHX_ PL_no_modify);
39caa665 407
93965878
NIS
408 /* Give any tie a chance to cleanup first */
409 if (SvRMAGICAL(av))
410 mg_clear((SV*)av);
411
a60c0954
NIS
412 if (AvMAX(av) < 0)
413 return;
414
a0d0e21e
LW
415 if (AvREAL(av)) {
416 ary = AvARRAY(av);
93965878 417 key = AvFILLp(av) + 1;
a0d0e21e
LW
418 while (key) {
419 SvREFCNT_dec(ary[--key]);
3280af22 420 ary[key] = &PL_sv_undef;
a0d0e21e
LW
421 }
422 }
155aba94 423 if ((key = AvARRAY(av) - AvALLOC(av))) {
463ee0b2 424 AvMAX(av) += key;
a0d0e21e 425 SvPVX(av) = (char*)AvALLOC(av);
79072805 426 }
93965878 427 AvFILLp(av) = -1;
fb73857a 428
79072805
LW
429}
430
cb50131a
CB
431/*
432=for apidoc av_undef
433
434Undefines the array. Frees the memory used by the array itself.
435
436=cut
437*/
438
79072805 439void
864dbfa3 440Perl_av_undef(pTHX_ register AV *av)
79072805
LW
441{
442 register I32 key;
443
463ee0b2 444 if (!av)
79072805
LW
445 return;
446 /*SUPPRESS 560*/
93965878
NIS
447
448 /* Give any tie a chance to cleanup first */
14befaf4 449 if (SvTIED_mg((SV*)av, PERL_MAGIC_tied))
93965878
NIS
450 av_fill(av, -1); /* mg_clear() ? */
451
a0d0e21e 452 if (AvREAL(av)) {
93965878 453 key = AvFILLp(av) + 1;
a0d0e21e
LW
454 while (key)
455 SvREFCNT_dec(AvARRAY(av)[--key]);
456 }
463ee0b2
LW
457 Safefree(AvALLOC(av));
458 AvALLOC(av) = 0;
459 SvPVX(av) = 0;
93965878 460 AvMAX(av) = AvFILLp(av) = -1;
748a9306
LW
461 if (AvARYLEN(av)) {
462 SvREFCNT_dec(AvARYLEN(av));
463 AvARYLEN(av) = 0;
464 }
79072805
LW
465}
466
cb50131a
CB
467/*
468=for apidoc av_push
469
470Pushes an SV onto the end of the array. The array will grow automatically
471to accommodate the addition.
472
473=cut
474*/
475
a0d0e21e 476void
864dbfa3 477Perl_av_push(pTHX_ register AV *av, SV *val)
93965878
NIS
478{
479 MAGIC *mg;
a0d0e21e
LW
480 if (!av)
481 return;
93965878 482 if (SvREADONLY(av))
cea2e8a9 483 Perl_croak(aTHX_ PL_no_modify);
93965878 484
14befaf4 485 if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
93965878 486 dSP;
e788e7d3 487 PUSHSTACKi(PERLSI_MAGIC);
924508f0
GS
488 PUSHMARK(SP);
489 EXTEND(SP,2);
33c27489 490 PUSHs(SvTIED_obj((SV*)av, mg));
93965878 491 PUSHs(val);
a60c0954
NIS
492 PUTBACK;
493 ENTER;
864dbfa3 494 call_method("PUSH", G_SCALAR|G_DISCARD);
a60c0954 495 LEAVE;
d3acc0f7 496 POPSTACK;
93965878
NIS
497 return;
498 }
499 av_store(av,AvFILLp(av)+1,val);
79072805
LW
500}
501
cb50131a
CB
502/*
503=for apidoc av_pop
504
505Pops an SV off the end of the array. Returns C<&PL_sv_undef> if the array
506is empty.
507
508=cut
509*/
510
79072805 511SV *
864dbfa3 512Perl_av_pop(pTHX_ register AV *av)
79072805
LW
513{
514 SV *retval;
93965878 515 MAGIC* mg;
79072805 516
d19c0e07
MJD
517 if (!av)
518 return &PL_sv_undef;
43fcc5d2 519 if (SvREADONLY(av))
cea2e8a9 520 Perl_croak(aTHX_ PL_no_modify);
14befaf4 521 if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
93965878 522 dSP;
e788e7d3 523 PUSHSTACKi(PERLSI_MAGIC);
924508f0 524 PUSHMARK(SP);
33c27489 525 XPUSHs(SvTIED_obj((SV*)av, mg));
a60c0954
NIS
526 PUTBACK;
527 ENTER;
864dbfa3 528 if (call_method("POP", G_SCALAR)) {
3280af22 529 retval = newSVsv(*PL_stack_sp--);
93965878 530 } else {
3280af22 531 retval = &PL_sv_undef;
93965878 532 }
a60c0954 533 LEAVE;
d3acc0f7 534 POPSTACK;
93965878
NIS
535 return retval;
536 }
d19c0e07
MJD
537 if (AvFILL(av) < 0)
538 return &PL_sv_undef;
93965878 539 retval = AvARRAY(av)[AvFILLp(av)];
3280af22 540 AvARRAY(av)[AvFILLp(av)--] = &PL_sv_undef;
8990e307 541 if (SvSMAGICAL(av))
463ee0b2 542 mg_set((SV*)av);
79072805
LW
543 return retval;
544}
545
cb50131a
CB
546/*
547=for apidoc av_unshift
548
549Unshift the given number of C<undef> values onto the beginning of the
550array. The array will grow automatically to accommodate the addition. You
551must then use C<av_store> to assign values to these new elements.
552
553=cut
554*/
555
79072805 556void
864dbfa3 557Perl_av_unshift(pTHX_ register AV *av, register I32 num)
79072805
LW
558{
559 register I32 i;
67a38de0 560 register SV **ary;
93965878 561 MAGIC* mg;
e2b534e7 562 I32 slide;
79072805 563
d19c0e07 564 if (!av)
79072805 565 return;
43fcc5d2 566 if (SvREADONLY(av))
cea2e8a9 567 Perl_croak(aTHX_ PL_no_modify);
93965878 568
14befaf4 569 if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
93965878 570 dSP;
e788e7d3 571 PUSHSTACKi(PERLSI_MAGIC);
924508f0
GS
572 PUSHMARK(SP);
573 EXTEND(SP,1+num);
33c27489 574 PUSHs(SvTIED_obj((SV*)av, mg));
93965878 575 while (num-- > 0) {
3280af22 576 PUSHs(&PL_sv_undef);
93965878
NIS
577 }
578 PUTBACK;
a60c0954 579 ENTER;
864dbfa3 580 call_method("UNSHIFT", G_SCALAR|G_DISCARD);
a60c0954 581 LEAVE;
d3acc0f7 582 POPSTACK;
93965878
NIS
583 return;
584 }
585
d19c0e07
MJD
586 if (num <= 0)
587 return;
49beac48
CS
588 if (!AvREAL(av) && AvREIFY(av))
589 av_reify(av);
a0d0e21e
LW
590 i = AvARRAY(av) - AvALLOC(av);
591 if (i) {
592 if (i > num)
593 i = num;
594 num -= i;
595
596 AvMAX(av) += i;
93965878 597 AvFILLp(av) += i;
a0d0e21e
LW
598 SvPVX(av) = (char*)(AvARRAY(av) - i);
599 }
d2719217 600 if (num) {
67a38de0 601 i = AvFILLp(av);
e2b534e7
BT
602 /* Create extra elements */
603 slide = i > 0 ? i : 0;
604 num += slide;
67a38de0 605 av_extend(av, i + num);
93965878 606 AvFILLp(av) += num;
67a38de0
NIS
607 ary = AvARRAY(av);
608 Move(ary, ary + num, i + 1, SV*);
609 do {
3280af22 610 ary[--num] = &PL_sv_undef;
67a38de0 611 } while (num);
e2b534e7
BT
612 /* Make extra elements into a buffer */
613 AvMAX(av) -= slide;
614 AvFILLp(av) -= slide;
615 SvPVX(av) = (char*)(AvARRAY(av) + slide);
79072805
LW
616 }
617}
618
cb50131a
CB
619/*
620=for apidoc av_shift
621
622Shifts an SV off the beginning of the array.
623
624=cut
625*/
626
79072805 627SV *
864dbfa3 628Perl_av_shift(pTHX_ register AV *av)
79072805
LW
629{
630 SV *retval;
93965878 631 MAGIC* mg;
79072805 632
d19c0e07 633 if (!av)
3280af22 634 return &PL_sv_undef;
43fcc5d2 635 if (SvREADONLY(av))
cea2e8a9 636 Perl_croak(aTHX_ PL_no_modify);
14befaf4 637 if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
93965878 638 dSP;
e788e7d3 639 PUSHSTACKi(PERLSI_MAGIC);
924508f0 640 PUSHMARK(SP);
33c27489 641 XPUSHs(SvTIED_obj((SV*)av, mg));
a60c0954
NIS
642 PUTBACK;
643 ENTER;
864dbfa3 644 if (call_method("SHIFT", G_SCALAR)) {
3280af22 645 retval = newSVsv(*PL_stack_sp--);
93965878 646 } else {
3280af22 647 retval = &PL_sv_undef;
a60c0954
NIS
648 }
649 LEAVE;
d3acc0f7 650 POPSTACK;
93965878
NIS
651 return retval;
652 }
d19c0e07
MJD
653 if (AvFILL(av) < 0)
654 return &PL_sv_undef;
463ee0b2 655 retval = *AvARRAY(av);
a0d0e21e 656 if (AvREAL(av))
3280af22 657 *AvARRAY(av) = &PL_sv_undef;
463ee0b2
LW
658 SvPVX(av) = (char*)(AvARRAY(av) + 1);
659 AvMAX(av)--;
93965878 660 AvFILLp(av)--;
8990e307 661 if (SvSMAGICAL(av))
463ee0b2 662 mg_set((SV*)av);
79072805
LW
663 return retval;
664}
665
cb50131a
CB
666/*
667=for apidoc av_len
668
669Returns the highest index in the array. Returns -1 if the array is
670empty.
671
672=cut
673*/
674
79072805 675I32
864dbfa3 676Perl_av_len(pTHX_ register AV *av)
79072805 677{
463ee0b2 678 return AvFILL(av);
79072805
LW
679}
680
f3b76584
SC
681/*
682=for apidoc av_fill
683
684Ensure than an array has a given number of elements, equivalent to
685Perl's C<$#array = $fill;>.
686
687=cut
688*/
79072805 689void
864dbfa3 690Perl_av_fill(pTHX_ register AV *av, I32 fill)
79072805 691{
93965878 692 MAGIC *mg;
a0d0e21e 693 if (!av)
cea2e8a9 694 Perl_croak(aTHX_ "panic: null array");
79072805
LW
695 if (fill < 0)
696 fill = -1;
14befaf4 697 if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
93965878
NIS
698 dSP;
699 ENTER;
700 SAVETMPS;
e788e7d3 701 PUSHSTACKi(PERLSI_MAGIC);
924508f0
GS
702 PUSHMARK(SP);
703 EXTEND(SP,2);
33c27489 704 PUSHs(SvTIED_obj((SV*)av, mg));
a60c0954 705 PUSHs(sv_2mortal(newSViv(fill+1)));
93965878 706 PUTBACK;
864dbfa3 707 call_method("STORESIZE", G_SCALAR|G_DISCARD);
d3acc0f7 708 POPSTACK;
93965878
NIS
709 FREETMPS;
710 LEAVE;
711 return;
712 }
463ee0b2 713 if (fill <= AvMAX(av)) {
93965878 714 I32 key = AvFILLp(av);
a0d0e21e
LW
715 SV** ary = AvARRAY(av);
716
717 if (AvREAL(av)) {
718 while (key > fill) {
719 SvREFCNT_dec(ary[key]);
3280af22 720 ary[key--] = &PL_sv_undef;
a0d0e21e
LW
721 }
722 }
723 else {
724 while (key < fill)
3280af22 725 ary[++key] = &PL_sv_undef;
a0d0e21e
LW
726 }
727
93965878 728 AvFILLp(av) = fill;
8990e307 729 if (SvSMAGICAL(av))
463ee0b2
LW
730 mg_set((SV*)av);
731 }
a0d0e21e 732 else
3280af22 733 (void)av_store(av,fill,&PL_sv_undef);
79072805 734}
c750a3ec 735
f3b76584
SC
736/*
737=for apidoc av_delete
738
739Deletes the element indexed by C<key> from the array. Returns the
740deleted element. C<flags> is currently ignored.
741
742=cut
743*/
146174a9
CB
744SV *
745Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
746{
747 SV *sv;
748
749 if (!av)
750 return Nullsv;
751 if (SvREADONLY(av))
752 Perl_croak(aTHX_ PL_no_modify);
753 if (key < 0) {
754 key += AvFILL(av) + 1;
755 if (key < 0)
756 return Nullsv;
757 }
758 if (SvRMAGICAL(av)) {
759 SV **svp;
14befaf4
DM
760 if ((mg_find((SV*)av, PERL_MAGIC_tied) ||
761 mg_find((SV*)av, PERL_MAGIC_regdata))
146174a9
CB
762 && (svp = av_fetch(av, key, TRUE)))
763 {
764 sv = *svp;
765 mg_clear(sv);
14befaf4
DM
766 if (mg_find(sv, PERL_MAGIC_tiedelem)) {
767 sv_unmagic(sv, PERL_MAGIC_tiedelem); /* No longer an element */
146174a9
CB
768 return sv;
769 }
770 return Nullsv; /* element cannot be deleted */
771 }
772 }
773 if (key > AvFILLp(av))
774 return Nullsv;
775 else {
776 sv = AvARRAY(av)[key];
777 if (key == AvFILLp(av)) {
d9c63288 778 AvARRAY(av)[key] = &PL_sv_undef;
146174a9
CB
779 do {
780 AvFILLp(av)--;
781 } while (--key >= 0 && AvARRAY(av)[key] == &PL_sv_undef);
782 }
783 else
784 AvARRAY(av)[key] = &PL_sv_undef;
785 if (SvSMAGICAL(av))
786 mg_set((SV*)av);
787 }
788 if (flags & G_DISCARD) {
789 SvREFCNT_dec(sv);
790 sv = Nullsv;
791 }
792 return sv;
793}
794
795/*
f3b76584
SC
796=for apidoc av_exists
797
798Returns true if the element indexed by C<key> has been initialized.
146174a9 799
f3b76584
SC
800This relies on the fact that uninitialized array elements are set to
801C<&PL_sv_undef>.
802
803=cut
804*/
146174a9
CB
805bool
806Perl_av_exists(pTHX_ AV *av, I32 key)
807{
808 if (!av)
809 return FALSE;
810 if (key < 0) {
811 key += AvFILL(av) + 1;
812 if (key < 0)
813 return FALSE;
814 }
815 if (SvRMAGICAL(av)) {
14befaf4
DM
816 if (mg_find((SV*)av, PERL_MAGIC_tied) ||
817 mg_find((SV*)av, PERL_MAGIC_regdata))
818 {
146174a9 819 SV *sv = sv_newmortal();
e38197b3
JH
820 MAGIC *mg;
821
146174a9 822 mg_copy((SV*)av, sv, 0, key);
14befaf4 823 mg = mg_find(sv, PERL_MAGIC_tiedelem);
e38197b3
JH
824 if (mg) {
825 magic_existspack(sv, mg);
826 return SvTRUE(sv);
827 }
146174a9
CB
828 }
829 }
830 if (key <= AvFILLp(av) && AvARRAY(av)[key] != &PL_sv_undef
831 && AvARRAY(av)[key])
832 {
833 return TRUE;
834 }
835 else
836 return FALSE;
837}
57079c46
GA
838
839/* AVHV: Support for treating arrays as if they were hashes. The
840 * first element of the array should be a hash reference that maps
841 * hash keys to array indices.
842 */
843
72311751 844STATIC I32
cea2e8a9 845S_avhv_index_sv(pTHX_ SV* sv)
57079c46
GA
846{
847 I32 index = SvIV(sv);
848 if (index < 1)
cea2e8a9 849 Perl_croak(aTHX_ "Bad index while coercing array into hash");
57079c46
GA
850 return index;
851}
852
10c8fecd
GS
853STATIC I32
854S_avhv_index(pTHX_ AV *av, SV *keysv, U32 hash)
855{
856 HV *keys;
857 HE *he;
858 STRLEN n_a;
859
860 keys = avhv_keys(av);
861 he = hv_fetch_ent(keys, keysv, FALSE, hash);
862 if (!he)
863 Perl_croak(aTHX_ "No such pseudo-hash field \"%s\"", SvPV(keysv,n_a));
864 return avhv_index_sv(HeVAL(he));
865}
866
5d5aaa5e 867HV*
864dbfa3 868Perl_avhv_keys(pTHX_ AV *av)
5d5aaa5e 869{
57079c46 870 SV **keysp = av_fetch(av, 0, FALSE);
5d5aaa5e 871 if (keysp) {
d627ae4e
MB
872 SV *sv = *keysp;
873 if (SvGMAGICAL(sv))
874 mg_get(sv);
875 if (SvROK(sv)) {
876 sv = SvRV(sv);
877 if (SvTYPE(sv) == SVt_PVHV)
57079c46 878 return (HV*)sv;
5d5aaa5e
JP
879 }
880 }
cea2e8a9 881 Perl_croak(aTHX_ "Can't coerce array into hash");
72311751 882 return Nullhv;
c750a3ec
MB
883}
884
885SV**
10c8fecd
GS
886Perl_avhv_store_ent(pTHX_ AV *av, SV *keysv, SV *val, U32 hash)
887{
888 return av_store(av, avhv_index(av, keysv, hash), val);
889}
890
891SV**
864dbfa3 892Perl_avhv_fetch_ent(pTHX_ AV *av, SV *keysv, I32 lval, U32 hash)
97fcbf96 893{
10c8fecd 894 return av_fetch(av, avhv_index(av, keysv, hash), lval);
5bc6513d
MB
895}
896
146174a9
CB
897SV *
898Perl_avhv_delete_ent(pTHX_ AV *av, SV *keysv, I32 flags, U32 hash)
899{
900 HV *keys = avhv_keys(av);
901 HE *he;
902
903 he = hv_fetch_ent(keys, keysv, FALSE, hash);
904 if (!he || !SvOK(HeVAL(he)))
905 return Nullsv;
906
907 return av_delete(av, avhv_index_sv(HeVAL(he)), flags);
908}
909
910/* Check for the existence of an element named by a given key.
911 *
912 */
c750a3ec 913bool
864dbfa3 914Perl_avhv_exists_ent(pTHX_ AV *av, SV *keysv, U32 hash)
97fcbf96 915{
5d5aaa5e 916 HV *keys = avhv_keys(av);
146174a9
CB
917 HE *he;
918
919 he = hv_fetch_ent(keys, keysv, FALSE, hash);
920 if (!he || !SvOK(HeVAL(he)))
921 return FALSE;
922
923 return av_exists(av, avhv_index_sv(HeVAL(he)));
97fcbf96
MB
924}
925
c750a3ec 926HE *
864dbfa3 927Perl_avhv_iternext(pTHX_ AV *av)
c750a3ec 928{
5d5aaa5e
JP
929 HV *keys = avhv_keys(av);
930 return hv_iternext(keys);
c750a3ec
MB
931}
932
933SV *
864dbfa3 934Perl_avhv_iterval(pTHX_ AV *av, register HE *entry)
c750a3ec 935{
57079c46
GA
936 SV *sv = hv_iterval(avhv_keys(av), entry);
937 return *av_fetch(av, avhv_index_sv(sv), TRUE);
c750a3ec 938}