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