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