/[[:alpha]/ now dies on unmatched [] instead of
[p5sagit/p5-mst-13.2.git] / av.c
CommitLineData
a0d0e21e 1/* av.c
79072805 2 *
cb50131a 3 * Copyright (c) 1991-2000, 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
0453d815 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 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 42 key = AvARRAY(av) - AvALLOC(av);
43 while (key)
3280af22 44 AvALLOC(av)[--key] = &PL_sv_undef;
62b1ebc2 45 AvREIFY_off(av);
a0d0e21e 46 AvREAL_on(av);
47}
48
cb50131a 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;
33c27489 63 if (mg = SvTIED_mg((SV*)av, 'P')) {
93965878 64 dSP;
65 ENTER;
66 SAVETMPS;
e788e7d3 67 PUSHSTACKi(PERLSI_MAGIC);
924508f0 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 75 FREETMPS;
76 LEAVE;
77 return;
78 }
a0d0e21e 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 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 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 103 MEM_SIZE bytes;
104 IV itmp;
c07a80fd 105#endif
4633a7c4 106
f5a32c7f 107#if defined(MYMALLOC) && !defined(LEAKTEST)
8d6dde3e 108 newmax = malloced_size((void*)AvALLOC(av))/sizeof(SV*) - 1;
109
110 if (key <= newmax)
111 goto resized;
112#endif
a0d0e21e 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 117#else
118 bytes = (newmax + 1) * sizeof(SV*);
119#define MALLOC_OVERHEAD 16
c1f7b11a 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 128 New(2,ary, newmax+1, SV*);
129 Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*);
fba3b22e 130 if (AvMAX(av) > 64)
131 offer_nice_chunk(AvALLOC(av), (AvMAX(av)+1) * sizeof(SV*));
4633a7c4 132 else
133 Safefree(AvALLOC(av));
134 AvALLOC(av) = ary;
135#endif
8d6dde3e 136 resized:
a0d0e21e 137 ary = AvALLOC(av) + AvMAX(av) + 1;
138 tmp = newmax - AvMAX(av);
3280af22 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 143 }
144 }
145 else {
8d6dde3e 146 newmax = key < 3 ? 3 : key;
a0d0e21e 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 151 }
152 if (AvREAL(av)) {
153 while (tmp)
3280af22 154 ary[--tmp] = &PL_sv_undef;
a0d0e21e 155 }
156
157 SvPVX(av) = (char*)AvALLOC(av);
158 AvMAX(av) = newmax;
159 }
160 }
161}
162
cb50131a 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 178{
179 SV *sv;
180
a0d0e21e 181 if (!av)
182 return 0;
183
93965878 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 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;
93965878 244 U32 fill;
245
79072805 246
a0d0e21e 247 if (!av)
248 return 0;
43fcc5d2 249 if (!val)
3280af22 250 val = &PL_sv_undef;
463ee0b2 251
a0d0e21e 252 if (key < 0) {
253 key += AvFILL(av) + 1;
254 if (key < 0)
255 return 0;
79072805 256 }
93965878 257
43fcc5d2 258 if (SvREADONLY(av) && key >= AvFILL(av))
cea2e8a9 259 Perl_croak(aTHX_ PL_no_modify);
93965878 260
261 if (SvRMAGICAL(av)) {
262 if (mg_find((SV*)av,'P')) {
3280af22 263 if (val != &PL_sv_undef) {
93965878 264 mg_copy((SV*)av, val, 0, key);
265 }
266 return 0;
267 }
268 }
269
49beac48 270 if (!AvREAL(av) && AvREIFY(av))
a0d0e21e 271 av_reify(av);
a0d0e21e 272 if (key > AvMAX(av))
273 av_extend(av,key);
463ee0b2 274 ary = AvARRAY(av);
93965878 275 if (AvFILLp(av) < key) {
a0d0e21e 276 if (!AvREAL(av)) {
11343788 277 dTHR;
3280af22 278 if (av == PL_curstack && key > PL_stack_sp - PL_stack_base)
279 PL_stack_sp = PL_stack_base + key; /* XPUSH in disguise */
a0d0e21e 280 do
3280af22 281 ary[++AvFILLp(av)] = &PL_sv_undef;
93965878 282 while (AvFILLp(av) < key);
79072805 283 }
93965878 284 AvFILLp(av) = key;
79072805 285 }
a0d0e21e 286 else if (AvREAL(av))
287 SvREFCNT_dec(ary[key]);
79072805 288 ary[key] = val;
8990e307 289 if (SvSMAGICAL(av)) {
3280af22 290 if (val != &PL_sv_undef) {
a0d0e21e 291 MAGIC* mg = SvMAGIC(av);
292 sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key);
293 }
463ee0b2 294 mg_set((SV*)av);
295 }
79072805 296 return &ary[key];
297}
298
cb50131a 299/*
300=for apidoc newAV
301
302Creates a new AV. The reference count is set to 1.
303
304=cut
305*/
306
79072805 307AV *
864dbfa3 308Perl_newAV(pTHX)
79072805 309{
463ee0b2 310 register AV *av;
79072805 311
a0d0e21e 312 av = (AV*)NEWSV(3,0);
313 sv_upgrade((SV *)av, SVt_PVAV);
463ee0b2 314 AvREAL_on(av);
315 AvALLOC(av) = 0;
316 SvPVX(av) = 0;
93965878 317 AvMAX(av) = AvFILLp(av) = -1;
463ee0b2 318 return av;
79072805 319}
320
cb50131a 321/*
322=for apidoc av_make
323
324Creates a new AV and populates it with a list of SVs. The SVs are copied
325into the array, so they may be freed after the call to av_make. The new AV
326will have a reference count of 1.
327
328=cut
329*/
330
79072805 331AV *
864dbfa3 332Perl_av_make(pTHX_ register I32 size, register SV **strp)
79072805 333{
463ee0b2 334 register AV *av;
79072805 335 register I32 i;
336 register SV** ary;
337
a0d0e21e 338 av = (AV*)NEWSV(8,0);
339 sv_upgrade((SV *) av,SVt_PVAV);
a0d0e21e 340 AvFLAGS(av) = AVf_REAL;
573fa4ea 341 if (size) { /* `defined' was returning undef for size==0 anyway. */
342 New(4,ary,size,SV*);
343 AvALLOC(av) = ary;
344 SvPVX(av) = (char*)ary;
93965878 345 AvFILLp(av) = size - 1;
573fa4ea 346 AvMAX(av) = size - 1;
347 for (i = 0; i < size; i++) {
348 assert (*strp);
349 ary[i] = NEWSV(7,0);
350 sv_setsv(ary[i], *strp);
351 strp++;
352 }
79072805 353 }
463ee0b2 354 return av;
79072805 355}
356
357AV *
864dbfa3 358Perl_av_fake(pTHX_ register I32 size, register SV **strp)
79072805 359{
463ee0b2 360 register AV *av;
79072805 361 register SV** ary;
362
a0d0e21e 363 av = (AV*)NEWSV(9,0);
364 sv_upgrade((SV *)av, SVt_PVAV);
79072805 365 New(4,ary,size+1,SV*);
463ee0b2 366 AvALLOC(av) = ary;
79072805 367 Copy(strp,ary,size,SV*);
a0d0e21e 368 AvFLAGS(av) = AVf_REIFY;
463ee0b2 369 SvPVX(av) = (char*)ary;
93965878 370 AvFILLp(av) = size - 1;
463ee0b2 371 AvMAX(av) = size - 1;
79072805 372 while (size--) {
a0d0e21e 373 assert (*strp);
374 SvTEMP_off(*strp);
79072805 375 strp++;
376 }
463ee0b2 377 return av;
79072805 378}
379
cb50131a 380/*
381=for apidoc av_clear
382
383Clears an array, making it empty. Does not free the memory used by the
384array itself.
385
386=cut
387*/
388
79072805 389void
864dbfa3 390Perl_av_clear(pTHX_ register AV *av)
79072805 391{
392 register I32 key;
a0d0e21e 393 SV** ary;
79072805 394
7d55f622 395#ifdef DEBUGGING
32da55ab 396 if (SvREFCNT(av) == 0 && ckWARN_d(WARN_DEBUGGING)) {
0453d815 397 Perl_warner(aTHX_ WARN_DEBUGGING, "Attempt to clear deleted array");
7d55f622 398 }
399#endif
a60c0954 400 if (!av)
79072805 401 return;
402 /*SUPPRESS 560*/
a0d0e21e 403
39caa665 404 if (SvREADONLY(av))
cea2e8a9 405 Perl_croak(aTHX_ PL_no_modify);
39caa665 406
93965878 407 /* Give any tie a chance to cleanup first */
408 if (SvRMAGICAL(av))
409 mg_clear((SV*)av);
410
a60c0954 411 if (AvMAX(av) < 0)
412 return;
413
a0d0e21e 414 if (AvREAL(av)) {
415 ary = AvARRAY(av);
93965878 416 key = AvFILLp(av) + 1;
a0d0e21e 417 while (key) {
418 SvREFCNT_dec(ary[--key]);
3280af22 419 ary[key] = &PL_sv_undef;
a0d0e21e 420 }
421 }
463ee0b2 422 if (key = AvARRAY(av) - AvALLOC(av)) {
423 AvMAX(av) += key;
a0d0e21e 424 SvPVX(av) = (char*)AvALLOC(av);
79072805 425 }
93965878 426 AvFILLp(av) = -1;
fb73857a 427
79072805 428}
429
cb50131a 430/*
431=for apidoc av_undef
432
433Undefines the array. Frees the memory used by the array itself.
434
435=cut
436*/
437
79072805 438void
864dbfa3 439Perl_av_undef(pTHX_ register AV *av)
79072805 440{
441 register I32 key;
442
463ee0b2 443 if (!av)
79072805 444 return;
445 /*SUPPRESS 560*/
93965878 446
447 /* Give any tie a chance to cleanup first */
33c27489 448 if (SvTIED_mg((SV*)av, 'P'))
93965878 449 av_fill(av, -1); /* mg_clear() ? */
450
a0d0e21e 451 if (AvREAL(av)) {
93965878 452 key = AvFILLp(av) + 1;
a0d0e21e 453 while (key)
454 SvREFCNT_dec(AvARRAY(av)[--key]);
455 }
463ee0b2 456 Safefree(AvALLOC(av));
457 AvALLOC(av) = 0;
458 SvPVX(av) = 0;
93965878 459 AvMAX(av) = AvFILLp(av) = -1;
748a9306 460 if (AvARYLEN(av)) {
461 SvREFCNT_dec(AvARYLEN(av));
462 AvARYLEN(av) = 0;
463 }
79072805 464}
465
cb50131a 466/*
467=for apidoc av_push
468
469Pushes an SV onto the end of the array. The array will grow automatically
470to accommodate the addition.
471
472=cut
473*/
474
a0d0e21e 475void
864dbfa3 476Perl_av_push(pTHX_ register AV *av, SV *val)
93965878 477{
478 MAGIC *mg;
a0d0e21e 479 if (!av)
480 return;
93965878 481 if (SvREADONLY(av))
cea2e8a9 482 Perl_croak(aTHX_ PL_no_modify);
93965878 483
33c27489 484 if (mg = SvTIED_mg((SV*)av, 'P')) {
93965878 485 dSP;
e788e7d3 486 PUSHSTACKi(PERLSI_MAGIC);
924508f0 487 PUSHMARK(SP);
488 EXTEND(SP,2);
33c27489 489 PUSHs(SvTIED_obj((SV*)av, mg));
93965878 490 PUSHs(val);
a60c0954 491 PUTBACK;
492 ENTER;
864dbfa3 493 call_method("PUSH", G_SCALAR|G_DISCARD);
a60c0954 494 LEAVE;
d3acc0f7 495 POPSTACK;
93965878 496 return;
497 }
498 av_store(av,AvFILLp(av)+1,val);
79072805 499}
500
cb50131a 501/*
502=for apidoc av_pop
503
504Pops an SV off the end of the array. Returns C<&PL_sv_undef> if the array
505is empty.
506
507=cut
508*/
509
79072805 510SV *
864dbfa3 511Perl_av_pop(pTHX_ register AV *av)
79072805 512{
513 SV *retval;
93965878 514 MAGIC* mg;
79072805 515
a0d0e21e 516 if (!av || AvFILL(av) < 0)
3280af22 517 return &PL_sv_undef;
43fcc5d2 518 if (SvREADONLY(av))
cea2e8a9 519 Perl_croak(aTHX_ PL_no_modify);
33c27489 520 if (mg = SvTIED_mg((SV*)av, 'P')) {
93965878 521 dSP;
e788e7d3 522 PUSHSTACKi(PERLSI_MAGIC);
924508f0 523 PUSHMARK(SP);
33c27489 524 XPUSHs(SvTIED_obj((SV*)av, mg));
a60c0954 525 PUTBACK;
526 ENTER;
864dbfa3 527 if (call_method("POP", G_SCALAR)) {
3280af22 528 retval = newSVsv(*PL_stack_sp--);
93965878 529 } else {
3280af22 530 retval = &PL_sv_undef;
93965878 531 }
a60c0954 532 LEAVE;
d3acc0f7 533 POPSTACK;
93965878 534 return retval;
535 }
536 retval = AvARRAY(av)[AvFILLp(av)];
3280af22 537 AvARRAY(av)[AvFILLp(av)--] = &PL_sv_undef;
8990e307 538 if (SvSMAGICAL(av))
463ee0b2 539 mg_set((SV*)av);
79072805 540 return retval;
541}
542
cb50131a 543/*
544=for apidoc av_unshift
545
546Unshift the given number of C<undef> values onto the beginning of the
547array. The array will grow automatically to accommodate the addition. You
548must then use C<av_store> to assign values to these new elements.
549
550=cut
551*/
552
79072805 553void
864dbfa3 554Perl_av_unshift(pTHX_ register AV *av, register I32 num)
79072805 555{
556 register I32 i;
67a38de0 557 register SV **ary;
93965878 558 MAGIC* mg;
79072805 559
a0d0e21e 560 if (!av || num <= 0)
79072805 561 return;
43fcc5d2 562 if (SvREADONLY(av))
cea2e8a9 563 Perl_croak(aTHX_ PL_no_modify);
93965878 564
33c27489 565 if (mg = SvTIED_mg((SV*)av, 'P')) {
93965878 566 dSP;
e788e7d3 567 PUSHSTACKi(PERLSI_MAGIC);
924508f0 568 PUSHMARK(SP);
569 EXTEND(SP,1+num);
33c27489 570 PUSHs(SvTIED_obj((SV*)av, mg));
93965878 571 while (num-- > 0) {
3280af22 572 PUSHs(&PL_sv_undef);
93965878 573 }
574 PUTBACK;
a60c0954 575 ENTER;
864dbfa3 576 call_method("UNSHIFT", G_SCALAR|G_DISCARD);
a60c0954 577 LEAVE;
d3acc0f7 578 POPSTACK;
93965878 579 return;
580 }
581
49beac48 582 if (!AvREAL(av) && AvREIFY(av))
583 av_reify(av);
a0d0e21e 584 i = AvARRAY(av) - AvALLOC(av);
585 if (i) {
586 if (i > num)
587 i = num;
588 num -= i;
589
590 AvMAX(av) += i;
93965878 591 AvFILLp(av) += i;
a0d0e21e 592 SvPVX(av) = (char*)(AvARRAY(av) - i);
593 }
d2719217 594 if (num) {
67a38de0 595 i = AvFILLp(av);
596 av_extend(av, i + num);
93965878 597 AvFILLp(av) += num;
67a38de0 598 ary = AvARRAY(av);
599 Move(ary, ary + num, i + 1, SV*);
600 do {
3280af22 601 ary[--num] = &PL_sv_undef;
67a38de0 602 } while (num);
79072805 603 }
604}
605
cb50131a 606/*
607=for apidoc av_shift
608
609Shifts an SV off the beginning of the array.
610
611=cut
612*/
613
79072805 614SV *
864dbfa3 615Perl_av_shift(pTHX_ register AV *av)
79072805 616{
617 SV *retval;
93965878 618 MAGIC* mg;
79072805 619
a0d0e21e 620 if (!av || AvFILL(av) < 0)
3280af22 621 return &PL_sv_undef;
43fcc5d2 622 if (SvREADONLY(av))
cea2e8a9 623 Perl_croak(aTHX_ PL_no_modify);
33c27489 624 if (mg = SvTIED_mg((SV*)av, 'P')) {
93965878 625 dSP;
e788e7d3 626 PUSHSTACKi(PERLSI_MAGIC);
924508f0 627 PUSHMARK(SP);
33c27489 628 XPUSHs(SvTIED_obj((SV*)av, mg));
a60c0954 629 PUTBACK;
630 ENTER;
864dbfa3 631 if (call_method("SHIFT", G_SCALAR)) {
3280af22 632 retval = newSVsv(*PL_stack_sp--);
93965878 633 } else {
3280af22 634 retval = &PL_sv_undef;
a60c0954 635 }
636 LEAVE;
d3acc0f7 637 POPSTACK;
93965878 638 return retval;
639 }
463ee0b2 640 retval = *AvARRAY(av);
a0d0e21e 641 if (AvREAL(av))
3280af22 642 *AvARRAY(av) = &PL_sv_undef;
463ee0b2 643 SvPVX(av) = (char*)(AvARRAY(av) + 1);
644 AvMAX(av)--;
93965878 645 AvFILLp(av)--;
8990e307 646 if (SvSMAGICAL(av))
463ee0b2 647 mg_set((SV*)av);
79072805 648 return retval;
649}
650
cb50131a 651/*
652=for apidoc av_len
653
654Returns the highest index in the array. Returns -1 if the array is
655empty.
656
657=cut
658*/
659
79072805 660I32
864dbfa3 661Perl_av_len(pTHX_ register AV *av)
79072805 662{
463ee0b2 663 return AvFILL(av);
79072805 664}
665
666void
864dbfa3 667Perl_av_fill(pTHX_ register AV *av, I32 fill)
79072805 668{
93965878 669 MAGIC *mg;
a0d0e21e 670 if (!av)
cea2e8a9 671 Perl_croak(aTHX_ "panic: null array");
79072805 672 if (fill < 0)
673 fill = -1;
33c27489 674 if (mg = SvTIED_mg((SV*)av, 'P')) {
93965878 675 dSP;
676 ENTER;
677 SAVETMPS;
e788e7d3 678 PUSHSTACKi(PERLSI_MAGIC);
924508f0 679 PUSHMARK(SP);
680 EXTEND(SP,2);
33c27489 681 PUSHs(SvTIED_obj((SV*)av, mg));
a60c0954 682 PUSHs(sv_2mortal(newSViv(fill+1)));
93965878 683 PUTBACK;
864dbfa3 684 call_method("STORESIZE", G_SCALAR|G_DISCARD);
d3acc0f7 685 POPSTACK;
93965878 686 FREETMPS;
687 LEAVE;
688 return;
689 }
463ee0b2 690 if (fill <= AvMAX(av)) {
93965878 691 I32 key = AvFILLp(av);
a0d0e21e 692 SV** ary = AvARRAY(av);
693
694 if (AvREAL(av)) {
695 while (key > fill) {
696 SvREFCNT_dec(ary[key]);
3280af22 697 ary[key--] = &PL_sv_undef;
a0d0e21e 698 }
699 }
700 else {
701 while (key < fill)
3280af22 702 ary[++key] = &PL_sv_undef;
a0d0e21e 703 }
704
93965878 705 AvFILLp(av) = fill;
8990e307 706 if (SvSMAGICAL(av))
463ee0b2 707 mg_set((SV*)av);
708 }
a0d0e21e 709 else
3280af22 710 (void)av_store(av,fill,&PL_sv_undef);
79072805 711}
c750a3ec 712
146174a9 713SV *
714Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
715{
716 SV *sv;
717
718 if (!av)
719 return Nullsv;
720 if (SvREADONLY(av))
721 Perl_croak(aTHX_ PL_no_modify);
722 if (key < 0) {
723 key += AvFILL(av) + 1;
724 if (key < 0)
725 return Nullsv;
726 }
727 if (SvRMAGICAL(av)) {
728 SV **svp;
729 if ((mg_find((SV*)av,'P') || mg_find((SV*)av,'D'))
730 && (svp = av_fetch(av, key, TRUE)))
731 {
732 sv = *svp;
733 mg_clear(sv);
734 if (mg_find(sv, 'p')) {
735 sv_unmagic(sv, 'p'); /* No longer an element */
736 return sv;
737 }
738 return Nullsv; /* element cannot be deleted */
739 }
740 }
741 if (key > AvFILLp(av))
742 return Nullsv;
743 else {
744 sv = AvARRAY(av)[key];
745 if (key == AvFILLp(av)) {
746 do {
747 AvFILLp(av)--;
748 } while (--key >= 0 && AvARRAY(av)[key] == &PL_sv_undef);
749 }
750 else
751 AvARRAY(av)[key] = &PL_sv_undef;
752 if (SvSMAGICAL(av))
753 mg_set((SV*)av);
754 }
755 if (flags & G_DISCARD) {
756 SvREFCNT_dec(sv);
757 sv = Nullsv;
758 }
759 return sv;
760}
761
762/*
763 * This relies on the fact that uninitialized array elements
764 * are set to &PL_sv_undef.
765 */
766
767bool
768Perl_av_exists(pTHX_ AV *av, I32 key)
769{
770 if (!av)
771 return FALSE;
772 if (key < 0) {
773 key += AvFILL(av) + 1;
774 if (key < 0)
775 return FALSE;
776 }
777 if (SvRMAGICAL(av)) {
778 if (mg_find((SV*)av,'P') || mg_find((SV*)av,'D')) {
779 SV *sv = sv_newmortal();
780 mg_copy((SV*)av, sv, 0, key);
781 magic_existspack(sv, mg_find(sv, 'p'));
782 return SvTRUE(sv);
783 }
784 }
785 if (key <= AvFILLp(av) && AvARRAY(av)[key] != &PL_sv_undef
786 && AvARRAY(av)[key])
787 {
788 return TRUE;
789 }
790 else
791 return FALSE;
792}
57079c46 793
794/* AVHV: Support for treating arrays as if they were hashes. The
795 * first element of the array should be a hash reference that maps
796 * hash keys to array indices.
797 */
798
72311751 799STATIC I32
cea2e8a9 800S_avhv_index_sv(pTHX_ SV* sv)
57079c46 801{
802 I32 index = SvIV(sv);
803 if (index < 1)
cea2e8a9 804 Perl_croak(aTHX_ "Bad index while coercing array into hash");
57079c46 805 return index;
806}
807
5d5aaa5e 808HV*
864dbfa3 809Perl_avhv_keys(pTHX_ AV *av)
5d5aaa5e 810{
57079c46 811 SV **keysp = av_fetch(av, 0, FALSE);
5d5aaa5e 812 if (keysp) {
d627ae4e 813 SV *sv = *keysp;
814 if (SvGMAGICAL(sv))
815 mg_get(sv);
816 if (SvROK(sv)) {
817 sv = SvRV(sv);
818 if (SvTYPE(sv) == SVt_PVHV)
57079c46 819 return (HV*)sv;
5d5aaa5e 820 }
821 }
cea2e8a9 822 Perl_croak(aTHX_ "Can't coerce array into hash");
72311751 823 return Nullhv;
c750a3ec 824}
825
826SV**
864dbfa3 827Perl_avhv_fetch_ent(pTHX_ AV *av, SV *keysv, I32 lval, U32 hash)
97fcbf96 828{
5d5aaa5e 829 SV **indsvp;
830 HV *keys = avhv_keys(av);
97fcbf96 831 HE *he;
146174a9 832 STRLEN n_a;
833
5d5aaa5e 834 he = hv_fetch_ent(keys, keysv, FALSE, hash);
57079c46 835 if (!he)
146174a9 836 Perl_croak(aTHX_ "No such pseudo-hash field \"%s\"", SvPV(keysv,n_a));
57079c46 837 return av_fetch(av, avhv_index_sv(HeVAL(he)), lval);
5bc6513d 838}
839
146174a9 840SV *
841Perl_avhv_delete_ent(pTHX_ AV *av, SV *keysv, I32 flags, U32 hash)
842{
843 HV *keys = avhv_keys(av);
844 HE *he;
845
846 he = hv_fetch_ent(keys, keysv, FALSE, hash);
847 if (!he || !SvOK(HeVAL(he)))
848 return Nullsv;
849
850 return av_delete(av, avhv_index_sv(HeVAL(he)), flags);
851}
852
853/* Check for the existence of an element named by a given key.
854 *
855 */
c750a3ec 856bool
864dbfa3 857Perl_avhv_exists_ent(pTHX_ AV *av, SV *keysv, U32 hash)
97fcbf96 858{
5d5aaa5e 859 HV *keys = avhv_keys(av);
146174a9 860 HE *he;
861
862 he = hv_fetch_ent(keys, keysv, FALSE, hash);
863 if (!he || !SvOK(HeVAL(he)))
864 return FALSE;
865
866 return av_exists(av, avhv_index_sv(HeVAL(he)));
97fcbf96 867}
868
c750a3ec 869HE *
864dbfa3 870Perl_avhv_iternext(pTHX_ AV *av)
c750a3ec 871{
5d5aaa5e 872 HV *keys = avhv_keys(av);
873 return hv_iternext(keys);
c750a3ec 874}
875
876SV *
864dbfa3 877Perl_avhv_iterval(pTHX_ AV *av, register HE *entry)
c750a3ec 878{
57079c46 879 SV *sv = hv_iterval(avhv_keys(av), entry);
880 return *av_fetch(av, avhv_index_sv(sv), TRUE);
c750a3ec 881}