This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix %ENV assignment when environment starts out empty
[perl5.git] / av.c
1 /*    av.c
2  *
3  *    Copyright (c) 1991-1994, Larry Wall
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  *
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
13  */
14
15 #include "EXTERN.h"
16 #include "perl.h"
17
18 static void     av_reify _((AV* av));
19
20 static void
21 av_reify(av)
22 AV* 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
39 void
40 av_extend(av,key)
41 AV *av;
42 I32 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)) {
67 #ifndef STRANGE_MALLOC
68                 U32 bytes;
69 #endif
70
71                 newmax = key + AvMAX(av) / 5;
72               resize:
73 #ifdef STRANGE_MALLOC
74                 Renew(AvALLOC(av),newmax+1, SV*);
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*);
87                 if (AvMAX(av) > 64 && !nice_chunk) {
88                     nice_chunk = (char*)AvALLOC(av);
89                     nice_chunk_size = (AvMAX(av) + 1) * sizeof(SV*);
90                 }
91                 else
92                     Safefree(AvALLOC(av));
93                 AvALLOC(av) = ary;
94 #endif
95                 ary = AvALLOC(av) + AvMAX(av) + 1;
96                 tmp = newmax - AvMAX(av);
97                 if (av == curstack) {   /* Oops, grew stack (via av_store()?) */
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
121 SV**
122 av_fetch(av,key,lval)
123 register AV *av;
124 I32 key;
125 I32 lval;
126 {
127     SV *sv;
128
129     if (!av)
130         return 0;
131
132     if (SvRMAGICAL(av)) {
133         if (mg_find((SV*)av,'P')) {
134             sv = sv_newmortal();
135             mg_copy((SV*)av, sv, 0, key);
136             Sv = sv;
137             return &Sv;
138         }
139     }
140
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);
154     }
155     if (AvARRAY(av)[key] == &sv_undef) {
156     emptyness:
157         if (lval) {
158             sv = NEWSV(6,0);
159             return av_store(av,key,sv);
160         }
161         return 0;
162     }
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     }
169     return &AvARRAY(av)[key];
170 }
171
172 SV**
173 av_store(av,key,val)
174 register AV *av;
175 I32 key;
176 SV *val;
177 {
178     SV** ary;
179
180     if (!av)
181         return 0;
182
183     if (SvRMAGICAL(av)) {
184         if (mg_find((SV*)av,'P')) {
185             mg_copy((SV*)av, val, 0, key);
186             return 0;
187         }
188     }
189
190     if (key < 0) {
191         key += AvFILL(av) + 1;
192         if (key < 0)
193             return 0;
194     }
195     if (!val)
196         val = &sv_undef;
197
198     if (key > AvMAX(av))
199         av_extend(av,key);
200     if (AvREIFY(av))
201         av_reify(av);
202
203     ary = AvARRAY(av);
204     if (AvFILL(av) < key) {
205         if (!AvREAL(av)) {
206             if (av == curstack && key > stack_sp - stack_base)
207                 stack_sp = stack_base + key;    /* XPUSH in disguise */
208             do
209                 ary[++AvFILL(av)] = &sv_undef;
210             while (AvFILL(av) < key);
211         }
212         AvFILL(av) = key;
213     }
214     else if (AvREAL(av))
215         SvREFCNT_dec(ary[key]);
216     ary[key] = val;
217     if (SvSMAGICAL(av)) {
218         if (val != &sv_undef) {
219             MAGIC* mg = SvMAGIC(av);
220             sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key);
221         }
222         mg_set((SV*)av);
223     }
224     return &ary[key];
225 }
226
227 AV *
228 newAV()
229 {
230     register AV *av;
231
232     av = (AV*)NEWSV(3,0);
233     sv_upgrade((SV *)av, SVt_PVAV);
234     AvREAL_on(av);
235     AvALLOC(av) = 0;
236     SvPVX(av) = 0;
237     AvMAX(av) = AvFILL(av) = -1;
238     return av;
239 }
240
241 AV *
242 av_make(size,strp)
243 register I32 size;
244 register SV **strp;
245 {
246     register AV *av;
247     register I32 i;
248     register SV** ary;
249
250     av = (AV*)NEWSV(8,0);
251     sv_upgrade((SV *) av,SVt_PVAV);
252     New(4,ary,size+1,SV*);
253     AvALLOC(av) = ary;
254     AvFLAGS(av) = AVf_REAL;
255     SvPVX(av) = (char*)ary;
256     AvFILL(av) = size - 1;
257     AvMAX(av) = size - 1;
258     for (i = 0; i < size; i++) {
259         assert (*strp);
260         ary[i] = NEWSV(7,0);
261         sv_setsv(ary[i], *strp);
262         strp++;
263     }
264     return av;
265 }
266
267 AV *
268 av_fake(size,strp)
269 register I32 size;
270 register SV **strp;
271 {
272     register AV *av;
273     register SV** ary;
274
275     av = (AV*)NEWSV(9,0);
276     sv_upgrade((SV *)av, SVt_PVAV);
277     New(4,ary,size+1,SV*);
278     AvALLOC(av) = ary;
279     Copy(strp,ary,size,SV*);
280     AvFLAGS(av) = AVf_REIFY;
281     SvPVX(av) = (char*)ary;
282     AvFILL(av) = size - 1;
283     AvMAX(av) = size - 1;
284     while (size--) {
285         assert (*strp);
286         SvTEMP_off(*strp);
287         strp++;
288     }
289     return av;
290 }
291
292 void
293 av_clear(av)
294 register AV *av;
295 {
296     register I32 key;
297     SV** ary;
298
299 #ifdef DEBUGGING
300     if (SvREFCNT(av) <= 0) {
301         warn("Attempt to clear deleted array");
302     }
303 #endif
304     if (!av || AvMAX(av) < 0)
305         return;
306     /*SUPPRESS 560*/
307
308     if (AvREAL(av)) {
309         ary = AvARRAY(av);
310         key = AvFILL(av) + 1;
311         while (key) {
312             SvREFCNT_dec(ary[--key]);
313             ary[key] = &sv_undef;
314         }
315     }
316     if (key = AvARRAY(av) - AvALLOC(av)) {
317         AvMAX(av) += key;
318         SvPVX(av) = (char*)AvALLOC(av);
319     }
320     AvFILL(av) = -1;
321 }
322
323 void
324 av_undef(av)
325 register AV *av;
326 {
327     register I32 key;
328
329     if (!av)
330         return;
331     /*SUPPRESS 560*/
332     if (AvREAL(av)) {
333         key = AvFILL(av) + 1;
334         while (key)
335             SvREFCNT_dec(AvARRAY(av)[--key]);
336     }
337     Safefree(AvALLOC(av));
338     AvALLOC(av) = 0;
339     SvPVX(av) = 0;
340     AvMAX(av) = AvFILL(av) = -1;
341     if (AvARYLEN(av)) {
342         SvREFCNT_dec(AvARYLEN(av));
343         AvARYLEN(av) = 0;
344     }
345 }
346
347 void
348 av_push(av,val)
349 register AV *av;
350 SV *val;
351 {
352     if (!av)
353         return;
354     av_store(av,AvFILL(av)+1,val);
355 }
356
357 SV *
358 av_pop(av)
359 register AV *av;
360 {
361     SV *retval;
362
363     if (!av || AvFILL(av) < 0)
364         return &sv_undef;
365     retval = AvARRAY(av)[AvFILL(av)];
366     AvARRAY(av)[AvFILL(av)--] = &sv_undef;
367     if (SvSMAGICAL(av))
368         mg_set((SV*)av);
369     return retval;
370 }
371
372 void
373 av_unshift(av,num)
374 register AV *av;
375 register I32 num;
376 {
377     register I32 i;
378     register SV **sstr,**dstr;
379
380     if (!av || num <= 0)
381         return;
382     if (!AvREAL(av)) {
383         if (AvREIFY(av))
384             av_reify(av);
385         else
386             croak("Can't unshift");
387     }
388     i = AvARRAY(av) - AvALLOC(av);
389     if (i) {
390         if (i > num)
391             i = num;
392         num -= i;
393     
394         AvMAX(av) += i;
395         AvFILL(av) += i;
396         SvPVX(av) = (char*)(AvARRAY(av) - i);
397     }
398     if (num) {
399         av_extend(av,AvFILL(av)+num);
400         AvFILL(av) += num;
401         dstr = AvARRAY(av) + AvFILL(av);
402         sstr = dstr - num;
403 #ifdef BUGGY_MSC5
404  # pragma loop_opt(off) /* don't loop-optimize the following code */
405 #endif /* BUGGY_MSC5 */
406         for (i = AvFILL(av) - num; i >= 0; --i) {
407             *dstr-- = *sstr--;
408 #ifdef BUGGY_MSC5
409  # pragma loop_opt()    /* loop-optimization back to command-line setting */
410 #endif /* BUGGY_MSC5 */
411         }
412         while (num)
413             AvARRAY(av)[--num] = &sv_undef;
414     }
415 }
416
417 SV *
418 av_shift(av)
419 register AV *av;
420 {
421     SV *retval;
422
423     if (!av || AvFILL(av) < 0)
424         return &sv_undef;
425     retval = *AvARRAY(av);
426     if (AvREAL(av))
427         *AvARRAY(av) = &sv_undef;
428     SvPVX(av) = (char*)(AvARRAY(av) + 1);
429     AvMAX(av)--;
430     AvFILL(av)--;
431     if (SvSMAGICAL(av))
432         mg_set((SV*)av);
433     return retval;
434 }
435
436 I32
437 av_len(av)
438 register AV *av;
439 {
440     return AvFILL(av);
441 }
442
443 void
444 av_fill(av, fill)
445 register AV *av;
446 I32 fill;
447 {
448     if (!av)
449         croak("panic: null array");
450     if (fill < 0)
451         fill = -1;
452     if (fill <= AvMAX(av)) {
453         I32 key = AvFILL(av);
454         SV** ary = AvARRAY(av);
455
456         if (AvREAL(av)) {
457             while (key > fill) {
458                 SvREFCNT_dec(ary[key]);
459                 ary[key--] = &sv_undef;
460             }
461         }
462         else {
463             while (key < fill)
464                 ary[++key] = &sv_undef;
465         }
466             
467         AvFILL(av) = fill;
468         if (SvSMAGICAL(av))
469             mg_set((SV*)av);
470     }
471     else
472         (void)av_store(av,fill,&sv_undef);
473 }