Skip to content
Newer
Older
100644 894 lines (782 sloc) 17.2 KB
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
1 /* av.c
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
2 *
cb50131 Resync with mainline
Charles Bailey authored Feb 9, 2000
3 * Copyright (c) 1991-2000, Larry Wall
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
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 *
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
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
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
13 */
14
15 #include "EXTERN.h"
864dbfa initial stub implementation of implicit thread/this
Gurusamy Sarathy authored Jun 7, 1999
16 #define PERL_IN_AV_C
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
17 #include "perl.h"
18
fb73857 [inseparable changes from patch to perl 5.004_04]
Perl 5 Porters authored Sep 5, 1997
19 void
864dbfa initial stub implementation of implicit thread/this
Gurusamy Sarathy authored Jun 7, 1999
20 Perl_av_reify(pTHX_ AV *av)
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
21 {
22 I32 key;
23 SV* sv;
fb73857 [inseparable changes from patch to perl 5.004_04]
Perl 5 Porters authored Sep 5, 1997
24
3c78faf [win32] sundry whitespace cleanups from maintbranch
Gurusamy Sarathy authored May 17, 1998
25 if (AvREAL(av))
26 return;
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
27 #ifdef DEBUGGING
0453d81 @pmqs lexical warnings update (warning.t fails one test
pmqs authored Jun 27, 1999
28 if (SvTIED_mg((SV*)av, 'P') && ckWARN_d(WARN_DEBUGGING))
29 Perl_warner(aTHX_ WARN_DEBUGGING, "av_reify called on tied array");
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
30 #endif
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
31 key = AvMAX(av) + 1;
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
32 while (key > AvFILLp(av) + 1)
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored Jul 18, 1998
33 AvARRAY(av)[--key] = &PL_sv_undef;
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
34 while (key) {
35 sv = AvARRAY(av)[--key];
36 assert(sv);
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored Jul 18, 1998
37 if (sv != &PL_sv_undef) {
1134378 Initial 3-way merge from (5.001m, thr1m, 5.003) plus fixups.
Malcolm Beattie authored Mar 28, 1997
38 dTHR;
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
39 (void)SvREFCNT_inc(sv);
1134378 Initial 3-way merge from (5.001m, thr1m, 5.003) plus fixups.
Malcolm Beattie authored Mar 28, 1997
40 }
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
41 }
29de640 Make conversion of @_ to real array work right after C<shift>
Chip Salzenberg authored Mar 7, 1997
42 key = AvARRAY(av) - AvALLOC(av);
43 while (key)
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored Jul 18, 1998
44 AvALLOC(av)[--key] = &PL_sv_undef;
62b1ebc fix handling of mayhaps-extended @_ in goto &sub
Gurusamy Sarathy authored Oct 21, 1998
45 AvREIFY_off(av);
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
46 AvREAL_on(av);
47 }
48
cb50131 Resync with mainline
Charles Bailey authored Feb 9, 2000
49 /*
50 =for apidoc av_extend
51
52 Pre-extend an array. The C<key> is the index to which the array should be
53 extended.
54
55 =cut
56 */
57
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
58 void
864dbfa initial stub implementation of implicit thread/this
Gurusamy Sarathy authored Jun 7, 1999
59 Perl_av_extend(pTHX_ AV *av, I32 key)
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
60 {
1134378 Initial 3-way merge from (5.001m, thr1m, 5.003) plus fixups.
Malcolm Beattie authored Mar 28, 1997
61 dTHR; /* only necessary if we have to extend stack */
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
62 MAGIC *mg;
33c2748 integrate changes#1982,2014,2021 (from maint-5.005)
Gurusamy Sarathy authored Oct 25, 1998
63 if (mg = SvTIED_mg((SV*)av, 'P')) {
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
64 dSP;
65 ENTER;
66 SAVETMPS;
e788e7d rename s/\bSI_/PERLSI_/ to avoid collisions with sysinfo headers
Gurusamy Sarathy authored Jul 6, 1998
67 PUSHSTACKi(PERLSI_MAGIC);
924508f [win32] change all 'sp' to 'SP' in code and in the docs. Explicitly
Gurusamy Sarathy authored Mar 7, 1998
68 PUSHMARK(SP);
69 EXTEND(SP,2);
33c2748 integrate changes#1982,2014,2021 (from maint-5.005)
Gurusamy Sarathy authored Oct 25, 1998
70 PUSHs(SvTIED_obj((SV*)av, mg));
a60c095 TIEARRAY updates - almost works ...
Nick Ing-Simmons authored Jan 14, 1998
71 PUSHs(sv_2mortal(newSViv(key+1)));
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
72 PUTBACK;
864dbfa initial stub implementation of implicit thread/this
Gurusamy Sarathy authored Jun 7, 1999
73 call_method("EXTEND", G_SCALAR|G_DISCARD);
d3acc0f PUSHSTACK renovation
Joshua Pritikin authored Jun 26, 1998
74 POPSTACK;
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
75 FREETMPS;
76 LEAVE;
77 return;
78 }
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
79 if (key > AvMAX(av)) {
80 SV** ary;
81 I32 tmp;
82 I32 newmax;
83
84 if (AvALLOC(av) != AvARRAY(av)) {
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
85 ary = AvALLOC(av) + AvFILLp(av) + 1;
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
86 tmp = AvARRAY(av) - AvALLOC(av);
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
87 Move(AvARRAY(av), AvALLOC(av), AvFILLp(av)+1, SV*);
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
88 AvMAX(av) += tmp;
89 SvPVX(av) = (char*)AvALLOC(av);
90 if (AvREAL(av)) {
91 while (tmp)
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored Jul 18, 1998
92 ary[--tmp] = &PL_sv_undef;
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
93 }
94
95 if (key > AvMAX(av) - 10) {
96 newmax = key + AvMAX(av);
97 goto resize;
98 }
99 }
100 else {
101 if (AvALLOC(av)) {
c07a80f perl5.002beta3
Perl 5 Porters authored Feb 2, 1996
102 #ifndef STRANGE_MALLOC
c1f7b11 Avoid core dumps resulting from humongous array indices
Spider Boardman authored Jul 22, 1999
103 MEM_SIZE bytes;
104 IV itmp;
c07a80f perl5.002beta3
Perl 5 Porters authored Feb 3, 1996
105 #endif
4633a7c 5.002 beta 1
Larry Wall authored Nov 21, 1995
106
f5a32c7 notes about running Purify
Gurusamy Sarathy authored Feb 14, 2000
107 #if defined(MYMALLOC) && !defined(LEAKTEST)
8d6dde3 applied patch, regen headers
Ilya Zakharevich authored Jun 22, 1998
108 newmax = malloced_size((void*)AvALLOC(av))/sizeof(SV*) - 1;
109
110 if (key <= newmax)
111 goto resized;
112 #endif
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
113 newmax = key + AvMAX(av) / 5;
114 resize:
8d6dde3 applied patch, regen headers
Ilya Zakharevich authored Jun 22, 1998
115 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
116 Renew(AvALLOC(av),newmax+1, SV*);
4633a7c 5.002 beta 1
Larry Wall authored Nov 20, 1995
117 #else
118 bytes = (newmax + 1) * sizeof(SV*);
119 #define MALLOC_OVERHEAD 16
c1f7b11 Avoid core dumps resulting from humongous array indices
Spider Boardman authored Jul 22, 1999
120 itmp = MALLOC_OVERHEAD;
121 while (itmp - MALLOC_OVERHEAD < bytes)
122 itmp += itmp;
123 itmp -= MALLOC_OVERHEAD;
124 itmp /= sizeof(SV*);
125 assert(itmp > newmax);
126 newmax = itmp - 1;
127 assert(newmax >= AvMAX(av));
4633a7c 5.002 beta 1
Larry Wall authored Nov 20, 1995
128 New(2,ary, newmax+1, SV*);
129 Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*);
fba3b22 Fixed sv_mutex locking for new_SV, del_SV and nice_chunks.
Malcolm Beattie authored Oct 3, 1997
130 if (AvMAX(av) > 64)
131 offer_nice_chunk(AvALLOC(av), (AvMAX(av)+1) * sizeof(SV*));
4633a7c 5.002 beta 1
Larry Wall authored Nov 20, 1995
132 else
133 Safefree(AvALLOC(av));
134 AvALLOC(av) = ary;
135 #endif
8d6dde3 applied patch, regen headers
Ilya Zakharevich authored Jun 22, 1998
136 resized:
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
137 ary = AvALLOC(av) + AvMAX(av) + 1;
138 tmp = newmax - AvMAX(av);
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored Jul 18, 1998
139 if (av == PL_curstack) { /* Oops, grew stack (via av_store()?) */
140 PL_stack_sp = AvALLOC(av) + (PL_stack_sp - PL_stack_base);
141 PL_stack_base = AvALLOC(av);
142 PL_stack_max = PL_stack_base + newmax;
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
143 }
144 }
145 else {
8d6dde3 applied patch, regen headers
Ilya Zakharevich authored Jun 22, 1998
146 newmax = key < 3 ? 3 : key;
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
147 New(2,AvALLOC(av), newmax+1, SV*);
148 ary = AvALLOC(av) + 1;
149 tmp = newmax;
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored Jul 18, 1998
150 AvALLOC(av)[0] = &PL_sv_undef; /* For the stacks */
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
151 }
152 if (AvREAL(av)) {
153 while (tmp)
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored Jul 18, 1998
154 ary[--tmp] = &PL_sv_undef;
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
155 }
156
157 SvPVX(av) = (char*)AvALLOC(av);
158 AvMAX(av) = newmax;
159 }
160 }
161 }
162
cb50131 Resync with mainline
Charles Bailey authored Feb 9, 2000
163 /*
164 =for apidoc av_fetch
165
166 Returns the SV at the specified index in the array. The C<key> is the
167 index. If C<lval> is set then the fetch will be part of a store. Check
168 that the return value is non-null before dereferencing it to a C<SV*>.
169
170 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
171 more information on how to use this function on tied arrays.
172
173 =cut
174 */
175
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
176 SV**
864dbfa initial stub implementation of implicit thread/this
Gurusamy Sarathy authored Jun 7, 1999
177 Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval)
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
178 {
179 SV *sv;
180
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
181 if (!av)
182 return 0;
183
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
184 if (key < 0) {
185 key += AvFILL(av) + 1;
186 if (key < 0)
187 return 0;
188 }
189
8990e30 perl 5.0 alpha 6
Larry Wall authored Mar 18, 1994
190 if (SvRMAGICAL(av)) {
6cef1e7 support match indices via special variables @- and @+
Ilya Zakharevich authored Jul 21, 1998
191 if (mg_find((SV*)av,'P') || mg_find((SV*)av,'D')) {
1134378 Initial 3-way merge from (5.001m, thr1m, 5.003) plus fixups.
Malcolm Beattie authored Mar 28, 1997
192 dTHR;
8990e30 perl 5.0 alpha 6
Larry Wall authored Mar 18, 1994
193 sv = sv_newmortal();
463ee0b perl 5.0 alpha 4
Larry Wall authored Nov 10, 1993
194 mg_copy((SV*)av, sv, 0, key);
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored Jul 18, 1998
195 PL_av_fetch_sv = sv;
196 return &PL_av_fetch_sv;
463ee0b perl 5.0 alpha 4
Larry Wall authored Nov 10, 1993
197 }
198 }
199
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
200 if (key > AvFILLp(av)) {
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
201 if (!lval)
202 return 0;
352edd9 fix AvREALISH bogusness
Gurusamy Sarathy authored Nov 6, 1998
203 sv = NEWSV(5,0);
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
204 return av_store(av,key,sv);
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
205 }
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored Jul 18, 1998
206 if (AvARRAY(av)[key] == &PL_sv_undef) {
4dbf434 random cleanup
Perl 5 Porters authored Aug 28, 1996
207 emptyness:
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
208 if (lval) {
209 sv = NEWSV(6,0);
463ee0b perl 5.0 alpha 4
Larry Wall authored Nov 10, 1993
210 return av_store(av,key,sv);
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
211 }
212 return 0;
213 }
4dbf434 random cleanup
Perl 5 Porters authored Aug 28, 1996
214 else if (AvREIFY(av)
215 && (!AvARRAY(av)[key] /* eg. @_ could have freed elts */
216 || SvTYPE(AvARRAY(av)[key]) == SVTYPEMASK)) {
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored Jul 18, 1998
217 AvARRAY(av)[key] = &PL_sv_undef; /* 1/2 reify */
4dbf434 random cleanup
Perl 5 Porters authored Aug 28, 1996
218 goto emptyness;
219 }
463ee0b perl 5.0 alpha 4
Larry Wall authored Nov 10, 1993
220 return &AvARRAY(av)[key];
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
221 }
222
cb50131 Resync with mainline
Charles Bailey authored Feb 9, 2000
223 /*
224 =for apidoc av_store
225
226 Stores an SV in an array. The array index is specified as C<key>. The
227 return value will be NULL if the operation failed or if the value did not
228 need to be actually stored within the array (as in the case of tied
229 arrays). Otherwise it can be dereferenced to get the original C<SV*>. Note
230 that the caller is responsible for suitably incrementing the reference
231 count of C<val> before the call, and decrementing it if the function
232 returned NULL.
233
234 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
235 more information on how to use this function on tied arrays.
236
237 =cut
238 */
239
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
240 SV**
864dbfa initial stub implementation of implicit thread/this
Gurusamy Sarathy authored Jun 7, 1999
241 Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
242 {
243 SV** ary;
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
244 U32 fill;
245
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
246
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
247 if (!av)
248 return 0;
43fcc5d Support SvREADONLY on arrays
Chip Salzenberg authored Dec 17, 1996
249 if (!val)
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored Jul 18, 1998
250 val = &PL_sv_undef;
463ee0b perl 5.0 alpha 4
Larry Wall authored Nov 10, 1993
251
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
252 if (key < 0) {
253 key += AvFILL(av) + 1;
254 if (key < 0)
255 return 0;
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
256 }
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
257
43fcc5d Support SvREADONLY on arrays
Chip Salzenberg authored Dec 16, 1996
258 if (SvREADONLY(av) && key >= AvFILL(av))
cea2e8a more complete support for implicit thread/interpreter pointer,
Gurusamy Sarathy authored Jun 9, 1999
259 Perl_croak(aTHX_ PL_no_modify);
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
260
261 if (SvRMAGICAL(av)) {
262 if (mg_find((SV*)av,'P')) {
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored Jul 18, 1998
263 if (val != &PL_sv_undef) {
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
264 mg_copy((SV*)av, val, 0, key);
265 }
266 return 0;
267 }
268 }
269
49beac4 Fix scalar leak in av_unshift
Chip Salzenberg authored Jan 31, 1997
270 if (!AvREAL(av) && AvREIFY(av))
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
271 av_reify(av);
272 if (key > AvMAX(av))
273 av_extend(av,key);
463ee0b perl 5.0 alpha 4
Larry Wall authored Nov 10, 1993
274 ary = AvARRAY(av);
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
275 if (AvFILLp(av) < key) {
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
276 if (!AvREAL(av)) {
1134378 Initial 3-way merge from (5.001m, thr1m, 5.003) plus fixups.
Malcolm Beattie authored Mar 28, 1997
277 dTHR;
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored Jul 18, 1998
278 if (av == PL_curstack && key > PL_stack_sp - PL_stack_base)
279 PL_stack_sp = PL_stack_base + key; /* XPUSH in disguise */
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
280 do
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored Jul 18, 1998
281 ary[++AvFILLp(av)] = &PL_sv_undef;
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
282 while (AvFILLp(av) < key);
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
283 }
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
284 AvFILLp(av) = key;
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
285 }
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
286 else if (AvREAL(av))
287 SvREFCNT_dec(ary[key]);
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
288 ary[key] = val;
8990e30 perl 5.0 alpha 6
Larry Wall authored Mar 18, 1994
289 if (SvSMAGICAL(av)) {
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored Jul 18, 1998
290 if (val != &PL_sv_undef) {
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
291 MAGIC* mg = SvMAGIC(av);
292 sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key);
293 }
463ee0b perl 5.0 alpha 4
Larry Wall authored Nov 10, 1993
294 mg_set((SV*)av);
295 }
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
296 return &ary[key];
297 }
298
cb50131 Resync with mainline
Charles Bailey authored Feb 9, 2000
299 /*
300 =for apidoc newAV
301
302 Creates a new AV. The reference count is set to 1.
303
304 =cut
305 */
306
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
307 AV *
864dbfa initial stub implementation of implicit thread/this
Gurusamy Sarathy authored Jun 7, 1999
308 Perl_newAV(pTHX)
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
309 {
463ee0b perl 5.0 alpha 4
Larry Wall authored Nov 10, 1993
310 register AV *av;
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
311
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
312 av = (AV*)NEWSV(3,0);
313 sv_upgrade((SV *)av, SVt_PVAV);
463ee0b perl 5.0 alpha 4
Larry Wall authored Nov 10, 1993
314 AvREAL_on(av);
315 AvALLOC(av) = 0;
316 SvPVX(av) = 0;
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
317 AvMAX(av) = AvFILLp(av) = -1;
463ee0b perl 5.0 alpha 4
Larry Wall authored Nov 10, 1993
318 return av;
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
319 }
320
cb50131 Resync with mainline
Charles Bailey authored Feb 9, 2000
321 /*
322 =for apidoc av_make
323
324 Creates a new AV and populates it with a list of SVs. The SVs are copied
325 into the array, so they may be freed after the call to av_make. The new AV
326 will have a reference count of 1.
327
328 =cut
329 */
330
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
331 AV *
864dbfa initial stub implementation of implicit thread/this
Gurusamy Sarathy authored Jun 7, 1999
332 Perl_av_make(pTHX_ register I32 size, register SV **strp)
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
333 {
463ee0b perl 5.0 alpha 4
Larry Wall authored Nov 10, 1993
334 register AV *av;
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
335 register I32 i;
336 register SV** ary;
337
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
338 av = (AV*)NEWSV(8,0);
339 sv_upgrade((SV *) av,SVt_PVAV);
340 AvFLAGS(av) = AVf_REAL;
573fa4e : reduced malloc patch
Tim Bunce authored Aug 7, 1997
341 if (size) { /* `defined' was returning undef for size==0 anyway. */
342 New(4,ary,size,SV*);
343 AvALLOC(av) = ary;
344 SvPVX(av) = (char*)ary;
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
345 AvFILLp(av) = size - 1;
573fa4e : reduced malloc patch
Tim Bunce authored Aug 6, 1997
346 AvMAX(av) = size - 1;
347 for (i = 0; i < size; i++) {
348 assert (*strp);
349 ary[i] = NEWSV(7,0);
350 sv_setsv(ary[i], *strp);
351 strp++;
352 }
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
353 }
463ee0b perl 5.0 alpha 4
Larry Wall authored Nov 10, 1993
354 return av;
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
355 }
356
357 AV *
864dbfa initial stub implementation of implicit thread/this
Gurusamy Sarathy authored Jun 7, 1999
358 Perl_av_fake(pTHX_ register I32 size, register SV **strp)
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
359 {
463ee0b perl 5.0 alpha 4
Larry Wall authored Nov 10, 1993
360 register AV *av;
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
361 register SV** ary;
362
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
363 av = (AV*)NEWSV(9,0);
364 sv_upgrade((SV *)av, SVt_PVAV);
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
365 New(4,ary,size+1,SV*);
463ee0b perl 5.0 alpha 4
Larry Wall authored Nov 10, 1993
366 AvALLOC(av) = ary;
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
367 Copy(strp,ary,size,SV*);
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
368 AvFLAGS(av) = AVf_REIFY;
463ee0b perl 5.0 alpha 4
Larry Wall authored Nov 10, 1993
369 SvPVX(av) = (char*)ary;
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
370 AvFILLp(av) = size - 1;
463ee0b perl 5.0 alpha 4
Larry Wall authored Nov 10, 1993
371 AvMAX(av) = size - 1;
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
372 while (size--) {
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
373 assert (*strp);
374 SvTEMP_off(*strp);
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
375 strp++;
376 }
463ee0b perl 5.0 alpha 4
Larry Wall authored Nov 10, 1993
377 return av;
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
378 }
379
cb50131 Resync with mainline
Charles Bailey authored Feb 9, 2000
380 /*
381 =for apidoc av_clear
382
383 Clears an array, making it empty. Does not free the memory used by the
384 array itself.
385
386 =cut
387 */
388
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
389 void
864dbfa initial stub implementation of implicit thread/this
Gurusamy Sarathy authored Jun 7, 1999
390 Perl_av_clear(pTHX_ register AV *av)
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
391 {
392 register I32 key;
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
393 SV** ary;
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
394
7d55f62 perl 5.003_01: av.c
Perl 5 Porters authored Jul 5, 1996
395 #ifdef DEBUGGING
32da55a Minor fixes to assuage picky compilers (unsigned comparisons and
Charles Bailey authored Feb 9, 2000
396 if (SvREFCNT(av) == 0 && ckWARN_d(WARN_DEBUGGING)) {
0453d81 @pmqs lexical warnings update (warning.t fails one test
pmqs authored Jun 26, 1999
397 Perl_warner(aTHX_ WARN_DEBUGGING, "Attempt to clear deleted array");
7d55f62 perl 5.003_01: av.c
Perl 5 Porters authored Jul 5, 1996
398 }
399 #endif
a60c095 TIEARRAY updates - almost works ...
Nick Ing-Simmons authored Jan 14, 1998
400 if (!av)
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
401 return;
402 /*SUPPRESS 560*/
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
403
39caa66 hand apply whitespace-mutiliated patch
Joshua Pritikin authored Jun 15, 1998
404 if (SvREADONLY(av))
cea2e8a more complete support for implicit thread/interpreter pointer,
Gurusamy Sarathy authored Jun 9, 1999
405 Perl_croak(aTHX_ PL_no_modify);
39caa66 hand apply whitespace-mutiliated patch
Joshua Pritikin authored Jun 15, 1998
406
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
407 /* Give any tie a chance to cleanup first */
408 if (SvRMAGICAL(av))
409 mg_clear((SV*)av);
410
a60c095 TIEARRAY updates - almost works ...
Nick Ing-Simmons authored Jan 14, 1998
411 if (AvMAX(av) < 0)
412 return;
413
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
414 if (AvREAL(av)) {
415 ary = AvARRAY(av);
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
416 key = AvFILLp(av) + 1;
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
417 while (key) {
418 SvREFCNT_dec(ary[--key]);
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored Jul 18, 1998
419 ary[key] = &PL_sv_undef;
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
420 }
421 }
463ee0b perl 5.0 alpha 4
Larry Wall authored Nov 10, 1993
422 if (key = AvARRAY(av) - AvALLOC(av)) {
423 AvMAX(av) += key;
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
424 SvPVX(av) = (char*)AvALLOC(av);
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
425 }
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
426 AvFILLp(av) = -1;
fb73857 [inseparable changes from patch to perl 5.004_04]
Perl 5 Porters authored Sep 5, 1997
427
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
428 }
429
cb50131 Resync with mainline
Charles Bailey authored Feb 9, 2000
430 /*
431 =for apidoc av_undef
432
433 Undefines the array. Frees the memory used by the array itself.
434
435 =cut
436 */
437
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
438 void
864dbfa initial stub implementation of implicit thread/this
Gurusamy Sarathy authored Jun 7, 1999
439 Perl_av_undef(pTHX_ register AV *av)
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
440 {
441 register I32 key;
442
463ee0b perl 5.0 alpha 4
Larry Wall authored Nov 10, 1993
443 if (!av)
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
444 return;
445 /*SUPPRESS 560*/
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
446
447 /* Give any tie a chance to cleanup first */
33c2748 integrate changes#1982,2014,2021 (from maint-5.005)
Gurusamy Sarathy authored Oct 25, 1998
448 if (SvTIED_mg((SV*)av, 'P'))
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
449 av_fill(av, -1); /* mg_clear() ? */
450
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
451 if (AvREAL(av)) {
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
452 key = AvFILLp(av) + 1;
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
453 while (key)
454 SvREFCNT_dec(AvARRAY(av)[--key]);
455 }
463ee0b perl 5.0 alpha 4
Larry Wall authored Nov 10, 1993
456 Safefree(AvALLOC(av));
457 AvALLOC(av) = 0;
458 SvPVX(av) = 0;
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
459 AvMAX(av) = AvFILLp(av) = -1;
748a930 Perl 5.001
Larry Wall authored Mar 12, 1995
460 if (AvARYLEN(av)) {
461 SvREFCNT_dec(AvARYLEN(av));
462 AvARYLEN(av) = 0;
463 }
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
464 }
465
cb50131 Resync with mainline
Charles Bailey authored Feb 9, 2000
466 /*
467 =for apidoc av_push
468
469 Pushes an SV onto the end of the array. The array will grow automatically
470 to accommodate the addition.
471
472 =cut
473 */
474
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
475 void
864dbfa initial stub implementation of implicit thread/this
Gurusamy Sarathy authored Jun 7, 1999
476 Perl_av_push(pTHX_ register AV *av, SV *val)
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
477 {
478 MAGIC *mg;
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
479 if (!av)
480 return;
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
481 if (SvREADONLY(av))
cea2e8a more complete support for implicit thread/interpreter pointer,
Gurusamy Sarathy authored Jun 9, 1999
482 Perl_croak(aTHX_ PL_no_modify);
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
483
33c2748 integrate changes#1982,2014,2021 (from maint-5.005)
Gurusamy Sarathy authored Oct 25, 1998
484 if (mg = SvTIED_mg((SV*)av, 'P')) {
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
485 dSP;
e788e7d rename s/\bSI_/PERLSI_/ to avoid collisions with sysinfo headers
Gurusamy Sarathy authored Jul 6, 1998
486 PUSHSTACKi(PERLSI_MAGIC);
924508f [win32] change all 'sp' to 'SP' in code and in the docs. Explicitly
Gurusamy Sarathy authored Mar 7, 1998
487 PUSHMARK(SP);
488 EXTEND(SP,2);
33c2748 integrate changes#1982,2014,2021 (from maint-5.005)
Gurusamy Sarathy authored Oct 25, 1998
489 PUSHs(SvTIED_obj((SV*)av, mg));
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
490 PUSHs(val);
a60c095 TIEARRAY updates - almost works ...
Nick Ing-Simmons authored Jan 14, 1998
491 PUTBACK;
492 ENTER;
864dbfa initial stub implementation of implicit thread/this
Gurusamy Sarathy authored Jun 7, 1999
493 call_method("PUSH", G_SCALAR|G_DISCARD);
a60c095 TIEARRAY updates - almost works ...
Nick Ing-Simmons authored Jan 14, 1998
494 LEAVE;
d3acc0f PUSHSTACK renovation
Joshua Pritikin authored Jun 26, 1998
495 POPSTACK;
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
496 return;
497 }
498 av_store(av,AvFILLp(av)+1,val);
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
499 }
500
cb50131 Resync with mainline
Charles Bailey authored Feb 9, 2000
501 /*
502 =for apidoc av_pop
503
504 Pops an SV off the end of the array. Returns C<&PL_sv_undef> if the array
505 is empty.
506
507 =cut
508 */
509
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
510 SV *
864dbfa initial stub implementation of implicit thread/this
Gurusamy Sarathy authored Jun 7, 1999
511 Perl_av_pop(pTHX_ register AV *av)
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
512 {
513 SV *retval;
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
514 MAGIC* mg;
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
515
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
516 if (!av || AvFILL(av) < 0)
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored Jul 18, 1998
517 return &PL_sv_undef;
43fcc5d Support SvREADONLY on arrays
Chip Salzenberg authored Dec 16, 1996
518 if (SvREADONLY(av))
cea2e8a more complete support for implicit thread/interpreter pointer,
Gurusamy Sarathy authored Jun 9, 1999
519 Perl_croak(aTHX_ PL_no_modify);
33c2748 integrate changes#1982,2014,2021 (from maint-5.005)
Gurusamy Sarathy authored Oct 25, 1998
520 if (mg = SvTIED_mg((SV*)av, 'P')) {
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
521 dSP;
e788e7d rename s/\bSI_/PERLSI_/ to avoid collisions with sysinfo headers
Gurusamy Sarathy authored Jul 6, 1998
522 PUSHSTACKi(PERLSI_MAGIC);
924508f [win32] change all 'sp' to 'SP' in code and in the docs. Explicitly
Gurusamy Sarathy authored Mar 7, 1998
523 PUSHMARK(SP);
33c2748 integrate changes#1982,2014,2021 (from maint-5.005)
Gurusamy Sarathy authored Oct 25, 1998
524 XPUSHs(SvTIED_obj((SV*)av, mg));
a60c095 TIEARRAY updates - almost works ...
Nick Ing-Simmons authored Jan 14, 1998
525 PUTBACK;
526 ENTER;
864dbfa initial stub implementation of implicit thread/this
Gurusamy Sarathy authored Jun 7, 1999
527 if (call_method("POP", G_SCALAR)) {
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored Jul 18, 1998
528 retval = newSVsv(*PL_stack_sp--);
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
529 } else {
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored Jul 18, 1998
530 retval = &PL_sv_undef;
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
531 }
a60c095 TIEARRAY updates - almost works ...
Nick Ing-Simmons authored Jan 14, 1998
532 LEAVE;
d3acc0f PUSHSTACK renovation
Joshua Pritikin authored Jun 26, 1998
533 POPSTACK;
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
534 return retval;
535 }
536 retval = AvARRAY(av)[AvFILLp(av)];
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored Jul 18, 1998
537 AvARRAY(av)[AvFILLp(av)--] = &PL_sv_undef;
8990e30 perl 5.0 alpha 6
Larry Wall authored Mar 18, 1994
538 if (SvSMAGICAL(av))
463ee0b perl 5.0 alpha 4
Larry Wall authored Nov 10, 1993
539 mg_set((SV*)av);
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
540 return retval;
541 }
542
cb50131 Resync with mainline
Charles Bailey authored Feb 9, 2000
543 /*
544 =for apidoc av_unshift
545
546 Unshift the given number of C<undef> values onto the beginning of the
547 array. The array will grow automatically to accommodate the addition. You
548 must then use C<av_store> to assign values to these new elements.
549
550 =cut
551 */
552
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
553 void
864dbfa initial stub implementation of implicit thread/this
Gurusamy Sarathy authored Jun 7, 1999
554 Perl_av_unshift(pTHX_ register AV *av, register I32 num)
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
555 {
556 register I32 i;
67a38de Gisle's av_unshift tweak, two small patches from chip
Nick Ing-Simmons authored Jan 24, 1998
557 register SV **ary;
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
558 MAGIC* mg;
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
559
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
560 if (!av || num <= 0)
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
561 return;
43fcc5d Support SvREADONLY on arrays
Chip Salzenberg authored Dec 16, 1996
562 if (SvREADONLY(av))
cea2e8a more complete support for implicit thread/interpreter pointer,
Gurusamy Sarathy authored Jun 9, 1999
563 Perl_croak(aTHX_ PL_no_modify);
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
564
33c2748 integrate changes#1982,2014,2021 (from maint-5.005)
Gurusamy Sarathy authored Oct 25, 1998
565 if (mg = SvTIED_mg((SV*)av, 'P')) {
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
566 dSP;
e788e7d rename s/\bSI_/PERLSI_/ to avoid collisions with sysinfo headers
Gurusamy Sarathy authored Jul 6, 1998
567 PUSHSTACKi(PERLSI_MAGIC);
924508f [win32] change all 'sp' to 'SP' in code and in the docs. Explicitly
Gurusamy Sarathy authored Mar 7, 1998
568 PUSHMARK(SP);
569 EXTEND(SP,1+num);
33c2748 integrate changes#1982,2014,2021 (from maint-5.005)
Gurusamy Sarathy authored Oct 25, 1998
570 PUSHs(SvTIED_obj((SV*)av, mg));
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
571 while (num-- > 0) {
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored Jul 18, 1998
572 PUSHs(&PL_sv_undef);
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
573 }
574 PUTBACK;
a60c095 TIEARRAY updates - almost works ...
Nick Ing-Simmons authored Jan 14, 1998
575 ENTER;
864dbfa initial stub implementation of implicit thread/this
Gurusamy Sarathy authored Jun 7, 1999
576 call_method("UNSHIFT", G_SCALAR|G_DISCARD);
a60c095 TIEARRAY updates - almost works ...
Nick Ing-Simmons authored Jan 14, 1998
577 LEAVE;
d3acc0f PUSHSTACK renovation
Joshua Pritikin authored Jun 26, 1998
578 POPSTACK;
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
579 return;
580 }
581
49beac4 Fix scalar leak in av_unshift
Chip Salzenberg authored Jan 31, 1997
582 if (!AvREAL(av) && AvREIFY(av))
583 av_reify(av);
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
584 i = AvARRAY(av) - AvALLOC(av);
585 if (i) {
586 if (i > num)
587 i = num;
588 num -= i;
589
590 AvMAX(av) += i;
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
591 AvFILLp(av) += i;
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
592 SvPVX(av) = (char*)(AvARRAY(av) - i);
593 }
d271921 [win32] more whitespace tweaks from maintbranch
Gurusamy Sarathy authored May 18, 1998
594 if (num) {
67a38de Gisle's av_unshift tweak, two small patches from chip
Nick Ing-Simmons authored Jan 24, 1998
595 i = AvFILLp(av);
596 av_extend(av, i + num);
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
597 AvFILLp(av) += num;
67a38de Gisle's av_unshift tweak, two small patches from chip
Nick Ing-Simmons authored Jan 24, 1998
598 ary = AvARRAY(av);
599 Move(ary, ary + num, i + 1, SV*);
600 do {
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored Jul 18, 1998
601 ary[--num] = &PL_sv_undef;
67a38de Gisle's av_unshift tweak, two small patches from chip
Nick Ing-Simmons authored Jan 24, 1998
602 } while (num);
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
603 }
604 }
605
cb50131 Resync with mainline
Charles Bailey authored Feb 9, 2000
606 /*
607 =for apidoc av_shift
608
609 Shifts an SV off the beginning of the array.
610
611 =cut
612 */
613
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
614 SV *
864dbfa initial stub implementation of implicit thread/this
Gurusamy Sarathy authored Jun 7, 1999
615 Perl_av_shift(pTHX_ register AV *av)
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
616 {
617 SV *retval;
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
618 MAGIC* mg;
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
619
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
620 if (!av || AvFILL(av) < 0)
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored Jul 18, 1998
621 return &PL_sv_undef;
43fcc5d Support SvREADONLY on arrays
Chip Salzenberg authored Dec 16, 1996
622 if (SvREADONLY(av))
cea2e8a more complete support for implicit thread/interpreter pointer,
Gurusamy Sarathy authored Jun 9, 1999
623 Perl_croak(aTHX_ PL_no_modify);
33c2748 integrate changes#1982,2014,2021 (from maint-5.005)
Gurusamy Sarathy authored Oct 25, 1998
624 if (mg = SvTIED_mg((SV*)av, 'P')) {
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
625 dSP;
e788e7d rename s/\bSI_/PERLSI_/ to avoid collisions with sysinfo headers
Gurusamy Sarathy authored Jul 6, 1998
626 PUSHSTACKi(PERLSI_MAGIC);
924508f [win32] change all 'sp' to 'SP' in code and in the docs. Explicitly
Gurusamy Sarathy authored Mar 7, 1998
627 PUSHMARK(SP);
33c2748 integrate changes#1982,2014,2021 (from maint-5.005)
Gurusamy Sarathy authored Oct 25, 1998
628 XPUSHs(SvTIED_obj((SV*)av, mg));
a60c095 TIEARRAY updates - almost works ...
Nick Ing-Simmons authored Jan 14, 1998
629 PUTBACK;
630 ENTER;
864dbfa initial stub implementation of implicit thread/this
Gurusamy Sarathy authored Jun 7, 1999
631 if (call_method("SHIFT", G_SCALAR)) {
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored Jul 18, 1998
632 retval = newSVsv(*PL_stack_sp--);
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
633 } else {
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored Jul 18, 1998
634 retval = &PL_sv_undef;
a60c095 TIEARRAY updates - almost works ...
Nick Ing-Simmons authored Jan 14, 1998
635 }
636 LEAVE;
d3acc0f PUSHSTACK renovation
Joshua Pritikin authored Jun 26, 1998
637 POPSTACK;
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
638 return retval;
639 }
463ee0b perl 5.0 alpha 4
Larry Wall authored Nov 10, 1993
640 retval = *AvARRAY(av);
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
641 if (AvREAL(av))
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored Jul 18, 1998
642 *AvARRAY(av) = &PL_sv_undef;
463ee0b perl 5.0 alpha 4
Larry Wall authored Nov 10, 1993
643 SvPVX(av) = (char*)(AvARRAY(av) + 1);
644 AvMAX(av)--;
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
645 AvFILLp(av)--;
8990e30 perl 5.0 alpha 6
Larry Wall authored Mar 18, 1994
646 if (SvSMAGICAL(av))
463ee0b perl 5.0 alpha 4
Larry Wall authored Nov 10, 1993
647 mg_set((SV*)av);
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
648 return retval;
649 }
650
cb50131 Resync with mainline
Charles Bailey authored Feb 9, 2000
651 /*
652 =for apidoc av_len
653
654 Returns the highest index in the array. Returns -1 if the array is
655 empty.
656
657 =cut
658 */
659
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
660 I32
864dbfa initial stub implementation of implicit thread/this
Gurusamy Sarathy authored Jun 7, 1999
661 Perl_av_len(pTHX_ register AV *av)
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
662 {
463ee0b perl 5.0 alpha 4
Larry Wall authored Nov 10, 1993
663 return AvFILL(av);
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
664 }
665
666 void
864dbfa initial stub implementation of implicit thread/this
Gurusamy Sarathy authored Jun 7, 1999
667 Perl_av_fill(pTHX_ register AV *av, I32 fill)
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
668 {
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
669 MAGIC *mg;
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
670 if (!av)
cea2e8a more complete support for implicit thread/interpreter pointer,
Gurusamy Sarathy authored Jun 9, 1999
671 Perl_croak(aTHX_ "panic: null array");
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
672 if (fill < 0)
673 fill = -1;
33c2748 integrate changes#1982,2014,2021 (from maint-5.005)
Gurusamy Sarathy authored Oct 25, 1998
674 if (mg = SvTIED_mg((SV*)av, 'P')) {
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
675 dSP;
676 ENTER;
677 SAVETMPS;
e788e7d rename s/\bSI_/PERLSI_/ to avoid collisions with sysinfo headers
Gurusamy Sarathy authored Jul 6, 1998
678 PUSHSTACKi(PERLSI_MAGIC);
924508f [win32] change all 'sp' to 'SP' in code and in the docs. Explicitly
Gurusamy Sarathy authored Mar 7, 1998
679 PUSHMARK(SP);
680 EXTEND(SP,2);
33c2748 integrate changes#1982,2014,2021 (from maint-5.005)
Gurusamy Sarathy authored Oct 25, 1998
681 PUSHs(SvTIED_obj((SV*)av, mg));
a60c095 TIEARRAY updates - almost works ...
Nick Ing-Simmons authored Jan 14, 1998
682 PUSHs(sv_2mortal(newSViv(fill+1)));
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
683 PUTBACK;
864dbfa initial stub implementation of implicit thread/this
Gurusamy Sarathy authored Jun 7, 1999
684 call_method("STORESIZE", G_SCALAR|G_DISCARD);
d3acc0f PUSHSTACK renovation
Joshua Pritikin authored Jun 26, 1998
685 POPSTACK;
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
686 FREETMPS;
687 LEAVE;
688 return;
689 }
463ee0b perl 5.0 alpha 4
Larry Wall authored Nov 10, 1993
690 if (fill <= AvMAX(av)) {
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
691 I32 key = AvFILLp(av);
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
692 SV** ary = AvARRAY(av);
693
694 if (AvREAL(av)) {
695 while (key > fill) {
696 SvREFCNT_dec(ary[key]);
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored Jul 18, 1998
697 ary[key--] = &PL_sv_undef;
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
698 }
699 }
700 else {
701 while (key < fill)
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored Jul 18, 1998
702 ary[++key] = &PL_sv_undef;
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
703 }
704
9396587 tie array changes to core and tests
Nick Ing-Simmons authored Jan 13, 1998
705 AvFILLp(av) = fill;
8990e30 perl 5.0 alpha 6
Larry Wall authored Mar 18, 1994
706 if (SvSMAGICAL(av))
463ee0b perl 5.0 alpha 4
Larry Wall authored Nov 10, 1993
707 mg_set((SV*)av);
708 }
a0d0e21 perl 5.000
Larry Wall authored Oct 17, 1994
709 else
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored Jul 18, 1998
710 (void)av_store(av,fill,&PL_sv_undef);
7907280 perl 5.0 alpha 2
Larry Wall authored Oct 7, 1993
711 }
c750a3e Initial devel changes.
Malcolm Beattie authored Mar 28, 1997
712
146174a Quick integration of mainline changes to date
Charles Bailey authored Jan 20, 2000
713 SV *
714 Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
715 {
716 SV *sv;
717
718 if (!av)
719 return Nullsv;
720 if (SvREADONLY(av))
721 Perl_croak(aTHX_ PL_no_modify);
722 if (key < 0) {
723 key += AvFILL(av) + 1;
724 if (key < 0)
725 return Nullsv;
726 }
727 if (SvRMAGICAL(av)) {
728 SV **svp;
729 if ((mg_find((SV*)av,'P') || mg_find((SV*)av,'D'))
730 && (svp = av_fetch(av, key, TRUE)))
731 {
732 sv = *svp;
733 mg_clear(sv);
734 if (mg_find(sv, 'p')) {
735 sv_unmagic(sv, 'p'); /* No longer an element */
736 return sv;
737 }
738 return Nullsv; /* element cannot be deleted */
739 }
740 }
741 if (key > AvFILLp(av))
742 return Nullsv;
743 else {
744 sv = AvARRAY(av)[key];
745 if (key == AvFILLp(av)) {
746 do {
747 AvFILLp(av)--;
748 } while (--key >= 0 && AvARRAY(av)[key] == &PL_sv_undef);
749 }
750 else
751 AvARRAY(av)[key] = &PL_sv_undef;
752 if (SvSMAGICAL(av))
753 mg_set((SV*)av);
754 }
755 if (flags & G_DISCARD) {
756 SvREFCNT_dec(sv);
757 sv = Nullsv;
758 }
759 return sv;
760 }
761
762 /*
763 * This relies on the fact that uninitialized array elements
764 * are set to &PL_sv_undef.
765 */
766
767 bool
768 Perl_av_exists(pTHX_ AV *av, I32 key)
769 {
770 if (!av)
771 return FALSE;
772 if (key < 0) {
773 key += AvFILL(av) + 1;
774 if (key < 0)
775 return FALSE;
776 }
777 if (SvRMAGICAL(av)) {
778 if (mg_find((SV*)av,'P') || mg_find((SV*)av,'D')) {
779 SV *sv = sv_newmortal();
780 mg_copy((SV*)av, sv, 0, key);
781 magic_existspack(sv, mg_find(sv, 'p'));
782 return SvTRUE(sv);
783 }
784 }
785 if (key <= AvFILLp(av) && AvARRAY(av)[key] != &PL_sv_undef
786 && AvARRAY(av)[key])
787 {
788 return TRUE;
789 }
790 else
791 return FALSE;
792 }
57079c4 @gisle applied patch with tweaks to prose
gisle authored Jun 30, 1998
793
794 /* AVHV: Support for treating arrays as if they were hashes. The
795 * first element of the array should be a hash reference that maps
796 * hash keys to array indices.
797 */
798
7231175 patchlevel up to 5.004_70, various tweaks
Gurusamy Sarathy authored Jul 5, 1998
799 STATIC I32
cea2e8a more complete support for implicit thread/interpreter pointer,
Gurusamy Sarathy authored Jun 9, 1999
800 S_avhv_index_sv(pTHX_ SV* sv)
57079c4 @gisle applied patch with tweaks to prose
gisle authored Jun 30, 1998
801 {
802 I32 index = SvIV(sv);
803 if (index < 1)
cea2e8a more complete support for implicit thread/interpreter pointer,
Gurusamy Sarathy authored Jun 9, 1999
804 Perl_croak(aTHX_ "Bad index while coercing array into hash");
57079c4 @gisle applied patch with tweaks to prose
gisle authored Jun 30, 1998
805 return index;
806 }
807
10c8fec support for list assignment to pseudohashes (from John Tobey
Gurusamy Sarathy authored Mar 3, 2000
808 STATIC I32
809 S_avhv_index(pTHX_ AV *av, SV *keysv, U32 hash)
810 {
811 HV *keys;
812 HE *he;
813 STRLEN n_a;
814
815 keys = avhv_keys(av);
816 he = hv_fetch_ent(keys, keysv, FALSE, hash);
817 if (!he)
818 Perl_croak(aTHX_ "No such pseudo-hash field \"%s\"", SvPV(keysv,n_a));
819 return avhv_index_sv(HeVAL(he));
820 }
821
5d5aaa5 Separate avhv_foo() key handling into avhv_keys(). Slightly tweaked
Joshua Pritikin authored Nov 15, 1997
822 HV*
864dbfa initial stub implementation of implicit thread/this
Gurusamy Sarathy authored Jun 7, 1999
823 Perl_avhv_keys(pTHX_ AV *av)
5d5aaa5 Separate avhv_foo() key handling into avhv_keys(). Slightly tweaked
Joshua Pritikin authored Nov 15, 1997
824 {
57079c4 @gisle applied patch with tweaks to prose
gisle authored Jun 30, 1998
825 SV **keysp = av_fetch(av, 0, FALSE);
5d5aaa5 Separate avhv_foo() key handling into avhv_keys(). Slightly tweaked
Joshua Pritikin authored Nov 15, 1997
826 if (keysp) {
d627ae4 avhv_keys under Digital UNIX made avhv.t fail because *keysp was
Malcolm Beattie authored Nov 19, 1997
827 SV *sv = *keysp;
828 if (SvGMAGICAL(sv))
829 mg_get(sv);
830 if (SvROK(sv)) {
831 sv = SvRV(sv);
832 if (SvTYPE(sv) == SVt_PVHV)
57079c4 @gisle applied patch with tweaks to prose
gisle authored Jun 30, 1998
833 return (HV*)sv;
5d5aaa5 Separate avhv_foo() key handling into avhv_keys(). Slightly tweaked
Joshua Pritikin authored Nov 15, 1997
834 }
835 }
cea2e8a more complete support for implicit thread/interpreter pointer,
Gurusamy Sarathy authored Jun 9, 1999
836 Perl_croak(aTHX_ "Can't coerce array into hash");
7231175 patchlevel up to 5.004_70, various tweaks
Gurusamy Sarathy authored Jul 5, 1998
837 return Nullhv;
c750a3e Initial devel changes.
Malcolm Beattie authored Mar 28, 1997
838 }
839
840 SV**
10c8fec support for list assignment to pseudohashes (from John Tobey
Gurusamy Sarathy authored Mar 3, 2000
841 Perl_avhv_store_ent(pTHX_ AV *av, SV *keysv, SV *val, U32 hash)
842 {
843 return av_store(av, avhv_index(av, keysv, hash), val);
844 }
845
846 SV**
864dbfa initial stub implementation of implicit thread/this
Gurusamy Sarathy authored Jun 7, 1999
847 Perl_avhv_fetch_ent(pTHX_ AV *av, SV *keysv, I32 lval, U32 hash)
97fcbf9 Fix up integration 5.003->5.004.
Malcolm Beattie authored May 25, 1997
848 {
10c8fec support for list assignment to pseudohashes (from John Tobey
Gurusamy Sarathy authored Mar 3, 2000
849 return av_fetch(av, avhv_index(av, keysv, hash), lval);
5bc6513 Add avhv_store_ent. Add missing avhv_* to global.sym.
Malcolm Beattie authored May 26, 1997
850 }
851
146174a Quick integration of mainline changes to date
Charles Bailey authored Jan 20, 2000
852 SV *
853 Perl_avhv_delete_ent(pTHX_ AV *av, SV *keysv, I32 flags, U32 hash)
854 {
855 HV *keys = avhv_keys(av);
856 HE *he;
857
858 he = hv_fetch_ent(keys, keysv, FALSE, hash);
859 if (!he || !SvOK(HeVAL(he)))
860 return Nullsv;
861
862 return av_delete(av, avhv_index_sv(HeVAL(he)), flags);
863 }
864
865 /* Check for the existence of an element named by a given key.
866 *
867 */
c750a3e Initial devel changes.
Malcolm Beattie authored Mar 28, 1997
868 bool
864dbfa initial stub implementation of implicit thread/this
Gurusamy Sarathy authored Jun 7, 1999
869 Perl_avhv_exists_ent(pTHX_ AV *av, SV *keysv, U32 hash)
97fcbf9 Fix up integration 5.003->5.004.
Malcolm Beattie authored May 25, 1997
870 {
5d5aaa5 Separate avhv_foo() key handling into avhv_keys(). Slightly tweaked
Joshua Pritikin authored Nov 15, 1997
871 HV *keys = avhv_keys(av);
146174a Quick integration of mainline changes to date
Charles Bailey authored Jan 20, 2000
872 HE *he;
873
874 he = hv_fetch_ent(keys, keysv, FALSE, hash);
875 if (!he || !SvOK(HeVAL(he)))
876 return FALSE;
877
878 return av_exists(av, avhv_index_sv(HeVAL(he)));
97fcbf9 Fix up integration 5.003->5.004.
Malcolm Beattie authored May 25, 1997
879 }
880
c750a3e Initial devel changes.
Malcolm Beattie authored Mar 28, 1997
881 HE *
864dbfa initial stub implementation of implicit thread/this
Gurusamy Sarathy authored Jun 7, 1999
882 Perl_avhv_iternext(pTHX_ AV *av)
c750a3e Initial devel changes.
Malcolm Beattie authored Mar 28, 1997
883 {
5d5aaa5 Separate avhv_foo() key handling into avhv_keys(). Slightly tweaked
Joshua Pritikin authored Nov 15, 1997
884 HV *keys = avhv_keys(av);
885 return hv_iternext(keys);
c750a3e Initial devel changes.
Malcolm Beattie authored Mar 28, 1997
886 }
887
888 SV *
864dbfa initial stub implementation of implicit thread/this
Gurusamy Sarathy authored Jun 7, 1999
889 Perl_avhv_iterval(pTHX_ AV *av, register HE *entry)
c750a3e Initial devel changes.
Malcolm Beattie authored Mar 28, 1997
890 {
57079c4 @gisle applied patch with tweaks to prose
gisle authored Jun 30, 1998
891 SV *sv = hv_iterval(avhv_keys(av), entry);
892 return *av_fetch(av, avhv_index_sv(sv), TRUE);
c750a3e Initial devel changes.
Malcolm Beattie authored Mar 28, 1997
893 }
Something went wrong with that request. Please try again.