This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
win32: additional default libraries
[perl5.git] / av.c
CommitLineData
a0d0e21e 1/* av.c
79072805 2 *
9607fc9c 3 * Copyright (c) 1991-1997, Larry Wall
79072805
LW
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 *
a0d0e21e
LW
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
79072805
LW
13 */
14
15#include "EXTERN.h"
16#include "perl.h"
17
a0d0e21e
LW
18static void av_reify _((AV* av));
19
20static void
21av_reify(av)
22AV* 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 }
29de640a
CS
36 key = AvARRAY(av) - AvALLOC(av);
37 while (key)
38 AvALLOC(av)[--key] = &sv_undef;
a0d0e21e
LW
39 AvREAL_on(av);
40}
41
42void
43av_extend(av,key)
44AV *av;
45I32 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)) {
c07a80fd 70#ifndef STRANGE_MALLOC
4633a7c4 71 U32 bytes;
c07a80fd 72#endif
4633a7c4 73
a0d0e21e
LW
74 newmax = key + AvMAX(av) / 5;
75 resize:
4633a7c4 76#ifdef STRANGE_MALLOC
a0d0e21e 77 Renew(AvALLOC(av),newmax+1, SV*);
4633a7c4
LW
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*);
c07a80fd 90 if (AvMAX(av) > 64 && !nice_chunk) {
91 nice_chunk = (char*)AvALLOC(av);
92 nice_chunk_size = (AvMAX(av) + 1) * sizeof(SV*);
93 }
4633a7c4
LW
94 else
95 Safefree(AvALLOC(av));
96 AvALLOC(av) = ary;
97#endif
a0d0e21e
LW
98 ary = AvALLOC(av) + AvMAX(av) + 1;
99 tmp = newmax - AvMAX(av);
7d55f622 100 if (av == curstack) { /* Oops, grew stack (via av_store()?) */
a0d0e21e
LW
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
79072805 124SV**
463ee0b2
LW
125av_fetch(av,key,lval)
126register AV *av;
79072805
LW
127I32 key;
128I32 lval;
129{
130 SV *sv;
131
a0d0e21e
LW
132 if (!av)
133 return 0;
134
8990e307 135 if (SvRMAGICAL(av)) {
463ee0b2 136 if (mg_find((SV*)av,'P')) {
8990e307 137 sv = sv_newmortal();
463ee0b2 138 mg_copy((SV*)av, sv, 0, key);
463ee0b2
LW
139 Sv = sv;
140 return &Sv;
141 }
142 }
143
a0d0e21e
LW
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);
79072805 157 }
a0d0e21e 158 if (AvARRAY(av)[key] == &sv_undef) {
4dbf4341 159 emptyness:
79072805
LW
160 if (lval) {
161 sv = NEWSV(6,0);
463ee0b2 162 return av_store(av,key,sv);
79072805
LW
163 }
164 return 0;
165 }
4dbf4341 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 }
463ee0b2 172 return &AvARRAY(av)[key];
79072805
LW
173}
174
175SV**
463ee0b2
LW
176av_store(av,key,val)
177register AV *av;
79072805
LW
178I32 key;
179SV *val;
180{
79072805
LW
181 SV** ary;
182
a0d0e21e
LW
183 if (!av)
184 return 0;
43fcc5d2
CS
185 if (!val)
186 val = &sv_undef;
463ee0b2 187
8990e307 188 if (SvRMAGICAL(av)) {
463ee0b2 189 if (mg_find((SV*)av,'P')) {
43fcc5d2
CS
190 if (val != &sv_undef)
191 mg_copy((SV*)av, val, 0, key);
463ee0b2
LW
192 return 0;
193 }
194 }
195
a0d0e21e
LW
196 if (key < 0) {
197 key += AvFILL(av) + 1;
198 if (key < 0)
199 return 0;
79072805 200 }
43fcc5d2
CS
201 if (SvREADONLY(av) && key >= AvFILL(av))
202 croak(no_modify);
49beac48 203 if (!AvREAL(av) && AvREIFY(av))
a0d0e21e 204 av_reify(av);
29de640a
CS
205 if (key > AvMAX(av))
206 av_extend(av,key);
463ee0b2 207 ary = AvARRAY(av);
a0d0e21e
LW
208 if (AvFILL(av) < key) {
209 if (!AvREAL(av)) {
7d55f622 210 if (av == curstack && key > stack_sp - stack_base)
a0d0e21e
LW
211 stack_sp = stack_base + key; /* XPUSH in disguise */
212 do
213 ary[++AvFILL(av)] = &sv_undef;
214 while (AvFILL(av) < key);
79072805 215 }
a0d0e21e 216 AvFILL(av) = key;
79072805 217 }
a0d0e21e
LW
218 else if (AvREAL(av))
219 SvREFCNT_dec(ary[key]);
79072805 220 ary[key] = val;
8990e307 221 if (SvSMAGICAL(av)) {
a0d0e21e
LW
222 if (val != &sv_undef) {
223 MAGIC* mg = SvMAGIC(av);
224 sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key);
225 }
463ee0b2
LW
226 mg_set((SV*)av);
227 }
79072805
LW
228 return &ary[key];
229}
230
231AV *
232newAV()
233{
463ee0b2 234 register AV *av;
79072805 235
a0d0e21e
LW
236 av = (AV*)NEWSV(3,0);
237 sv_upgrade((SV *)av, SVt_PVAV);
463ee0b2
LW
238 AvREAL_on(av);
239 AvALLOC(av) = 0;
240 SvPVX(av) = 0;
241 AvMAX(av) = AvFILL(av) = -1;
242 return av;
79072805
LW
243}
244
245AV *
246av_make(size,strp)
247register I32 size;
248register SV **strp;
249{
463ee0b2 250 register AV *av;
79072805
LW
251 register I32 i;
252 register SV** ary;
253
a0d0e21e
LW
254 av = (AV*)NEWSV(8,0);
255 sv_upgrade((SV *) av,SVt_PVAV);
79072805 256 New(4,ary,size+1,SV*);
463ee0b2 257 AvALLOC(av) = ary;
a0d0e21e 258 AvFLAGS(av) = AVf_REAL;
463ee0b2
LW
259 SvPVX(av) = (char*)ary;
260 AvFILL(av) = size - 1;
261 AvMAX(av) = size - 1;
79072805 262 for (i = 0; i < size; i++) {
a0d0e21e
LW
263 assert (*strp);
264 ary[i] = NEWSV(7,0);
265 sv_setsv(ary[i], *strp);
79072805
LW
266 strp++;
267 }
463ee0b2 268 return av;
79072805
LW
269}
270
271AV *
272av_fake(size,strp)
273register I32 size;
274register SV **strp;
275{
463ee0b2 276 register AV *av;
79072805
LW
277 register SV** ary;
278
a0d0e21e
LW
279 av = (AV*)NEWSV(9,0);
280 sv_upgrade((SV *)av, SVt_PVAV);
79072805 281 New(4,ary,size+1,SV*);
463ee0b2 282 AvALLOC(av) = ary;
79072805 283 Copy(strp,ary,size,SV*);
a0d0e21e 284 AvFLAGS(av) = AVf_REIFY;
463ee0b2
LW
285 SvPVX(av) = (char*)ary;
286 AvFILL(av) = size - 1;
287 AvMAX(av) = size - 1;
79072805 288 while (size--) {
a0d0e21e
LW
289 assert (*strp);
290 SvTEMP_off(*strp);
79072805
LW
291 strp++;
292 }
463ee0b2 293 return av;
79072805
LW
294}
295
296void
463ee0b2
LW
297av_clear(av)
298register AV *av;
79072805
LW
299{
300 register I32 key;
a0d0e21e 301 SV** ary;
79072805 302
7d55f622 303#ifdef DEBUGGING
304 if (SvREFCNT(av) <= 0) {
305 warn("Attempt to clear deleted array");
306 }
307#endif
a0d0e21e 308 if (!av || AvMAX(av) < 0)
79072805
LW
309 return;
310 /*SUPPRESS 560*/
a0d0e21e
LW
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 }
463ee0b2
LW
320 if (key = AvARRAY(av) - AvALLOC(av)) {
321 AvMAX(av) += key;
a0d0e21e 322 SvPVX(av) = (char*)AvALLOC(av);
79072805 323 }
463ee0b2 324 AvFILL(av) = -1;
79072805
LW
325}
326
327void
463ee0b2
LW
328av_undef(av)
329register AV *av;
79072805
LW
330{
331 register I32 key;
332
463ee0b2 333 if (!av)
79072805
LW
334 return;
335 /*SUPPRESS 560*/
a0d0e21e
LW
336 if (AvREAL(av)) {
337 key = AvFILL(av) + 1;
338 while (key)
339 SvREFCNT_dec(AvARRAY(av)[--key]);
340 }
463ee0b2
LW
341 Safefree(AvALLOC(av));
342 AvALLOC(av) = 0;
343 SvPVX(av) = 0;
344 AvMAX(av) = AvFILL(av) = -1;
748a9306
LW
345 if (AvARYLEN(av)) {
346 SvREFCNT_dec(AvARYLEN(av));
347 AvARYLEN(av) = 0;
348 }
79072805
LW
349}
350
a0d0e21e 351void
463ee0b2
LW
352av_push(av,val)
353register AV *av;
79072805
LW
354SV *val;
355{
a0d0e21e
LW
356 if (!av)
357 return;
358 av_store(av,AvFILL(av)+1,val);
79072805
LW
359}
360
361SV *
463ee0b2
LW
362av_pop(av)
363register AV *av;
79072805
LW
364{
365 SV *retval;
366
a0d0e21e
LW
367 if (!av || AvFILL(av) < 0)
368 return &sv_undef;
43fcc5d2
CS
369 if (SvREADONLY(av))
370 croak(no_modify);
463ee0b2 371 retval = AvARRAY(av)[AvFILL(av)];
a0d0e21e 372 AvARRAY(av)[AvFILL(av)--] = &sv_undef;
8990e307 373 if (SvSMAGICAL(av))
463ee0b2 374 mg_set((SV*)av);
79072805
LW
375 return retval;
376}
377
378void
463ee0b2
LW
379av_unshift(av,num)
380register AV *av;
79072805
LW
381register I32 num;
382{
383 register I32 i;
384 register SV **sstr,**dstr;
385
a0d0e21e 386 if (!av || num <= 0)
79072805 387 return;
43fcc5d2
CS
388 if (SvREADONLY(av))
389 croak(no_modify);
49beac48
CS
390 if (!AvREAL(av) && AvREIFY(av))
391 av_reify(av);
a0d0e21e
LW
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;
463ee0b2 405 dstr = AvARRAY(av) + AvFILL(av);
79072805
LW
406 sstr = dstr - num;
407#ifdef BUGGY_MSC5
408 # pragma loop_opt(off) /* don't loop-optimize the following code */
409#endif /* BUGGY_MSC5 */
a0d0e21e 410 for (i = AvFILL(av) - num; i >= 0; --i) {
79072805
LW
411 *dstr-- = *sstr--;
412#ifdef BUGGY_MSC5
413 # pragma loop_opt() /* loop-optimization back to command-line setting */
414#endif /* BUGGY_MSC5 */
415 }
a0d0e21e
LW
416 while (num)
417 AvARRAY(av)[--num] = &sv_undef;
79072805
LW
418 }
419}
420
421SV *
463ee0b2
LW
422av_shift(av)
423register AV *av;
79072805
LW
424{
425 SV *retval;
426
a0d0e21e
LW
427 if (!av || AvFILL(av) < 0)
428 return &sv_undef;
43fcc5d2
CS
429 if (SvREADONLY(av))
430 croak(no_modify);
463ee0b2 431 retval = *AvARRAY(av);
a0d0e21e
LW
432 if (AvREAL(av))
433 *AvARRAY(av) = &sv_undef;
463ee0b2
LW
434 SvPVX(av) = (char*)(AvARRAY(av) + 1);
435 AvMAX(av)--;
436 AvFILL(av)--;
8990e307 437 if (SvSMAGICAL(av))
463ee0b2 438 mg_set((SV*)av);
79072805
LW
439 return retval;
440}
441
442I32
463ee0b2
LW
443av_len(av)
444register AV *av;
79072805 445{
463ee0b2 446 return AvFILL(av);
79072805
LW
447}
448
449void
463ee0b2
LW
450av_fill(av, fill)
451register AV *av;
79072805
LW
452I32 fill;
453{
a0d0e21e
LW
454 if (!av)
455 croak("panic: null array");
79072805
LW
456 if (fill < 0)
457 fill = -1;
463ee0b2 458 if (fill <= AvMAX(av)) {
a0d0e21e
LW
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
463ee0b2 473 AvFILL(av) = fill;
8990e307 474 if (SvSMAGICAL(av))
463ee0b2
LW
475 mg_set((SV*)av);
476 }
a0d0e21e
LW
477 else
478 (void)av_store(av,fill,&sv_undef);
79072805 479}