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