Reword the alarm explanation.
[p5sagit/p5-mst-13.2.git] / av.c
CommitLineData
a0d0e21e 1/* av.c
79072805 2 *
bc89e66f 3 * Copyright (c) 1991-2001, Larry Wall
79072805 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 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 13 */
14
15#include "EXTERN.h"
864dbfa3 16#define PERL_IN_AV_C
79072805 17#include "perl.h"
18
fb73857a 19void
864dbfa3 20Perl_av_reify(pTHX_ AV *av)
a0d0e21e 21{
22 I32 key;
23 SV* sv;
fb73857a 24
3c78fafa 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 34 while (key) {
35 sv = AvARRAY(av)[--key];
36 assert(sv);
411caa50 37 if (sv != &PL_sv_undef)
a0d0e21e 38 (void)SvREFCNT_inc(sv);
39 }
29de640a 40 key = AvARRAY(av) - AvALLOC(av);
41 while (key)
3280af22 42 AvALLOC(av)[--key] = &PL_sv_undef;
62b1ebc2 43 AvREIFY_off(av);
a0d0e21e 44 AvREAL_on(av);
45}
46
cb50131a 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 61 dSP;
62 ENTER;
63 SAVETMPS;
e788e7d3 64 PUSHSTACKi(PERLSI_MAGIC);
924508f0 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 72 FREETMPS;
73 LEAVE;
74 return;
75 }
a0d0e21e 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 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 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 100 MEM_SIZE bytes;
101 IV itmp;
c07a80fd 102#endif
4633a7c4 103
f5a32c7f 104#if defined(MYMALLOC) && !defined(LEAKTEST)
8d6dde3e 105 newmax = malloced_size((void*)AvALLOC(av))/sizeof(SV*) - 1;
106
107 if (key <= newmax)
108 goto resized;
109#endif
a0d0e21e 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 114#else
115 bytes = (newmax + 1) * sizeof(SV*);
116#define MALLOC_OVERHEAD 16
c1f7b11a 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 125 New(2,ary, newmax+1, SV*);
126 Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*);
fba3b22e 127 if (AvMAX(av) > 64)
128 offer_nice_chunk(AvALLOC(av), (AvMAX(av)+1) * sizeof(SV*));
4633a7c4 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 136 ary = AvALLOC(av) + AvMAX(av) + 1;
137 tmp = newmax - AvMAX(av);
3280af22 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 142 }
143 }
144 else {
8d6dde3e 145 newmax = key < 3 ? 3 : key;
a0d0e21e 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 150 }
151 if (AvREAL(av)) {
152 while (tmp)
3280af22 153 ary[--tmp] = &PL_sv_undef;
a0d0e21e 154 }
155
156 SvPVX(av) = (char*)AvALLOC(av);
157 AvMAX(av) = newmax;
158 }
159 }
160}
161
cb50131a 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 177{
178 SV *sv;
179
a0d0e21e 180 if (!av)
181 return 0;
182
93965878 183 if (key < 0) {
184 key += AvFILL(av) + 1;
185 if (key < 0)
186 return 0;
187 }
188
8990e307 189 if (SvRMAGICAL(av)) {
14befaf4 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 195 PL_av_fetch_sv = sv;
196 return &PL_av_fetch_sv;
463ee0b2 197 }
198 }
199
93965878 200 if (key > AvFILLp(av)) {
a0d0e21e 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 208 if (lval) {
209 sv = NEWSV(6,0);
463ee0b2 210 return av_store(av,key,sv);
79072805 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 221}
222
cb50131a 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 243 SV** ary;
244
a0d0e21e 245 if (!av)
246 return 0;
43fcc5d2 247 if (!val)
3280af22 248 val = &PL_sv_undef;
463ee0b2 249
a0d0e21e 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 258
259 if (SvRMAGICAL(av)) {
14befaf4 260 if (mg_find((SV*)av, PERL_MAGIC_tied)) {
3280af22 261 if (val != &PL_sv_undef) {
93965878 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 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 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 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 288 MAGIC* mg = SvMAGIC(av);
289 sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key);
290 }
463ee0b2 291 mg_set((SV*)av);
292 }
79072805 293 return &ary[key];
294}
295
cb50131a 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 309 av = (AV*)NEWSV(3,0);
310 sv_upgrade((SV *)av, SVt_PVAV);
463ee0b2 311 AvREAL_on(av);
312 AvALLOC(av) = 0;
313 SvPVX(av) = 0;
93965878 314 AvMAX(av) = AvFILLp(av) = -1;
463ee0b2 315 return av;
79072805 316}
317
cb50131a 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 332 register I32 i;
333 register SV** ary;
334
a0d0e21e 335 av = (AV*)NEWSV(8,0);
336 sv_upgrade((SV *) av,SVt_PVAV);
a0d0e21e 337 AvFLAGS(av) = AVf_REAL;
573fa4ea 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 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 352}
353
354AV *
864dbfa3 355Perl_av_fake(pTHX_ register I32 size, register SV **strp)
79072805 356{
463ee0b2 357 register AV *av;
79072805 358 register SV** ary;
359
a0d0e21e 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 370 assert (*strp);
371 SvTEMP_off(*strp);
79072805 372 strp++;
373 }
463ee0b2 374 return av;
79072805 375}
376
cb50131a 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 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 395 }
396#endif
a60c0954 397 if (!av)
79072805 398 return;
399 /*SUPPRESS 560*/
a0d0e21e 400
39caa665 401 if (SvREADONLY(av))
cea2e8a9 402 Perl_croak(aTHX_ PL_no_modify);
39caa665 403
93965878 404 /* Give any tie a chance to cleanup first */
405 if (SvRMAGICAL(av))
406 mg_clear((SV*)av);
407
a60c0954 408 if (AvMAX(av) < 0)
409 return;
410
a0d0e21e 411 if (AvREAL(av)) {
412 ary = AvARRAY(av);
93965878 413 key = AvFILLp(av) + 1;
a0d0e21e 414 while (key) {
415 SvREFCNT_dec(ary[--key]);
3280af22 416 ary[key] = &PL_sv_undef;
a0d0e21e 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 425}
426
cb50131a 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 437{
438 register I32 key;
439
463ee0b2 440 if (!av)
79072805 441 return;
442 /*SUPPRESS 560*/
93965878 443
444 /* Give any tie a chance to cleanup first */
14befaf4 445 if (SvTIED_mg((SV*)av, PERL_MAGIC_tied))
93965878 446 av_fill(av, -1); /* mg_clear() ? */
447
a0d0e21e 448 if (AvREAL(av)) {
93965878 449 key = AvFILLp(av) + 1;
a0d0e21e 450 while (key)
451 SvREFCNT_dec(AvARRAY(av)[--key]);
452 }
463ee0b2 453 Safefree(AvALLOC(av));
454 AvALLOC(av) = 0;
455 SvPVX(av) = 0;
93965878 456 AvMAX(av) = AvFILLp(av) = -1;
748a9306 457 if (AvARYLEN(av)) {
458 SvREFCNT_dec(AvARYLEN(av));
459 AvARYLEN(av) = 0;
460 }
79072805 461}
462
cb50131a 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 474{
475 MAGIC *mg;
a0d0e21e 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 484 PUSHMARK(SP);
485 EXTEND(SP,2);
33c27489 486 PUSHs(SvTIED_obj((SV*)av, mg));
93965878 487 PUSHs(val);
a60c0954 488 PUTBACK;
489 ENTER;
864dbfa3 490 call_method("PUSH", G_SCALAR|G_DISCARD);
a60c0954 491 LEAVE;
d3acc0f7 492 POPSTACK;
93965878 493 return;
494 }
495 av_store(av,AvFILLp(av)+1,val);
79072805 496}
497
cb50131a 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 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 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 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 537 return retval;
538}
539
cb50131a 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 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 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 571 }
572 PUTBACK;
a60c0954 573 ENTER;
864dbfa3 574 call_method("UNSHIFT", G_SCALAR|G_DISCARD);
a60c0954 575 LEAVE;
d3acc0f7 576 POPSTACK;
93965878 577 return;
578 }
579
49beac48 580 if (!AvREAL(av) && AvREIFY(av))
581 av_reify(av);
a0d0e21e 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 590 SvPVX(av) = (char*)(AvARRAY(av) - i);
591 }
d2719217 592 if (num) {
67a38de0 593 i = AvFILLp(av);
e2b534e7 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 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 604 /* Make extra elements into a buffer */
605 AvMAX(av) -= slide;
606 AvFILLp(av) -= slide;
607 SvPVX(av) = (char*)(AvARRAY(av) + slide);
79072805 608 }
609}
610
cb50131a 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 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 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 640 }
641 LEAVE;
d3acc0f7 642 POPSTACK;
93965878 643 return retval;
644 }
463ee0b2 645 retval = *AvARRAY(av);
a0d0e21e 646 if (AvREAL(av))
3280af22 647 *AvARRAY(av) = &PL_sv_undef;
463ee0b2 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 653 return retval;
654}
655
cb50131a 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 669}
670
f3b76584 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 685 if (fill < 0)
686 fill = -1;
14befaf4 687 if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
93965878 688 dSP;
689 ENTER;
690 SAVETMPS;
e788e7d3 691 PUSHSTACKi(PERLSI_MAGIC);
924508f0 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 699 FREETMPS;
700 LEAVE;
701 return;
702 }
463ee0b2 703 if (fill <= AvMAX(av)) {
93965878 704 I32 key = AvFILLp(av);
a0d0e21e 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 711 }
712 }
713 else {
714 while (key < fill)
3280af22 715 ary[++key] = &PL_sv_undef;
a0d0e21e 716 }
717
93965878 718 AvFILLp(av) = fill;
8990e307 719 if (SvSMAGICAL(av))
463ee0b2 720 mg_set((SV*)av);
721 }
a0d0e21e 722 else
3280af22 723 (void)av_store(av,fill,&PL_sv_undef);
79072805 724}
c750a3ec 725
f3b76584 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 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 750 if ((mg_find((SV*)av, PERL_MAGIC_tied) ||
751 mg_find((SV*)av, PERL_MAGIC_regdata))
146174a9 752 && (svp = av_fetch(av, key, TRUE)))
753 {
754 sv = *svp;
755 mg_clear(sv);
14befaf4 756 if (mg_find(sv, PERL_MAGIC_tiedelem)) {
757 sv_unmagic(sv, PERL_MAGIC_tiedelem); /* No longer an element */
146174a9 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 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 786=for apidoc av_exists
787
788Returns true if the element indexed by C<key> has been initialized.
146174a9 789
f3b76584 790This relies on the fact that uninitialized array elements are set to
791C<&PL_sv_undef>.
792
793=cut
794*/
146174a9 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 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 810 MAGIC *mg;
811
146174a9 812 mg_copy((SV*)av, sv, 0, key);
14befaf4 813 mg = mg_find(sv, PERL_MAGIC_tiedelem);
e38197b3 814 if (mg) {
815 magic_existspack(sv, mg);
816 return SvTRUE(sv);
817 }
146174a9 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 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 836{
837 I32 index = SvIV(sv);
838 if (index < 1)
cea2e8a9 839 Perl_croak(aTHX_ "Bad index while coercing array into hash");
57079c46 840 return index;
841}
842
10c8fecd 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 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 869 }
870 }
cea2e8a9 871 Perl_croak(aTHX_ "Can't coerce array into hash");
72311751 872 return Nullhv;
c750a3ec 873}
874
875SV**
10c8fecd 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 885}
886
146174a9 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 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 914}
915
c750a3ec 916HE *
864dbfa3 917Perl_avhv_iternext(pTHX_ AV *av)
c750a3ec 918{
5d5aaa5e 919 HV *keys = avhv_keys(av);
920 return hv_iternext(keys);
c750a3ec 921}
922
923SV *
864dbfa3 924Perl_avhv_iterval(pTHX_ AV *av, register HE *entry)
c750a3ec 925{
57079c46 926 SV *sv = hv_iterval(avhv_keys(av), entry);
927 return *av_fetch(av, avhv_index_sv(sv), TRUE);
c750a3ec 928}