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