(?p{}) has been deprecated for a long time.
[p5sagit/p5-mst-13.2.git] / av.c
CommitLineData
a0d0e21e 1/* av.c
79072805 2 *
4bb101f2 3 * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
54ca4ee7 4 * 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
79072805 5 *
6 * You may distribute under the terms of either the GNU General Public
7 * License or the Artistic License, as specified in the README file.
8 *
a0d0e21e 9 */
10
11/*
12 * "...for the Entwives desired order, and plenty, and peace (by which they
13 * meant that things should remain where they had set them)." --Treebeard
79072805 14 */
15
ccfc67b7 16/*
17=head1 Array Manipulation Functions
18*/
19
79072805 20#include "EXTERN.h"
864dbfa3 21#define PERL_IN_AV_C
79072805 22#include "perl.h"
23
fb73857a 24void
864dbfa3 25Perl_av_reify(pTHX_ AV *av)
a0d0e21e 26{
97aff369 27 dVAR;
a0d0e21e 28 I32 key;
fb73857a 29
ba5d1d60 30 assert(av);
31
3c78fafa 32 if (AvREAL(av))
33 return;
93965878 34#ifdef DEBUGGING
14befaf4 35 if (SvTIED_mg((SV*)av, PERL_MAGIC_tied) && ckWARN_d(WARN_DEBUGGING))
9014280d 36 Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "av_reify called on tied array");
93965878 37#endif
a0d0e21e 38 key = AvMAX(av) + 1;
93965878 39 while (key > AvFILLp(av) + 1)
3280af22 40 AvARRAY(av)[--key] = &PL_sv_undef;
a0d0e21e 41 while (key) {
4373e329 42 SV * const sv = AvARRAY(av)[--key];
a0d0e21e 43 assert(sv);
411caa50 44 if (sv != &PL_sv_undef)
e2d306cb 45 SvREFCNT_inc_simple_void_NN(sv);
a0d0e21e 46 }
29de640a 47 key = AvARRAY(av) - AvALLOC(av);
48 while (key)
3280af22 49 AvALLOC(av)[--key] = &PL_sv_undef;
62b1ebc2 50 AvREIFY_off(av);
a0d0e21e 51 AvREAL_on(av);
52}
53
cb50131a 54/*
55=for apidoc av_extend
56
57Pre-extend an array. The C<key> is the index to which the array should be
58extended.
59
60=cut
61*/
62
a0d0e21e 63void
864dbfa3 64Perl_av_extend(pTHX_ AV *av, I32 key)
a0d0e21e 65{
97aff369 66 dVAR;
7a5b473e 67 MAGIC *mg;
68
ba5d1d60 69 assert(av);
70
7a5b473e 71 mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied);
823a54a3 72 if (mg) {
93965878 73 dSP;
74 ENTER;
75 SAVETMPS;
e788e7d3 76 PUSHSTACKi(PERLSI_MAGIC);
924508f0 77 PUSHMARK(SP);
78 EXTEND(SP,2);
33c27489 79 PUSHs(SvTIED_obj((SV*)av, mg));
a60c0954 80 PUSHs(sv_2mortal(newSViv(key+1)));
93965878 81 PUTBACK;
864dbfa3 82 call_method("EXTEND", G_SCALAR|G_DISCARD);
d3acc0f7 83 POPSTACK;
93965878 84 FREETMPS;
85 LEAVE;
86 return;
87 }
a0d0e21e 88 if (key > AvMAX(av)) {
89 SV** ary;
90 I32 tmp;
91 I32 newmax;
92
93 if (AvALLOC(av) != AvARRAY(av)) {
93965878 94 ary = AvALLOC(av) + AvFILLp(av) + 1;
a0d0e21e 95 tmp = AvARRAY(av) - AvALLOC(av);
93965878 96 Move(AvARRAY(av), AvALLOC(av), AvFILLp(av)+1, SV*);
a0d0e21e 97 AvMAX(av) += tmp;
9c6bc640 98 AvARRAY(av) = AvALLOC(av);
a0d0e21e 99 if (AvREAL(av)) {
100 while (tmp)
3280af22 101 ary[--tmp] = &PL_sv_undef;
a0d0e21e 102 }
a0d0e21e 103 if (key > AvMAX(av) - 10) {
104 newmax = key + AvMAX(av);
105 goto resize;
106 }
107 }
108 else {
2b573ace 109#ifdef PERL_MALLOC_WRAP
110 static const char oom_array_extend[] =
111 "Out of memory during array extend"; /* Duplicated in pp_hot.c */
112#endif
113
a0d0e21e 114 if (AvALLOC(av)) {
516a5887 115#if !defined(STRANGE_MALLOC) && !defined(MYMALLOC)
c1f7b11a 116 MEM_SIZE bytes;
117 IV itmp;
c07a80fd 118#endif
4633a7c4 119
7bab3ede 120#ifdef MYMALLOC
8d6dde3e 121 newmax = malloced_size((void*)AvALLOC(av))/sizeof(SV*) - 1;
122
123 if (key <= newmax)
124 goto resized;
125#endif
a0d0e21e 126 newmax = key + AvMAX(av) / 5;
127 resize:
2b573ace 128 MEM_WRAP_CHECK_1(newmax+1, SV*, oom_array_extend);
8d6dde3e 129#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
a0d0e21e 130 Renew(AvALLOC(av),newmax+1, SV*);
4633a7c4 131#else
132 bytes = (newmax + 1) * sizeof(SV*);
133#define MALLOC_OVERHEAD 16
c1f7b11a 134 itmp = MALLOC_OVERHEAD;
eb160463 135 while ((MEM_SIZE)(itmp - MALLOC_OVERHEAD) < bytes)
c1f7b11a 136 itmp += itmp;
137 itmp -= MALLOC_OVERHEAD;
138 itmp /= sizeof(SV*);
139 assert(itmp > newmax);
140 newmax = itmp - 1;
141 assert(newmax >= AvMAX(av));
a02a5408 142 Newx(ary, newmax+1, SV*);
4633a7c4 143 Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*);
fba3b22e 144 if (AvMAX(av) > 64)
145 offer_nice_chunk(AvALLOC(av), (AvMAX(av)+1) * sizeof(SV*));
4633a7c4 146 else
147 Safefree(AvALLOC(av));
148 AvALLOC(av) = ary;
149#endif
7bab3ede 150#ifdef MYMALLOC
8d6dde3e 151 resized:
9c5ffd7c 152#endif
a0d0e21e 153 ary = AvALLOC(av) + AvMAX(av) + 1;
154 tmp = newmax - AvMAX(av);
3280af22 155 if (av == PL_curstack) { /* Oops, grew stack (via av_store()?) */
156 PL_stack_sp = AvALLOC(av) + (PL_stack_sp - PL_stack_base);
157 PL_stack_base = AvALLOC(av);
158 PL_stack_max = PL_stack_base + newmax;
a0d0e21e 159 }
160 }
161 else {
8d6dde3e 162 newmax = key < 3 ? 3 : key;
2b573ace 163 MEM_WRAP_CHECK_1(newmax+1, SV*, oom_array_extend);
a02a5408 164 Newx(AvALLOC(av), newmax+1, SV*);
a0d0e21e 165 ary = AvALLOC(av) + 1;
166 tmp = newmax;
3280af22 167 AvALLOC(av)[0] = &PL_sv_undef; /* For the stacks */
a0d0e21e 168 }
169 if (AvREAL(av)) {
170 while (tmp)
3280af22 171 ary[--tmp] = &PL_sv_undef;
a0d0e21e 172 }
173
9c6bc640 174 AvARRAY(av) = AvALLOC(av);
a0d0e21e 175 AvMAX(av) = newmax;
176 }
177 }
178}
179
cb50131a 180/*
181=for apidoc av_fetch
182
183Returns the SV at the specified index in the array. The C<key> is the
184index. If C<lval> is set then the fetch will be part of a store. Check
185that the return value is non-null before dereferencing it to a C<SV*>.
186
187See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
188more information on how to use this function on tied arrays.
189
190=cut
191*/
192
79072805 193SV**
864dbfa3 194Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval)
79072805 195{
97aff369 196 dVAR;
79072805 197
ba5d1d60 198 assert(av);
a0d0e21e 199
6f12eb6d 200 if (SvRMAGICAL(av)) {
35a4481c 201 const MAGIC * const tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
6f12eb6d 202 if (tied_magic || mg_find((SV*)av, PERL_MAGIC_regdata)) {
e2d306cb 203 SV *sv;
204 if (key < 0) {
205 I32 adjust_index = 1;
206 if (tied_magic) {
207 /* Handle negative array indices 20020222 MJD */
208 SV * const * const negative_indices_glob =
209 hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av, tied_magic))),
210 NEGATIVE_INDICES_VAR, 16, 0);
211
212 if (negative_indices_glob && SvTRUE(GvSV(*negative_indices_glob)))
213 adjust_index = 0;
214 }
6f12eb6d 215
e2d306cb 216 if (adjust_index) {
217 key += AvFILL(av) + 1;
218 if (key < 0)
219 return NULL;
220 }
221 }
6f12eb6d 222
223 sv = sv_newmortal();
dd28f7bb 224 sv_upgrade(sv, SVt_PVLV);
225 mg_copy((SV*)av, sv, 0, key);
226 LvTYPE(sv) = 't';
227 LvTARG(sv) = sv; /* fake (SV**) */
228 return &(LvTARG(sv));
6f12eb6d 229 }
230 }
231
93965878 232 if (key < 0) {
233 key += AvFILL(av) + 1;
234 if (key < 0)
e2d306cb 235 return NULL;
93965878 236 }
237
93965878 238 if (key > AvFILLp(av)) {
a0d0e21e 239 if (!lval)
e2d306cb 240 return NULL;
241 return av_store(av,key,newSV(0));
79072805 242 }
3280af22 243 if (AvARRAY(av)[key] == &PL_sv_undef) {
4dbf4341 244 emptyness:
e2d306cb 245 if (lval)
246 return av_store(av,key,newSV(0));
247 return NULL;
79072805 248 }
4dbf4341 249 else if (AvREIFY(av)
250 && (!AvARRAY(av)[key] /* eg. @_ could have freed elts */
0565a181 251 || SvIS_FREED(AvARRAY(av)[key]))) {
3280af22 252 AvARRAY(av)[key] = &PL_sv_undef; /* 1/2 reify */
4dbf4341 253 goto emptyness;
254 }
463ee0b2 255 return &AvARRAY(av)[key];
79072805 256}
257
cb50131a 258/*
259=for apidoc av_store
260
261Stores an SV in an array. The array index is specified as C<key>. The
262return value will be NULL if the operation failed or if the value did not
263need to be actually stored within the array (as in the case of tied
264arrays). Otherwise it can be dereferenced to get the original C<SV*>. Note
265that the caller is responsible for suitably incrementing the reference
266count of C<val> before the call, and decrementing it if the function
267returned NULL.
268
269See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
270more information on how to use this function on tied arrays.
271
272=cut
273*/
274
79072805 275SV**
864dbfa3 276Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
79072805 277{
97aff369 278 dVAR;
79072805 279 SV** ary;
280
ba5d1d60 281 assert(av);
282
725ac12f 283 /* S_regclass relies on being able to pass in a NULL sv
284 (unicode_alternate may be NULL).
285 */
286
43fcc5d2 287 if (!val)
3280af22 288 val = &PL_sv_undef;
463ee0b2 289
6f12eb6d 290 if (SvRMAGICAL(av)) {
35a4481c 291 const MAGIC * const tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
6f12eb6d 292 if (tied_magic) {
293 /* Handle negative array indices 20020222 MJD */
294 if (key < 0) {
e2d306cb 295 bool adjust_index = 1;
823a54a3 296 SV * const * const negative_indices_glob =
6f12eb6d 297 hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av,
298 tied_magic))),
299 NEGATIVE_INDICES_VAR, 16, 0);
300 if (negative_indices_glob
301 && SvTRUE(GvSV(*negative_indices_glob)))
302 adjust_index = 0;
303 if (adjust_index) {
304 key += AvFILL(av) + 1;
305 if (key < 0)
306 return 0;
307 }
308 }
309 if (val != &PL_sv_undef) {
310 mg_copy((SV*)av, val, 0, key);
311 }
e2d306cb 312 return NULL;
6f12eb6d 313 }
314 }
315
316
a0d0e21e 317 if (key < 0) {
318 key += AvFILL(av) + 1;
319 if (key < 0)
e2d306cb 320 return NULL;
79072805 321 }
93965878 322
43fcc5d2 323 if (SvREADONLY(av) && key >= AvFILL(av))
cea2e8a9 324 Perl_croak(aTHX_ PL_no_modify);
93965878 325
49beac48 326 if (!AvREAL(av) && AvREIFY(av))
a0d0e21e 327 av_reify(av);
a0d0e21e 328 if (key > AvMAX(av))
329 av_extend(av,key);
463ee0b2 330 ary = AvARRAY(av);
93965878 331 if (AvFILLp(av) < key) {
a0d0e21e 332 if (!AvREAL(av)) {
3280af22 333 if (av == PL_curstack && key > PL_stack_sp - PL_stack_base)
334 PL_stack_sp = PL_stack_base + key; /* XPUSH in disguise */
e2d306cb 335 do {
3280af22 336 ary[++AvFILLp(av)] = &PL_sv_undef;
e2d306cb 337 } while (AvFILLp(av) < key);
79072805 338 }
93965878 339 AvFILLp(av) = key;
79072805 340 }
a0d0e21e 341 else if (AvREAL(av))
342 SvREFCNT_dec(ary[key]);
79072805 343 ary[key] = val;
8990e307 344 if (SvSMAGICAL(av)) {
3280af22 345 if (val != &PL_sv_undef) {
fabdb6c0 346 const MAGIC* const mg = SvMAGIC(av);
a0d0e21e 347 sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key);
348 }
463ee0b2 349 mg_set((SV*)av);
350 }
79072805 351 return &ary[key];
352}
353
cb50131a 354/*
355=for apidoc newAV
356
357Creates a new AV. The reference count is set to 1.
358
359=cut
360*/
361
79072805 362AV *
864dbfa3 363Perl_newAV(pTHX)
79072805 364{
b9f83d2f 365 register AV * const av = (AV*)newSV_type(SVt_PVAV);
a7f5e44d 366 /* sv_upgrade does AvREAL_only() */
463ee0b2 367 AvALLOC(av) = 0;
9c6bc640 368 AvARRAY(av) = NULL;
93965878 369 AvMAX(av) = AvFILLp(av) = -1;
463ee0b2 370 return av;
79072805 371}
372
cb50131a 373/*
374=for apidoc av_make
375
376Creates a new AV and populates it with a list of SVs. The SVs are copied
377into the array, so they may be freed after the call to av_make. The new AV
378will have a reference count of 1.
379
380=cut
381*/
382
79072805 383AV *
864dbfa3 384Perl_av_make(pTHX_ register I32 size, register SV **strp)
79072805 385{
b9f83d2f 386 register AV * const av = (AV*)newSV_type(SVt_PVAV);
a7f5e44d 387 /* sv_upgrade does AvREAL_only() */
a0288114 388 if (size) { /* "defined" was returning undef for size==0 anyway. */
dd374669 389 register SV** ary;
390 register I32 i;
a02a5408 391 Newx(ary,size,SV*);
573fa4ea 392 AvALLOC(av) = ary;
9c6bc640 393 AvARRAY(av) = ary;
35da51f7 394 AvFILLp(av) = AvMAX(av) = size - 1;
573fa4ea 395 for (i = 0; i < size; i++) {
396 assert (*strp);
561b68a9 397 ary[i] = newSV(0);
573fa4ea 398 sv_setsv(ary[i], *strp);
399 strp++;
400 }
79072805 401 }
463ee0b2 402 return av;
79072805 403}
404
cb50131a 405/*
406=for apidoc av_clear
407
408Clears an array, making it empty. Does not free the memory used by the
409array itself.
410
411=cut
412*/
413
79072805 414void
864dbfa3 415Perl_av_clear(pTHX_ register AV *av)
79072805 416{
97aff369 417 dVAR;
e2d306cb 418 I32 extra;
79072805 419
ba5d1d60 420 assert(av);
7d55f622 421#ifdef DEBUGGING
32da55ab 422 if (SvREFCNT(av) == 0 && ckWARN_d(WARN_DEBUGGING)) {
9014280d 423 Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "Attempt to clear deleted array");
7d55f622 424 }
425#endif
a0d0e21e 426
39caa665 427 if (SvREADONLY(av))
cea2e8a9 428 Perl_croak(aTHX_ PL_no_modify);
39caa665 429
93965878 430 /* Give any tie a chance to cleanup first */
431 if (SvRMAGICAL(av))
432 mg_clear((SV*)av);
433
a60c0954 434 if (AvMAX(av) < 0)
435 return;
436
a0d0e21e 437 if (AvREAL(av)) {
823a54a3 438 SV** const ary = AvARRAY(av);
e2d306cb 439 I32 index = AvFILLp(av) + 1;
440 while (index) {
441 SV * const sv = ary[--index];
6b42d12b 442 /* undef the slot before freeing the value, because a
e2d306cb 443 * destructor might try to modify this array */
444 ary[index] = &PL_sv_undef;
6b42d12b 445 SvREFCNT_dec(sv);
a0d0e21e 446 }
447 }
e2d306cb 448 extra = AvARRAY(av) - AvALLOC(av);
449 if (extra) {
450 AvMAX(av) += extra;
9c6bc640 451 AvARRAY(av) = AvALLOC(av);
79072805 452 }
93965878 453 AvFILLp(av) = -1;
fb73857a 454
79072805 455}
456
cb50131a 457/*
458=for apidoc av_undef
459
460Undefines the array. Frees the memory used by the array itself.
461
462=cut
463*/
464
79072805 465void
864dbfa3 466Perl_av_undef(pTHX_ register AV *av)
79072805 467{
ba5d1d60 468 assert(av);
93965878 469
470 /* Give any tie a chance to cleanup first */
14befaf4 471 if (SvTIED_mg((SV*)av, PERL_MAGIC_tied))
93965878 472 av_fill(av, -1); /* mg_clear() ? */
473
a0d0e21e 474 if (AvREAL(av)) {
a3b680e6 475 register I32 key = AvFILLp(av) + 1;
a0d0e21e 476 while (key)
477 SvREFCNT_dec(AvARRAY(av)[--key]);
478 }
463ee0b2 479 Safefree(AvALLOC(av));
35da51f7 480 AvALLOC(av) = NULL;
9c6bc640 481 AvARRAY(av) = NULL;
93965878 482 AvMAX(av) = AvFILLp(av) = -1;
79072805 483}
484
cb50131a 485/*
29a861e7 486
487=for apidoc av_create_and_push
488
489Push an SV onto the end of the array, creating the array if necessary.
490A small internal helper function to remove a commonly duplicated idiom.
491
492=cut
493*/
494
495void
496Perl_av_create_and_push(pTHX_ AV **const avp, SV *const val)
497{
498 if (!*avp)
499 *avp = newAV();
500 av_push(*avp, val);
501}
502
503/*
cb50131a 504=for apidoc av_push
505
506Pushes an SV onto the end of the array. The array will grow automatically
507to accommodate the addition.
508
509=cut
510*/
511
a0d0e21e 512void
864dbfa3 513Perl_av_push(pTHX_ register AV *av, SV *val)
93965878 514{
27da23d5 515 dVAR;
93965878 516 MAGIC *mg;
ba5d1d60 517 assert(av);
518
93965878 519 if (SvREADONLY(av))
cea2e8a9 520 Perl_croak(aTHX_ PL_no_modify);
93965878 521
14befaf4 522 if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
93965878 523 dSP;
e788e7d3 524 PUSHSTACKi(PERLSI_MAGIC);
924508f0 525 PUSHMARK(SP);
526 EXTEND(SP,2);
33c27489 527 PUSHs(SvTIED_obj((SV*)av, mg));
93965878 528 PUSHs(val);
a60c0954 529 PUTBACK;
530 ENTER;
864dbfa3 531 call_method("PUSH", G_SCALAR|G_DISCARD);
a60c0954 532 LEAVE;
d3acc0f7 533 POPSTACK;
93965878 534 return;
535 }
536 av_store(av,AvFILLp(av)+1,val);
79072805 537}
538
cb50131a 539/*
540=for apidoc av_pop
541
542Pops an SV off the end of the array. Returns C<&PL_sv_undef> if the array
543is empty.
544
545=cut
546*/
547
79072805 548SV *
864dbfa3 549Perl_av_pop(pTHX_ register AV *av)
79072805 550{
27da23d5 551 dVAR;
79072805 552 SV *retval;
93965878 553 MAGIC* mg;
79072805 554
ba5d1d60 555 assert(av);
556
43fcc5d2 557 if (SvREADONLY(av))
cea2e8a9 558 Perl_croak(aTHX_ PL_no_modify);
14befaf4 559 if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
93965878 560 dSP;
e788e7d3 561 PUSHSTACKi(PERLSI_MAGIC);
924508f0 562 PUSHMARK(SP);
33c27489 563 XPUSHs(SvTIED_obj((SV*)av, mg));
a60c0954 564 PUTBACK;
565 ENTER;
864dbfa3 566 if (call_method("POP", G_SCALAR)) {
3280af22 567 retval = newSVsv(*PL_stack_sp--);
93965878 568 } else {
3280af22 569 retval = &PL_sv_undef;
93965878 570 }
a60c0954 571 LEAVE;
d3acc0f7 572 POPSTACK;
93965878 573 return retval;
574 }
d19c0e07 575 if (AvFILL(av) < 0)
576 return &PL_sv_undef;
93965878 577 retval = AvARRAY(av)[AvFILLp(av)];
3280af22 578 AvARRAY(av)[AvFILLp(av)--] = &PL_sv_undef;
8990e307 579 if (SvSMAGICAL(av))
463ee0b2 580 mg_set((SV*)av);
79072805 581 return retval;
582}
583
cb50131a 584/*
29a861e7 585
586=for apidoc av_create_and_unshift_one
587
588Unshifts an SV onto the beginning of the array, creating the array if
589necessary.
590A small internal helper function to remove a commonly duplicated idiom.
591
592=cut
593*/
594
595SV **
596Perl_av_create_and_unshift_one(pTHX_ AV **const avp, SV *const val)
597{
598 if (!*avp)
599 *avp = newAV();
600 av_unshift(*avp, 1);
601 return av_store(*avp, 0, val);
602}
603
604/*
cb50131a 605=for apidoc av_unshift
606
607Unshift the given number of C<undef> values onto the beginning of the
608array. The array will grow automatically to accommodate the addition. You
609must then use C<av_store> to assign values to these new elements.
610
611=cut
612*/
613
79072805 614void
864dbfa3 615Perl_av_unshift(pTHX_ register AV *av, register I32 num)
79072805 616{
27da23d5 617 dVAR;
79072805 618 register I32 i;
93965878 619 MAGIC* mg;
79072805 620
ba5d1d60 621 assert(av);
622
43fcc5d2 623 if (SvREADONLY(av))
cea2e8a9 624 Perl_croak(aTHX_ PL_no_modify);
93965878 625
14befaf4 626 if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
93965878 627 dSP;
e788e7d3 628 PUSHSTACKi(PERLSI_MAGIC);
924508f0 629 PUSHMARK(SP);
630 EXTEND(SP,1+num);
33c27489 631 PUSHs(SvTIED_obj((SV*)av, mg));
93965878 632 while (num-- > 0) {
3280af22 633 PUSHs(&PL_sv_undef);
93965878 634 }
635 PUTBACK;
a60c0954 636 ENTER;
864dbfa3 637 call_method("UNSHIFT", G_SCALAR|G_DISCARD);
a60c0954 638 LEAVE;
d3acc0f7 639 POPSTACK;
93965878 640 return;
641 }
642
d19c0e07 643 if (num <= 0)
644 return;
49beac48 645 if (!AvREAL(av) && AvREIFY(av))
646 av_reify(av);
a0d0e21e 647 i = AvARRAY(av) - AvALLOC(av);
648 if (i) {
649 if (i > num)
650 i = num;
651 num -= i;
652
653 AvMAX(av) += i;
93965878 654 AvFILLp(av) += i;
9c6bc640 655 AvARRAY(av) = AvARRAY(av) - i;
a0d0e21e 656 }
d2719217 657 if (num) {
a3b680e6 658 register SV **ary;
659 I32 slide;
67a38de0 660 i = AvFILLp(av);
e2b534e7 661 /* Create extra elements */
662 slide = i > 0 ? i : 0;
663 num += slide;
67a38de0 664 av_extend(av, i + num);
93965878 665 AvFILLp(av) += num;
67a38de0 666 ary = AvARRAY(av);
667 Move(ary, ary + num, i + 1, SV*);
668 do {
3280af22 669 ary[--num] = &PL_sv_undef;
67a38de0 670 } while (num);
e2b534e7 671 /* Make extra elements into a buffer */
672 AvMAX(av) -= slide;
673 AvFILLp(av) -= slide;
9c6bc640 674 AvARRAY(av) = AvARRAY(av) + slide;
79072805 675 }
676}
677
cb50131a 678/*
679=for apidoc av_shift
680
681Shifts an SV off the beginning of the array.
682
683=cut
684*/
685
79072805 686SV *
864dbfa3 687Perl_av_shift(pTHX_ register AV *av)
79072805 688{
27da23d5 689 dVAR;
79072805 690 SV *retval;
93965878 691 MAGIC* mg;
79072805 692
ba5d1d60 693 assert(av);
694
43fcc5d2 695 if (SvREADONLY(av))
cea2e8a9 696 Perl_croak(aTHX_ PL_no_modify);
14befaf4 697 if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
93965878 698 dSP;
e788e7d3 699 PUSHSTACKi(PERLSI_MAGIC);
924508f0 700 PUSHMARK(SP);
33c27489 701 XPUSHs(SvTIED_obj((SV*)av, mg));
a60c0954 702 PUTBACK;
703 ENTER;
864dbfa3 704 if (call_method("SHIFT", G_SCALAR)) {
3280af22 705 retval = newSVsv(*PL_stack_sp--);
93965878 706 } else {
3280af22 707 retval = &PL_sv_undef;
a60c0954 708 }
709 LEAVE;
d3acc0f7 710 POPSTACK;
93965878 711 return retval;
712 }
d19c0e07 713 if (AvFILL(av) < 0)
714 return &PL_sv_undef;
463ee0b2 715 retval = *AvARRAY(av);
a0d0e21e 716 if (AvREAL(av))
3280af22 717 *AvARRAY(av) = &PL_sv_undef;
9c6bc640 718 AvARRAY(av) = AvARRAY(av) + 1;
463ee0b2 719 AvMAX(av)--;
93965878 720 AvFILLp(av)--;
8990e307 721 if (SvSMAGICAL(av))
463ee0b2 722 mg_set((SV*)av);
79072805 723 return retval;
724}
725
cb50131a 726/*
727=for apidoc av_len
728
977a499b 729Returns the highest index in the array. The number of elements in the
730array is C<av_len(av) + 1>. Returns -1 if the array is empty.
cb50131a 731
732=cut
733*/
734
79072805 735I32
0d46e09a 736Perl_av_len(pTHX_ register const AV *av)
79072805 737{
ba5d1d60 738 assert(av);
463ee0b2 739 return AvFILL(av);
79072805 740}
741
f3b76584 742/*
743=for apidoc av_fill
744
977a499b 745Set the highest index in the array to the given number, equivalent to
f3b76584 746Perl's C<$#array = $fill;>.
747
977a499b 748The number of elements in the an array will be C<fill + 1> after
749av_fill() returns. If the array was previously shorter then the
750additional elements appended are set to C<PL_sv_undef>. If the array
751was longer, then the excess elements are freed. C<av_fill(av, -1)> is
752the same as C<av_clear(av)>.
753
f3b76584 754=cut
755*/
79072805 756void
864dbfa3 757Perl_av_fill(pTHX_ register AV *av, I32 fill)
79072805 758{
27da23d5 759 dVAR;
93965878 760 MAGIC *mg;
ba5d1d60 761
762 assert(av);
763
79072805 764 if (fill < 0)
765 fill = -1;
14befaf4 766 if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
93965878 767 dSP;
768 ENTER;
769 SAVETMPS;
e788e7d3 770 PUSHSTACKi(PERLSI_MAGIC);
924508f0 771 PUSHMARK(SP);
772 EXTEND(SP,2);
33c27489 773 PUSHs(SvTIED_obj((SV*)av, mg));
a60c0954 774 PUSHs(sv_2mortal(newSViv(fill+1)));
93965878 775 PUTBACK;
864dbfa3 776 call_method("STORESIZE", G_SCALAR|G_DISCARD);
d3acc0f7 777 POPSTACK;
93965878 778 FREETMPS;
779 LEAVE;
780 return;
781 }
463ee0b2 782 if (fill <= AvMAX(av)) {
93965878 783 I32 key = AvFILLp(av);
fabdb6c0 784 SV** const ary = AvARRAY(av);
a0d0e21e 785
786 if (AvREAL(av)) {
787 while (key > fill) {
788 SvREFCNT_dec(ary[key]);
3280af22 789 ary[key--] = &PL_sv_undef;
a0d0e21e 790 }
791 }
792 else {
793 while (key < fill)
3280af22 794 ary[++key] = &PL_sv_undef;
a0d0e21e 795 }
796
93965878 797 AvFILLp(av) = fill;
8990e307 798 if (SvSMAGICAL(av))
463ee0b2 799 mg_set((SV*)av);
800 }
a0d0e21e 801 else
3280af22 802 (void)av_store(av,fill,&PL_sv_undef);
79072805 803}
c750a3ec 804
f3b76584 805/*
806=for apidoc av_delete
807
808Deletes the element indexed by C<key> from the array. Returns the
a6214072 809deleted element. If C<flags> equals C<G_DISCARD>, the element is freed
810and null is returned.
f3b76584 811
812=cut
813*/
146174a9 814SV *
815Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
816{
97aff369 817 dVAR;
146174a9 818 SV *sv;
819
ba5d1d60 820 assert(av);
821
146174a9 822 if (SvREADONLY(av))
823 Perl_croak(aTHX_ PL_no_modify);
6f12eb6d 824
825 if (SvRMAGICAL(av)) {
35a4481c 826 const MAGIC * const tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
6f12eb6d 827 if ((tied_magic || mg_find((SV*)av, PERL_MAGIC_regdata))) {
828 /* Handle negative array indices 20020222 MJD */
35a4481c 829 SV **svp;
6f12eb6d 830 if (key < 0) {
831 unsigned adjust_index = 1;
832 if (tied_magic) {
823a54a3 833 SV * const * const negative_indices_glob =
6f12eb6d 834 hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av,
835 tied_magic))),
836 NEGATIVE_INDICES_VAR, 16, 0);
837 if (negative_indices_glob
838 && SvTRUE(GvSV(*negative_indices_glob)))
839 adjust_index = 0;
840 }
841 if (adjust_index) {
842 key += AvFILL(av) + 1;
843 if (key < 0)
fabdb6c0 844 return NULL;
6f12eb6d 845 }
846 }
847 svp = av_fetch(av, key, TRUE);
848 if (svp) {
849 sv = *svp;
850 mg_clear(sv);
851 if (mg_find(sv, PERL_MAGIC_tiedelem)) {
852 sv_unmagic(sv, PERL_MAGIC_tiedelem); /* No longer an element */
853 return sv;
854 }
fabdb6c0 855 return NULL;
6f12eb6d 856 }
857 }
858 }
859
146174a9 860 if (key < 0) {
861 key += AvFILL(av) + 1;
862 if (key < 0)
fabdb6c0 863 return NULL;
146174a9 864 }
6f12eb6d 865
146174a9 866 if (key > AvFILLp(av))
fabdb6c0 867 return NULL;
146174a9 868 else {
a6214072 869 if (!AvREAL(av) && AvREIFY(av))
870 av_reify(av);
146174a9 871 sv = AvARRAY(av)[key];
872 if (key == AvFILLp(av)) {
d9c63288 873 AvARRAY(av)[key] = &PL_sv_undef;
146174a9 874 do {
875 AvFILLp(av)--;
876 } while (--key >= 0 && AvARRAY(av)[key] == &PL_sv_undef);
877 }
878 else
879 AvARRAY(av)[key] = &PL_sv_undef;
880 if (SvSMAGICAL(av))
881 mg_set((SV*)av);
882 }
883 if (flags & G_DISCARD) {
884 SvREFCNT_dec(sv);
fabdb6c0 885 sv = NULL;
146174a9 886 }
fdb3bdd0 887 else if (AvREAL(av))
2c8ddff3 888 sv = sv_2mortal(sv);
146174a9 889 return sv;
890}
891
892/*
f3b76584 893=for apidoc av_exists
894
895Returns true if the element indexed by C<key> has been initialized.
146174a9 896
f3b76584 897This relies on the fact that uninitialized array elements are set to
898C<&PL_sv_undef>.
899
900=cut
901*/
146174a9 902bool
903Perl_av_exists(pTHX_ AV *av, I32 key)
904{
97aff369 905 dVAR;
ba5d1d60 906 assert(av);
6f12eb6d 907
908 if (SvRMAGICAL(av)) {
35a4481c 909 const MAGIC * const tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
6f12eb6d 910 if (tied_magic || mg_find((SV*)av, PERL_MAGIC_regdata)) {
fabdb6c0 911 SV * const sv = sv_newmortal();
6f12eb6d 912 MAGIC *mg;
913 /* Handle negative array indices 20020222 MJD */
914 if (key < 0) {
915 unsigned adjust_index = 1;
916 if (tied_magic) {
823a54a3 917 SV * const * const negative_indices_glob =
6f12eb6d 918 hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av,
919 tied_magic))),
920 NEGATIVE_INDICES_VAR, 16, 0);
921 if (negative_indices_glob
922 && SvTRUE(GvSV(*negative_indices_glob)))
923 adjust_index = 0;
924 }
925 if (adjust_index) {
926 key += AvFILL(av) + 1;
927 if (key < 0)
928 return FALSE;
929 }
930 }
931
932 mg_copy((SV*)av, sv, 0, key);
933 mg = mg_find(sv, PERL_MAGIC_tiedelem);
934 if (mg) {
935 magic_existspack(sv, mg);
936 return (bool)SvTRUE(sv);
937 }
938
939 }
940 }
941
146174a9 942 if (key < 0) {
943 key += AvFILL(av) + 1;
944 if (key < 0)
945 return FALSE;
946 }
6f12eb6d 947
146174a9 948 if (key <= AvFILLp(av) && AvARRAY(av)[key] != &PL_sv_undef
949 && AvARRAY(av)[key])
950 {
951 return TRUE;
952 }
953 else
954 return FALSE;
955}
66610fdd 956
a3874608 957SV **
958Perl_av_arylen_p(pTHX_ AV *av) {
959 dVAR;
ba5d1d60 960 MAGIC *mg;
961
962 assert(av);
963
964 mg = mg_find((SV*)av, PERL_MAGIC_arylen_p);
a3874608 965
966 if (!mg) {
1b20cd17 967 mg = sv_magicext((SV*)av, 0, PERL_MAGIC_arylen_p, &PL_vtbl_arylen_p,
968 0, 0);
c82c7adc 969 assert(mg);
a3874608 970 /* sv_magicext won't set this for us because we pass in a NULL obj */
971 mg->mg_flags |= MGf_REFCOUNTED;
972 }
973 return &(mg->mg_obj);
974}
975
66610fdd 976/*
977 * Local variables:
978 * c-indentation-style: bsd
979 * c-basic-offset: 4
980 * indent-tabs-mode: t
981 * End:
982 *
37442d52 983 * ex: set ts=8 sts=4 sw=4 noet:
984 */