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