line |
stmt |
bran |
cond |
sub |
time |
code |
1
|
|
|
|
|
|
/* av.c |
2
|
|
|
|
|
|
* |
3
|
|
|
|
|
|
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, |
4
|
|
|
|
|
|
* 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others |
5
|
|
|
|
|
|
* |
6
|
|
|
|
|
|
* You may distribute under the terms of either the GNU General Public |
7
|
|
|
|
|
|
* License or the Artistic License, as specified in the README file. |
8
|
|
|
|
|
|
* |
9
|
|
|
|
|
|
*/ |
10
|
|
|
|
|
|
|
11
|
|
|
|
|
|
/* |
12
|
|
|
|
|
|
* '...for the Entwives desired order, and plenty, and peace (by which they |
13
|
|
|
|
|
|
* meant that things should remain where they had set them).' --Treebeard |
14
|
|
|
|
|
|
* |
15
|
|
|
|
|
|
* [p.476 of _The Lord of the Rings_, III/iv: "Treebeard"] |
16
|
|
|
|
|
|
*/ |
17
|
|
|
|
|
|
|
18
|
|
|
|
|
|
/* |
19
|
|
|
|
|
|
=head1 Array Manipulation Functions |
20
|
|
|
|
|
|
*/ |
21
|
|
|
|
|
|
|
22
|
|
|
|
|
|
#include "EXTERN.h" |
23
|
|
|
|
|
|
#define PERL_IN_AV_C |
24
|
|
|
|
|
|
#include "perl.h" |
25
|
|
|
|
|
|
|
26
|
|
|
|
|
|
void |
27
|
276731
|
|
|
|
|
Perl_av_reify(pTHX_ AV *av) |
28
|
|
|
|
|
|
{ |
29
|
|
|
|
|
|
dVAR; |
30
|
|
|
|
|
|
SSize_t key; |
31
|
|
|
|
|
|
|
32
|
|
|
|
|
|
PERL_ARGS_ASSERT_AV_REIFY; |
33
|
|
|
|
|
|
assert(SvTYPE(av) == SVt_PVAV); |
34
|
|
|
|
|
|
|
35
|
276731
|
50
|
|
|
|
if (AvREAL(av)) |
36
|
276731
|
|
|
|
|
return; |
37
|
|
|
|
|
|
#ifdef DEBUGGING |
38
|
|
|
|
|
|
if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied)) |
39
|
|
|
|
|
|
Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "av_reify called on tied array"); |
40
|
|
|
|
|
|
#endif |
41
|
276731
|
|
|
|
|
key = AvMAX(av) + 1; |
42
|
8045216
|
100
|
|
|
|
while (key > AvFILLp(av) + 1) |
43
|
7632998
|
|
|
|
|
AvARRAY(av)[--key] = NULL; |
44
|
315131
|
100
|
|
|
|
while (key) { |
45
|
38400
|
|
|
|
|
SV * const sv = AvARRAY(av)[--key]; |
46
|
38400
|
100
|
|
|
|
if (sv != &PL_sv_undef) |
47
|
38387
|
50
|
|
|
|
SvREFCNT_inc_simple_void(sv); |
48
|
|
|
|
|
|
} |
49
|
276731
|
|
|
|
|
key = AvARRAY(av) - AvALLOC(av); |
50
|
424992
|
100
|
|
|
|
while (key) |
51
|
12774
|
|
|
|
|
AvALLOC(av)[--key] = NULL; |
52
|
276731
|
|
|
|
|
AvREIFY_off(av); |
53
|
276731
|
|
|
|
|
AvREAL_on(av); |
54
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
56
|
|
|
|
|
|
/* |
57
|
|
|
|
|
|
=for apidoc av_extend |
58
|
|
|
|
|
|
|
59
|
|
|
|
|
|
Pre-extend an array. The C is the index to which the array should be |
60
|
|
|
|
|
|
extended. |
61
|
|
|
|
|
|
|
62
|
|
|
|
|
|
=cut |
63
|
|
|
|
|
|
*/ |
64
|
|
|
|
|
|
|
65
|
|
|
|
|
|
void |
66
|
271258913
|
|
|
|
|
Perl_av_extend(pTHX_ AV *av, SSize_t key) |
67
|
|
|
|
|
|
{ |
68
|
|
|
|
|
|
dVAR; |
69
|
|
|
|
|
|
MAGIC *mg; |
70
|
|
|
|
|
|
|
71
|
|
|
|
|
|
PERL_ARGS_ASSERT_AV_EXTEND; |
72
|
|
|
|
|
|
assert(SvTYPE(av) == SVt_PVAV); |
73
|
|
|
|
|
|
|
74
|
271258913
|
100
|
|
|
|
mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied); |
75
|
271258913
|
100
|
|
|
|
if (mg) { |
76
|
278
|
|
|
|
|
SV *arg1 = sv_newmortal(); |
77
|
278
|
|
|
|
|
sv_setiv(arg1, (IV)(key + 1)); |
78
|
278
|
100
|
|
|
|
Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(EXTEND), G_DISCARD, 1, |
79
|
|
|
|
|
|
arg1); |
80
|
271259050
|
|
|
|
|
return; |
81
|
|
|
|
|
|
} |
82
|
271258635
|
|
|
|
|
av_extend_guts(av,key,&AvMAX(av),&AvALLOC(av),&AvARRAY(av)); |
83
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
85
|
|
|
|
|
|
/* The guts of av_extend. *Not* for general use! */ |
86
|
|
|
|
|
|
void |
87
|
271668473
|
|
|
|
|
Perl_av_extend_guts(pTHX_ AV *av, SSize_t key, SSize_t *maxp, SV ***allocp, |
88
|
|
|
|
|
|
SV ***arrayp) |
89
|
|
|
|
|
|
{ |
90
|
|
|
|
|
|
dVAR; |
91
|
|
|
|
|
|
|
92
|
|
|
|
|
|
PERL_ARGS_ASSERT_AV_EXTEND_GUTS; |
93
|
|
|
|
|
|
|
94
|
271668473
|
100
|
|
|
|
if (key > *maxp) { |
95
|
|
|
|
|
|
SV** ary; |
96
|
|
|
|
|
|
SSize_t tmp; |
97
|
|
|
|
|
|
SSize_t newmax; |
98
|
|
|
|
|
|
|
99
|
253289756
|
100
|
|
|
|
if (av && *allocp != *arrayp) { |
|
|
100
|
|
|
|
|
100
|
449002
|
|
|
|
|
ary = *allocp + AvFILLp(av) + 1; |
101
|
449002
|
|
|
|
|
tmp = *arrayp - *allocp; |
102
|
449002
|
50
|
|
|
|
Move(*arrayp, *allocp, AvFILLp(av)+1, SV*); |
103
|
449002
|
|
|
|
|
*maxp += tmp; |
104
|
449002
|
|
|
|
|
*arrayp = *allocp; |
105
|
449002
|
100
|
|
|
|
if (AvREAL(av)) { |
106
|
2245996
|
100
|
|
|
|
while (tmp) |
107
|
1847130
|
|
|
|
|
ary[--tmp] = NULL; |
108
|
|
|
|
|
|
} |
109
|
449002
|
100
|
|
|
|
if (key > *maxp - 10) { |
110
|
433498
|
|
|
|
|
newmax = key + *maxp; |
111
|
433498
|
|
|
|
|
goto resize; |
112
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
else { |
115
|
|
|
|
|
|
#ifdef PERL_MALLOC_WRAP |
116
|
|
|
|
|
|
static const char oom_array_extend[] = |
117
|
|
|
|
|
|
"Out of memory during array extend"; /* Duplicated in pp_hot.c */ |
118
|
|
|
|
|
|
#endif |
119
|
|
|
|
|
|
|
120
|
431942813
|
100
|
|
|
|
if (*allocp) { |
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
121
|
|
|
|
|
|
|
122
|
|
|
|
|
|
#ifdef Perl_safesysmalloc_size |
123
|
|
|
|
|
|
/* Whilst it would be quite possible to move this logic around |
124
|
|
|
|
|
|
(as I did in the SV code), so as to set AvMAX(av) early, |
125
|
|
|
|
|
|
based on calling Perl_safesysmalloc_size() immediately after |
126
|
|
|
|
|
|
allocation, I'm not convinced that it is a great idea here. |
127
|
|
|
|
|
|
In an array we have to loop round setting everything to |
128
|
|
|
|
|
|
NULL, which means writing to memory, potentially lots |
129
|
|
|
|
|
|
of it, whereas for the SV buffer case we don't touch the |
130
|
|
|
|
|
|
"bonus" memory. So there there is no cost in telling the |
131
|
|
|
|
|
|
world about it, whereas here we have to do work before we can |
132
|
|
|
|
|
|
tell the world about it, and that work involves writing to |
133
|
|
|
|
|
|
memory that might never be read. So, I feel, better to keep |
134
|
|
|
|
|
|
the current lazy system of only writing to it if our caller |
135
|
|
|
|
|
|
has a need for more space. NWC */ |
136
|
|
|
|
|
|
newmax = Perl_safesysmalloc_size((void*)*allocp) / |
137
|
|
|
|
|
|
sizeof(const SV *) - 1; |
138
|
|
|
|
|
|
|
139
|
|
|
|
|
|
if (key <= newmax) |
140
|
|
|
|
|
|
goto resized; |
141
|
|
|
|
|
|
#endif |
142
|
105565877
|
|
|
|
|
newmax = key + *maxp / 5; |
143
|
|
|
|
|
|
resize: |
144
|
52055040
|
|
|
|
|
MEM_WRAP_CHECK_1(newmax+1, SV*, oom_array_extend); |
145
|
105999375
|
50
|
|
|
|
Renew(*allocp,newmax+1, SV*); |
146
|
|
|
|
|
|
#ifdef Perl_safesysmalloc_size |
147
|
|
|
|
|
|
resized: |
148
|
|
|
|
|
|
#endif |
149
|
105999375
|
|
|
|
|
ary = *allocp + *maxp + 1; |
150
|
105999375
|
|
|
|
|
tmp = newmax - *maxp; |
151
|
105999375
|
100
|
|
|
|
if (av == PL_curstack) { /* Oops, grew stack (via av_store()?) */ |
152
|
50474
|
|
|
|
|
PL_stack_sp = *allocp + (PL_stack_sp - PL_stack_base); |
153
|
50474
|
|
|
|
|
PL_stack_base = *allocp; |
154
|
50474
|
|
|
|
|
PL_stack_max = PL_stack_base + newmax; |
155
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
else { |
158
|
147274877
|
|
|
|
|
newmax = key < 3 ? 3 : key; |
159
|
73102686
|
|
|
|
|
MEM_WRAP_CHECK_1(newmax+1, SV*, oom_array_extend); |
160
|
147274875
|
50
|
|
|
|
Newx(*allocp, newmax+1, SV*); |
161
|
147274875
|
|
|
|
|
ary = *allocp + 1; |
162
|
|
|
|
|
|
tmp = newmax; |
163
|
147274875
|
|
|
|
|
*allocp[0] = NULL; /* For the stacks */ |
164
|
|
|
|
|
|
} |
165
|
253274250
|
100
|
|
|
|
if (av && AvREAL(av)) { |
|
|
100
|
|
|
|
|
166
|
2294432303
|
100
|
|
|
|
while (tmp) |
167
|
2050010707
|
|
|
|
|
ary[--tmp] = NULL; |
168
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
170
|
253274250
|
|
|
|
|
*arrayp = *allocp; |
171
|
253274250
|
|
|
|
|
*maxp = newmax; |
172
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
} |
174
|
271668471
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
176
|
|
|
|
|
|
/* |
177
|
|
|
|
|
|
=for apidoc av_fetch |
178
|
|
|
|
|
|
|
179
|
|
|
|
|
|
Returns the SV at the specified index in the array. The C is the |
180
|
|
|
|
|
|
index. If lval is true, you are guaranteed to get a real SV back (in case |
181
|
|
|
|
|
|
it wasn't real before), which you can then modify. Check that the return |
182
|
|
|
|
|
|
value is non-null before dereferencing it to a C. |
183
|
|
|
|
|
|
|
184
|
|
|
|
|
|
See L for |
185
|
|
|
|
|
|
more information on how to use this function on tied arrays. |
186
|
|
|
|
|
|
|
187
|
|
|
|
|
|
The rough perl equivalent is C<$myarray[$idx]>. |
188
|
|
|
|
|
|
|
189
|
|
|
|
|
|
=cut |
190
|
|
|
|
|
|
*/ |
191
|
|
|
|
|
|
|
192
|
|
|
|
|
|
static bool |
193
|
60
|
|
|
|
|
S_adjust_index(pTHX_ AV *av, const MAGIC *mg, SSize_t *keyp) |
194
|
|
|
|
|
|
{ |
195
|
|
|
|
|
|
bool adjust_index = 1; |
196
|
120
|
50
|
|
|
|
if (mg) { |
|
|
50
|
|
|
|
|
197
|
|
|
|
|
|
/* Handle negative array indices 20020222 MJD */ |
198
|
60
|
50
|
|
|
|
SV * const ref = SvTIED_obj(MUTABLE_SV(av), mg); |
199
|
30
|
|
|
|
|
SvGETMAGIC(ref); |
200
|
60
|
100
|
|
|
|
if (SvROK(ref) && SvOBJECT(SvRV(ref))) { |
|
|
50
|
|
|
|
|
201
|
52
|
|
|
|
|
SV * const * const negative_indices_glob = |
202
|
52
|
|
|
|
|
hv_fetchs(SvSTASH(SvRV(ref)), NEGATIVE_INDICES_VAR, 0); |
203
|
|
|
|
|
|
|
204
|
52
|
100
|
|
|
|
if (negative_indices_glob && SvTRUE(GvSV(*negative_indices_glob))) |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
100
|
|
|
|
|
205
|
|
|
|
|
|
adjust_index = 0; |
206
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
209
|
60
|
100
|
|
|
|
if (adjust_index) { |
210
|
26
|
50
|
|
|
|
*keyp += AvFILL(av) + 1; |
211
|
18
|
100
|
|
|
|
if (*keyp < 0) |
212
|
|
|
|
|
|
return FALSE; |
213
|
|
|
|
|
|
} |
214
|
51
|
|
|
|
|
return TRUE; |
215
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
217
|
|
|
|
|
|
SV** |
218
|
710775002
|
|
|
|
|
Perl_av_fetch(pTHX_ AV *av, SSize_t key, I32 lval) |
219
|
|
|
|
|
|
{ |
220
|
|
|
|
|
|
dVAR; |
221
|
|
|
|
|
|
|
222
|
|
|
|
|
|
PERL_ARGS_ASSERT_AV_FETCH; |
223
|
|
|
|
|
|
assert(SvTYPE(av) == SVt_PVAV); |
224
|
|
|
|
|
|
|
225
|
710775002
|
100
|
|
|
|
if (SvRMAGICAL(av)) { |
226
|
1211914
|
|
|
|
|
const MAGIC * const tied_magic |
227
|
|
|
|
|
|
= mg_find((const SV *)av, PERL_MAGIC_tied); |
228
|
1211914
|
100
|
|
|
|
if (tied_magic || mg_find((const SV *)av, PERL_MAGIC_regdata)) { |
|
|
100
|
|
|
|
|
229
|
|
|
|
|
|
SV *sv; |
230
|
71822
|
100
|
|
|
|
if (key < 0) { |
231
|
36
|
50
|
|
|
|
if (!S_adjust_index(aTHX_ av, tied_magic, &key)) |
232
|
|
|
|
|
|
return NULL; |
233
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
235
|
71818
|
|
|
|
|
sv = sv_newmortal(); |
236
|
71818
|
|
|
|
|
sv_upgrade(sv, SVt_PVLV); |
237
|
71818
|
|
|
|
|
mg_copy(MUTABLE_SV(av), sv, 0, key); |
238
|
71818
|
100
|
|
|
|
if (!tied_magic) /* for regdata, force leavesub to make copies */ |
239
|
66760
|
|
|
|
|
SvTEMP_off(sv); |
240
|
71818
|
|
|
|
|
LvTYPE(sv) = 't'; |
241
|
71818
|
|
|
|
|
LvTARG(sv) = sv; /* fake (SV**) */ |
242
|
71818
|
|
|
|
|
return &(LvTARG(sv)); |
243
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
246
|
710703180
|
100
|
|
|
|
if (key < 0) { |
247
|
4063012
|
100
|
|
|
|
key += AvFILL(av) + 1; |
248
|
4063012
|
100
|
|
|
|
if (key < 0) |
249
|
|
|
|
|
|
return NULL; |
250
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
252
|
710702406
|
100
|
|
|
|
if (key > AvFILLp(av) || !AvARRAY(av)[key]) { |
|
|
100
|
|
|
|
|
253
|
|
|
|
|
|
emptyness: |
254
|
140199038
|
100
|
|
|
|
return lval ? av_store(av,key,newSV(0)) : NULL; |
255
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
257
|
570503386
|
100
|
|
|
|
if (AvREIFY(av) |
258
|
91394240
|
50
|
|
|
|
&& (!AvARRAY(av)[key] /* eg. @_ could have freed elts */ |
259
|
91394240
|
100
|
|
|
|
|| SvIS_FREED(AvARRAY(av)[key]))) { |
260
|
18
|
|
|
|
|
AvARRAY(av)[key] = NULL; /* 1/2 reify */ |
261
|
18
|
|
|
|
|
goto emptyness; |
262
|
|
|
|
|
|
} |
263
|
642647766
|
|
|
|
|
return &AvARRAY(av)[key]; |
264
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
266
|
|
|
|
|
|
/* |
267
|
|
|
|
|
|
=for apidoc av_store |
268
|
|
|
|
|
|
|
269
|
|
|
|
|
|
Stores an SV in an array. The array index is specified as C. The |
270
|
|
|
|
|
|
return value will be NULL if the operation failed or if the value did not |
271
|
|
|
|
|
|
need to be actually stored within the array (as in the case of tied |
272
|
|
|
|
|
|
arrays). Otherwise, it can be dereferenced |
273
|
|
|
|
|
|
to get the C that was stored |
274
|
|
|
|
|
|
there (= C)). |
275
|
|
|
|
|
|
|
276
|
|
|
|
|
|
Note that the caller is responsible for suitably incrementing the reference |
277
|
|
|
|
|
|
count of C before the call, and decrementing it if the function |
278
|
|
|
|
|
|
returned NULL. |
279
|
|
|
|
|
|
|
280
|
|
|
|
|
|
Approximate Perl equivalent: C<$myarray[$key] = $val;>. |
281
|
|
|
|
|
|
|
282
|
|
|
|
|
|
See L for |
283
|
|
|
|
|
|
more information on how to use this function on tied arrays. |
284
|
|
|
|
|
|
|
285
|
|
|
|
|
|
=cut |
286
|
|
|
|
|
|
*/ |
287
|
|
|
|
|
|
|
288
|
|
|
|
|
|
SV** |
289
|
1854136888
|
|
|
|
|
Perl_av_store(pTHX_ AV *av, SSize_t key, SV *val) |
290
|
|
|
|
|
|
{ |
291
|
|
|
|
|
|
dVAR; |
292
|
|
|
|
|
|
SV** ary; |
293
|
|
|
|
|
|
|
294
|
|
|
|
|
|
PERL_ARGS_ASSERT_AV_STORE; |
295
|
|
|
|
|
|
assert(SvTYPE(av) == SVt_PVAV); |
296
|
|
|
|
|
|
|
297
|
|
|
|
|
|
/* S_regclass relies on being able to pass in a NULL sv |
298
|
|
|
|
|
|
(unicode_alternate may be NULL). |
299
|
|
|
|
|
|
*/ |
300
|
|
|
|
|
|
|
301
|
1854136888
|
100
|
|
|
|
if (SvRMAGICAL(av)) { |
302
|
1102040
|
|
|
|
|
const MAGIC * const tied_magic = mg_find((const SV *)av, PERL_MAGIC_tied); |
303
|
1102040
|
100
|
|
|
|
if (tied_magic) { |
304
|
1154
|
50
|
|
|
|
if (key < 0) { |
305
|
0
|
0
|
|
|
|
if (!S_adjust_index(aTHX_ av, tied_magic, &key)) |
306
|
|
|
|
|
|
return 0; |
307
|
|
|
|
|
|
} |
308
|
1154
|
50
|
|
|
|
if (val) { |
309
|
1154
|
|
|
|
|
mg_copy(MUTABLE_SV(av), val, 0, key); |
310
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
return NULL; |
312
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
316
|
1854135734
|
50
|
|
|
|
if (key < 0) { |
317
|
0
|
0
|
|
|
|
key += AvFILL(av) + 1; |
318
|
0
|
0
|
|
|
|
if (key < 0) |
319
|
|
|
|
|
|
return NULL; |
320
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
322
|
1854135734
|
50
|
|
|
|
if (SvREADONLY(av) && key >= AvFILL(av)) |
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
323
|
0
|
|
|
|
|
Perl_croak_no_modify(); |
324
|
|
|
|
|
|
|
325
|
1854135734
|
100
|
|
|
|
if (!AvREAL(av) && AvREIFY(av)) |
|
|
50
|
|
|
|
|
326
|
263555
|
|
|
|
|
av_reify(av); |
327
|
1854135734
|
100
|
|
|
|
if (key > AvMAX(av)) |
328
|
152702887
|
|
|
|
|
av_extend(av,key); |
329
|
1854135732
|
|
|
|
|
ary = AvARRAY(av); |
330
|
1854135732
|
100
|
|
|
|
if (AvFILLp(av) < key) { |
331
|
1811365383
|
50
|
|
|
|
if (!AvREAL(av)) { |
332
|
0
|
0
|
|
|
|
if (av == PL_curstack && key > PL_stack_sp - PL_stack_base) |
|
|
0
|
|
|
|
|
333
|
0
|
|
|
|
|
PL_stack_sp = PL_stack_base + key; /* XPUSH in disguise */ |
334
|
|
|
|
|
|
do { |
335
|
0
|
|
|
|
|
ary[++AvFILLp(av)] = NULL; |
336
|
0
|
0
|
|
|
|
} while (AvFILLp(av) < key); |
337
|
|
|
|
|
|
} |
338
|
1811365383
|
|
|
|
|
AvFILLp(av) = key; |
339
|
|
|
|
|
|
} |
340
|
42770349
|
50
|
|
|
|
else if (AvREAL(av)) |
341
|
42770349
|
|
|
|
|
SvREFCNT_dec(ary[key]); |
342
|
1854135732
|
|
|
|
|
ary[key] = val; |
343
|
1854135732
|
100
|
|
|
|
if (SvSMAGICAL(av)) { |
344
|
523282
|
|
|
|
|
const MAGIC *mg = SvMAGIC(av); |
345
|
|
|
|
|
|
bool set = TRUE; |
346
|
1046580
|
100
|
|
|
|
for (; mg; mg = mg->mg_moremagic) { |
347
|
523298
|
100
|
|
|
|
if (!isUPPER(mg->mg_type)) continue; |
348
|
523290
|
50
|
|
|
|
if (val) { |
349
|
523290
|
50
|
|
|
|
sv_magic(val, MUTABLE_SV(av), toLOWER(mg->mg_type), 0, key); |
350
|
|
|
|
|
|
} |
351
|
523290
|
100
|
|
|
|
if (PL_delaymagic && mg->mg_type == PERL_MAGIC_isa) { |
|
|
50
|
|
|
|
|
352
|
449046
|
|
|
|
|
PL_delaymagic |= DM_ARRAY_ISA; |
353
|
|
|
|
|
|
set = FALSE; |
354
|
|
|
|
|
|
} |
355
|
|
|
|
|
|
} |
356
|
523282
|
100
|
|
|
|
if (set) |
357
|
74244
|
|
|
|
|
mg_set(MUTABLE_SV(av)); |
358
|
|
|
|
|
|
} |
359
|
1854136309
|
|
|
|
|
return &ary[key]; |
360
|
|
|
|
|
|
} |
361
|
|
|
|
|
|
|
362
|
|
|
|
|
|
/* |
363
|
|
|
|
|
|
=for apidoc av_make |
364
|
|
|
|
|
|
|
365
|
|
|
|
|
|
Creates a new AV and populates it with a list of SVs. The SVs are copied |
366
|
|
|
|
|
|
into the array, so they may be freed after the call to av_make. The new AV |
367
|
|
|
|
|
|
will have a reference count of 1. |
368
|
|
|
|
|
|
|
369
|
|
|
|
|
|
Perl equivalent: C |
370
|
|
|
|
|
|
|
371
|
|
|
|
|
|
=cut |
372
|
|
|
|
|
|
*/ |
373
|
|
|
|
|
|
|
374
|
|
|
|
|
|
AV * |
375
|
10282641
|
|
|
|
|
Perl_av_make(pTHX_ SSize_t size, SV **strp) |
376
|
|
|
|
|
|
{ |
377
|
10282641
|
|
|
|
|
AV * const av = MUTABLE_AV(newSV_type(SVt_PVAV)); |
378
|
|
|
|
|
|
/* sv_upgrade does AvREAL_only() */ |
379
|
|
|
|
|
|
PERL_ARGS_ASSERT_AV_MAKE; |
380
|
|
|
|
|
|
assert(SvTYPE(av) == SVt_PVAV); |
381
|
|
|
|
|
|
|
382
|
33836160
|
100
|
|
|
|
if (size) { /* "defined" was returning undef for size==0 anyway. */ |
|
|
100
|
|
|
|
|
383
|
|
|
|
|
|
SV** ary; |
384
|
|
|
|
|
|
SSize_t i; |
385
|
7227966
|
50
|
|
|
|
Newx(ary,size,SV*); |
386
|
7227966
|
|
|
|
|
AvALLOC(av) = ary; |
387
|
7227966
|
|
|
|
|
AvARRAY(av) = ary; |
388
|
7227966
|
|
|
|
|
AvMAX(av) = size - 1; |
389
|
7227966
|
|
|
|
|
AvFILLp(av) = -1; |
390
|
7227966
|
|
|
|
|
ENTER; |
391
|
7227966
|
|
|
|
|
SAVEFREESV(av); |
392
|
30781481
|
100
|
|
|
|
for (i = 0; i < size; i++) { |
393
|
|
|
|
|
|
assert (*strp); |
394
|
|
|
|
|
|
|
395
|
|
|
|
|
|
/* Don't let sv_setsv swipe, since our source array might |
396
|
|
|
|
|
|
have multiple references to the same temp scalar (e.g. |
397
|
|
|
|
|
|
from a list slice) */ |
398
|
|
|
|
|
|
|
399
|
11842441
|
|
|
|
|
SvGETMAGIC(*strp); /* before newSV, in case it dies */ |
400
|
23553515
|
|
|
|
|
AvFILLp(av)++; |
401
|
23553515
|
|
|
|
|
ary[i] = newSV(0); |
402
|
23553515
|
|
|
|
|
sv_setsv_flags(ary[i], *strp, |
403
|
|
|
|
|
|
SV_DO_COW_SVSETSV|SV_NOSTEAL); |
404
|
23553515
|
|
|
|
|
strp++; |
405
|
|
|
|
|
|
} |
406
|
7227962
|
|
|
|
|
SvREFCNT_inc_simple_void_NN(av); |
407
|
7227962
|
|
|
|
|
LEAVE; |
408
|
|
|
|
|
|
} |
409
|
10282637
|
|
|
|
|
return av; |
410
|
|
|
|
|
|
} |
411
|
|
|
|
|
|
|
412
|
|
|
|
|
|
/* |
413
|
|
|
|
|
|
=for apidoc av_clear |
414
|
|
|
|
|
|
|
415
|
|
|
|
|
|
Clears an array, making it empty. Does not free the memory the av uses to |
416
|
|
|
|
|
|
store its list of scalars. If any destructors are triggered as a result, |
417
|
|
|
|
|
|
the av itself may be freed when this function returns. |
418
|
|
|
|
|
|
|
419
|
|
|
|
|
|
Perl equivalent: C<@myarray = ();>. |
420
|
|
|
|
|
|
|
421
|
|
|
|
|
|
=cut |
422
|
|
|
|
|
|
*/ |
423
|
|
|
|
|
|
|
424
|
|
|
|
|
|
void |
425
|
47288768
|
|
|
|
|
Perl_av_clear(pTHX_ AV *av) |
426
|
|
|
|
|
|
{ |
427
|
|
|
|
|
|
dVAR; |
428
|
|
|
|
|
|
SSize_t extra; |
429
|
|
|
|
|
|
bool real; |
430
|
|
|
|
|
|
|
431
|
|
|
|
|
|
PERL_ARGS_ASSERT_AV_CLEAR; |
432
|
|
|
|
|
|
assert(SvTYPE(av) == SVt_PVAV); |
433
|
|
|
|
|
|
|
434
|
|
|
|
|
|
#ifdef DEBUGGING |
435
|
|
|
|
|
|
if (SvREFCNT(av) == 0) { |
436
|
|
|
|
|
|
Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "Attempt to clear deleted array"); |
437
|
|
|
|
|
|
} |
438
|
|
|
|
|
|
#endif |
439
|
|
|
|
|
|
|
440
|
47288768
|
100
|
|
|
|
if (SvREADONLY(av)) |
441
|
2
|
|
|
|
|
Perl_croak_no_modify(); |
442
|
|
|
|
|
|
|
443
|
|
|
|
|
|
/* Give any tie a chance to cleanup first */ |
444
|
47288766
|
100
|
|
|
|
if (SvRMAGICAL(av)) { |
445
|
363480
|
|
|
|
|
const MAGIC* const mg = SvMAGIC(av); |
446
|
363480
|
100
|
|
|
|
if (PL_delaymagic && mg && mg->mg_type == PERL_MAGIC_isa) |
|
|
100
|
|
|
|
|
447
|
348442
|
|
|
|
|
PL_delaymagic |= DM_ARRAY_ISA; |
448
|
|
|
|
|
|
else |
449
|
15038
|
|
|
|
|
mg_clear(MUTABLE_SV(av)); |
450
|
|
|
|
|
|
} |
451
|
|
|
|
|
|
|
452
|
47288766
|
100
|
|
|
|
if (AvMAX(av) < 0) |
453
|
47288766
|
|
|
|
|
return; |
454
|
|
|
|
|
|
|
455
|
34638573
|
100
|
|
|
|
if ((real = !!AvREAL(av))) { |
456
|
34404911
|
|
|
|
|
SV** const ary = AvARRAY(av); |
457
|
34404911
|
|
|
|
|
SSize_t index = AvFILLp(av) + 1; |
458
|
34404911
|
|
|
|
|
ENTER; |
459
|
34404911
|
|
|
|
|
SAVEFREESV(SvREFCNT_inc_simple_NN(av)); |
460
|
167989638
|
100
|
|
|
|
while (index) { |
461
|
116403233
|
|
|
|
|
SV * const sv = ary[--index]; |
462
|
|
|
|
|
|
/* undef the slot before freeing the value, because a |
463
|
|
|
|
|
|
* destructor might try to modify this array */ |
464
|
116403233
|
|
|
|
|
ary[index] = NULL; |
465
|
116403233
|
|
|
|
|
SvREFCNT_dec(sv); |
466
|
|
|
|
|
|
} |
467
|
|
|
|
|
|
} |
468
|
34638573
|
|
|
|
|
extra = AvARRAY(av) - AvALLOC(av); |
469
|
34638573
|
100
|
|
|
|
if (extra) { |
470
|
1730406
|
|
|
|
|
AvMAX(av) += extra; |
471
|
1730406
|
|
|
|
|
AvARRAY(av) = AvALLOC(av); |
472
|
|
|
|
|
|
} |
473
|
34638573
|
|
|
|
|
AvFILLp(av) = -1; |
474
|
34638573
|
100
|
|
|
|
if (real) LEAVE; |
475
|
|
|
|
|
|
} |
476
|
|
|
|
|
|
|
477
|
|
|
|
|
|
/* |
478
|
|
|
|
|
|
=for apidoc av_undef |
479
|
|
|
|
|
|
|
480
|
|
|
|
|
|
Undefines the array. Frees the memory used by the av to store its list of |
481
|
|
|
|
|
|
scalars. If any destructors are triggered as a result, the av itself may |
482
|
|
|
|
|
|
be freed. |
483
|
|
|
|
|
|
|
484
|
|
|
|
|
|
=cut |
485
|
|
|
|
|
|
*/ |
486
|
|
|
|
|
|
|
487
|
|
|
|
|
|
void |
488
|
4458470
|
|
|
|
|
Perl_av_undef(pTHX_ AV *av) |
489
|
|
|
|
|
|
{ |
490
|
|
|
|
|
|
bool real; |
491
|
|
|
|
|
|
|
492
|
|
|
|
|
|
PERL_ARGS_ASSERT_AV_UNDEF; |
493
|
|
|
|
|
|
assert(SvTYPE(av) == SVt_PVAV); |
494
|
|
|
|
|
|
|
495
|
|
|
|
|
|
/* Give any tie a chance to cleanup first */ |
496
|
4458470
|
100
|
|
|
|
if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied)) |
|
|
50
|
|
|
|
|
497
|
0
|
|
|
|
|
av_fill(av, -1); |
498
|
|
|
|
|
|
|
499
|
4458470
|
50
|
|
|
|
if ((real = !!AvREAL(av))) { |
500
|
4458470
|
|
|
|
|
SSize_t key = AvFILLp(av) + 1; |
501
|
4458470
|
|
|
|
|
ENTER; |
502
|
4458470
|
|
|
|
|
SAVEFREESV(SvREFCNT_inc_simple_NN(av)); |
503
|
956288784
|
100
|
|
|
|
while (key) |
504
|
949601438
|
|
|
|
|
SvREFCNT_dec(AvARRAY(av)[--key]); |
505
|
|
|
|
|
|
} |
506
|
|
|
|
|
|
|
507
|
4458470
|
|
|
|
|
Safefree(AvALLOC(av)); |
508
|
4458470
|
|
|
|
|
AvALLOC(av) = NULL; |
509
|
4458470
|
|
|
|
|
AvARRAY(av) = NULL; |
510
|
4458470
|
|
|
|
|
AvMAX(av) = AvFILLp(av) = -1; |
511
|
|
|
|
|
|
|
512
|
4458470
|
100
|
|
|
|
if(SvRMAGICAL(av)) mg_clear(MUTABLE_SV(av)); |
513
|
4458470
|
50
|
|
|
|
if(real) LEAVE; |
514
|
4458470
|
|
|
|
|
} |
515
|
|
|
|
|
|
|
516
|
|
|
|
|
|
/* |
517
|
|
|
|
|
|
|
518
|
|
|
|
|
|
=for apidoc av_create_and_push |
519
|
|
|
|
|
|
|
520
|
|
|
|
|
|
Push an SV onto the end of the array, creating the array if necessary. |
521
|
|
|
|
|
|
A small internal helper function to remove a commonly duplicated idiom. |
522
|
|
|
|
|
|
|
523
|
|
|
|
|
|
=cut |
524
|
|
|
|
|
|
*/ |
525
|
|
|
|
|
|
|
526
|
|
|
|
|
|
void |
527
|
7717064
|
|
|
|
|
Perl_av_create_and_push(pTHX_ AV **const avp, SV *const val) |
528
|
|
|
|
|
|
{ |
529
|
|
|
|
|
|
PERL_ARGS_ASSERT_AV_CREATE_AND_PUSH; |
530
|
|
|
|
|
|
|
531
|
7717064
|
100
|
|
|
|
if (!*avp) |
532
|
47148
|
|
|
|
|
*avp = newAV(); |
533
|
7717064
|
|
|
|
|
av_push(*avp, val); |
534
|
7717064
|
|
|
|
|
} |
535
|
|
|
|
|
|
|
536
|
|
|
|
|
|
/* |
537
|
|
|
|
|
|
=for apidoc av_push |
538
|
|
|
|
|
|
|
539
|
|
|
|
|
|
Pushes an SV onto the end of the array. The array will grow automatically |
540
|
|
|
|
|
|
to accommodate the addition. This takes ownership of one reference count. |
541
|
|
|
|
|
|
|
542
|
|
|
|
|
|
Perl equivalent: C. |
543
|
|
|
|
|
|
|
544
|
|
|
|
|
|
=cut |
545
|
|
|
|
|
|
*/ |
546
|
|
|
|
|
|
|
547
|
|
|
|
|
|
void |
548
|
28236052
|
|
|
|
|
Perl_av_push(pTHX_ AV *av, SV *val) |
549
|
|
|
|
|
|
{ |
550
|
|
|
|
|
|
dVAR; |
551
|
|
|
|
|
|
MAGIC *mg; |
552
|
|
|
|
|
|
|
553
|
|
|
|
|
|
PERL_ARGS_ASSERT_AV_PUSH; |
554
|
|
|
|
|
|
assert(SvTYPE(av) == SVt_PVAV); |
555
|
|
|
|
|
|
|
556
|
28236052
|
50
|
|
|
|
if (SvREADONLY(av)) |
557
|
0
|
|
|
|
|
Perl_croak_no_modify(); |
558
|
|
|
|
|
|
|
559
|
28236052
|
100
|
|
|
|
if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) { |
|
|
50
|
|
|
|
|
560
|
0
|
0
|
|
|
|
Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(PUSH), G_DISCARD, 1, |
561
|
|
|
|
|
|
val); |
562
|
28236052
|
|
|
|
|
return; |
563
|
|
|
|
|
|
} |
564
|
28236052
|
|
|
|
|
av_store(av,AvFILLp(av)+1,val); |
565
|
|
|
|
|
|
} |
566
|
|
|
|
|
|
|
567
|
|
|
|
|
|
/* |
568
|
|
|
|
|
|
=for apidoc av_pop |
569
|
|
|
|
|
|
|
570
|
|
|
|
|
|
Removes one SV from the end of the array, reducing its size by one and |
571
|
|
|
|
|
|
returning the SV (transferring control of one reference count) to the |
572
|
|
|
|
|
|
caller. Returns C<&PL_sv_undef> if the array is empty. |
573
|
|
|
|
|
|
|
574
|
|
|
|
|
|
Perl equivalent: C |
575
|
|
|
|
|
|
|
576
|
|
|
|
|
|
=cut |
577
|
|
|
|
|
|
*/ |
578
|
|
|
|
|
|
|
579
|
|
|
|
|
|
SV * |
580
|
11960920
|
|
|
|
|
Perl_av_pop(pTHX_ AV *av) |
581
|
|
|
|
|
|
{ |
582
|
|
|
|
|
|
dVAR; |
583
|
|
|
|
|
|
SV *retval; |
584
|
|
|
|
|
|
MAGIC* mg; |
585
|
|
|
|
|
|
|
586
|
|
|
|
|
|
PERL_ARGS_ASSERT_AV_POP; |
587
|
|
|
|
|
|
assert(SvTYPE(av) == SVt_PVAV); |
588
|
|
|
|
|
|
|
589
|
11960920
|
50
|
|
|
|
if (SvREADONLY(av)) |
590
|
0
|
|
|
|
|
Perl_croak_no_modify(); |
591
|
11960920
|
100
|
|
|
|
if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) { |
|
|
100
|
|
|
|
|
592
|
38
|
100
|
|
|
|
retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(POP), 0, 0); |
593
|
38
|
50
|
|
|
|
if (retval) |
594
|
38
|
|
|
|
|
retval = newSVsv(retval); |
595
|
38
|
|
|
|
|
return retval; |
596
|
|
|
|
|
|
} |
597
|
11960882
|
100
|
|
|
|
if (AvFILL(av) < 0) |
|
|
100
|
|
|
|
|
598
|
|
|
|
|
|
return &PL_sv_undef; |
599
|
11418616
|
|
|
|
|
retval = AvARRAY(av)[AvFILLp(av)]; |
600
|
11418616
|
|
|
|
|
AvARRAY(av)[AvFILLp(av)--] = NULL; |
601
|
11418616
|
50
|
|
|
|
if (SvSMAGICAL(av)) |
602
|
0
|
|
|
|
|
mg_set(MUTABLE_SV(av)); |
603
|
11689768
|
50
|
|
|
|
return retval ? retval : &PL_sv_undef; |
604
|
|
|
|
|
|
} |
605
|
|
|
|
|
|
|
606
|
|
|
|
|
|
/* |
607
|
|
|
|
|
|
|
608
|
|
|
|
|
|
=for apidoc av_create_and_unshift_one |
609
|
|
|
|
|
|
|
610
|
|
|
|
|
|
Unshifts an SV onto the beginning of the array, creating the array if |
611
|
|
|
|
|
|
necessary. |
612
|
|
|
|
|
|
A small internal helper function to remove a commonly duplicated idiom. |
613
|
|
|
|
|
|
|
614
|
|
|
|
|
|
=cut |
615
|
|
|
|
|
|
*/ |
616
|
|
|
|
|
|
|
617
|
|
|
|
|
|
SV ** |
618
|
27460
|
|
|
|
|
Perl_av_create_and_unshift_one(pTHX_ AV **const avp, SV *const val) |
619
|
|
|
|
|
|
{ |
620
|
|
|
|
|
|
PERL_ARGS_ASSERT_AV_CREATE_AND_UNSHIFT_ONE; |
621
|
|
|
|
|
|
|
622
|
27460
|
100
|
|
|
|
if (!*avp) |
623
|
12796
|
|
|
|
|
*avp = newAV(); |
624
|
27460
|
|
|
|
|
av_unshift(*avp, 1); |
625
|
27460
|
|
|
|
|
return av_store(*avp, 0, val); |
626
|
|
|
|
|
|
} |
627
|
|
|
|
|
|
|
628
|
|
|
|
|
|
/* |
629
|
|
|
|
|
|
=for apidoc av_unshift |
630
|
|
|
|
|
|
|
631
|
|
|
|
|
|
Unshift the given number of C values onto the beginning of the |
632
|
|
|
|
|
|
array. The array will grow automatically to accommodate the addition. You |
633
|
|
|
|
|
|
must then use C to assign values to these new elements. |
634
|
|
|
|
|
|
|
635
|
|
|
|
|
|
Perl equivalent: C |
636
|
|
|
|
|
|
|
637
|
|
|
|
|
|
=cut |
638
|
|
|
|
|
|
*/ |
639
|
|
|
|
|
|
|
640
|
|
|
|
|
|
void |
641
|
3922455
|
|
|
|
|
Perl_av_unshift(pTHX_ AV *av, SSize_t num) |
642
|
|
|
|
|
|
{ |
643
|
|
|
|
|
|
dVAR; |
644
|
|
|
|
|
|
SSize_t i; |
645
|
|
|
|
|
|
MAGIC* mg; |
646
|
|
|
|
|
|
|
647
|
|
|
|
|
|
PERL_ARGS_ASSERT_AV_UNSHIFT; |
648
|
|
|
|
|
|
assert(SvTYPE(av) == SVt_PVAV); |
649
|
|
|
|
|
|
|
650
|
3922455
|
50
|
|
|
|
if (SvREADONLY(av)) |
651
|
0
|
|
|
|
|
Perl_croak_no_modify(); |
652
|
|
|
|
|
|
|
653
|
3922455
|
100
|
|
|
|
if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) { |
|
|
50
|
|
|
|
|
654
|
0
|
0
|
|
|
|
Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(UNSHIFT), |
655
|
|
|
|
|
|
G_DISCARD | G_UNDEF_FILL, num); |
656
|
0
|
|
|
|
|
return; |
657
|
|
|
|
|
|
} |
658
|
|
|
|
|
|
|
659
|
3922455
|
100
|
|
|
|
if (num <= 0) |
660
|
|
|
|
|
|
return; |
661
|
3921459
|
100
|
|
|
|
if (!AvREAL(av) && AvREIFY(av)) |
|
|
50
|
|
|
|
|
662
|
7542
|
|
|
|
|
av_reify(av); |
663
|
3921459
|
|
|
|
|
i = AvARRAY(av) - AvALLOC(av); |
664
|
3921459
|
100
|
|
|
|
if (i) { |
665
|
2863126
|
100
|
|
|
|
if (i > num) |
666
|
|
|
|
|
|
i = num; |
667
|
2863126
|
|
|
|
|
num -= i; |
668
|
|
|
|
|
|
|
669
|
2863126
|
|
|
|
|
AvMAX(av) += i; |
670
|
2863126
|
|
|
|
|
AvFILLp(av) += i; |
671
|
2863126
|
|
|
|
|
AvARRAY(av) = AvARRAY(av) - i; |
672
|
|
|
|
|
|
} |
673
|
3921459
|
100
|
|
|
|
if (num) { |
674
|
|
|
|
|
|
SV **ary; |
675
|
1064253
|
|
|
|
|
const SSize_t i = AvFILLp(av); |
676
|
|
|
|
|
|
/* Create extra elements */ |
677
|
1064253
|
|
|
|
|
const SSize_t slide = i > 0 ? i : 0; |
678
|
1064253
|
|
|
|
|
num += slide; |
679
|
1064253
|
|
|
|
|
av_extend(av, i + num); |
680
|
1064253
|
|
|
|
|
AvFILLp(av) += num; |
681
|
1064253
|
|
|
|
|
ary = AvARRAY(av); |
682
|
1064253
|
50
|
|
|
|
Move(ary, ary + num, i + 1, SV*); |
683
|
|
|
|
|
|
do { |
684
|
2069134
|
|
|
|
|
ary[--num] = NULL; |
685
|
2069134
|
100
|
|
|
|
} while (num); |
686
|
|
|
|
|
|
/* Make extra elements into a buffer */ |
687
|
1064253
|
|
|
|
|
AvMAX(av) -= slide; |
688
|
1064253
|
|
|
|
|
AvFILLp(av) -= slide; |
689
|
2501994
|
|
|
|
|
AvARRAY(av) = AvARRAY(av) + slide; |
690
|
|
|
|
|
|
} |
691
|
|
|
|
|
|
} |
692
|
|
|
|
|
|
|
693
|
|
|
|
|
|
/* |
694
|
|
|
|
|
|
=for apidoc av_shift |
695
|
|
|
|
|
|
|
696
|
|
|
|
|
|
Removes one SV from the start of the array, reducing its size by one and |
697
|
|
|
|
|
|
returning the SV (transferring control of one reference count) to the |
698
|
|
|
|
|
|
caller. Returns C<&PL_sv_undef> if the array is empty. |
699
|
|
|
|
|
|
|
700
|
|
|
|
|
|
Perl equivalent: C |
701
|
|
|
|
|
|
|
702
|
|
|
|
|
|
=cut |
703
|
|
|
|
|
|
*/ |
704
|
|
|
|
|
|
|
705
|
|
|
|
|
|
SV * |
706
|
224641249
|
|
|
|
|
Perl_av_shift(pTHX_ AV *av) |
707
|
|
|
|
|
|
{ |
708
|
|
|
|
|
|
dVAR; |
709
|
|
|
|
|
|
SV *retval; |
710
|
|
|
|
|
|
MAGIC* mg; |
711
|
|
|
|
|
|
|
712
|
|
|
|
|
|
PERL_ARGS_ASSERT_AV_SHIFT; |
713
|
|
|
|
|
|
assert(SvTYPE(av) == SVt_PVAV); |
714
|
|
|
|
|
|
|
715
|
224641249
|
50
|
|
|
|
if (SvREADONLY(av)) |
716
|
0
|
|
|
|
|
Perl_croak_no_modify(); |
717
|
224641249
|
100
|
|
|
|
if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) { |
|
|
100
|
|
|
|
|
718
|
24
|
100
|
|
|
|
retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(SHIFT), 0, 0); |
719
|
24
|
50
|
|
|
|
if (retval) |
720
|
24
|
|
|
|
|
retval = newSVsv(retval); |
721
|
24
|
|
|
|
|
return retval; |
722
|
|
|
|
|
|
} |
723
|
224641225
|
100
|
|
|
|
if (AvFILL(av) < 0) |
|
|
100
|
|
|
|
|
724
|
|
|
|
|
|
return &PL_sv_undef; |
725
|
218947034
|
|
|
|
|
retval = *AvARRAY(av); |
726
|
218947034
|
100
|
|
|
|
if (AvREAL(av)) |
727
|
10510637
|
|
|
|
|
*AvARRAY(av) = NULL; |
728
|
218947034
|
|
|
|
|
AvARRAY(av) = AvARRAY(av) + 1; |
729
|
218947034
|
|
|
|
|
AvMAX(av)--; |
730
|
218947034
|
|
|
|
|
AvFILLp(av)--; |
731
|
218947034
|
50
|
|
|
|
if (SvSMAGICAL(av)) |
732
|
0
|
|
|
|
|
mg_set(MUTABLE_SV(av)); |
733
|
221794291
|
50
|
|
|
|
return retval ? retval : &PL_sv_undef; |
734
|
|
|
|
|
|
} |
735
|
|
|
|
|
|
|
736
|
|
|
|
|
|
/* |
737
|
|
|
|
|
|
=for apidoc av_top_index |
738
|
|
|
|
|
|
|
739
|
|
|
|
|
|
Returns the highest index in the array. The number of elements in the |
740
|
|
|
|
|
|
array is C. Returns -1 if the array is empty. |
741
|
|
|
|
|
|
|
742
|
|
|
|
|
|
The Perl equivalent for this is C<$#myarray>. |
743
|
|
|
|
|
|
|
744
|
|
|
|
|
|
(A slightly shorter form is C.) |
745
|
|
|
|
|
|
|
746
|
|
|
|
|
|
=for apidoc av_len |
747
|
|
|
|
|
|
|
748
|
|
|
|
|
|
Same as L. Returns the highest index in the array. Note that the |
749
|
|
|
|
|
|
return value is +1 what its name implies it returns; and hence differs in |
750
|
|
|
|
|
|
meaning from what the similarly named L returns. |
751
|
|
|
|
|
|
|
752
|
|
|
|
|
|
=cut |
753
|
|
|
|
|
|
*/ |
754
|
|
|
|
|
|
|
755
|
|
|
|
|
|
SSize_t |
756
|
79363742
|
|
|
|
|
Perl_av_len(pTHX_ AV *av) |
757
|
|
|
|
|
|
{ |
758
|
|
|
|
|
|
PERL_ARGS_ASSERT_AV_LEN; |
759
|
|
|
|
|
|
|
760
|
79363742
|
|
|
|
|
return av_top_index(av); |
761
|
|
|
|
|
|
} |
762
|
|
|
|
|
|
|
763
|
|
|
|
|
|
/* |
764
|
|
|
|
|
|
=for apidoc av_fill |
765
|
|
|
|
|
|
|
766
|
|
|
|
|
|
Set the highest index in the array to the given number, equivalent to |
767
|
|
|
|
|
|
Perl's C<$#array = $fill;>. |
768
|
|
|
|
|
|
|
769
|
|
|
|
|
|
The number of elements in the an array will be C after |
770
|
|
|
|
|
|
av_fill() returns. If the array was previously shorter, then the |
771
|
|
|
|
|
|
additional elements appended are set to NULL. If the array |
772
|
|
|
|
|
|
was longer, then the excess elements are freed. C is |
773
|
|
|
|
|
|
the same as C. |
774
|
|
|
|
|
|
|
775
|
|
|
|
|
|
=cut |
776
|
|
|
|
|
|
*/ |
777
|
|
|
|
|
|
void |
778
|
3197428
|
|
|
|
|
Perl_av_fill(pTHX_ AV *av, SSize_t fill) |
779
|
|
|
|
|
|
{ |
780
|
|
|
|
|
|
dVAR; |
781
|
|
|
|
|
|
MAGIC *mg; |
782
|
|
|
|
|
|
|
783
|
|
|
|
|
|
PERL_ARGS_ASSERT_AV_FILL; |
784
|
|
|
|
|
|
assert(SvTYPE(av) == SVt_PVAV); |
785
|
|
|
|
|
|
|
786
|
3197428
|
100
|
|
|
|
if (fill < 0) |
787
|
|
|
|
|
|
fill = -1; |
788
|
3197428
|
100
|
|
|
|
if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) { |
|
|
100
|
|
|
|
|
789
|
40
|
|
|
|
|
SV *arg1 = sv_newmortal(); |
790
|
40
|
|
|
|
|
sv_setiv(arg1, (IV)(fill + 1)); |
791
|
40
|
100
|
|
|
|
Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(STORESIZE), G_DISCARD, |
792
|
|
|
|
|
|
1, arg1); |
793
|
3197446
|
|
|
|
|
return; |
794
|
|
|
|
|
|
} |
795
|
3197388
|
100
|
|
|
|
if (fill <= AvMAX(av)) { |
796
|
2958988
|
|
|
|
|
SSize_t key = AvFILLp(av); |
797
|
2958988
|
|
|
|
|
SV** const ary = AvARRAY(av); |
798
|
|
|
|
|
|
|
799
|
2958988
|
50
|
|
|
|
if (AvREAL(av)) { |
800
|
4526916
|
100
|
|
|
|
while (key > fill) { |
801
|
1567928
|
|
|
|
|
SvREFCNT_dec(ary[key]); |
802
|
1567928
|
|
|
|
|
ary[key--] = NULL; |
803
|
|
|
|
|
|
} |
804
|
|
|
|
|
|
} |
805
|
|
|
|
|
|
else { |
806
|
0
|
0
|
|
|
|
while (key < fill) |
807
|
0
|
|
|
|
|
ary[++key] = NULL; |
808
|
|
|
|
|
|
} |
809
|
|
|
|
|
|
|
810
|
2958988
|
|
|
|
|
AvFILLp(av) = fill; |
811
|
2958988
|
100
|
|
|
|
if (SvSMAGICAL(av)) |
812
|
6
|
|
|
|
|
mg_set(MUTABLE_SV(av)); |
813
|
|
|
|
|
|
} |
814
|
|
|
|
|
|
else |
815
|
238400
|
|
|
|
|
(void)av_store(av,fill,NULL); |
816
|
|
|
|
|
|
} |
817
|
|
|
|
|
|
|
818
|
|
|
|
|
|
/* |
819
|
|
|
|
|
|
=for apidoc av_delete |
820
|
|
|
|
|
|
|
821
|
|
|
|
|
|
Deletes the element indexed by C from the array, makes the element mortal, |
822
|
|
|
|
|
|
and returns it. If C equals C, the element is freed and null |
823
|
|
|
|
|
|
is returned. Perl equivalent: C for the |
824
|
|
|
|
|
|
non-C version and a void-context C for the |
825
|
|
|
|
|
|
C version. |
826
|
|
|
|
|
|
|
827
|
|
|
|
|
|
=cut |
828
|
|
|
|
|
|
*/ |
829
|
|
|
|
|
|
SV * |
830
|
218
|
|
|
|
|
Perl_av_delete(pTHX_ AV *av, SSize_t key, I32 flags) |
831
|
|
|
|
|
|
{ |
832
|
|
|
|
|
|
dVAR; |
833
|
|
|
|
|
|
SV *sv; |
834
|
|
|
|
|
|
|
835
|
|
|
|
|
|
PERL_ARGS_ASSERT_AV_DELETE; |
836
|
|
|
|
|
|
assert(SvTYPE(av) == SVt_PVAV); |
837
|
|
|
|
|
|
|
838
|
218
|
50
|
|
|
|
if (SvREADONLY(av)) |
839
|
0
|
|
|
|
|
Perl_croak_no_modify(); |
840
|
|
|
|
|
|
|
841
|
218
|
100
|
|
|
|
if (SvRMAGICAL(av)) { |
842
|
112
|
|
|
|
|
const MAGIC * const tied_magic |
843
|
|
|
|
|
|
= mg_find((const SV *)av, PERL_MAGIC_tied); |
844
|
112
|
100
|
|
|
|
if ((tied_magic || mg_find((const SV *)av, PERL_MAGIC_regdata))) { |
|
|
50
|
|
|
|
|
845
|
|
|
|
|
|
SV **svp; |
846
|
58
|
100
|
|
|
|
if (key < 0) { |
847
|
6
|
50
|
|
|
|
if (!S_adjust_index(aTHX_ av, tied_magic, &key)) |
848
|
|
|
|
|
|
return NULL; |
849
|
|
|
|
|
|
} |
850
|
56
|
|
|
|
|
svp = av_fetch(av, key, TRUE); |
851
|
56
|
50
|
|
|
|
if (svp) { |
852
|
56
|
|
|
|
|
sv = *svp; |
853
|
56
|
|
|
|
|
mg_clear(sv); |
854
|
56
|
50
|
|
|
|
if (mg_find(sv, PERL_MAGIC_tiedelem)) { |
855
|
56
|
|
|
|
|
sv_unmagic(sv, PERL_MAGIC_tiedelem); /* No longer an element */ |
856
|
56
|
|
|
|
|
return sv; |
857
|
|
|
|
|
|
} |
858
|
|
|
|
|
|
return NULL; |
859
|
|
|
|
|
|
} |
860
|
|
|
|
|
|
} |
861
|
|
|
|
|
|
} |
862
|
|
|
|
|
|
|
863
|
160
|
50
|
|
|
|
if (key < 0) { |
864
|
0
|
0
|
|
|
|
key += AvFILL(av) + 1; |
865
|
0
|
0
|
|
|
|
if (key < 0) |
866
|
|
|
|
|
|
return NULL; |
867
|
|
|
|
|
|
} |
868
|
|
|
|
|
|
|
869
|
160
|
100
|
|
|
|
if (key > AvFILLp(av)) |
870
|
|
|
|
|
|
return NULL; |
871
|
|
|
|
|
|
else { |
872
|
104
|
100
|
|
|
|
if (!AvREAL(av) && AvREIFY(av)) |
|
|
50
|
|
|
|
|
873
|
2
|
|
|
|
|
av_reify(av); |
874
|
104
|
|
|
|
|
sv = AvARRAY(av)[key]; |
875
|
104
|
100
|
|
|
|
if (key == AvFILLp(av)) { |
876
|
60
|
|
|
|
|
AvARRAY(av)[key] = NULL; |
877
|
|
|
|
|
|
do { |
878
|
4072
|
|
|
|
|
AvFILLp(av)--; |
879
|
4072
|
100
|
|
|
|
} while (--key >= 0 && !AvARRAY(av)[key]); |
|
|
100
|
|
|
|
|
880
|
|
|
|
|
|
} |
881
|
|
|
|
|
|
else |
882
|
44
|
|
|
|
|
AvARRAY(av)[key] = NULL; |
883
|
104
|
50
|
|
|
|
if (SvSMAGICAL(av)) |
884
|
0
|
|
|
|
|
mg_set(MUTABLE_SV(av)); |
885
|
|
|
|
|
|
} |
886
|
104
|
100
|
|
|
|
if (flags & G_DISCARD) { |
887
|
44
|
|
|
|
|
SvREFCNT_dec(sv); |
888
|
|
|
|
|
|
sv = NULL; |
889
|
|
|
|
|
|
} |
890
|
60
|
50
|
|
|
|
else if (AvREAL(av)) |
891
|
60
|
|
|
|
|
sv = sv_2mortal(sv); |
892
|
160
|
|
|
|
|
return sv; |
893
|
|
|
|
|
|
} |
894
|
|
|
|
|
|
|
895
|
|
|
|
|
|
/* |
896
|
|
|
|
|
|
=for apidoc av_exists |
897
|
|
|
|
|
|
|
898
|
|
|
|
|
|
Returns true if the element indexed by C has been initialized. |
899
|
|
|
|
|
|
|
900
|
|
|
|
|
|
This relies on the fact that uninitialized array elements are set to |
901
|
|
|
|
|
|
NULL. |
902
|
|
|
|
|
|
|
903
|
|
|
|
|
|
Perl equivalent: C. |
904
|
|
|
|
|
|
|
905
|
|
|
|
|
|
=cut |
906
|
|
|
|
|
|
*/ |
907
|
|
|
|
|
|
bool |
908
|
2059230
|
|
|
|
|
Perl_av_exists(pTHX_ AV *av, SSize_t key) |
909
|
|
|
|
|
|
{ |
910
|
|
|
|
|
|
dVAR; |
911
|
|
|
|
|
|
PERL_ARGS_ASSERT_AV_EXISTS; |
912
|
|
|
|
|
|
assert(SvTYPE(av) == SVt_PVAV); |
913
|
|
|
|
|
|
|
914
|
2059230
|
100
|
|
|
|
if (SvRMAGICAL(av)) { |
915
|
206
|
|
|
|
|
const MAGIC * const tied_magic |
916
|
|
|
|
|
|
= mg_find((const SV *)av, PERL_MAGIC_tied); |
917
|
206
|
|
|
|
|
const MAGIC * const regdata_magic |
918
|
|
|
|
|
|
= mg_find((const SV *)av, PERL_MAGIC_regdata); |
919
|
206
|
100
|
|
|
|
if (tied_magic || regdata_magic) { |
920
|
|
|
|
|
|
MAGIC *mg; |
921
|
|
|
|
|
|
/* Handle negative array indices 20020222 MJD */ |
922
|
160
|
100
|
|
|
|
if (key < 0) { |
923
|
18
|
100
|
|
|
|
if (!S_adjust_index(aTHX_ av, tied_magic, &key)) |
924
|
|
|
|
|
|
return FALSE; |
925
|
|
|
|
|
|
} |
926
|
|
|
|
|
|
|
927
|
156
|
50
|
|
|
|
if(key >= 0 && regdata_magic) { |
928
|
0
|
0
|
|
|
|
if (key <= AvFILL(av)) |
|
|
0
|
|
|
|
|
929
|
|
|
|
|
|
return TRUE; |
930
|
|
|
|
|
|
else |
931
|
0
|
|
|
|
|
return FALSE; |
932
|
|
|
|
|
|
} |
933
|
|
|
|
|
|
{ |
934
|
156
|
|
|
|
|
SV * const sv = sv_newmortal(); |
935
|
156
|
|
|
|
|
mg_copy(MUTABLE_SV(av), sv, 0, key); |
936
|
156
|
|
|
|
|
mg = mg_find(sv, PERL_MAGIC_tiedelem); |
937
|
156
|
50
|
|
|
|
if (mg) { |
938
|
156
|
|
|
|
|
magic_existspack(sv, mg); |
939
|
|
|
|
|
|
{ |
940
|
156
|
50
|
|
|
|
I32 retbool = SvTRUE_nomg_NN(sv); |
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
941
|
156
|
|
|
|
|
return cBOOL(retbool); |
942
|
|
|
|
|
|
} |
943
|
|
|
|
|
|
} |
944
|
|
|
|
|
|
} |
945
|
|
|
|
|
|
} |
946
|
|
|
|
|
|
} |
947
|
|
|
|
|
|
|
948
|
2059070
|
50
|
|
|
|
if (key < 0) { |
949
|
0
|
0
|
|
|
|
key += AvFILL(av) + 1; |
950
|
0
|
0
|
|
|
|
if (key < 0) |
951
|
|
|
|
|
|
return FALSE; |
952
|
|
|
|
|
|
} |
953
|
|
|
|
|
|
|
954
|
2059070
|
100
|
|
|
|
if (key <= AvFILLp(av) && AvARRAY(av)[key]) |
|
|
100
|
|
|
|
|
955
|
|
|
|
|
|
{ |
956
|
|
|
|
|
|
return TRUE; |
957
|
|
|
|
|
|
} |
958
|
|
|
|
|
|
else |
959
|
1760530
|
|
|
|
|
return FALSE; |
960
|
|
|
|
|
|
} |
961
|
|
|
|
|
|
|
962
|
|
|
|
|
|
static MAGIC * |
963
|
50840
|
|
|
|
|
S_get_aux_mg(pTHX_ AV *av) { |
964
|
|
|
|
|
|
dVAR; |
965
|
|
|
|
|
|
MAGIC *mg; |
966
|
|
|
|
|
|
|
967
|
|
|
|
|
|
PERL_ARGS_ASSERT_GET_AUX_MG; |
968
|
|
|
|
|
|
assert(SvTYPE(av) == SVt_PVAV); |
969
|
|
|
|
|
|
|
970
|
50840
|
|
|
|
|
mg = mg_find((const SV *)av, PERL_MAGIC_arylen_p); |
971
|
|
|
|
|
|
|
972
|
50840
|
100
|
|
|
|
if (!mg) { |
973
|
15520
|
|
|
|
|
mg = sv_magicext(MUTABLE_SV(av), 0, PERL_MAGIC_arylen_p, |
974
|
|
|
|
|
|
&PL_vtbl_arylen_p, 0, 0); |
975
|
|
|
|
|
|
assert(mg); |
976
|
|
|
|
|
|
/* sv_magicext won't set this for us because we pass in a NULL obj */ |
977
|
15520
|
|
|
|
|
mg->mg_flags |= MGf_REFCOUNTED; |
978
|
|
|
|
|
|
} |
979
|
50840
|
|
|
|
|
return mg; |
980
|
|
|
|
|
|
} |
981
|
|
|
|
|
|
|
982
|
|
|
|
|
|
SV ** |
983
|
50398
|
|
|
|
|
Perl_av_arylen_p(pTHX_ AV *av) { |
984
|
50398
|
|
|
|
|
MAGIC *const mg = get_aux_mg(av); |
985
|
|
|
|
|
|
|
986
|
|
|
|
|
|
PERL_ARGS_ASSERT_AV_ARYLEN_P; |
987
|
|
|
|
|
|
assert(SvTYPE(av) == SVt_PVAV); |
988
|
|
|
|
|
|
|
989
|
50398
|
|
|
|
|
return &(mg->mg_obj); |
990
|
|
|
|
|
|
} |
991
|
|
|
|
|
|
|
992
|
|
|
|
|
|
IV * |
993
|
442
|
|
|
|
|
Perl_av_iter_p(pTHX_ AV *av) { |
994
|
442
|
|
|
|
|
MAGIC *const mg = get_aux_mg(av); |
995
|
|
|
|
|
|
|
996
|
|
|
|
|
|
PERL_ARGS_ASSERT_AV_ITER_P; |
997
|
|
|
|
|
|
assert(SvTYPE(av) == SVt_PVAV); |
998
|
|
|
|
|
|
|
999
|
|
|
|
|
|
#if IVSIZE == I32SIZE |
1000
|
|
|
|
|
|
return (IV *)&(mg->mg_len); |
1001
|
|
|
|
|
|
#else |
1002
|
442
|
100
|
|
|
|
if (!mg->mg_ptr) { |
1003
|
|
|
|
|
|
IV *temp; |
1004
|
36
|
|
|
|
|
mg->mg_len = IVSIZE; |
1005
|
36
|
|
|
|
|
Newxz(temp, 1, IV); |
1006
|
36
|
|
|
|
|
mg->mg_ptr = (char *) temp; |
1007
|
|
|
|
|
|
} |
1008
|
442
|
|
|
|
|
return (IV *)mg->mg_ptr; |
1009
|
|
|
|
|
|
#endif |
1010
|
|
|
|
|
|
} |
1011
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
/* |
1013
|
|
|
|
|
|
* Local variables: |
1014
|
|
|
|
|
|
* c-indentation-style: bsd |
1015
|
|
|
|
|
|
* c-basic-offset: 4 |
1016
|
|
|
|
|
|
* indent-tabs-mode: nil |
1017
|
|
|
|
|
|
* End: |
1018
|
|
|
|
|
|
* |
1019
|
|
|
|
|
|
* ex: set ts=8 sts=4 sw=4 et: |
1020
|
|
|
|
|
|
*/ |