perl 5.003_01: pod/perlxstut.pod
[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 #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         if (lval) {
157             sv = NEWSV(6,0);
158             return av_store(av,key,sv);
159         }
160         return 0;
161     }
162     return &AvARRAY(av)[key];
163 }
164
165 SV**
166 av_store(av,key,val)
167 register AV *av;
168 I32 key;
169 SV *val;
170 {
171     SV** ary;
172
173     if (!av)
174         return 0;
175
176     if (SvRMAGICAL(av)) {
177         if (mg_find((SV*)av,'P')) {
178             mg_copy((SV*)av, val, 0, key);
179             return 0;
180         }
181     }
182
183     if (key < 0) {
184         key += AvFILL(av) + 1;
185         if (key < 0)
186             return 0;
187     }
188     if (!val)
189         val = &sv_undef;
190
191     if (key > AvMAX(av))
192         av_extend(av,key);
193     if (AvREIFY(av))
194         av_reify(av);
195
196     ary = AvARRAY(av);
197     if (AvFILL(av) < key) {
198         if (!AvREAL(av)) {
199             if (av == curstack && key > stack_sp - stack_base)
200                 stack_sp = stack_base + key;    /* XPUSH in disguise */
201             do
202                 ary[++AvFILL(av)] = &sv_undef;
203             while (AvFILL(av) < key);
204         }
205         AvFILL(av) = key;
206     }
207     else if (AvREAL(av))
208         SvREFCNT_dec(ary[key]);
209     ary[key] = val;
210     if (SvSMAGICAL(av)) {
211         if (val != &sv_undef) {
212             MAGIC* mg = SvMAGIC(av);
213             sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key);
214         }
215         mg_set((SV*)av);
216     }
217     return &ary[key];
218 }
219
220 AV *
221 newAV()
222 {
223     register AV *av;
224
225     av = (AV*)NEWSV(3,0);
226     sv_upgrade((SV *)av, SVt_PVAV);
227     AvREAL_on(av);
228     AvALLOC(av) = 0;
229     SvPVX(av) = 0;
230     AvMAX(av) = AvFILL(av) = -1;
231     return av;
232 }
233
234 AV *
235 av_make(size,strp)
236 register I32 size;
237 register SV **strp;
238 {
239     register AV *av;
240     register I32 i;
241     register SV** ary;
242
243     av = (AV*)NEWSV(8,0);
244     sv_upgrade((SV *) av,SVt_PVAV);
245     New(4,ary,size+1,SV*);
246     AvALLOC(av) = ary;
247     AvFLAGS(av) = AVf_REAL;
248     SvPVX(av) = (char*)ary;
249     AvFILL(av) = size - 1;
250     AvMAX(av) = size - 1;
251     for (i = 0; i < size; i++) {
252         assert (*strp);
253         ary[i] = NEWSV(7,0);
254         sv_setsv(ary[i], *strp);
255         strp++;
256     }
257     return av;
258 }
259
260 AV *
261 av_fake(size,strp)
262 register I32 size;
263 register SV **strp;
264 {
265     register AV *av;
266     register SV** ary;
267
268     av = (AV*)NEWSV(9,0);
269     sv_upgrade((SV *)av, SVt_PVAV);
270     New(4,ary,size+1,SV*);
271     AvALLOC(av) = ary;
272     Copy(strp,ary,size,SV*);
273     AvFLAGS(av) = AVf_REIFY;
274     SvPVX(av) = (char*)ary;
275     AvFILL(av) = size - 1;
276     AvMAX(av) = size - 1;
277     while (size--) {
278         assert (*strp);
279         SvTEMP_off(*strp);
280         strp++;
281     }
282     return av;
283 }
284
285 void
286 av_clear(av)
287 register AV *av;
288 {
289     register I32 key;
290     SV** ary;
291
292 #ifdef DEBUGGING
293     if (SvREFCNT(av) <= 0) {
294         warn("Attempt to clear deleted array");
295     }
296 #endif
297     if (!av || AvMAX(av) < 0)
298         return;
299     /*SUPPRESS 560*/
300
301     if (AvREAL(av)) {
302         ary = AvARRAY(av);
303         key = AvFILL(av) + 1;
304         while (key) {
305             SvREFCNT_dec(ary[--key]);
306             ary[key] = &sv_undef;
307         }
308     }
309     if (key = AvARRAY(av) - AvALLOC(av)) {
310         AvMAX(av) += key;
311         SvPVX(av) = (char*)AvALLOC(av);
312     }
313     AvFILL(av) = -1;
314 }
315
316 void
317 av_undef(av)
318 register AV *av;
319 {
320     register I32 key;
321
322     if (!av)
323         return;
324     /*SUPPRESS 560*/
325     if (AvREAL(av)) {
326         key = AvFILL(av) + 1;
327         while (key)
328             SvREFCNT_dec(AvARRAY(av)[--key]);
329     }
330     if (key = AvARRAY(av) - AvALLOC(av)) {
331         AvMAX(av) += key;
332         SvPVX(av) = (char*)AvALLOC(av);
333     }
334     Safefree(AvALLOC(av));
335     AvALLOC(av) = 0;
336     SvPVX(av) = 0;
337     AvMAX(av) = AvFILL(av) = -1;
338     if (AvARYLEN(av)) {
339         SvREFCNT_dec(AvARYLEN(av));
340         AvARYLEN(av) = 0;
341     }
342 }
343
344 void
345 av_push(av,val)
346 register AV *av;
347 SV *val;
348 {
349     if (!av)
350         return;
351     av_store(av,AvFILL(av)+1,val);
352 }
353
354 SV *
355 av_pop(av)
356 register AV *av;
357 {
358     SV *retval;
359
360     if (!av || AvFILL(av) < 0)
361         return &sv_undef;
362     retval = AvARRAY(av)[AvFILL(av)];
363     AvARRAY(av)[AvFILL(av)--] = &sv_undef;
364     if (SvSMAGICAL(av))
365         mg_set((SV*)av);
366     return retval;
367 }
368
369 void
370 av_unshift(av,num)
371 register AV *av;
372 register I32 num;
373 {
374     register I32 i;
375     register SV **sstr,**dstr;
376
377     if (!av || num <= 0)
378         return;
379     if (!AvREAL(av)) {
380         if (AvREIFY(av))
381             av_reify(av);
382         else
383             croak("Can't unshift");
384     }
385     i = AvARRAY(av) - AvALLOC(av);
386     if (i) {
387         if (i > num)
388             i = num;
389         num -= i;
390     
391         AvMAX(av) += i;
392         AvFILL(av) += i;
393         SvPVX(av) = (char*)(AvARRAY(av) - i);
394     }
395     if (num) {
396         av_extend(av,AvFILL(av)+num);
397         AvFILL(av) += num;
398         dstr = AvARRAY(av) + AvFILL(av);
399         sstr = dstr - num;
400 #ifdef BUGGY_MSC5
401  # pragma loop_opt(off) /* don't loop-optimize the following code */
402 #endif /* BUGGY_MSC5 */
403         for (i = AvFILL(av) - num; i >= 0; --i) {
404             *dstr-- = *sstr--;
405 #ifdef BUGGY_MSC5
406  # pragma loop_opt()    /* loop-optimization back to command-line setting */
407 #endif /* BUGGY_MSC5 */
408         }
409         while (num)
410             AvARRAY(av)[--num] = &sv_undef;
411     }
412 }
413
414 SV *
415 av_shift(av)
416 register AV *av;
417 {
418     SV *retval;
419
420     if (!av || AvFILL(av) < 0)
421         return &sv_undef;
422     retval = *AvARRAY(av);
423     if (AvREAL(av))
424         *AvARRAY(av) = &sv_undef;
425     SvPVX(av) = (char*)(AvARRAY(av) + 1);
426     AvMAX(av)--;
427     AvFILL(av)--;
428     if (SvSMAGICAL(av))
429         mg_set((SV*)av);
430     return retval;
431 }
432
433 I32
434 av_len(av)
435 register AV *av;
436 {
437     return AvFILL(av);
438 }
439
440 void
441 av_fill(av, fill)
442 register AV *av;
443 I32 fill;
444 {
445     if (!av)
446         croak("panic: null array");
447     if (fill < 0)
448         fill = -1;
449     if (fill <= AvMAX(av)) {
450         I32 key = AvFILL(av);
451         SV** ary = AvARRAY(av);
452
453         if (AvREAL(av)) {
454             while (key > fill) {
455                 SvREFCNT_dec(ary[key]);
456                 ary[key--] = &sv_undef;
457             }
458         }
459         else {
460             while (key < fill)
461                 ary[++key] = &sv_undef;
462         }
463             
464         AvFILL(av) = fill;
465         if (SvSMAGICAL(av))
466             mg_set((SV*)av);
467     }
468     else
469         (void)av_store(av,fill,&sv_undef);
470 }