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