Commit | Line | Data |
---|---|---|
a0d0e21e | 1 | /* av.c |
79072805 | 2 | * |
4eb8286e | 3 | * Copyright (c) 1991-1999, 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" | |
16 | #include "perl.h" | |
17 | ||
fb73857a | 18 | void |
8ac85365 | 19 | av_reify(AV *av) |
a0d0e21e LW |
20 | { |
21 | I32 key; | |
22 | SV* sv; | |
fb73857a | 23 | |
3c78fafa GS |
24 | if (AvREAL(av)) |
25 | return; | |
93965878 | 26 | #ifdef DEBUGGING |
33c27489 | 27 | if (SvTIED_mg((SV*)av, 'P')) |
93965878 NIS |
28 | warn("av_reify called on tied array"); |
29 | #endif | |
a0d0e21e | 30 | key = AvMAX(av) + 1; |
93965878 | 31 | while (key > AvFILLp(av) + 1) |
3280af22 | 32 | AvARRAY(av)[--key] = &PL_sv_undef; |
a0d0e21e LW |
33 | while (key) { |
34 | sv = AvARRAY(av)[--key]; | |
35 | assert(sv); | |
3280af22 | 36 | if (sv != &PL_sv_undef) { |
11343788 | 37 | dTHR; |
a0d0e21e | 38 | (void)SvREFCNT_inc(sv); |
11343788 | 39 | } |
a0d0e21e | 40 | } |
29de640a CS |
41 | key = AvARRAY(av) - AvALLOC(av); |
42 | while (key) | |
3280af22 | 43 | AvALLOC(av)[--key] = &PL_sv_undef; |
62b1ebc2 | 44 | AvREIFY_off(av); |
a0d0e21e LW |
45 | AvREAL_on(av); |
46 | } | |
47 | ||
48 | void | |
8ac85365 | 49 | av_extend(AV *av, I32 key) |
a0d0e21e | 50 | { |
11343788 | 51 | dTHR; /* only necessary if we have to extend stack */ |
93965878 | 52 | MAGIC *mg; |
33c27489 | 53 | if (mg = SvTIED_mg((SV*)av, 'P')) { |
93965878 NIS |
54 | dSP; |
55 | ENTER; | |
56 | SAVETMPS; | |
e788e7d3 | 57 | PUSHSTACKi(PERLSI_MAGIC); |
924508f0 GS |
58 | PUSHMARK(SP); |
59 | EXTEND(SP,2); | |
33c27489 | 60 | PUSHs(SvTIED_obj((SV*)av, mg)); |
a60c0954 | 61 | PUSHs(sv_2mortal(newSViv(key+1))); |
93965878 NIS |
62 | PUTBACK; |
63 | perl_call_method("EXTEND", G_SCALAR|G_DISCARD); | |
d3acc0f7 | 64 | POPSTACK; |
93965878 NIS |
65 | FREETMPS; |
66 | LEAVE; | |
67 | return; | |
68 | } | |
a0d0e21e LW |
69 | if (key > AvMAX(av)) { |
70 | SV** ary; | |
71 | I32 tmp; | |
72 | I32 newmax; | |
73 | ||
74 | if (AvALLOC(av) != AvARRAY(av)) { | |
93965878 | 75 | ary = AvALLOC(av) + AvFILLp(av) + 1; |
a0d0e21e | 76 | tmp = AvARRAY(av) - AvALLOC(av); |
93965878 | 77 | Move(AvARRAY(av), AvALLOC(av), AvFILLp(av)+1, SV*); |
a0d0e21e LW |
78 | AvMAX(av) += tmp; |
79 | SvPVX(av) = (char*)AvALLOC(av); | |
80 | if (AvREAL(av)) { | |
81 | while (tmp) | |
3280af22 | 82 | ary[--tmp] = &PL_sv_undef; |
a0d0e21e LW |
83 | } |
84 | ||
85 | if (key > AvMAX(av) - 10) { | |
86 | newmax = key + AvMAX(av); | |
87 | goto resize; | |
88 | } | |
89 | } | |
90 | else { | |
91 | if (AvALLOC(av)) { | |
c07a80fd | 92 | #ifndef STRANGE_MALLOC |
4633a7c4 | 93 | U32 bytes; |
c07a80fd | 94 | #endif |
4633a7c4 | 95 | |
1fe09876 | 96 | #if defined(MYMALLOC) && !defined(PURIFY) && !defined(LEAKTEST) |
8d6dde3e IZ |
97 | newmax = malloced_size((void*)AvALLOC(av))/sizeof(SV*) - 1; |
98 | ||
99 | if (key <= newmax) | |
100 | goto resized; | |
101 | #endif | |
a0d0e21e LW |
102 | newmax = key + AvMAX(av) / 5; |
103 | resize: | |
8d6dde3e | 104 | #if defined(STRANGE_MALLOC) || defined(MYMALLOC) |
a0d0e21e | 105 | Renew(AvALLOC(av),newmax+1, SV*); |
4633a7c4 LW |
106 | #else |
107 | bytes = (newmax + 1) * sizeof(SV*); | |
108 | #define MALLOC_OVERHEAD 16 | |
109 | tmp = MALLOC_OVERHEAD; | |
110 | while (tmp - MALLOC_OVERHEAD < bytes) | |
111 | tmp += tmp; | |
112 | tmp -= MALLOC_OVERHEAD; | |
113 | tmp /= sizeof(SV*); | |
114 | assert(tmp > newmax); | |
115 | newmax = tmp - 1; | |
116 | New(2,ary, newmax+1, SV*); | |
117 | Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*); | |
fba3b22e MB |
118 | if (AvMAX(av) > 64) |
119 | offer_nice_chunk(AvALLOC(av), (AvMAX(av)+1) * sizeof(SV*)); | |
4633a7c4 LW |
120 | else |
121 | Safefree(AvALLOC(av)); | |
122 | AvALLOC(av) = ary; | |
123 | #endif | |
8d6dde3e | 124 | resized: |
a0d0e21e LW |
125 | ary = AvALLOC(av) + AvMAX(av) + 1; |
126 | tmp = newmax - AvMAX(av); | |
3280af22 NIS |
127 | if (av == PL_curstack) { /* Oops, grew stack (via av_store()?) */ |
128 | PL_stack_sp = AvALLOC(av) + (PL_stack_sp - PL_stack_base); | |
129 | PL_stack_base = AvALLOC(av); | |
130 | PL_stack_max = PL_stack_base + newmax; | |
a0d0e21e LW |
131 | } |
132 | } | |
133 | else { | |
8d6dde3e | 134 | newmax = key < 3 ? 3 : key; |
a0d0e21e LW |
135 | New(2,AvALLOC(av), newmax+1, SV*); |
136 | ary = AvALLOC(av) + 1; | |
137 | tmp = newmax; | |
3280af22 | 138 | AvALLOC(av)[0] = &PL_sv_undef; /* For the stacks */ |
a0d0e21e LW |
139 | } |
140 | if (AvREAL(av)) { | |
141 | while (tmp) | |
3280af22 | 142 | ary[--tmp] = &PL_sv_undef; |
a0d0e21e LW |
143 | } |
144 | ||
145 | SvPVX(av) = (char*)AvALLOC(av); | |
146 | AvMAX(av) = newmax; | |
147 | } | |
148 | } | |
149 | } | |
150 | ||
79072805 | 151 | SV** |
8ac85365 | 152 | av_fetch(register AV *av, I32 key, I32 lval) |
79072805 LW |
153 | { |
154 | SV *sv; | |
155 | ||
a0d0e21e LW |
156 | if (!av) |
157 | return 0; | |
158 | ||
93965878 NIS |
159 | if (key < 0) { |
160 | key += AvFILL(av) + 1; | |
161 | if (key < 0) | |
162 | return 0; | |
163 | } | |
164 | ||
8990e307 | 165 | if (SvRMAGICAL(av)) { |
6cef1e77 | 166 | if (mg_find((SV*)av,'P') || mg_find((SV*)av,'D')) { |
11343788 | 167 | dTHR; |
8990e307 | 168 | sv = sv_newmortal(); |
463ee0b2 | 169 | mg_copy((SV*)av, sv, 0, key); |
3280af22 NIS |
170 | PL_av_fetch_sv = sv; |
171 | return &PL_av_fetch_sv; | |
463ee0b2 LW |
172 | } |
173 | } | |
174 | ||
93965878 | 175 | if (key > AvFILLp(av)) { |
a0d0e21e LW |
176 | if (!lval) |
177 | return 0; | |
352edd90 | 178 | sv = NEWSV(5,0); |
a0d0e21e | 179 | return av_store(av,key,sv); |
79072805 | 180 | } |
3280af22 | 181 | if (AvARRAY(av)[key] == &PL_sv_undef) { |
4dbf4341 | 182 | emptyness: |
79072805 LW |
183 | if (lval) { |
184 | sv = NEWSV(6,0); | |
463ee0b2 | 185 | return av_store(av,key,sv); |
79072805 LW |
186 | } |
187 | return 0; | |
188 | } | |
4dbf4341 | 189 | else if (AvREIFY(av) |
190 | && (!AvARRAY(av)[key] /* eg. @_ could have freed elts */ | |
191 | || SvTYPE(AvARRAY(av)[key]) == SVTYPEMASK)) { | |
3280af22 | 192 | AvARRAY(av)[key] = &PL_sv_undef; /* 1/2 reify */ |
4dbf4341 | 193 | goto emptyness; |
194 | } | |
463ee0b2 | 195 | return &AvARRAY(av)[key]; |
79072805 LW |
196 | } |
197 | ||
198 | SV** | |
8ac85365 | 199 | av_store(register AV *av, I32 key, SV *val) |
79072805 | 200 | { |
79072805 | 201 | SV** ary; |
93965878 NIS |
202 | U32 fill; |
203 | ||
79072805 | 204 | |
a0d0e21e LW |
205 | if (!av) |
206 | return 0; | |
43fcc5d2 | 207 | if (!val) |
3280af22 | 208 | val = &PL_sv_undef; |
463ee0b2 | 209 | |
a0d0e21e LW |
210 | if (key < 0) { |
211 | key += AvFILL(av) + 1; | |
212 | if (key < 0) | |
213 | return 0; | |
79072805 | 214 | } |
93965878 | 215 | |
43fcc5d2 | 216 | if (SvREADONLY(av) && key >= AvFILL(av)) |
22c35a8c | 217 | croak(PL_no_modify); |
93965878 NIS |
218 | |
219 | if (SvRMAGICAL(av)) { | |
220 | if (mg_find((SV*)av,'P')) { | |
3280af22 | 221 | if (val != &PL_sv_undef) { |
93965878 NIS |
222 | mg_copy((SV*)av, val, 0, key); |
223 | } | |
224 | return 0; | |
225 | } | |
226 | } | |
227 | ||
49beac48 | 228 | if (!AvREAL(av) && AvREIFY(av)) |
a0d0e21e | 229 | av_reify(av); |
a0d0e21e LW |
230 | if (key > AvMAX(av)) |
231 | av_extend(av,key); | |
463ee0b2 | 232 | ary = AvARRAY(av); |
93965878 | 233 | if (AvFILLp(av) < key) { |
a0d0e21e | 234 | if (!AvREAL(av)) { |
11343788 | 235 | dTHR; |
3280af22 NIS |
236 | if (av == PL_curstack && key > PL_stack_sp - PL_stack_base) |
237 | PL_stack_sp = PL_stack_base + key; /* XPUSH in disguise */ | |
a0d0e21e | 238 | do |
3280af22 | 239 | ary[++AvFILLp(av)] = &PL_sv_undef; |
93965878 | 240 | while (AvFILLp(av) < key); |
79072805 | 241 | } |
93965878 | 242 | AvFILLp(av) = key; |
79072805 | 243 | } |
a0d0e21e LW |
244 | else if (AvREAL(av)) |
245 | SvREFCNT_dec(ary[key]); | |
79072805 | 246 | ary[key] = val; |
8990e307 | 247 | if (SvSMAGICAL(av)) { |
3280af22 | 248 | if (val != &PL_sv_undef) { |
a0d0e21e LW |
249 | MAGIC* mg = SvMAGIC(av); |
250 | sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key); | |
251 | } | |
463ee0b2 LW |
252 | mg_set((SV*)av); |
253 | } | |
79072805 LW |
254 | return &ary[key]; |
255 | } | |
256 | ||
257 | AV * | |
8ac85365 | 258 | newAV(void) |
79072805 | 259 | { |
463ee0b2 | 260 | register AV *av; |
79072805 | 261 | |
a0d0e21e LW |
262 | av = (AV*)NEWSV(3,0); |
263 | sv_upgrade((SV *)av, SVt_PVAV); | |
463ee0b2 LW |
264 | AvREAL_on(av); |
265 | AvALLOC(av) = 0; | |
266 | SvPVX(av) = 0; | |
93965878 | 267 | AvMAX(av) = AvFILLp(av) = -1; |
463ee0b2 | 268 | return av; |
79072805 LW |
269 | } |
270 | ||
271 | AV * | |
8ac85365 | 272 | av_make(register I32 size, register SV **strp) |
79072805 | 273 | { |
463ee0b2 | 274 | register AV *av; |
79072805 LW |
275 | register I32 i; |
276 | register SV** ary; | |
277 | ||
a0d0e21e LW |
278 | av = (AV*)NEWSV(8,0); |
279 | sv_upgrade((SV *) av,SVt_PVAV); | |
a0d0e21e | 280 | AvFLAGS(av) = AVf_REAL; |
573fa4ea TB |
281 | if (size) { /* `defined' was returning undef for size==0 anyway. */ |
282 | New(4,ary,size,SV*); | |
283 | AvALLOC(av) = ary; | |
284 | SvPVX(av) = (char*)ary; | |
93965878 | 285 | AvFILLp(av) = size - 1; |
573fa4ea TB |
286 | AvMAX(av) = size - 1; |
287 | for (i = 0; i < size; i++) { | |
288 | assert (*strp); | |
289 | ary[i] = NEWSV(7,0); | |
290 | sv_setsv(ary[i], *strp); | |
291 | strp++; | |
292 | } | |
79072805 | 293 | } |
463ee0b2 | 294 | return av; |
79072805 LW |
295 | } |
296 | ||
297 | AV * | |
8ac85365 | 298 | av_fake(register I32 size, register SV **strp) |
79072805 | 299 | { |
463ee0b2 | 300 | register AV *av; |
79072805 LW |
301 | register SV** ary; |
302 | ||
a0d0e21e LW |
303 | av = (AV*)NEWSV(9,0); |
304 | sv_upgrade((SV *)av, SVt_PVAV); | |
79072805 | 305 | New(4,ary,size+1,SV*); |
463ee0b2 | 306 | AvALLOC(av) = ary; |
79072805 | 307 | Copy(strp,ary,size,SV*); |
a0d0e21e | 308 | AvFLAGS(av) = AVf_REIFY; |
463ee0b2 | 309 | SvPVX(av) = (char*)ary; |
93965878 | 310 | AvFILLp(av) = size - 1; |
463ee0b2 | 311 | AvMAX(av) = size - 1; |
79072805 | 312 | while (size--) { |
a0d0e21e LW |
313 | assert (*strp); |
314 | SvTEMP_off(*strp); | |
79072805 LW |
315 | strp++; |
316 | } | |
463ee0b2 | 317 | return av; |
79072805 LW |
318 | } |
319 | ||
320 | void | |
8ac85365 | 321 | av_clear(register AV *av) |
79072805 LW |
322 | { |
323 | register I32 key; | |
a0d0e21e | 324 | SV** ary; |
79072805 | 325 | |
7d55f622 | 326 | #ifdef DEBUGGING |
327 | if (SvREFCNT(av) <= 0) { | |
328 | warn("Attempt to clear deleted array"); | |
329 | } | |
330 | #endif | |
a60c0954 | 331 | if (!av) |
79072805 LW |
332 | return; |
333 | /*SUPPRESS 560*/ | |
a0d0e21e | 334 | |
39caa665 | 335 | if (SvREADONLY(av)) |
22c35a8c | 336 | croak(PL_no_modify); |
39caa665 | 337 | |
93965878 NIS |
338 | /* Give any tie a chance to cleanup first */ |
339 | if (SvRMAGICAL(av)) | |
340 | mg_clear((SV*)av); | |
341 | ||
a60c0954 NIS |
342 | if (AvMAX(av) < 0) |
343 | return; | |
344 | ||
a0d0e21e LW |
345 | if (AvREAL(av)) { |
346 | ary = AvARRAY(av); | |
93965878 | 347 | key = AvFILLp(av) + 1; |
a0d0e21e LW |
348 | while (key) { |
349 | SvREFCNT_dec(ary[--key]); | |
3280af22 | 350 | ary[key] = &PL_sv_undef; |
a0d0e21e LW |
351 | } |
352 | } | |
463ee0b2 LW |
353 | if (key = AvARRAY(av) - AvALLOC(av)) { |
354 | AvMAX(av) += key; | |
a0d0e21e | 355 | SvPVX(av) = (char*)AvALLOC(av); |
79072805 | 356 | } |
93965878 | 357 | AvFILLp(av) = -1; |
fb73857a | 358 | |
79072805 LW |
359 | } |
360 | ||
361 | void | |
8ac85365 | 362 | av_undef(register AV *av) |
79072805 LW |
363 | { |
364 | register I32 key; | |
365 | ||
463ee0b2 | 366 | if (!av) |
79072805 LW |
367 | return; |
368 | /*SUPPRESS 560*/ | |
93965878 NIS |
369 | |
370 | /* Give any tie a chance to cleanup first */ | |
33c27489 | 371 | if (SvTIED_mg((SV*)av, 'P')) |
93965878 NIS |
372 | av_fill(av, -1); /* mg_clear() ? */ |
373 | ||
a0d0e21e | 374 | if (AvREAL(av)) { |
93965878 | 375 | key = AvFILLp(av) + 1; |
a0d0e21e LW |
376 | while (key) |
377 | SvREFCNT_dec(AvARRAY(av)[--key]); | |
378 | } | |
463ee0b2 LW |
379 | Safefree(AvALLOC(av)); |
380 | AvALLOC(av) = 0; | |
381 | SvPVX(av) = 0; | |
93965878 | 382 | AvMAX(av) = AvFILLp(av) = -1; |
748a9306 LW |
383 | if (AvARYLEN(av)) { |
384 | SvREFCNT_dec(AvARYLEN(av)); | |
385 | AvARYLEN(av) = 0; | |
386 | } | |
79072805 LW |
387 | } |
388 | ||
a0d0e21e | 389 | void |
8ac85365 | 390 | av_push(register AV *av, SV *val) |
93965878 NIS |
391 | { |
392 | MAGIC *mg; | |
a0d0e21e LW |
393 | if (!av) |
394 | return; | |
93965878 | 395 | if (SvREADONLY(av)) |
22c35a8c | 396 | croak(PL_no_modify); |
93965878 | 397 | |
33c27489 | 398 | if (mg = SvTIED_mg((SV*)av, 'P')) { |
93965878 | 399 | dSP; |
e788e7d3 | 400 | PUSHSTACKi(PERLSI_MAGIC); |
924508f0 GS |
401 | PUSHMARK(SP); |
402 | EXTEND(SP,2); | |
33c27489 | 403 | PUSHs(SvTIED_obj((SV*)av, mg)); |
93965878 | 404 | PUSHs(val); |
a60c0954 NIS |
405 | PUTBACK; |
406 | ENTER; | |
93965878 | 407 | perl_call_method("PUSH", G_SCALAR|G_DISCARD); |
a60c0954 | 408 | LEAVE; |
d3acc0f7 | 409 | POPSTACK; |
93965878 NIS |
410 | return; |
411 | } | |
412 | av_store(av,AvFILLp(av)+1,val); | |
79072805 LW |
413 | } |
414 | ||
415 | SV * | |
8ac85365 | 416 | av_pop(register AV *av) |
79072805 LW |
417 | { |
418 | SV *retval; | |
93965878 | 419 | MAGIC* mg; |
79072805 | 420 | |
a0d0e21e | 421 | if (!av || AvFILL(av) < 0) |
3280af22 | 422 | return &PL_sv_undef; |
43fcc5d2 | 423 | if (SvREADONLY(av)) |
22c35a8c | 424 | croak(PL_no_modify); |
33c27489 | 425 | if (mg = SvTIED_mg((SV*)av, 'P')) { |
93965878 | 426 | dSP; |
e788e7d3 | 427 | PUSHSTACKi(PERLSI_MAGIC); |
924508f0 | 428 | PUSHMARK(SP); |
33c27489 | 429 | XPUSHs(SvTIED_obj((SV*)av, mg)); |
a60c0954 NIS |
430 | PUTBACK; |
431 | ENTER; | |
93965878 | 432 | if (perl_call_method("POP", G_SCALAR)) { |
3280af22 | 433 | retval = newSVsv(*PL_stack_sp--); |
93965878 | 434 | } else { |
3280af22 | 435 | retval = &PL_sv_undef; |
93965878 | 436 | } |
a60c0954 | 437 | LEAVE; |
d3acc0f7 | 438 | POPSTACK; |
93965878 NIS |
439 | return retval; |
440 | } | |
441 | retval = AvARRAY(av)[AvFILLp(av)]; | |
3280af22 | 442 | AvARRAY(av)[AvFILLp(av)--] = &PL_sv_undef; |
8990e307 | 443 | if (SvSMAGICAL(av)) |
463ee0b2 | 444 | mg_set((SV*)av); |
79072805 LW |
445 | return retval; |
446 | } | |
447 | ||
448 | void | |
8ac85365 | 449 | av_unshift(register AV *av, register I32 num) |
79072805 LW |
450 | { |
451 | register I32 i; | |
67a38de0 | 452 | register SV **ary; |
93965878 | 453 | MAGIC* mg; |
79072805 | 454 | |
a0d0e21e | 455 | if (!av || num <= 0) |
79072805 | 456 | return; |
43fcc5d2 | 457 | if (SvREADONLY(av)) |
22c35a8c | 458 | croak(PL_no_modify); |
93965878 | 459 | |
33c27489 | 460 | if (mg = SvTIED_mg((SV*)av, 'P')) { |
93965878 | 461 | dSP; |
e788e7d3 | 462 | PUSHSTACKi(PERLSI_MAGIC); |
924508f0 GS |
463 | PUSHMARK(SP); |
464 | EXTEND(SP,1+num); | |
33c27489 | 465 | PUSHs(SvTIED_obj((SV*)av, mg)); |
93965878 | 466 | while (num-- > 0) { |
3280af22 | 467 | PUSHs(&PL_sv_undef); |
93965878 NIS |
468 | } |
469 | PUTBACK; | |
a60c0954 | 470 | ENTER; |
93965878 | 471 | perl_call_method("UNSHIFT", G_SCALAR|G_DISCARD); |
a60c0954 | 472 | LEAVE; |
d3acc0f7 | 473 | POPSTACK; |
93965878 NIS |
474 | return; |
475 | } | |
476 | ||
49beac48 CS |
477 | if (!AvREAL(av) && AvREIFY(av)) |
478 | av_reify(av); | |
a0d0e21e LW |
479 | i = AvARRAY(av) - AvALLOC(av); |
480 | if (i) { | |
481 | if (i > num) | |
482 | i = num; | |
483 | num -= i; | |
484 | ||
485 | AvMAX(av) += i; | |
93965878 | 486 | AvFILLp(av) += i; |
a0d0e21e LW |
487 | SvPVX(av) = (char*)(AvARRAY(av) - i); |
488 | } | |
d2719217 | 489 | if (num) { |
67a38de0 NIS |
490 | i = AvFILLp(av); |
491 | av_extend(av, i + num); | |
93965878 | 492 | AvFILLp(av) += num; |
67a38de0 NIS |
493 | ary = AvARRAY(av); |
494 | Move(ary, ary + num, i + 1, SV*); | |
495 | do { | |
3280af22 | 496 | ary[--num] = &PL_sv_undef; |
67a38de0 | 497 | } while (num); |
79072805 LW |
498 | } |
499 | } | |
500 | ||
501 | SV * | |
8ac85365 | 502 | av_shift(register AV *av) |
79072805 LW |
503 | { |
504 | SV *retval; | |
93965878 | 505 | MAGIC* mg; |
79072805 | 506 | |
a0d0e21e | 507 | if (!av || AvFILL(av) < 0) |
3280af22 | 508 | return &PL_sv_undef; |
43fcc5d2 | 509 | if (SvREADONLY(av)) |
22c35a8c | 510 | croak(PL_no_modify); |
33c27489 | 511 | if (mg = SvTIED_mg((SV*)av, 'P')) { |
93965878 | 512 | dSP; |
e788e7d3 | 513 | PUSHSTACKi(PERLSI_MAGIC); |
924508f0 | 514 | PUSHMARK(SP); |
33c27489 | 515 | XPUSHs(SvTIED_obj((SV*)av, mg)); |
a60c0954 NIS |
516 | PUTBACK; |
517 | ENTER; | |
93965878 | 518 | if (perl_call_method("SHIFT", G_SCALAR)) { |
3280af22 | 519 | retval = newSVsv(*PL_stack_sp--); |
93965878 | 520 | } else { |
3280af22 | 521 | retval = &PL_sv_undef; |
a60c0954 NIS |
522 | } |
523 | LEAVE; | |
d3acc0f7 | 524 | POPSTACK; |
93965878 NIS |
525 | return retval; |
526 | } | |
463ee0b2 | 527 | retval = *AvARRAY(av); |
a0d0e21e | 528 | if (AvREAL(av)) |
3280af22 | 529 | *AvARRAY(av) = &PL_sv_undef; |
463ee0b2 LW |
530 | SvPVX(av) = (char*)(AvARRAY(av) + 1); |
531 | AvMAX(av)--; | |
93965878 | 532 | AvFILLp(av)--; |
8990e307 | 533 | if (SvSMAGICAL(av)) |
463ee0b2 | 534 | mg_set((SV*)av); |
79072805 LW |
535 | return retval; |
536 | } | |
537 | ||
538 | I32 | |
8ac85365 | 539 | av_len(register AV *av) |
79072805 | 540 | { |
463ee0b2 | 541 | return AvFILL(av); |
79072805 LW |
542 | } |
543 | ||
544 | void | |
8ac85365 | 545 | av_fill(register AV *av, I32 fill) |
79072805 | 546 | { |
93965878 | 547 | MAGIC *mg; |
a0d0e21e LW |
548 | if (!av) |
549 | croak("panic: null array"); | |
79072805 LW |
550 | if (fill < 0) |
551 | fill = -1; | |
33c27489 | 552 | if (mg = SvTIED_mg((SV*)av, 'P')) { |
93965878 NIS |
553 | dSP; |
554 | ENTER; | |
555 | SAVETMPS; | |
e788e7d3 | 556 | PUSHSTACKi(PERLSI_MAGIC); |
924508f0 GS |
557 | PUSHMARK(SP); |
558 | EXTEND(SP,2); | |
33c27489 | 559 | PUSHs(SvTIED_obj((SV*)av, mg)); |
a60c0954 | 560 | PUSHs(sv_2mortal(newSViv(fill+1))); |
93965878 NIS |
561 | PUTBACK; |
562 | perl_call_method("STORESIZE", G_SCALAR|G_DISCARD); | |
d3acc0f7 | 563 | POPSTACK; |
93965878 NIS |
564 | FREETMPS; |
565 | LEAVE; | |
566 | return; | |
567 | } | |
463ee0b2 | 568 | if (fill <= AvMAX(av)) { |
93965878 | 569 | I32 key = AvFILLp(av); |
a0d0e21e LW |
570 | SV** ary = AvARRAY(av); |
571 | ||
572 | if (AvREAL(av)) { | |
573 | while (key > fill) { | |
574 | SvREFCNT_dec(ary[key]); | |
3280af22 | 575 | ary[key--] = &PL_sv_undef; |
a0d0e21e LW |
576 | } |
577 | } | |
578 | else { | |
579 | while (key < fill) | |
3280af22 | 580 | ary[++key] = &PL_sv_undef; |
a0d0e21e LW |
581 | } |
582 | ||
93965878 | 583 | AvFILLp(av) = fill; |
8990e307 | 584 | if (SvSMAGICAL(av)) |
463ee0b2 LW |
585 | mg_set((SV*)av); |
586 | } | |
a0d0e21e | 587 | else |
3280af22 | 588 | (void)av_store(av,fill,&PL_sv_undef); |
79072805 | 589 | } |
c750a3ec | 590 | |
57079c46 GA |
591 | |
592 | /* AVHV: Support for treating arrays as if they were hashes. The | |
593 | * first element of the array should be a hash reference that maps | |
594 | * hash keys to array indices. | |
595 | */ | |
596 | ||
72311751 | 597 | STATIC I32 |
57079c46 GA |
598 | avhv_index_sv(SV* sv) |
599 | { | |
600 | I32 index = SvIV(sv); | |
601 | if (index < 1) | |
602 | croak("Bad index while coercing array into hash"); | |
603 | return index; | |
604 | } | |
605 | ||
5d5aaa5e JP |
606 | HV* |
607 | avhv_keys(AV *av) | |
608 | { | |
57079c46 | 609 | SV **keysp = av_fetch(av, 0, FALSE); |
5d5aaa5e | 610 | if (keysp) { |
d627ae4e MB |
611 | SV *sv = *keysp; |
612 | if (SvGMAGICAL(sv)) | |
613 | mg_get(sv); | |
614 | if (SvROK(sv)) { | |
615 | sv = SvRV(sv); | |
616 | if (SvTYPE(sv) == SVt_PVHV) | |
57079c46 | 617 | return (HV*)sv; |
5d5aaa5e JP |
618 | } |
619 | } | |
57079c46 | 620 | croak("Can't coerce array into hash"); |
72311751 | 621 | return Nullhv; |
c750a3ec MB |
622 | } |
623 | ||
624 | SV** | |
8ac85365 | 625 | avhv_fetch_ent(AV *av, SV *keysv, I32 lval, U32 hash) |
97fcbf96 | 626 | { |
5d5aaa5e JP |
627 | SV **indsvp; |
628 | HV *keys = avhv_keys(av); | |
97fcbf96 | 629 | HE *he; |
5bc6513d | 630 | |
5d5aaa5e | 631 | he = hv_fetch_ent(keys, keysv, FALSE, hash); |
57079c46 GA |
632 | if (!he) |
633 | croak("No such array field"); | |
634 | return av_fetch(av, avhv_index_sv(HeVAL(he)), lval); | |
5bc6513d MB |
635 | } |
636 | ||
c750a3ec | 637 | bool |
8ac85365 | 638 | avhv_exists_ent(AV *av, SV *keysv, U32 hash) |
97fcbf96 | 639 | { |
5d5aaa5e JP |
640 | HV *keys = avhv_keys(av); |
641 | return hv_exists_ent(keys, keysv, hash); | |
97fcbf96 MB |
642 | } |
643 | ||
c750a3ec | 644 | HE * |
8ac85365 | 645 | avhv_iternext(AV *av) |
c750a3ec | 646 | { |
5d5aaa5e JP |
647 | HV *keys = avhv_keys(av); |
648 | return hv_iternext(keys); | |
c750a3ec MB |
649 | } |
650 | ||
651 | SV * | |
8ac85365 | 652 | avhv_iterval(AV *av, register HE *entry) |
c750a3ec | 653 | { |
57079c46 GA |
654 | SV *sv = hv_iterval(avhv_keys(av), entry); |
655 | return *av_fetch(av, avhv_index_sv(sv), TRUE); | |
c750a3ec | 656 | } |