This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 5.002_01: hints/bsdos.sh
[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 == stack) {      /* 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 == stack && 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     if (!av || AvMAX(av) < 0)
293         return;
294     /*SUPPRESS 560*/
295
296     if (AvREAL(av)) {
297         ary = AvARRAY(av);
298         key = AvFILL(av) + 1;
299         while (key) {
300             SvREFCNT_dec(ary[--key]);
301             ary[key] = &sv_undef;
302         }
303     }
304     if (key = AvARRAY(av) - AvALLOC(av)) {
305         AvMAX(av) += key;
306         SvPVX(av) = (char*)AvALLOC(av);
307     }
308     AvFILL(av) = -1;
309 }
310
311 void
312 av_undef(av)
313 register AV *av;
314 {
315     register I32 key;
316
317     if (!av)
318         return;
319     /*SUPPRESS 560*/
320     if (AvREAL(av)) {
321         key = AvFILL(av) + 1;
322         while (key)
323             SvREFCNT_dec(AvARRAY(av)[--key]);
324     }
325     if (key = AvARRAY(av) - AvALLOC(av)) {
326         AvMAX(av) += key;
327         SvPVX(av) = (char*)AvALLOC(av);
328     }
329     Safefree(AvALLOC(av));
330     AvALLOC(av) = 0;
331     SvPVX(av) = 0;
332     AvMAX(av) = AvFILL(av) = -1;
333     if (AvARYLEN(av)) {
334         SvREFCNT_dec(AvARYLEN(av));
335         AvARYLEN(av) = 0;
336     }
337 }
338
339 void
340 av_push(av,val)
341 register AV *av;
342 SV *val;
343 {
344     if (!av)
345         return;
346     av_store(av,AvFILL(av)+1,val);
347 }
348
349 SV *
350 av_pop(av)
351 register AV *av;
352 {
353     SV *retval;
354
355     if (!av || AvFILL(av) < 0)
356         return &sv_undef;
357     retval = AvARRAY(av)[AvFILL(av)];
358     AvARRAY(av)[AvFILL(av)--] = &sv_undef;
359     if (SvSMAGICAL(av))
360         mg_set((SV*)av);
361     return retval;
362 }
363
364 void
365 av_unshift(av,num)
366 register AV *av;
367 register I32 num;
368 {
369     register I32 i;
370     register SV **sstr,**dstr;
371
372     if (!av || num <= 0)
373         return;
374     if (!AvREAL(av)) {
375         if (AvREIFY(av))
376             av_reify(av);
377         else
378             croak("Can't unshift");
379     }
380     i = AvARRAY(av) - AvALLOC(av);
381     if (i) {
382         if (i > num)
383             i = num;
384         num -= i;
385     
386         AvMAX(av) += i;
387         AvFILL(av) += i;
388         SvPVX(av) = (char*)(AvARRAY(av) - i);
389     }
390     if (num) {
391         av_extend(av,AvFILL(av)+num);
392         AvFILL(av) += num;
393         dstr = AvARRAY(av) + AvFILL(av);
394         sstr = dstr - num;
395 #ifdef BUGGY_MSC5
396  # pragma loop_opt(off) /* don't loop-optimize the following code */
397 #endif /* BUGGY_MSC5 */
398         for (i = AvFILL(av) - num; i >= 0; --i) {
399             *dstr-- = *sstr--;
400 #ifdef BUGGY_MSC5
401  # pragma loop_opt()    /* loop-optimization back to command-line setting */
402 #endif /* BUGGY_MSC5 */
403         }
404         while (num)
405             AvARRAY(av)[--num] = &sv_undef;
406     }
407 }
408
409 SV *
410 av_shift(av)
411 register AV *av;
412 {
413     SV *retval;
414
415     if (!av || AvFILL(av) < 0)
416         return &sv_undef;
417     retval = *AvARRAY(av);
418     if (AvREAL(av))
419         *AvARRAY(av) = &sv_undef;
420     SvPVX(av) = (char*)(AvARRAY(av) + 1);
421     AvMAX(av)--;
422     AvFILL(av)--;
423     if (SvSMAGICAL(av))
424         mg_set((SV*)av);
425     return retval;
426 }
427
428 I32
429 av_len(av)
430 register AV *av;
431 {
432     return AvFILL(av);
433 }
434
435 void
436 av_fill(av, fill)
437 register AV *av;
438 I32 fill;
439 {
440     if (!av)
441         croak("panic: null array");
442     if (fill < 0)
443         fill = -1;
444     if (fill <= AvMAX(av)) {
445         I32 key = AvFILL(av);
446         SV** ary = AvARRAY(av);
447
448         if (AvREAL(av)) {
449             while (key > fill) {
450                 SvREFCNT_dec(ary[key]);
451                 ary[key--] = &sv_undef;
452             }
453         }
454         else {
455             while (key < fill)
456                 ary[++key] = &sv_undef;
457         }
458             
459         AvFILL(av) = fill;
460         if (SvSMAGICAL(av))
461             mg_set((SV*)av);
462     }
463     else
464         (void)av_store(av,fill,&sv_undef);
465 }