This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Describe interation of untie and DESTROY
[perl5.git] / av.c
CommitLineData
a0d0e21e 1/* av.c
79072805 2 *
a0d0e21e 3 * Copyright (c) 1991-1994, 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
a0d0e21e
LW
18static void av_reify _((AV* av));
19
20static void
21av_reify(av)
22AV* av;
23{
24 I32 key;
25 SV* sv;
26
27 key = AvMAX(av) + 1;
28 while (key > AvFILL(av) + 1)
29 AvARRAY(av)[--key] = &sv_undef;
30 while (key) {
31 sv = AvARRAY(av)[--key];
32 assert(sv);
33 if (sv != &sv_undef)
34 (void)SvREFCNT_inc(sv);
35 }
36 AvREAL_on(av);
37}
38
39void
40av_extend(av,key)
41AV *av;
42I32 key;
43{
44 if (key > AvMAX(av)) {
45 SV** ary;
46 I32 tmp;
47 I32 newmax;
48
49 if (AvALLOC(av) != AvARRAY(av)) {
50 ary = AvALLOC(av) + AvFILL(av) + 1;
51 tmp = AvARRAY(av) - AvALLOC(av);
52 Move(AvARRAY(av), AvALLOC(av), AvFILL(av)+1, SV*);
53 AvMAX(av) += tmp;
54 SvPVX(av) = (char*)AvALLOC(av);
55 if (AvREAL(av)) {
56 while (tmp)
57 ary[--tmp] = &sv_undef;
58 }
59
60 if (key > AvMAX(av) - 10) {
61 newmax = key + AvMAX(av);
62 goto resize;
63 }
64 }
65 else {
66 if (AvALLOC(av)) {
c07a80fd 67#ifndef STRANGE_MALLOC
4633a7c4 68 U32 bytes;
c07a80fd 69#endif
4633a7c4 70
a0d0e21e
LW
71 newmax = key + AvMAX(av) / 5;
72 resize:
4633a7c4 73#ifdef STRANGE_MALLOC
a0d0e21e 74 Renew(AvALLOC(av),newmax+1, SV*);
4633a7c4
LW
75#else
76 bytes = (newmax + 1) * sizeof(SV*);
77#define MALLOC_OVERHEAD 16
78 tmp = MALLOC_OVERHEAD;
79 while (tmp - MALLOC_OVERHEAD < bytes)
80 tmp += tmp;
81 tmp -= MALLOC_OVERHEAD;
82 tmp /= sizeof(SV*);
83 assert(tmp > newmax);
84 newmax = tmp - 1;
85 New(2,ary, newmax+1, SV*);
86 Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*);
c07a80fd 87 if (AvMAX(av) > 64 && !nice_chunk) {
88 nice_chunk = (char*)AvALLOC(av);
89 nice_chunk_size = (AvMAX(av) + 1) * sizeof(SV*);
90 }
4633a7c4
LW
91 else
92 Safefree(AvALLOC(av));
93 AvALLOC(av) = ary;
94#endif
a0d0e21e
LW
95 ary = AvALLOC(av) + AvMAX(av) + 1;
96 tmp = newmax - AvMAX(av);
7d55f622 97 if (av == curstack) { /* Oops, grew stack (via av_store()?) */
a0d0e21e
LW
98 stack_sp = AvALLOC(av) + (stack_sp - stack_base);
99 stack_base = AvALLOC(av);
100 stack_max = stack_base + newmax;
101 }
102 }
103 else {
104 newmax = key < 4 ? 4 : key;
105 New(2,AvALLOC(av), newmax+1, SV*);
106 ary = AvALLOC(av) + 1;
107 tmp = newmax;
108 AvALLOC(av)[0] = &sv_undef; /* For the stacks */
109 }
110 if (AvREAL(av)) {
111 while (tmp)
112 ary[--tmp] = &sv_undef;
113 }
114
115 SvPVX(av) = (char*)AvALLOC(av);
116 AvMAX(av) = newmax;
117 }
118 }
119}
120
79072805 121SV**
463ee0b2
LW
122av_fetch(av,key,lval)
123register AV *av;
79072805
LW
124I32 key;
125I32 lval;
126{
127 SV *sv;
128
a0d0e21e
LW
129 if (!av)
130 return 0;
131
8990e307 132 if (SvRMAGICAL(av)) {
463ee0b2 133 if (mg_find((SV*)av,'P')) {
8990e307 134 sv = sv_newmortal();
463ee0b2 135 mg_copy((SV*)av, sv, 0, key);
463ee0b2
LW
136 Sv = sv;
137 return &Sv;
138 }
139 }
140
a0d0e21e
LW
141 if (key < 0) {
142 key += AvFILL(av) + 1;
143 if (key < 0)
144 return 0;
145 }
146 else if (key > AvFILL(av)) {
147 if (!lval)
148 return 0;
149 if (AvREALISH(av))
150 sv = NEWSV(5,0);
151 else
152 sv = sv_newmortal();
153 return av_store(av,key,sv);
79072805 154 }
a0d0e21e 155 if (AvARRAY(av)[key] == &sv_undef) {
4dbf4341 156 emptyness:
79072805
LW
157 if (lval) {
158 sv = NEWSV(6,0);
463ee0b2 159 return av_store(av,key,sv);
79072805
LW
160 }
161 return 0;
162 }
4dbf4341 163 else if (AvREIFY(av)
164 && (!AvARRAY(av)[key] /* eg. @_ could have freed elts */
165 || SvTYPE(AvARRAY(av)[key]) == SVTYPEMASK)) {
166 AvARRAY(av)[key] = &sv_undef; /* 1/2 reify */
167 goto emptyness;
168 }
463ee0b2 169 return &AvARRAY(av)[key];
79072805
LW
170}
171
172SV**
463ee0b2
LW
173av_store(av,key,val)
174register AV *av;
79072805
LW
175I32 key;
176SV *val;
177{
79072805
LW
178 SV** ary;
179
a0d0e21e
LW
180 if (!av)
181 return 0;
43fcc5d2
CS
182 if (!val)
183 val = &sv_undef;
463ee0b2 184
8990e307 185 if (SvRMAGICAL(av)) {
463ee0b2 186 if (mg_find((SV*)av,'P')) {
43fcc5d2
CS
187 if (val != &sv_undef)
188 mg_copy((SV*)av, val, 0, key);
463ee0b2
LW
189 return 0;
190 }
191 }
192
a0d0e21e
LW
193 if (key < 0) {
194 key += AvFILL(av) + 1;
195 if (key < 0)
196 return 0;
79072805 197 }
43fcc5d2
CS
198 if (SvREADONLY(av) && key >= AvFILL(av))
199 croak(no_modify);
a0d0e21e
LW
200 if (key > AvMAX(av))
201 av_extend(av,key);
49beac48 202 if (!AvREAL(av) && AvREIFY(av))
a0d0e21e 203 av_reify(av);
463ee0b2 204 ary = AvARRAY(av);
a0d0e21e
LW
205 if (AvFILL(av) < key) {
206 if (!AvREAL(av)) {
7d55f622 207 if (av == curstack && key > stack_sp - stack_base)
a0d0e21e
LW
208 stack_sp = stack_base + key; /* XPUSH in disguise */
209 do
210 ary[++AvFILL(av)] = &sv_undef;
211 while (AvFILL(av) < key);
79072805 212 }
a0d0e21e 213 AvFILL(av) = key;
79072805 214 }
a0d0e21e
LW
215 else if (AvREAL(av))
216 SvREFCNT_dec(ary[key]);
79072805 217 ary[key] = val;
8990e307 218 if (SvSMAGICAL(av)) {
a0d0e21e
LW
219 if (val != &sv_undef) {
220 MAGIC* mg = SvMAGIC(av);
221 sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key);
222 }
463ee0b2
LW
223 mg_set((SV*)av);
224 }
79072805
LW
225 return &ary[key];
226}
227
228AV *
229newAV()
230{
463ee0b2 231 register AV *av;
79072805 232
a0d0e21e
LW
233 av = (AV*)NEWSV(3,0);
234 sv_upgrade((SV *)av, SVt_PVAV);
463ee0b2
LW
235 AvREAL_on(av);
236 AvALLOC(av) = 0;
237 SvPVX(av) = 0;
238 AvMAX(av) = AvFILL(av) = -1;
239 return av;
79072805
LW
240}
241
242AV *
243av_make(size,strp)
244register I32 size;
245register SV **strp;
246{
463ee0b2 247 register AV *av;
79072805
LW
248 register I32 i;
249 register SV** ary;
250
a0d0e21e
LW
251 av = (AV*)NEWSV(8,0);
252 sv_upgrade((SV *) av,SVt_PVAV);
79072805 253 New(4,ary,size+1,SV*);
463ee0b2 254 AvALLOC(av) = ary;
a0d0e21e 255 AvFLAGS(av) = AVf_REAL;
463ee0b2
LW
256 SvPVX(av) = (char*)ary;
257 AvFILL(av) = size - 1;
258 AvMAX(av) = size - 1;
79072805 259 for (i = 0; i < size; i++) {
a0d0e21e
LW
260 assert (*strp);
261 ary[i] = NEWSV(7,0);
262 sv_setsv(ary[i], *strp);
79072805
LW
263 strp++;
264 }
463ee0b2 265 return av;
79072805
LW
266}
267
268AV *
269av_fake(size,strp)
270register I32 size;
271register SV **strp;
272{
463ee0b2 273 register AV *av;
79072805
LW
274 register SV** ary;
275
a0d0e21e
LW
276 av = (AV*)NEWSV(9,0);
277 sv_upgrade((SV *)av, SVt_PVAV);
79072805 278 New(4,ary,size+1,SV*);
463ee0b2 279 AvALLOC(av) = ary;
79072805 280 Copy(strp,ary,size,SV*);
a0d0e21e 281 AvFLAGS(av) = AVf_REIFY;
463ee0b2
LW
282 SvPVX(av) = (char*)ary;
283 AvFILL(av) = size - 1;
284 AvMAX(av) = size - 1;
79072805 285 while (size--) {
a0d0e21e
LW
286 assert (*strp);
287 SvTEMP_off(*strp);
79072805
LW
288 strp++;
289 }
463ee0b2 290 return av;
79072805
LW
291}
292
293void
463ee0b2
LW
294av_clear(av)
295register AV *av;
79072805
LW
296{
297 register I32 key;
a0d0e21e 298 SV** ary;
79072805 299
7d55f622 300#ifdef DEBUGGING
301 if (SvREFCNT(av) <= 0) {
302 warn("Attempt to clear deleted array");
303 }
304#endif
a0d0e21e 305 if (!av || AvMAX(av) < 0)
79072805
LW
306 return;
307 /*SUPPRESS 560*/
a0d0e21e
LW
308
309 if (AvREAL(av)) {
310 ary = AvARRAY(av);
311 key = AvFILL(av) + 1;
312 while (key) {
313 SvREFCNT_dec(ary[--key]);
314 ary[key] = &sv_undef;
315 }
316 }
463ee0b2
LW
317 if (key = AvARRAY(av) - AvALLOC(av)) {
318 AvMAX(av) += key;
a0d0e21e 319 SvPVX(av) = (char*)AvALLOC(av);
79072805 320 }
463ee0b2 321 AvFILL(av) = -1;
79072805
LW
322}
323
324void
463ee0b2
LW
325av_undef(av)
326register AV *av;
79072805
LW
327{
328 register I32 key;
329
463ee0b2 330 if (!av)
79072805
LW
331 return;
332 /*SUPPRESS 560*/
a0d0e21e
LW
333 if (AvREAL(av)) {
334 key = AvFILL(av) + 1;
335 while (key)
336 SvREFCNT_dec(AvARRAY(av)[--key]);
337 }
463ee0b2
LW
338 Safefree(AvALLOC(av));
339 AvALLOC(av) = 0;
340 SvPVX(av) = 0;
341 AvMAX(av) = AvFILL(av) = -1;
748a9306
LW
342 if (AvARYLEN(av)) {
343 SvREFCNT_dec(AvARYLEN(av));
344 AvARYLEN(av) = 0;
345 }
79072805
LW
346}
347
a0d0e21e 348void
463ee0b2
LW
349av_push(av,val)
350register AV *av;
79072805
LW
351SV *val;
352{
a0d0e21e
LW
353 if (!av)
354 return;
355 av_store(av,AvFILL(av)+1,val);
79072805
LW
356}
357
358SV *
463ee0b2
LW
359av_pop(av)
360register AV *av;
79072805
LW
361{
362 SV *retval;
363
a0d0e21e
LW
364 if (!av || AvFILL(av) < 0)
365 return &sv_undef;
43fcc5d2
CS
366 if (SvREADONLY(av))
367 croak(no_modify);
463ee0b2 368 retval = AvARRAY(av)[AvFILL(av)];
a0d0e21e 369 AvARRAY(av)[AvFILL(av)--] = &sv_undef;
8990e307 370 if (SvSMAGICAL(av))
463ee0b2 371 mg_set((SV*)av);
79072805
LW
372 return retval;
373}
374
375void
463ee0b2
LW
376av_unshift(av,num)
377register AV *av;
79072805
LW
378register I32 num;
379{
380 register I32 i;
381 register SV **sstr,**dstr;
382
a0d0e21e 383 if (!av || num <= 0)
79072805 384 return;
43fcc5d2
CS
385 if (SvREADONLY(av))
386 croak(no_modify);
49beac48
CS
387 if (!AvREAL(av) && AvREIFY(av))
388 av_reify(av);
a0d0e21e
LW
389 i = AvARRAY(av) - AvALLOC(av);
390 if (i) {
391 if (i > num)
392 i = num;
393 num -= i;
394
395 AvMAX(av) += i;
396 AvFILL(av) += i;
397 SvPVX(av) = (char*)(AvARRAY(av) - i);
398 }
399 if (num) {
400 av_extend(av,AvFILL(av)+num);
401 AvFILL(av) += num;
463ee0b2 402 dstr = AvARRAY(av) + AvFILL(av);
79072805
LW
403 sstr = dstr - num;
404#ifdef BUGGY_MSC5
405 # pragma loop_opt(off) /* don't loop-optimize the following code */
406#endif /* BUGGY_MSC5 */
a0d0e21e 407 for (i = AvFILL(av) - num; i >= 0; --i) {
79072805
LW
408 *dstr-- = *sstr--;
409#ifdef BUGGY_MSC5
410 # pragma loop_opt() /* loop-optimization back to command-line setting */
411#endif /* BUGGY_MSC5 */
412 }
a0d0e21e
LW
413 while (num)
414 AvARRAY(av)[--num] = &sv_undef;
79072805
LW
415 }
416}
417
418SV *
463ee0b2
LW
419av_shift(av)
420register AV *av;
79072805
LW
421{
422 SV *retval;
423
a0d0e21e
LW
424 if (!av || AvFILL(av) < 0)
425 return &sv_undef;
43fcc5d2
CS
426 if (SvREADONLY(av))
427 croak(no_modify);
463ee0b2 428 retval = *AvARRAY(av);
a0d0e21e
LW
429 if (AvREAL(av))
430 *AvARRAY(av) = &sv_undef;
463ee0b2
LW
431 SvPVX(av) = (char*)(AvARRAY(av) + 1);
432 AvMAX(av)--;
433 AvFILL(av)--;
8990e307 434 if (SvSMAGICAL(av))
463ee0b2 435 mg_set((SV*)av);
79072805
LW
436 return retval;
437}
438
439I32
463ee0b2
LW
440av_len(av)
441register AV *av;
79072805 442{
463ee0b2 443 return AvFILL(av);
79072805
LW
444}
445
446void
463ee0b2
LW
447av_fill(av, fill)
448register AV *av;
79072805
LW
449I32 fill;
450{
a0d0e21e
LW
451 if (!av)
452 croak("panic: null array");
79072805
LW
453 if (fill < 0)
454 fill = -1;
463ee0b2 455 if (fill <= AvMAX(av)) {
a0d0e21e
LW
456 I32 key = AvFILL(av);
457 SV** ary = AvARRAY(av);
458
459 if (AvREAL(av)) {
460 while (key > fill) {
461 SvREFCNT_dec(ary[key]);
462 ary[key--] = &sv_undef;
463 }
464 }
465 else {
466 while (key < fill)
467 ary[++key] = &sv_undef;
468 }
469
463ee0b2 470 AvFILL(av) = fill;
8990e307 471 if (SvSMAGICAL(av))
463ee0b2
LW
472 mg_set((SV*)av);
473 }
a0d0e21e
LW
474 else
475 (void)av_store(av,fill,&sv_undef);
79072805 476}