Commit | Line | Data |
---|---|---|
a0d0e21e | 1 | /* av.c |
79072805 | 2 | * |
9607fc9c | 3 | * Copyright (c) 1991-1997, 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 | |
93965878 NIS |
24 | if (AvREAL(av)) |
25 | return; | |
26 | #ifdef DEBUGGING | |
27 | if (SvRMAGICAL(av) && mg_find((SV*)av,'P')) | |
28 | warn("av_reify called on tied array"); | |
29 | #endif | |
a0d0e21e | 30 | key = AvMAX(av) + 1; |
93965878 | 31 | while (key > AvFILLp(av) + 1) |
a0d0e21e LW |
32 | AvARRAY(av)[--key] = &sv_undef; |
33 | while (key) { | |
34 | sv = AvARRAY(av)[--key]; | |
35 | assert(sv); | |
11343788 MB |
36 | if (sv != &sv_undef) { |
37 | dTHR; | |
a0d0e21e | 38 | (void)SvREFCNT_inc(sv); |
11343788 | 39 | } |
a0d0e21e | 40 | } |
29de640a CS |
41 | key = AvARRAY(av) - AvALLOC(av); |
42 | while (key) | |
43 | AvALLOC(av)[--key] = &sv_undef; | |
a0d0e21e LW |
44 | AvREAL_on(av); |
45 | } | |
46 | ||
47 | void | |
8ac85365 | 48 | av_extend(AV *av, I32 key) |
a0d0e21e | 49 | { |
11343788 | 50 | dTHR; /* only necessary if we have to extend stack */ |
93965878 NIS |
51 | MAGIC *mg; |
52 | if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) { | |
53 | dSP; | |
54 | ENTER; | |
55 | SAVETMPS; | |
56 | PUSHMARK(sp); | |
57 | EXTEND(sp,2); | |
58 | PUSHs(mg->mg_obj); | |
a60c0954 | 59 | PUSHs(sv_2mortal(newSViv(key+1))); |
93965878 NIS |
60 | PUTBACK; |
61 | perl_call_method("EXTEND", G_SCALAR|G_DISCARD); | |
62 | FREETMPS; | |
63 | LEAVE; | |
64 | return; | |
65 | } | |
a0d0e21e LW |
66 | if (key > AvMAX(av)) { |
67 | SV** ary; | |
68 | I32 tmp; | |
69 | I32 newmax; | |
70 | ||
71 | if (AvALLOC(av) != AvARRAY(av)) { | |
93965878 | 72 | ary = AvALLOC(av) + AvFILLp(av) + 1; |
a0d0e21e | 73 | tmp = AvARRAY(av) - AvALLOC(av); |
93965878 | 74 | Move(AvARRAY(av), AvALLOC(av), AvFILLp(av)+1, SV*); |
a0d0e21e LW |
75 | AvMAX(av) += tmp; |
76 | SvPVX(av) = (char*)AvALLOC(av); | |
77 | if (AvREAL(av)) { | |
78 | while (tmp) | |
79 | ary[--tmp] = &sv_undef; | |
80 | } | |
81 | ||
82 | if (key > AvMAX(av) - 10) { | |
83 | newmax = key + AvMAX(av); | |
84 | goto resize; | |
85 | } | |
86 | } | |
87 | else { | |
88 | if (AvALLOC(av)) { | |
c07a80fd | 89 | #ifndef STRANGE_MALLOC |
4633a7c4 | 90 | U32 bytes; |
c07a80fd | 91 | #endif |
4633a7c4 | 92 | |
a0d0e21e LW |
93 | newmax = key + AvMAX(av) / 5; |
94 | resize: | |
4633a7c4 | 95 | #ifdef STRANGE_MALLOC |
a0d0e21e | 96 | Renew(AvALLOC(av),newmax+1, SV*); |
4633a7c4 LW |
97 | #else |
98 | bytes = (newmax + 1) * sizeof(SV*); | |
99 | #define MALLOC_OVERHEAD 16 | |
100 | tmp = MALLOC_OVERHEAD; | |
101 | while (tmp - MALLOC_OVERHEAD < bytes) | |
102 | tmp += tmp; | |
103 | tmp -= MALLOC_OVERHEAD; | |
104 | tmp /= sizeof(SV*); | |
105 | assert(tmp > newmax); | |
106 | newmax = tmp - 1; | |
107 | New(2,ary, newmax+1, SV*); | |
108 | Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*); | |
fba3b22e MB |
109 | if (AvMAX(av) > 64) |
110 | offer_nice_chunk(AvALLOC(av), (AvMAX(av)+1) * sizeof(SV*)); | |
4633a7c4 LW |
111 | else |
112 | Safefree(AvALLOC(av)); | |
113 | AvALLOC(av) = ary; | |
114 | #endif | |
a0d0e21e LW |
115 | ary = AvALLOC(av) + AvMAX(av) + 1; |
116 | tmp = newmax - AvMAX(av); | |
7d55f622 | 117 | if (av == curstack) { /* Oops, grew stack (via av_store()?) */ |
a0d0e21e LW |
118 | stack_sp = AvALLOC(av) + (stack_sp - stack_base); |
119 | stack_base = AvALLOC(av); | |
120 | stack_max = stack_base + newmax; | |
121 | } | |
122 | } | |
123 | else { | |
124 | newmax = key < 4 ? 4 : key; | |
125 | New(2,AvALLOC(av), newmax+1, SV*); | |
126 | ary = AvALLOC(av) + 1; | |
127 | tmp = newmax; | |
128 | AvALLOC(av)[0] = &sv_undef; /* For the stacks */ | |
129 | } | |
130 | if (AvREAL(av)) { | |
131 | while (tmp) | |
132 | ary[--tmp] = &sv_undef; | |
133 | } | |
134 | ||
135 | SvPVX(av) = (char*)AvALLOC(av); | |
136 | AvMAX(av) = newmax; | |
137 | } | |
138 | } | |
139 | } | |
140 | ||
79072805 | 141 | SV** |
8ac85365 | 142 | av_fetch(register AV *av, I32 key, I32 lval) |
79072805 LW |
143 | { |
144 | SV *sv; | |
145 | ||
a0d0e21e LW |
146 | if (!av) |
147 | return 0; | |
148 | ||
93965878 NIS |
149 | if (key < 0) { |
150 | key += AvFILL(av) + 1; | |
151 | if (key < 0) | |
152 | return 0; | |
153 | } | |
154 | ||
8990e307 | 155 | if (SvRMAGICAL(av)) { |
463ee0b2 | 156 | if (mg_find((SV*)av,'P')) { |
11343788 | 157 | dTHR; |
8990e307 | 158 | sv = sv_newmortal(); |
463ee0b2 | 159 | mg_copy((SV*)av, sv, 0, key); |
463ee0b2 LW |
160 | Sv = sv; |
161 | return &Sv; | |
162 | } | |
163 | } | |
164 | ||
93965878 | 165 | if (key > AvFILLp(av)) { |
a0d0e21e LW |
166 | if (!lval) |
167 | return 0; | |
168 | if (AvREALISH(av)) | |
169 | sv = NEWSV(5,0); | |
170 | else | |
171 | sv = sv_newmortal(); | |
172 | return av_store(av,key,sv); | |
79072805 | 173 | } |
a0d0e21e | 174 | if (AvARRAY(av)[key] == &sv_undef) { |
4dbf4341 | 175 | emptyness: |
79072805 LW |
176 | if (lval) { |
177 | sv = NEWSV(6,0); | |
463ee0b2 | 178 | return av_store(av,key,sv); |
79072805 LW |
179 | } |
180 | return 0; | |
181 | } | |
4dbf4341 | 182 | else if (AvREIFY(av) |
183 | && (!AvARRAY(av)[key] /* eg. @_ could have freed elts */ | |
184 | || SvTYPE(AvARRAY(av)[key]) == SVTYPEMASK)) { | |
185 | AvARRAY(av)[key] = &sv_undef; /* 1/2 reify */ | |
186 | goto emptyness; | |
187 | } | |
463ee0b2 | 188 | return &AvARRAY(av)[key]; |
79072805 LW |
189 | } |
190 | ||
191 | SV** | |
8ac85365 | 192 | av_store(register AV *av, I32 key, SV *val) |
79072805 | 193 | { |
79072805 | 194 | SV** ary; |
93965878 NIS |
195 | U32 fill; |
196 | ||
79072805 | 197 | |
a0d0e21e LW |
198 | if (!av) |
199 | return 0; | |
43fcc5d2 CS |
200 | if (!val) |
201 | val = &sv_undef; | |
463ee0b2 | 202 | |
a0d0e21e LW |
203 | if (key < 0) { |
204 | key += AvFILL(av) + 1; | |
205 | if (key < 0) | |
206 | return 0; | |
79072805 | 207 | } |
93965878 | 208 | |
43fcc5d2 CS |
209 | if (SvREADONLY(av) && key >= AvFILL(av)) |
210 | croak(no_modify); | |
93965878 NIS |
211 | |
212 | if (SvRMAGICAL(av)) { | |
213 | if (mg_find((SV*)av,'P')) { | |
214 | if (val != &sv_undef) { | |
215 | mg_copy((SV*)av, val, 0, key); | |
216 | } | |
217 | return 0; | |
218 | } | |
219 | } | |
220 | ||
49beac48 | 221 | if (!AvREAL(av) && AvREIFY(av)) |
a0d0e21e | 222 | av_reify(av); |
a0d0e21e LW |
223 | if (key > AvMAX(av)) |
224 | av_extend(av,key); | |
463ee0b2 | 225 | ary = AvARRAY(av); |
93965878 | 226 | if (AvFILLp(av) < key) { |
a0d0e21e | 227 | if (!AvREAL(av)) { |
11343788 | 228 | dTHR; |
7d55f622 | 229 | if (av == curstack && key > stack_sp - stack_base) |
a0d0e21e LW |
230 | stack_sp = stack_base + key; /* XPUSH in disguise */ |
231 | do | |
93965878 NIS |
232 | ary[++AvFILLp(av)] = &sv_undef; |
233 | while (AvFILLp(av) < key); | |
79072805 | 234 | } |
93965878 | 235 | AvFILLp(av) = key; |
79072805 | 236 | } |
a0d0e21e LW |
237 | else if (AvREAL(av)) |
238 | SvREFCNT_dec(ary[key]); | |
79072805 | 239 | ary[key] = val; |
8990e307 | 240 | if (SvSMAGICAL(av)) { |
a0d0e21e LW |
241 | if (val != &sv_undef) { |
242 | MAGIC* mg = SvMAGIC(av); | |
243 | sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key); | |
244 | } | |
463ee0b2 LW |
245 | mg_set((SV*)av); |
246 | } | |
79072805 LW |
247 | return &ary[key]; |
248 | } | |
249 | ||
250 | AV * | |
8ac85365 | 251 | newAV(void) |
79072805 | 252 | { |
463ee0b2 | 253 | register AV *av; |
79072805 | 254 | |
a0d0e21e LW |
255 | av = (AV*)NEWSV(3,0); |
256 | sv_upgrade((SV *)av, SVt_PVAV); | |
463ee0b2 LW |
257 | AvREAL_on(av); |
258 | AvALLOC(av) = 0; | |
259 | SvPVX(av) = 0; | |
93965878 | 260 | AvMAX(av) = AvFILLp(av) = -1; |
463ee0b2 | 261 | return av; |
79072805 LW |
262 | } |
263 | ||
264 | AV * | |
8ac85365 | 265 | av_make(register I32 size, register SV **strp) |
79072805 | 266 | { |
463ee0b2 | 267 | register AV *av; |
79072805 LW |
268 | register I32 i; |
269 | register SV** ary; | |
270 | ||
a0d0e21e LW |
271 | av = (AV*)NEWSV(8,0); |
272 | sv_upgrade((SV *) av,SVt_PVAV); | |
a0d0e21e | 273 | AvFLAGS(av) = AVf_REAL; |
573fa4ea TB |
274 | if (size) { /* `defined' was returning undef for size==0 anyway. */ |
275 | New(4,ary,size,SV*); | |
276 | AvALLOC(av) = ary; | |
277 | SvPVX(av) = (char*)ary; | |
93965878 | 278 | AvFILLp(av) = size - 1; |
573fa4ea TB |
279 | AvMAX(av) = size - 1; |
280 | for (i = 0; i < size; i++) { | |
281 | assert (*strp); | |
282 | ary[i] = NEWSV(7,0); | |
283 | sv_setsv(ary[i], *strp); | |
284 | strp++; | |
285 | } | |
79072805 | 286 | } |
463ee0b2 | 287 | return av; |
79072805 LW |
288 | } |
289 | ||
290 | AV * | |
8ac85365 | 291 | av_fake(register I32 size, register SV **strp) |
79072805 | 292 | { |
463ee0b2 | 293 | register AV *av; |
79072805 LW |
294 | register SV** ary; |
295 | ||
a0d0e21e LW |
296 | av = (AV*)NEWSV(9,0); |
297 | sv_upgrade((SV *)av, SVt_PVAV); | |
79072805 | 298 | New(4,ary,size+1,SV*); |
463ee0b2 | 299 | AvALLOC(av) = ary; |
79072805 | 300 | Copy(strp,ary,size,SV*); |
a0d0e21e | 301 | AvFLAGS(av) = AVf_REIFY; |
463ee0b2 | 302 | SvPVX(av) = (char*)ary; |
93965878 | 303 | AvFILLp(av) = size - 1; |
463ee0b2 | 304 | AvMAX(av) = size - 1; |
79072805 | 305 | while (size--) { |
a0d0e21e LW |
306 | assert (*strp); |
307 | SvTEMP_off(*strp); | |
79072805 LW |
308 | strp++; |
309 | } | |
463ee0b2 | 310 | return av; |
79072805 LW |
311 | } |
312 | ||
313 | void | |
8ac85365 | 314 | av_clear(register AV *av) |
79072805 LW |
315 | { |
316 | register I32 key; | |
a0d0e21e | 317 | SV** ary; |
79072805 | 318 | |
7d55f622 | 319 | #ifdef DEBUGGING |
320 | if (SvREFCNT(av) <= 0) { | |
321 | warn("Attempt to clear deleted array"); | |
322 | } | |
323 | #endif | |
a60c0954 | 324 | if (!av) |
79072805 LW |
325 | return; |
326 | /*SUPPRESS 560*/ | |
a0d0e21e | 327 | |
93965878 NIS |
328 | /* Give any tie a chance to cleanup first */ |
329 | if (SvRMAGICAL(av)) | |
330 | mg_clear((SV*)av); | |
331 | ||
a60c0954 NIS |
332 | if (AvMAX(av) < 0) |
333 | return; | |
334 | ||
a0d0e21e LW |
335 | if (AvREAL(av)) { |
336 | ary = AvARRAY(av); | |
93965878 | 337 | key = AvFILLp(av) + 1; |
a0d0e21e LW |
338 | while (key) { |
339 | SvREFCNT_dec(ary[--key]); | |
340 | ary[key] = &sv_undef; | |
341 | } | |
342 | } | |
463ee0b2 LW |
343 | if (key = AvARRAY(av) - AvALLOC(av)) { |
344 | AvMAX(av) += key; | |
a0d0e21e | 345 | SvPVX(av) = (char*)AvALLOC(av); |
79072805 | 346 | } |
93965878 | 347 | AvFILLp(av) = -1; |
fb73857a | 348 | |
79072805 LW |
349 | } |
350 | ||
351 | void | |
8ac85365 | 352 | av_undef(register AV *av) |
79072805 LW |
353 | { |
354 | register I32 key; | |
355 | ||
463ee0b2 | 356 | if (!av) |
79072805 LW |
357 | return; |
358 | /*SUPPRESS 560*/ | |
93965878 NIS |
359 | |
360 | /* Give any tie a chance to cleanup first */ | |
361 | if (SvRMAGICAL(av) && mg_find((SV*)av,'P')) | |
362 | av_fill(av, -1); /* mg_clear() ? */ | |
363 | ||
a0d0e21e | 364 | if (AvREAL(av)) { |
93965878 | 365 | key = AvFILLp(av) + 1; |
a0d0e21e LW |
366 | while (key) |
367 | SvREFCNT_dec(AvARRAY(av)[--key]); | |
368 | } | |
463ee0b2 | 369 | Safefree(AvALLOC(av)); |
e1c148c2 | 370 | SvPVX(av) = 0; |
463ee0b2 LW |
371 | AvALLOC(av) = 0; |
372 | SvPVX(av) = 0; | |
93965878 | 373 | AvMAX(av) = AvFILLp(av) = -1; |
748a9306 LW |
374 | if (AvARYLEN(av)) { |
375 | SvREFCNT_dec(AvARYLEN(av)); | |
376 | AvARYLEN(av) = 0; | |
377 | } | |
79072805 LW |
378 | } |
379 | ||
a0d0e21e | 380 | void |
8ac85365 | 381 | av_push(register AV *av, SV *val) |
93965878 NIS |
382 | { |
383 | MAGIC *mg; | |
a0d0e21e LW |
384 | if (!av) |
385 | return; | |
93965878 NIS |
386 | if (SvREADONLY(av)) |
387 | croak(no_modify); | |
388 | ||
389 | if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) { | |
390 | dSP; | |
391 | PUSHMARK(sp); | |
392 | EXTEND(sp,2); | |
393 | PUSHs(mg->mg_obj); | |
394 | PUSHs(val); | |
a60c0954 NIS |
395 | PUTBACK; |
396 | ENTER; | |
93965878 | 397 | perl_call_method("PUSH", G_SCALAR|G_DISCARD); |
a60c0954 | 398 | LEAVE; |
93965878 NIS |
399 | return; |
400 | } | |
401 | av_store(av,AvFILLp(av)+1,val); | |
79072805 LW |
402 | } |
403 | ||
404 | SV * | |
8ac85365 | 405 | av_pop(register AV *av) |
79072805 LW |
406 | { |
407 | SV *retval; | |
93965878 | 408 | MAGIC* mg; |
79072805 | 409 | |
a0d0e21e LW |
410 | if (!av || AvFILL(av) < 0) |
411 | return &sv_undef; | |
43fcc5d2 CS |
412 | if (SvREADONLY(av)) |
413 | croak(no_modify); | |
93965878 NIS |
414 | if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) { |
415 | dSP; | |
416 | PUSHMARK(sp); | |
417 | XPUSHs(mg->mg_obj); | |
a60c0954 NIS |
418 | PUTBACK; |
419 | ENTER; | |
93965878 NIS |
420 | if (perl_call_method("POP", G_SCALAR)) { |
421 | retval = newSVsv(*stack_sp--); | |
422 | } else { | |
423 | retval = &sv_undef; | |
424 | } | |
a60c0954 | 425 | LEAVE; |
93965878 NIS |
426 | return retval; |
427 | } | |
428 | retval = AvARRAY(av)[AvFILLp(av)]; | |
429 | AvARRAY(av)[AvFILLp(av)--] = &sv_undef; | |
8990e307 | 430 | if (SvSMAGICAL(av)) |
463ee0b2 | 431 | mg_set((SV*)av); |
79072805 LW |
432 | return retval; |
433 | } | |
434 | ||
435 | void | |
8ac85365 | 436 | av_unshift(register AV *av, register I32 num) |
79072805 LW |
437 | { |
438 | register I32 i; | |
67a38de0 | 439 | register SV **ary; |
93965878 | 440 | MAGIC* mg; |
79072805 | 441 | |
a0d0e21e | 442 | if (!av || num <= 0) |
79072805 | 443 | return; |
43fcc5d2 CS |
444 | if (SvREADONLY(av)) |
445 | croak(no_modify); | |
93965878 NIS |
446 | |
447 | if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) { | |
448 | dSP; | |
449 | PUSHMARK(sp); | |
450 | EXTEND(sp,1+num); | |
451 | PUSHs(mg->mg_obj); | |
452 | while (num-- > 0) { | |
453 | PUSHs(&sv_undef); | |
454 | } | |
455 | PUTBACK; | |
a60c0954 | 456 | ENTER; |
93965878 | 457 | perl_call_method("UNSHIFT", G_SCALAR|G_DISCARD); |
a60c0954 | 458 | LEAVE; |
93965878 NIS |
459 | return; |
460 | } | |
461 | ||
49beac48 CS |
462 | if (!AvREAL(av) && AvREIFY(av)) |
463 | av_reify(av); | |
a0d0e21e LW |
464 | i = AvARRAY(av) - AvALLOC(av); |
465 | if (i) { | |
466 | if (i > num) | |
467 | i = num; | |
468 | num -= i; | |
469 | ||
470 | AvMAX(av) += i; | |
93965878 | 471 | AvFILLp(av) += i; |
a0d0e21e LW |
472 | SvPVX(av) = (char*)(AvARRAY(av) - i); |
473 | } | |
67a38de0 NIS |
474 | if (num) { |
475 | i = AvFILLp(av); | |
476 | av_extend(av, i + num); | |
93965878 | 477 | AvFILLp(av) += num; |
67a38de0 NIS |
478 | ary = AvARRAY(av); |
479 | Move(ary, ary + num, i + 1, SV*); | |
480 | do { | |
481 | ary[--num] = &sv_undef; | |
482 | } while (num); | |
79072805 LW |
483 | } |
484 | } | |
485 | ||
486 | SV * | |
8ac85365 | 487 | av_shift(register AV *av) |
79072805 LW |
488 | { |
489 | SV *retval; | |
93965878 | 490 | MAGIC* mg; |
79072805 | 491 | |
a0d0e21e LW |
492 | if (!av || AvFILL(av) < 0) |
493 | return &sv_undef; | |
43fcc5d2 CS |
494 | if (SvREADONLY(av)) |
495 | croak(no_modify); | |
93965878 NIS |
496 | if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) { |
497 | dSP; | |
498 | PUSHMARK(sp); | |
499 | XPUSHs(mg->mg_obj); | |
a60c0954 NIS |
500 | PUTBACK; |
501 | ENTER; | |
93965878 NIS |
502 | if (perl_call_method("SHIFT", G_SCALAR)) { |
503 | retval = newSVsv(*stack_sp--); | |
504 | } else { | |
505 | retval = &sv_undef; | |
a60c0954 NIS |
506 | } |
507 | LEAVE; | |
93965878 NIS |
508 | return retval; |
509 | } | |
463ee0b2 | 510 | retval = *AvARRAY(av); |
a0d0e21e LW |
511 | if (AvREAL(av)) |
512 | *AvARRAY(av) = &sv_undef; | |
463ee0b2 LW |
513 | SvPVX(av) = (char*)(AvARRAY(av) + 1); |
514 | AvMAX(av)--; | |
93965878 | 515 | AvFILLp(av)--; |
8990e307 | 516 | if (SvSMAGICAL(av)) |
463ee0b2 | 517 | mg_set((SV*)av); |
79072805 LW |
518 | return retval; |
519 | } | |
520 | ||
521 | I32 | |
8ac85365 | 522 | av_len(register AV *av) |
79072805 | 523 | { |
463ee0b2 | 524 | return AvFILL(av); |
79072805 LW |
525 | } |
526 | ||
527 | void | |
8ac85365 | 528 | av_fill(register AV *av, I32 fill) |
79072805 | 529 | { |
93965878 | 530 | MAGIC *mg; |
a0d0e21e LW |
531 | if (!av) |
532 | croak("panic: null array"); | |
79072805 LW |
533 | if (fill < 0) |
534 | fill = -1; | |
93965878 NIS |
535 | if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) { |
536 | dSP; | |
537 | ENTER; | |
538 | SAVETMPS; | |
539 | PUSHMARK(sp); | |
540 | EXTEND(sp,2); | |
541 | PUSHs(mg->mg_obj); | |
a60c0954 | 542 | PUSHs(sv_2mortal(newSViv(fill+1))); |
93965878 NIS |
543 | PUTBACK; |
544 | perl_call_method("STORESIZE", G_SCALAR|G_DISCARD); | |
545 | FREETMPS; | |
546 | LEAVE; | |
547 | return; | |
548 | } | |
463ee0b2 | 549 | if (fill <= AvMAX(av)) { |
93965878 | 550 | I32 key = AvFILLp(av); |
a0d0e21e LW |
551 | SV** ary = AvARRAY(av); |
552 | ||
553 | if (AvREAL(av)) { | |
554 | while (key > fill) { | |
555 | SvREFCNT_dec(ary[key]); | |
556 | ary[key--] = &sv_undef; | |
557 | } | |
558 | } | |
559 | else { | |
560 | while (key < fill) | |
561 | ary[++key] = &sv_undef; | |
562 | } | |
563 | ||
93965878 | 564 | AvFILLp(av) = fill; |
8990e307 | 565 | if (SvSMAGICAL(av)) |
463ee0b2 LW |
566 | mg_set((SV*)av); |
567 | } | |
a0d0e21e LW |
568 | else |
569 | (void)av_store(av,fill,&sv_undef); | |
79072805 | 570 | } |
c750a3ec | 571 | |
5d5aaa5e JP |
572 | |
573 | HV* | |
574 | avhv_keys(AV *av) | |
575 | { | |
576 | SV **keysp; | |
577 | HV *keys = Nullhv; | |
578 | ||
579 | keysp = av_fetch(av, 0, FALSE); | |
580 | if (keysp) { | |
d627ae4e MB |
581 | SV *sv = *keysp; |
582 | if (SvGMAGICAL(sv)) | |
583 | mg_get(sv); | |
584 | if (SvROK(sv)) { | |
585 | sv = SvRV(sv); | |
586 | if (SvTYPE(sv) == SVt_PVHV) | |
587 | keys = (HV*)sv; | |
5d5aaa5e JP |
588 | } |
589 | } | |
590 | if (!keys) | |
591 | croak("Can't coerce array into hash"); | |
592 | return keys; | |
593 | } | |
594 | ||
c750a3ec | 595 | SV** |
8ac85365 | 596 | avhv_fetch(AV *av, char *key, U32 klen, I32 lval) |
c750a3ec | 597 | { |
5d5aaa5e JP |
598 | SV **indsvp; |
599 | HV *keys = avhv_keys(av); | |
c750a3ec MB |
600 | I32 ind; |
601 | ||
5d5aaa5e | 602 | indsvp = hv_fetch(keys, key, klen, FALSE); |
c750a3ec MB |
603 | if (indsvp) { |
604 | ind = SvIV(*indsvp); | |
605 | if (ind < 1) | |
606 | croak("Bad index while coercing array into hash"); | |
607 | } else { | |
608 | if (!lval) | |
609 | return 0; | |
610 | ||
611 | ind = AvFILL(av) + 1; | |
5d5aaa5e | 612 | hv_store(keys, key, klen, newSViv(ind), 0); |
c750a3ec MB |
613 | } |
614 | return av_fetch(av, ind, lval); | |
615 | } | |
616 | ||
617 | SV** | |
8ac85365 | 618 | avhv_fetch_ent(AV *av, SV *keysv, I32 lval, U32 hash) |
97fcbf96 | 619 | { |
5d5aaa5e JP |
620 | SV **indsvp; |
621 | HV *keys = avhv_keys(av); | |
97fcbf96 MB |
622 | HE *he; |
623 | I32 ind; | |
624 | ||
5d5aaa5e | 625 | he = hv_fetch_ent(keys, keysv, FALSE, hash); |
97fcbf96 MB |
626 | if (he) { |
627 | ind = SvIV(HeVAL(he)); | |
628 | if (ind < 1) | |
629 | croak("Bad index while coercing array into hash"); | |
630 | } else { | |
631 | if (!lval) | |
632 | return 0; | |
633 | ||
634 | ind = AvFILL(av) + 1; | |
5d5aaa5e | 635 | hv_store_ent(keys, keysv, newSViv(ind), 0); |
97fcbf96 MB |
636 | } |
637 | return av_fetch(av, ind, lval); | |
638 | } | |
639 | ||
640 | SV** | |
8ac85365 | 641 | avhv_store(AV *av, char *key, U32 klen, SV *val, U32 hash) |
c750a3ec | 642 | { |
5d5aaa5e JP |
643 | SV **indsvp; |
644 | HV *keys = avhv_keys(av); | |
c750a3ec MB |
645 | I32 ind; |
646 | ||
5d5aaa5e | 647 | indsvp = hv_fetch(keys, key, klen, FALSE); |
c750a3ec MB |
648 | if (indsvp) { |
649 | ind = SvIV(*indsvp); | |
650 | if (ind < 1) | |
651 | croak("Bad index while coercing array into hash"); | |
652 | } else { | |
653 | ind = AvFILL(av) + 1; | |
5d5aaa5e | 654 | hv_store(keys, key, klen, newSViv(ind), hash); |
c750a3ec MB |
655 | } |
656 | return av_store(av, ind, val); | |
657 | } | |
658 | ||
5bc6513d | 659 | SV** |
8ac85365 | 660 | avhv_store_ent(AV *av, SV *keysv, SV *val, U32 hash) |
5bc6513d | 661 | { |
5d5aaa5e | 662 | HV *keys = avhv_keys(av); |
5bc6513d MB |
663 | HE *he; |
664 | I32 ind; | |
665 | ||
5d5aaa5e | 666 | he = hv_fetch_ent(keys, keysv, FALSE, hash); |
5bc6513d MB |
667 | if (he) { |
668 | ind = SvIV(HeVAL(he)); | |
669 | if (ind < 1) | |
670 | croak("Bad index while coercing array into hash"); | |
671 | } else { | |
672 | ind = AvFILL(av) + 1; | |
5d5aaa5e | 673 | hv_store_ent(keys, keysv, newSViv(ind), hash); |
5bc6513d MB |
674 | } |
675 | return av_store(av, ind, val); | |
676 | } | |
677 | ||
c750a3ec | 678 | bool |
8ac85365 | 679 | avhv_exists_ent(AV *av, SV *keysv, U32 hash) |
97fcbf96 | 680 | { |
5d5aaa5e JP |
681 | HV *keys = avhv_keys(av); |
682 | return hv_exists_ent(keys, keysv, hash); | |
97fcbf96 MB |
683 | } |
684 | ||
685 | bool | |
8ac85365 | 686 | avhv_exists(AV *av, char *key, U32 klen) |
c750a3ec | 687 | { |
5d5aaa5e JP |
688 | HV *keys = avhv_keys(av); |
689 | return hv_exists(keys, key, klen); | |
c750a3ec MB |
690 | } |
691 | ||
692 | /* avhv_delete leaks. Caller can re-index and compress if so desired. */ | |
693 | SV * | |
8ac85365 | 694 | avhv_delete(AV *av, char *key, U32 klen, I32 flags) |
c750a3ec | 695 | { |
5d5aaa5e | 696 | HV *keys = avhv_keys(av); |
c750a3ec MB |
697 | SV *sv; |
698 | SV **svp; | |
699 | I32 ind; | |
700 | ||
5d5aaa5e | 701 | sv = hv_delete(keys, key, klen, 0); |
c750a3ec MB |
702 | if (!sv) |
703 | return Nullsv; | |
704 | ind = SvIV(sv); | |
705 | if (ind < 1) | |
706 | croak("Bad index while coercing array into hash"); | |
707 | svp = av_fetch(av, ind, FALSE); | |
708 | if (!svp) | |
709 | return Nullsv; | |
710 | if (flags & G_DISCARD) { | |
711 | sv = Nullsv; | |
712 | SvREFCNT_dec(*svp); | |
713 | } else { | |
714 | sv = sv_2mortal(*svp); | |
715 | } | |
716 | *svp = &sv_undef; | |
717 | return sv; | |
718 | } | |
719 | ||
97fcbf96 MB |
720 | /* avhv_delete_ent leaks. Caller can re-index and compress if so desired. */ |
721 | SV * | |
8ac85365 | 722 | avhv_delete_ent(AV *av, SV *keysv, I32 flags, U32 hash) |
97fcbf96 | 723 | { |
5d5aaa5e | 724 | HV *keys = avhv_keys(av); |
97fcbf96 MB |
725 | SV *sv; |
726 | SV **svp; | |
727 | I32 ind; | |
728 | ||
5d5aaa5e | 729 | sv = hv_delete_ent(keys, keysv, 0, hash); |
97fcbf96 MB |
730 | if (!sv) |
731 | return Nullsv; | |
732 | ind = SvIV(sv); | |
733 | if (ind < 1) | |
734 | croak("Bad index while coercing array into hash"); | |
735 | svp = av_fetch(av, ind, FALSE); | |
736 | if (!svp) | |
737 | return Nullsv; | |
738 | if (flags & G_DISCARD) { | |
739 | sv = Nullsv; | |
740 | SvREFCNT_dec(*svp); | |
741 | } else { | |
742 | sv = sv_2mortal(*svp); | |
743 | } | |
744 | *svp = &sv_undef; | |
745 | return sv; | |
746 | } | |
747 | ||
c750a3ec | 748 | I32 |
8ac85365 | 749 | avhv_iterinit(AV *av) |
c750a3ec | 750 | { |
5d5aaa5e JP |
751 | HV *keys = avhv_keys(av); |
752 | return hv_iterinit(keys); | |
c750a3ec MB |
753 | } |
754 | ||
755 | HE * | |
8ac85365 | 756 | avhv_iternext(AV *av) |
c750a3ec | 757 | { |
5d5aaa5e JP |
758 | HV *keys = avhv_keys(av); |
759 | return hv_iternext(keys); | |
c750a3ec MB |
760 | } |
761 | ||
762 | SV * | |
8ac85365 | 763 | avhv_iterval(AV *av, register HE *entry) |
c750a3ec | 764 | { |
5d5aaa5e | 765 | HV *keys = avhv_keys(av); |
c750a3ec MB |
766 | SV *sv; |
767 | I32 ind; | |
768 | ||
5d5aaa5e | 769 | sv = hv_iterval(keys, entry); |
c750a3ec MB |
770 | ind = SvIV(sv); |
771 | if (ind < 1) | |
772 | croak("Bad index while coercing array into hash"); | |
773 | return *av_fetch(av, ind, TRUE); | |
774 | } | |
775 | ||
776 | SV * | |
8ac85365 | 777 | avhv_iternextsv(AV *av, char **key, I32 *retlen) |
c750a3ec | 778 | { |
5d5aaa5e | 779 | HV *keys = avhv_keys(av); |
c750a3ec MB |
780 | HE *he; |
781 | SV *sv; | |
782 | I32 ind; | |
783 | ||
5d5aaa5e JP |
784 | he = hv_iternext(keys); |
785 | if (!he) | |
786 | return Nullsv; | |
c750a3ec | 787 | *key = hv_iterkey(he, retlen); |
5d5aaa5e | 788 | sv = hv_iterval(keys, he); |
c750a3ec MB |
789 | ind = SvIV(sv); |
790 | if (ind < 1) | |
791 | croak("Bad index while coercing array into hash"); | |
792 | return *av_fetch(av, ind, TRUE); | |
793 | } |