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