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