This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Maintenance 5.004_03 changes (addendum)
[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     AvFLAGS(av) = AVf_REAL;
257     if (size) {         /* `defined' was returning undef for size==0 anyway. */
258         New(4,ary,size,SV*);
259         AvALLOC(av) = ary;
260         SvPVX(av) = (char*)ary;
261         AvFILL(av) = size - 1;
262         AvMAX(av) = size - 1;
263         for (i = 0; i < size; i++) {
264             assert (*strp);
265             ary[i] = NEWSV(7,0);
266             sv_setsv(ary[i], *strp);
267             strp++;
268         }
269     }
270     return av;
271 }
272
273 AV *
274 av_fake(size,strp)
275 register I32 size;
276 register SV **strp;
277 {
278     register AV *av;
279     register SV** ary;
280
281     av = (AV*)NEWSV(9,0);
282     sv_upgrade((SV *)av, SVt_PVAV);
283     New(4,ary,size+1,SV*);
284     AvALLOC(av) = ary;
285     Copy(strp,ary,size,SV*);
286     AvFLAGS(av) = AVf_REIFY;
287     SvPVX(av) = (char*)ary;
288     AvFILL(av) = size - 1;
289     AvMAX(av) = size - 1;
290     while (size--) {
291         assert (*strp);
292         SvTEMP_off(*strp);
293         strp++;
294     }
295     return av;
296 }
297
298 void
299 av_clear(av)
300 register AV *av;
301 {
302     register I32 key;
303     SV** ary;
304
305 #ifdef DEBUGGING
306     if (SvREFCNT(av) <= 0) {
307         warn("Attempt to clear deleted array");
308     }
309 #endif
310     if (!av || AvMAX(av) < 0)
311         return;
312     /*SUPPRESS 560*/
313
314     if (AvREAL(av)) {
315         ary = AvARRAY(av);
316         key = AvFILL(av) + 1;
317         while (key) {
318             SvREFCNT_dec(ary[--key]);
319             ary[key] = &sv_undef;
320         }
321     }
322     if (key = AvARRAY(av) - AvALLOC(av)) {
323         AvMAX(av) += key;
324         SvPVX(av) = (char*)AvALLOC(av);
325     }
326     AvFILL(av) = -1;
327 }
328
329 void
330 av_undef(av)
331 register AV *av;
332 {
333     register I32 key;
334
335     if (!av)
336         return;
337     /*SUPPRESS 560*/
338     if (AvREAL(av)) {
339         key = AvFILL(av) + 1;
340         while (key)
341             SvREFCNT_dec(AvARRAY(av)[--key]);
342     }
343     Safefree(AvALLOC(av));
344     AvALLOC(av) = 0;
345     SvPVX(av) = 0;
346     AvMAX(av) = AvFILL(av) = -1;
347     if (AvARYLEN(av)) {
348         SvREFCNT_dec(AvARYLEN(av));
349         AvARYLEN(av) = 0;
350     }
351 }
352
353 void
354 av_push(av,val)
355 register AV *av;
356 SV *val;
357 {
358     if (!av)
359         return;
360     av_store(av,AvFILL(av)+1,val);
361 }
362
363 SV *
364 av_pop(av)
365 register AV *av;
366 {
367     SV *retval;
368
369     if (!av || AvFILL(av) < 0)
370         return &sv_undef;
371     if (SvREADONLY(av))
372         croak(no_modify);
373     retval = AvARRAY(av)[AvFILL(av)];
374     AvARRAY(av)[AvFILL(av)--] = &sv_undef;
375     if (SvSMAGICAL(av))
376         mg_set((SV*)av);
377     return retval;
378 }
379
380 void
381 av_unshift(av,num)
382 register AV *av;
383 register I32 num;
384 {
385     register I32 i;
386     register SV **sstr,**dstr;
387
388     if (!av || num <= 0)
389         return;
390     if (SvREADONLY(av))
391         croak(no_modify);
392     if (!AvREAL(av) && AvREIFY(av))
393         av_reify(av);
394     i = AvARRAY(av) - AvALLOC(av);
395     if (i) {
396         if (i > num)
397             i = num;
398         num -= i;
399     
400         AvMAX(av) += i;
401         AvFILL(av) += i;
402         SvPVX(av) = (char*)(AvARRAY(av) - i);
403     }
404     if (num) {
405         av_extend(av,AvFILL(av)+num);
406         AvFILL(av) += num;
407         dstr = AvARRAY(av) + AvFILL(av);
408         sstr = dstr - num;
409 #ifdef BUGGY_MSC5
410  # pragma loop_opt(off) /* don't loop-optimize the following code */
411 #endif /* BUGGY_MSC5 */
412         for (i = AvFILL(av) - num; i >= 0; --i) {
413             *dstr-- = *sstr--;
414 #ifdef BUGGY_MSC5
415  # pragma loop_opt()    /* loop-optimization back to command-line setting */
416 #endif /* BUGGY_MSC5 */
417         }
418         while (num)
419             AvARRAY(av)[--num] = &sv_undef;
420     }
421 }
422
423 SV *
424 av_shift(av)
425 register AV *av;
426 {
427     SV *retval;
428
429     if (!av || AvFILL(av) < 0)
430         return &sv_undef;
431     if (SvREADONLY(av))
432         croak(no_modify);
433     retval = *AvARRAY(av);
434     if (AvREAL(av))
435         *AvARRAY(av) = &sv_undef;
436     SvPVX(av) = (char*)(AvARRAY(av) + 1);
437     AvMAX(av)--;
438     AvFILL(av)--;
439     if (SvSMAGICAL(av))
440         mg_set((SV*)av);
441     return retval;
442 }
443
444 I32
445 av_len(av)
446 register AV *av;
447 {
448     return AvFILL(av);
449 }
450
451 void
452 av_fill(av, fill)
453 register AV *av;
454 I32 fill;
455 {
456     if (!av)
457         croak("panic: null array");
458     if (fill < 0)
459         fill = -1;
460     if (fill <= AvMAX(av)) {
461         I32 key = AvFILL(av);
462         SV** ary = AvARRAY(av);
463
464         if (AvREAL(av)) {
465             while (key > fill) {
466                 SvREFCNT_dec(ary[key]);
467                 ary[key--] = &sv_undef;
468             }
469         }
470         else {
471             while (key < fill)
472                 ary[++key] = &sv_undef;
473         }
474             
475         AvFILL(av) = fill;
476         if (SvSMAGICAL(av))
477             mg_set((SV*)av);
478     }
479     else
480         (void)av_store(av,fill,&sv_undef);
481 }